/[pub]/suikawiki/script/bin/mkplugin2.pl
Suika

Diff of /suikawiki/script/bin/mkplugin2.pl

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.13 by wakaba, Sat Feb 14 10:59:55 2004 UTC revision 1.19 by wakaba, Sun Jul 25 06:54:28 2004 UTC
# Line 59  sub code ($$) { Line 59  sub code ($$) {
59      $code =~ s/\$$_\b/$Info->{const}->{$_}/ge;      $code =~ s/\$$_\b/$Info->{const}->{$_}/ge;
60    }    }
61    $code =~ s/__FUNCPACK__/$Info->{module_name}/g;    $code =~ s/__FUNCPACK__/$Info->{module_name}/g;
62      $code =~ s/__FUNCPACK{([^{}]+)}__/(\$SuikaWiki::Plugin::Registry::Info{@{[literal $1]}}->{module_name} || SuikaWiki::Plugin->module_package (@{[literal $1]}))/g;
63      $code =~ s{<Q:([^:]+):([^>]+)>}{
64        if ($Info->{Namespace}->{$1}) {
65          literal $Info->{Namespace}->{$1}.$2;
66        } else {
67          warn qq(Namespace prefix "$1" not defined);
68          literal $2;
69        }
70      }ge;
71      
72    $Info->{-message_error_used} = 1 if $code =~ /\buse\s+Message::Util::Error\b/;    $Info->{-message_error_used} = 1 if $code =~ /\buse\s+Message::Util::Error\b/;
73    if (not $Info->{-message_error_used} and    if (not $Info->{-message_error_used} and
74       ($code =~ /\btry\s*\{/ or $code =~ /\bcatch\s*\{/)) {       ($code =~ /\btry\s*\{/ or $code =~ /\bcatch\s*\{/)) {
# Line 107  sub literal_or_code ($$) { Line 117  sub literal_or_code ($$) {
117    substr ($s, 0, 1) ne '{' ? literal ($s)    substr ($s, 0, 1) ne '{' ? literal ($s)
118                             : code ($Info, substr ($s, 1, length ($s) - 2));                             : code ($Info, substr ($s, 1, length ($s) - 2));
119  }  }
120    sub expanded_uri ($$$) {
121      my ($Info, $prefix, $lname) = @_;
122      warn "$0: $prefix: Namespace prefix not declared";
123      $Info->{Namespace}->{$prefix} . $lname;
124    }
125    
126  my $parser = Message::Markup::SuikaWikiConfig20::Parser->new;  my $parser = Message::Markup::SuikaWikiConfig20::Parser->new;
127  my $plugins = $parser->parse_text ($src);  my $plugins = $parser->parse_text ($src);
# Line 163  print qq{\$Info{$Info{name_literal}}->{A Line 178  print qq{\$Info{$Info{name_literal}}->{A
178  } grep { $_->local_name eq 'Author' } @{$meta->child_nodes}  } grep { $_->local_name eq 'Author' } @{$meta->child_nodes}
179  ). qq{];\n};  ). qq{];\n};
180    
181    for (@{$meta->get_attribute ('Namespace', make_new_node => 1)->child_nodes}) {
182      $Info{Namespace}->{$_->local_name} = $_->value;
183    }
184    
185  my $use = $meta->get_attribute ('Use');  my $use = $meta->get_attribute ('Use');
186  if (ref $use) {  if (ref $use) {
187    print change_package \%Info, $Info{module_name};    print change_package \%Info, $Info{module_name};
# Line 186  for (@{$plugins->child_nodes}) { Line 205  for (@{$plugins->child_nodes}) {
205      register_plugin_const ($_, \%Info);      register_plugin_const ($_, \%Info);
206    } elsif ($_->local_name eq 'Format') {    } elsif ($_->local_name eq 'Format') {
207      print "\n", make_format ($_, \%Info);      print "\n", make_format ($_, \%Info);
208      } elsif ($_->local_name eq 'FormattingRuleAlias') {
209        print "\n", make_rule_alias ($_, \%Info);
210  # Parameter  # Parameter
211  # PluginCategory  # PluginCategory
212    }    }
# Line 213  sub make_format ($$) { Line 234  sub make_format ($$) {
234      $r .= qq{push \@ISA, 'SuikaWiki::Format::Definition::template';\n};          $r .= qq{push \@ISA, 'SuikaWiki::Format::Definition::template';\n};    
235    }    }
236    if (my $name = $src->get_attribute_value ('Name')) {    if (my $name = $src->get_attribute_value ('Name')) {
237      $r .= qq{\$SuikaWiki::Format::Definition::Class{@{[literal '/'.$name.'/'.$src->get_attribute_value ('Version', default => '').'//']}} = '$module_name';\n};      $r .= qq{\$SuikaWiki::Format::Definition::Class{@{[literal 'MAGIC:'.$name.'/'.$src->get_attribute_value ('Version', default => '').'##']}} = '$module_name';\n};
238    }    }
239    if (my $type = $src->get_attribute_value ('Type')) {    if (my $type = $src->get_attribute_value ('Type')) {
240      $type .= join '', map {      $type .= join '', map {
# Line 221  sub make_format ($$) { Line 242  sub make_format ($$) {
242               } sort {               } sort {
243                 $a->local_name cmp $b->local_name                 $a->local_name cmp $b->local_name
244               } @{$src->get_attribute ('Type')->child_nodes};               } @{$src->get_attribute ('Type')->child_nodes};
245      $r .= qq{\$SuikaWiki::Format::Definition::Class{@{[literal $type.'//']}} = '$module_name';\n};      $r .= qq{\$SuikaWiki::Format::Definition::Class{@{[literal 'IMT:'.$type.'##']}} = '$module_name';\n};
246    }    }
247        
248    my $convert = line $Info, line_no => __LINE__ + 2, realfile => __FILE__;    my $convert = line $Info, line_no => __LINE__ + 2, realfile => __FILE__;
# Line 229  sub make_format ($$) { Line 250  sub make_format ($$) {
250  our $Converter;  our $Converter;
251  sub convert ($$;%) {  sub convert ($$;%) {
252    my ($self, $source, %opt) = @_;    my ($self, $source, %opt) = @_;
253    my $converter;    my $t = SuikaWiki::Format::Definition->serialize_media_type (%opt);
254    my $flag = '//';    my $converter = $Converter->{$t->{_}};
   $flag .= 'f' if $opt{IsFragment};  
   $flag .= 'p' if $opt{IsPlaceholder};  
   my $type = $opt{Type} ?  
                 $opt{Type} .  
                 SuikaWiki::Format::Definition->__get_param_string  
                   ($opt{Type_param}) : undef;  
   if ($Converter->{$type.$flag}) {  
     $converter = $Converter->{$type.$flag};  
   } elsif ($Converter->{$opt{Name}.'/'.$opt{Version}.$flag}) {  
     $converter = $Converter->{'/'.$opt{Name}.'/'.$opt{Version}.$flag};  
   }  
255    return ($converter->{$opt{return_type} or 'Main'} or    return ($converter->{$opt{return_type} or 'Main'} or
256            CORE::die "Buggy implementation: $type $opt{Name}/$opt{Version}$flag/@{[$opt{return_type} or 'Main']} not defined")            CORE::die "Buggy implementation: $t->{_}/@{[$opt{return_type} or 'Main']} not defined")
257           ->($self, $source, \%opt)           ->($self, $source, \%opt)
258      if $converter;      if $converter;
259    $self->SUPER::convert ($source, %opt);    $self->SUPER::convert ($source, %opt);
# Line 278  EOH Line 288  EOH
288        $r .= code $Info, $_->get_attribute_value ('Main');        $r .= code $Info, $_->get_attribute_value ('Main');
289        $r .= line $Info, reset => 1;        $r .= line $Info, reset => 1;
290        $r .= qq(}\n);        $r .= qq(}\n);
291        } elsif ({qw/content_written 1 content_removed 1 content_type_changed_from 1
292                     content_prop_modified 1/}
293                 ->{my $node_name = $_->local_name}) {
294          $r .= q(sub ).$node_name
295             .  q( {)."\n".q(my ($self, %opt) = @_;)
296             .  line $Info, node_path => qq(Format[module-name()=$module_name]/$node_name]);
297          $r .= code $Info, $_->get_attribute_value ('Main');
298          $r .= line $Info, reset => 1;
299          $r .= qq(}\n);
300      } elsif ($_->local_name eq 'Use') {      } elsif ($_->local_name eq 'Use') {
301        $r .= line $Info, node_path => qq(Format[module-name()=$module_name]/Use);        $r .= line $Info, node_path => qq(Format[module-name()=$module_name]/Use);
302        $r .= code $Info, $_->inner_text;        $r .= code $Info, $_->inner_text;
303        } elsif ($_->local_name eq 'Prop') {
304          $r .= q<sub prop ($$;%) { my ($self, $name, %opt) = @_;>;
305          my $f = 0;
306          for my $prop (@{$_->child_nodes}) {
307            if ($prop->local_name =~ /^([^:]+):([^:]+)$/) {
308              $r .= qq{if (\$name eq @{[literal expanded_uri $Info, $1, $2]}) { return @{[literal $prop->value]} } els};
309              $f = 1;
310            }
311          }
312          $r .= q<e {> if $f;
313          $r .= q{$self->SUPER::prop ($name, %opt);};
314          $r .= q<}> if $f;
315          $r .= qq<\n}\n>;
316      }      }
317    }    }
318    $r;    $r;
# Line 289  EOH Line 321  EOH
321  sub make_format_converter ($$) {  sub make_format_converter ($$) {
322    my ($src, $Info) = @_;    my ($src, $Info) = @_;
323    my %def;    my %def;
324    $def{Type} = $src->get_attribute ('Type');    for (qw/Type Name Version TypeURIReference IsFragment IsPlaceholder/) {
325    if (ref $def{Type}) {      $def{$_} = $src->get_attribute_value ($_);
326      $def{Type} = $def{Type}->inner_text      delete $def{$_} unless defined $def{$_};
327            . join '', map {    }
328                ';'. $_->local_name .'='. quoted_string $_->inner_text    $def{Type_param} = {map {$_->local_name => $_->value}
329              } sort {                                @{$src->get_attribute ('Type', make_new_node => 1)
330                $a->local_name cmp $b->local_name                                    ->child_nodes}};
331              } @{$def{Type}->child_nodes};    my $type = serialize_media_type ($Info,
332    } else {                 Type => $def{Type},
333      delete $def{Type};                 Type_param => $def{Type_param},
334    }                 Name => $def{Name},
335    $def{Name} = $src->get_attribute_value ('Name');                 Version => $def{Version},
336    delete $def{Name} unless defined $def{Name};                 URIReference => $def{TypeURIReference},
337    $def{Version} = $src->get_attribute_value ('Version');                 IsFragment => $def{IsFragment},
338    delete $def{Version} if not defined $def{Version} or                 IsPlaceholder => $def{IsPlaceholder});
339                            not defined $def{Name};    $def{serialized_type} = $type->{_};
     
   my $flag = '//';  
   $flag .= 'f' and $def{IsFragment} = 1  
     if $src->get_attribute_value ('IsFragment');  
   $flag .= 'p' and $def{IsPlaceholder} = 1  
     if $src->get_attribute_value ('IsPlaceholder');  
340        
341    for (qw/Main ToString ToOctetStream/) {    for (qw/Main ToString ToOctetStream/) {
342      my $def = $src->get_attribute_value ($_);      my $def = $src->get_attribute_value ($_);
# Line 327  sub make_format_converter ($$) { Line 353  sub make_format_converter ($$) {
353    }    }
354        
355    my $r = list %def;    my $r = list %def;
356    if ($def{Type}) {    if ($type->{Type}) {
357      $r = qq{\$Converter->{@{[literal $def{Type}.$flag]}} = {$r};\n};      $r = qq{\$Converter->{@{[literal $type->{Type}]}} = {$r};\n};
358      $r .= qq{\$Converter->{@{[literal '/'.$def{Name}.'/'.$def{Version}.$flag]}} = \$Converter->{@{[literal $def{Type}.$flag]}};\n}      $r .= qq{\$Converter->{@{[literal $type->{Magic}]}} = \$Converter->{@{[literal $type->{Type}]}};\n}
359        if $def{Name};        if $type->{Magic};
360    } elsif ($def{Name}) {      $r .= qq{\$Converter->{@{[literal $type->{URIReference}]}} = \$Converter->{@{[literal $type->{Type}]}};\n}
361      $r = qq{\$Converter->{@{[literal '/'.$def{Name}.'/'.$def{Version}.$flag]}} = {$r};\n};        if $type->{URIReference};
362      } elsif ($type->{Magic}) {
363        $r = qq{\$Converter->{@{[literal $type->{Magic}]}} = {$r};\n};
364        $r .= qq{\$Converter->{@{[literal $type->{URIReference}]}} = \$Converter->{@{[literal $type->{Magic}]}};\n}
365          if $type->{URIReference};
366      } elsif ($type->{URIReference}) {
367        $r = qq{\$Converter->{@{[literal $type->{URIReference}]}} = {$r};\n};
368    } else {    } else {
369      $r = 'BEGIN { die "Invalid Syntax of Converter: Type or Name property required" }';      $r = 'BEGIN { die "Invalid Syntax of Converter: Type or Name or TypeURIReference property required" }';
370    }    }
371    $r;    $r;
372  }  }
373    
374    sub serialize_media_type ($%) {
375      my ($Info, %opt) = @_;
376      my %return;
377      if ($opt{Type}) {
378        $return{Type} = 'IMT:'.$opt{Type};
379        if ($opt{Type_param}) {
380          $return{Type} .= join '', map {my $s;
381                             ';'. $_ .'="'
382                           . (($s = $opt{Type_param}->{$_}) =~ s/([\\"])/\\$1/g, $s)
383                           . '"'
384                           } sort {
385                             $a cmp $b
386                           } keys %{$opt{Type_param}};
387        }
388      }
389      if ($opt{Magic}) {
390        $return{Magic} = 'MAGIC:'.$opt{Magic};
391      } elsif ($opt{Name}) {
392        $return{Name} = 'MAGIC:'.$opt{Name}.'/*';
393        $return{Magic} = 'MAGIC:'.$opt{Name}.'/'.$opt{Version} if $opt{Version};
394      }
395      if ($opt{URIReference}) {
396        $return{URIReference} = $opt{URIReference};
397      }
398      my $flag = '##';
399      $flag .= 'f' if $opt{IsFragment};
400      $flag .= 'p' if $opt{IsPlaceholder};
401      for (qw/URIReference Type Magic Name/) {
402        $return{$_} .= $flag if $return{$_};
403      }
404      $return{_} = $return{URIReference} || $return{Type}
405                || $return{Magic} || $return{Name};
406      \%return;
407    }
408    
409    
410  sub make_function ($$) {  sub make_function ($$) {
411    my ($src, $Info) = @_;    my ($src, $Info) = @_;
412    ## TODO: support of ARGV property    ## TODO: support of ARGV property
# Line 461  EOH Line 529  EOH
529    
530  sub make_view_template_method ($$) {  sub make_view_template_method ($$) {
531    my ($src, $Info, $ViewProp) = @_;    my ($src, $Info, $ViewProp) = @_;
532      my $media_type = $src->get_attribute_value
533                                ('media-type',
534                                 default => q<application/octet-stream>);
535    my $r = <<EOH;    my $r = <<EOH;
536    
537  sub main (\$\$\$) {  sub main (\$\$\$) {
# Line 485  sub main (\$\$\$) { Line 556  sub main (\$\$\$) {
556       $x?q{$opt2->{output}->{status_code} = }.(0 + $x).q{;}:q{}}]}       $x?q{$opt2->{output}->{status_code} = }.(0 + $x).q{;}:q{}}]}
557    @{[do{my $x=$src->get_attribute('http-status-phrase',make_new_node=>1)->inner_text;    @{[do{my $x=$src->get_attribute('http-status-phrase',make_new_node=>1)->inner_text;
558       $x?q{$opt2->{output}->{status_phrase} = }.literal($x).q{;}:q{}}]}       $x?q{$opt2->{output}->{status_phrase} = }.literal($x).q{;}:q{}}]}
559    \$opt2->{output}->{entity}->{media_type} = @{[literal    \$opt2->{output}->{entity}->{media_type} = @{[literal $media_type]};
560                             $src->get_attribute ('media-type',make_new_node=>1)  
                                ->inner_text || 'application/octet-stream']};  
561    @{[($src->get_attribute ('use-media-type-charset',make_new_node=>1)    @{[($src->get_attribute ('use-media-type-charset',make_new_node=>1)
562              ->inner_text || 0) ?              ->inner_text || 0) ?
563       q{$opt2->{output}->{entity}->{charset} = $self->{view}->{wiki}->{config}->{charset}->{output};}:       q{$opt2->{output}->{entity}->{charset} = $self->{view}->{wiki}->{config}->{charset}->{output};}:
# Line 507  sub main (\$\$\$) { Line 577  sub main (\$\$\$) {
577    \$self->{view}->{wiki}->init_db;    \$self->{view}->{wiki}->init_db;
578    \$self->main_pre (\$opt, \$opt2);    \$self->main_pre (\$opt, \$opt2);
579        
580      @{[$media_type eq 'text/html' ? q{require Message::Markup::XML::Serialize::HTML;} : '']}
581    use Message::Util::Error;    use Message::Util::Error;
582    try {    try {
583      \$opt2->{output}->{entity}->{body}      \$opt2->{output}->{entity}->{body}
584        = SuikaWiki::Plugin->formatter ('view')        = @{[$media_type eq 'text/html' ? q{Message::Markup::XML::Serialize::HTML::html_simple} : '']}
585          ->replace (\$opt2->{template}, param => \$opt2->{o});          (SuikaWiki::Plugin->formatter ('view')
586            ->replace (\$opt2->{template}, param => \$opt2->{o}));
587    } \$self->{view}->{wiki}->{config}->{catch}->{ @{[    } \$self->{view}->{wiki}->{config}->{catch}->{ @{[
588         $ViewProp->{Name} eq '-error' ? 'formatter_view_error'         $ViewProp->{Name} eq '-error' ? 'formatter_view_error'
589                                       : 'formatter_view' ]} };                                       : 'formatter_view' ]} };
# Line 615  EOH Line 687  EOH
687    $r;    $r;
688  }  }
689    
690    =item FormattingRuleAlias
691    
692    Generating an alias name for a formatting rule that is already loaded.
693    Example:
694    
695      FormattingRuleAlias:
696        @Category[list]:
697          category-1
698          category-2
699          ...
700        @Name: new-rule-name
701        @Reference:
702          @@Category: one-of-category
703          @@Name: one-of-name
704    
705    associates C<(I<category-1>, I<new-rule-name>)>,
706    C<(I<category-2>, I<new-rule-name>)>, ...
707    with C<(I<one-of-category>, I<one-of-name>)>.
708    
709    =cut
710    
711    sub make_rule_alias ($$) {
712      my ($src, $Info) = @_;
713      my $type = $src->get_attribute ('Category', make_new_node => 1)->value || [];
714      my $name = $src->get_attribute ('Name', make_new_node => 1)->value;
715      
716      my $ref = $src->get_attribute ('Reference', make_new_node => 1);
717      my $c = $ref->get_attribute_value ('Category');
718      my $n = $ref->get_attribute_value ('Name');
719      
720      s/(?<=.)-/_/g for $n, $name;
721      tr/-/_/ for $c, @$type;
722      
723      my $def = qq{\$SuikaWiki::Plugin::Rule{@{[literal $c]}}->{@{[literal $n]}} or warn qq{Formatting rule "$c/$n" not defined}};
724      
725      my $r = change_package $Info, $Info->{module_name};
726      for my $type (@$type) {
727        $r .= qq{\$SuikaWiki::Plugin::Rule{@{[literal $type]}}->{@{[literal $name]}} = $def;\n};
728        push @{$Info->{provide}->{rule}->{$type}}, $name;
729      }
730      $r;
731    }
732    
733    
734  sub random_module_name ($;$) {  sub random_module_name ($;$) {
735    my ($Info, $subname) = @_;    my ($Info, $subname) = @_;
# Line 625  sub random_module_name ($;$) { Line 740  sub random_module_name ($;$) {
740      sprintf ('%02d%02d%02d%02d%02d%02d', @date[5,4,3,2,1,0]),      sprintf ('%02d%02d%02d%02d%02d%02d', @date[5,4,3,2,1,0]),
741      join ('', @rand[rand@rand,rand@rand,rand@rand,rand@rand]);      join ('', @rand[rand@rand,rand@rand,rand@rand,rand@rand]);
742  }  }
743    
744    =head1 NAME
745    
746    mkplugin2.pl - SuikaWiki: WikiPlugin Generator
747    
748    =head1 SYNOPSIS
749    
750      mkplugin2.pl pluginsrc.wp2 > plugin.pm
751    
752    =head1 DESCRIPTION
753    
754    C<mkplugin2.pl> generates WikiPlugin module as a Perl module file
755    from WikiPlugin source description.  WikiPlugin source description
756    is described in SuikaWikiConfig/2.0 format and it contains
757    definitions of wiki constructions (such as formatting rules and
758    WikiView definitions) as both machine understandable code and
759    human readable documentation.  For more information, see
760    <http://suika.fam.cx/~wakaba/-temp/wiki/wiki?WikiPlugin>.
761    
762    This script is part of SuikaWiki.
763    
764    =head1 HISTORY AND COMPATIBILITY
765    
766    C<mkplugin2.pl> introduced as part of SuikaWiki 3.
767    It converts SuikaWiki 3 WikiPlugin source descriptions
768    (in SuikaWikiConfig/2.0) into Perl modules with SuikaWiki 3 interface.
769    
770    SuikaWiki 2 has C<mkplugin.pl>.  It also converts WikiPlugin
771    source descriptions into Perl modules.  But it support
772    SuikaWiki 2 format of WikiPlugin source description that differs from
773    SuikaWiki 3 format.  Wiki programming interface (not limited to
774    WikiPlugin related one) of SuikaWiki 3 also incompatible with that
775    of SuikaWiki 2 so that it is impossible to use SuikaWiki 2 WikiPlugin
776    module with SuikaWiki 3 and vice versa.
777    
778    =head1 SEE ALSO
779    
780    C<SuikaWiki::Plugin>, SuikaWiki:WikiPlugin
781    <http://suika.fam.cx/~wakaba/-temp/wiki/wiki?WikiPlugin>.
782    
783    =head1 LICENSE
784    
785    Copyright 2003-2004 Wakaba <w@suika.fam.cx>.  All rights reserved.
786    
787    This program is free software; you can redistribute it and/or
788    modify it under the same terms as Perl itself.
789    
790    =cut
791    
792    1; # $Date$
Legend:
Removed from v.1.13  
changed lines
  Added in v.1.19
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24