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