/[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.10 by wakaba, Fri Jan 16 08:06:06 2004 UTC revision 1.18 by wakaba, Thu Jun 3 06:38:48 2004 UTC
# Line 56  sub barecode ($) { Line 56  sub barecode ($) {
56  sub code ($$) {  sub code ($$) {
57    my ($Info, $code) = @_;    my ($Info, $code) = @_;
58    for (keys %{$Info->{const}}) {    for (keys %{$Info->{const}}) {
59      $code =~ s/\$$_\b/literal $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{<Q:([^:]+):([^>]+)>}{
63        if ($Info->{Namespace}->{$1}) {
64          literal $Info->{Namespace}->{$1}.$2;
65        } else {
66          warn qq(Namespace prefix "$1" not defined);
67          literal $2;
68        }
69      }ge;
70      
71      $Info->{-message_error_used} = 1 if $code =~ /\buse\s+Message::Util::Error\b/;
72      if (not $Info->{-message_error_used} and
73         ($code =~ /\btry\s*\{/ or $code =~ /\bcatch\s*\{/)) {
74        warn "Message::Util::Error MUST be 'use'd before 'try'...'catch' block used";
75      }
76    $code;    $code;
77  }  }
78  sub change_package ($$) {  sub change_package ($$) {
# Line 128  our \%Info; Line 142  our \%Info;
142  \$Info{$Info{name_literal}}->{Name} = $Info{name_literal};  \$Info{$Info{name_literal}}->{Name} = $Info{name_literal};
143  EOH  EOH
144  for (qw/Version InterfaceVersion mkpluginVersion module_name/) {  for (qw/Version InterfaceVersion mkpluginVersion module_name/) {
145    print qq{\$Info{$Info{name_literal}}->{$_} = @{[literal $Info{$_}]};\n};    print qq{\$Info{$Info{name_literal}}->{@{[literal $_]}} = @{[literal $Info{$_}]};\n};
146  }  }
147  for (qw/LastModified/) {  for (qw/LastModified Date.RCS/) {
148    $Info{$_} = n11n $meta->get_attribute ($_,make_new_node=>1)->value;    $Info{$_} = n11n $meta->get_attribute ($_,make_new_node=>1)->value;
149    next unless length $Info{$_};    next unless length $Info{$_};
150    print qq{\$Info{$Info{name_literal}}->{$_} = } . literal $Info{$_};    print qq{\$Info{$Info{name_literal}}->{@{[literal $_]}} = } . literal $Info{$_};
151    print ";\n";    print ";\n";
152  }  }
153  for (qw/RequiredPlugin RequiredModule/) {  for (qw/RequiredPlugin RequiredModule/) {
# Line 158  print qq{\$Info{$Info{name_literal}}->{A Line 172  print qq{\$Info{$Info{name_literal}}->{A
172  } grep { $_->local_name eq 'Author' } @{$meta->child_nodes}  } grep { $_->local_name eq 'Author' } @{$meta->child_nodes}
173  ). qq{];\n};  ). qq{];\n};
174    
175    for (@{$meta->get_attribute ('Namespace', make_new_node => 1)->child_nodes}) {
176      $Info{Namespace}->{$_->local_name} = $_->value;
177    }
178    
179  my $use = $meta->get_attribute ('Use');  my $use = $meta->get_attribute ('Use');
180  if (ref $use) {  if (ref $use) {
181    print change_package \%Info, $Info{module_name};    print change_package \%Info, $Info{module_name};
182    print line \%Info, node_path => 'Plugin/Use';    print line \%Info, node_path => 'Plugin/Use';
183    print $use->inner_text, "\n";    print code \%Info, $use->inner_text;
184    print line \%Info, reset => 1;    print line \%Info, reset => 1;
185  }  }
186    
# Line 181  for (@{$plugins->child_nodes}) { Line 199  for (@{$plugins->child_nodes}) {
199      register_plugin_const ($_, \%Info);      register_plugin_const ($_, \%Info);
200    } elsif ($_->local_name eq 'Format') {    } elsif ($_->local_name eq 'Format') {
201      print "\n", make_format ($_, \%Info);      print "\n", make_format ($_, \%Info);
202      } elsif ($_->local_name eq 'FormattingRuleAlias') {
203        print "\n", make_rule_alias ($_, \%Info);
204  # Parameter  # Parameter
205  # PluginCategory  # PluginCategory
206    }    }
# Line 198  sub make_format ($$) { Line 218  sub make_format ($$) {
218    my ($src, $Info) = @_;    my ($src, $Info) = @_;
219    my $module_name = 'SuikaWiki::Format::Definition::'.$src->get_attribute_value ('ModuleName');    my $module_name = 'SuikaWiki::Format::Definition::'.$src->get_attribute_value ('ModuleName');
220    my $r = change_package $Info, $module_name;    my $r = change_package $Info, $module_name;
221      local $Info->{-message_error_used} = 0;  
222    $r .= qq{our \@ISA;\n};    $r .= qq{our \@ISA;\n};
223    if (my $isa = $src->get_attribute_value ('Inherit')) {    if (my $isa = $src->get_attribute_value ('Inherit')) {
224      for (@$isa) {      for (@$isa) {
# Line 207  sub make_format ($$) { Line 228  sub make_format ($$) {
228      $r .= qq{push \@ISA, 'SuikaWiki::Format::Definition::template';\n};          $r .= qq{push \@ISA, 'SuikaWiki::Format::Definition::template';\n};    
229    }    }
230    if (my $name = $src->get_attribute_value ('Name')) {    if (my $name = $src->get_attribute_value ('Name')) {
231      $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};
232    }    }
233    if (my $type = $src->get_attribute_value ('Type')) {    if (my $type = $src->get_attribute_value ('Type')) {
234      $type .= join '', map {      $type .= join '', map {
# Line 215  sub make_format ($$) { Line 236  sub make_format ($$) {
236               } sort {               } sort {
237                 $a->local_name cmp $b->local_name                 $a->local_name cmp $b->local_name
238               } @{$src->get_attribute ('Type')->child_nodes};               } @{$src->get_attribute ('Type')->child_nodes};
239      $r .= qq{\$SuikaWiki::Format::Definition::Class{@{[literal $type.'//']}} = '$module_name';\n};      $r .= qq{\$SuikaWiki::Format::Definition::Class{@{[literal 'IMT:'.$type.'##']}} = '$module_name';\n};
240    }    }
241        
242    my $convert = line $Info, line_no => __LINE__ + 2, realfile => __FILE__;    my $convert = line $Info, line_no => __LINE__ + 2, realfile => __FILE__;
# Line 223  sub make_format ($$) { Line 244  sub make_format ($$) {
244  our $Converter;  our $Converter;
245  sub convert ($$;%) {  sub convert ($$;%) {
246    my ($self, $source, %opt) = @_;    my ($self, $source, %opt) = @_;
247    my $converter;    my $t = SuikaWiki::Format::Definition->serialize_media_type (%opt);
248    my $flag = '//';    my $converter = $Converter->{$t->{_}};
249    $flag .= 'f' if $opt{IsFragment};    return ($converter->{$opt{return_type} or 'Main'} or
250    $flag .= 'p' if $opt{IsPlaceholder};            CORE::die "Buggy implementation: $t->{_}/@{[$opt{return_type} or 'Main']} not defined")
251    if ($Converter->{$opt{Type}.$flag}) {           ->($self, $source, \%opt)
252      $converter = $Converter->{$opt{Type}.$flag};      if $converter;
   } elsif ($Converter->{$opt{Name}.'/'.$opt{Version}.$flag}) {  
     $converter = $Converter->{'/'.$opt{Name}.'/'.$opt{Version}.$flag};  
   }  
   return $converter->{Main}->($self, $source, \%opt) if $converter;  
253    $self->SUPER::convert ($source, %opt);    $self->SUPER::convert ($source, %opt);
254  }  }
255  EOH  EOH
# Line 251  EOH Line 268  EOH
268        $r .= code $Info, $_->get_attribute_value ('Main');        $r .= code $Info, $_->get_attribute_value ('Main');
269        $r .= line $Info, reset => 1;        $r .= line $Info, reset => 1;
270        $r .= qq(}\n);        $r .= qq(}\n);
271        } elsif ($_->local_name eq 'HeadSummary') {
272          $r .= q(sub headsummary {)."\n".q(my ($self, $source, %opt) = @_;);
273          $r .= line $Info, node_path => qq(Format[module-name()=$module_name]/HeadSummary);
274          $r .= code $Info, $_->get_attribute_value ('Main');
275          $r .= line $Info, reset => 1;
276          $r .= qq(}\n);
277      } elsif ($_->local_name eq 'NextIndex') {      } elsif ($_->local_name eq 'NextIndex') {
278        my $name = $_->get_attribute_value ('Name', default => '');        my $name = $_->get_attribute_value ('Name', default => '');
279        $r .= q(sub next_index_for_).$name        $r .= q(sub next_index_for_).$name
# Line 259  EOH Line 282  EOH
282        $r .= code $Info, $_->get_attribute_value ('Main');        $r .= code $Info, $_->get_attribute_value ('Main');
283        $r .= line $Info, reset => 1;        $r .= line $Info, reset => 1;
284        $r .= qq(}\n);        $r .= qq(}\n);
285        } elsif ({qw/content_written 1 content_removed 1 content_type_changed_from 1/}
286                 ->{my $node_name = $_->local_name}) {
287          $r .= q(sub ).$node_name
288             .  q( {)."\n".q(my ($self, %opt) = @_;)
289             .  line $Info, node_path => qq(Format[module-name()=$module_name]/$node_name]);
290          $r .= code $Info, $_->get_attribute_value ('Main');
291          $r .= line $Info, reset => 1;
292          $r .= qq(}\n);
293      } elsif ($_->local_name eq 'Use') {      } elsif ($_->local_name eq 'Use') {
294        $r .= line $Info, node_path => qq(Format[module-name()=$module_name]/Use);        $r .= line $Info, node_path => qq(Format[module-name()=$module_name]/Use);
295        $r .= $_->inner_text;        $r .= code $Info, $_->inner_text;
296      }      }
297    }    }
298    $r;    $r;
# Line 270  EOH Line 301  EOH
301  sub make_format_converter ($$) {  sub make_format_converter ($$) {
302    my ($src, $Info) = @_;    my ($src, $Info) = @_;
303    my %def;    my %def;
304    $def{Type} = $src->get_attribute ('Type');    for (qw/Type Name Version TypeURIReference IsFragment IsPlaceholder/) {
305    if (ref $def{Type}) {      $def{$_} = $src->get_attribute_value ($_);
306      $def{Type} = $def{Type}->inner_text      delete $def{$_} unless defined $def{$_};
307            . join '', map {    }
308                ';'. $_->local_name .'='. quoted_string $_->inner_text    $def{Type_param} = {map {$_->local_name => $_->value}
309              } sort {                                @{$src->get_attribute ('Type', make_new_node => 1)
310                $a->local_name cmp $b->local_name                                    ->child_nodes}};
311              } @{$def{Type}->child_nodes};    my $type = serialize_media_type ($Info,
312    } else {                 Type => $def{Type},
313      delete $def{Type};                 Type_param => $def{Type_param},
314                   Name => $def{Name},
315                   Version => $def{Version},
316                   URIReference => $def{TypeURIReference},
317                   IsFragment => $def{IsFragment},
318                   IsPlaceholder => $def{IsPlaceholder});
319      $def{serialized_type} = $type->{_};
320      
321      for (qw/Main ToString ToOctetStream/) {
322        my $def = $src->get_attribute_value ($_);
323        next unless $def;
324        $def{$_} = line ($Info, node_path => '//Converter/'.$_)
325                   . $def
326                   . line ($Info, reset => 1);
327        if ($def{$_} =~ /\$r\b/) {
328          $def{$_} = 'my $r;'."\n".$def{$_}."\n".'$r';
329        }
330        $def{$_} = barecode code $Info,
331                     'sub {my ($self, $source, $opt) = @_;'
332                   . $def{$_} . '}';
333    }    }
   $def{Name} = $src->get_attribute_value ('Name');  
   delete $def{Name} unless defined $def{Name};  
   $def{Version} = $src->get_attribute_value ('Version');  
   delete $def{Version} if not defined $def{Version} or  
                           not defined $def{Name};  
     
   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');  
     
   $def{Main} = $src->get_attribute_value ('Main');  
   $def{Main} = line ($Info, node_path => '//Converter/Main')  
              . $def{Main}  
              . line ($Info, reset => 1);  
   if ($def{Main} =~ /\$r\b/) {  
     $def{Main} = 'my $r;'."\n".$def{Main}."\n".'$r';  
   }  
   $def{Main} = barecode code $Info,  
                'sub {my ($self, $source, $opt) = @_;'  
              . $def{Main} . '}';  
334        
335    my $r = list %def;    my $r = list %def;
336    if ($def{Type}) {    if ($type->{Type}) {
337      $r = qq{\$Converter->{@{[literal $def{Type}.$flag]}} = {$r};\n};      $r = qq{\$Converter->{@{[literal $type->{Type}]}} = {$r};\n};
338      $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}
339        if $def{Name};        if $type->{Magic};
340    } elsif ($def{Name}) {      $r .= qq{\$Converter->{@{[literal $type->{URIReference}]}} = \$Converter->{@{[literal $type->{Type}]}};\n}
341      $r = qq{\$Converter->{@{[literal '/'.$def{Name}.'/'.$def{Version}.$flag]}} = {$r};\n};        if $type->{URIReference};
342      } elsif ($type->{Magic}) {
343        $r = qq{\$Converter->{@{[literal $type->{Magic}]}} = {$r};\n};
344        $r .= qq{\$Converter->{@{[literal $type->{URIReference}]}} = \$Converter->{@{[literal $type->{Magic}]}};\n}
345          if $type->{URIReference};
346      } elsif ($type->{URIReference}) {
347        $r = qq{\$Converter->{@{[literal $type->{URIReference}]}} = {$r};\n};
348    } else {    } else {
349      $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" }';
350    }    }
351    $r;    $r;
352  }  }
353    
354    sub serialize_media_type ($%) {
355      my ($Info, %opt) = @_;
356      my %return;
357      if ($opt{Type}) {
358        $return{Type} = 'IMT:'.$opt{Type};
359        if ($opt{Type_param}) {
360          $return{Type} .= join '', map {my $s;
361                             ';'. $_ .'="'
362                           . (($s = $opt{Type_param}->{$_}) =~ s/([\\"])/\\$1/g, $s)
363                           . '"'
364                           } sort {
365                             $a cmp $b
366                           } keys %{$opt{Type_param}};
367        }
368      }
369      if ($opt{Magic}) {
370        $return{Magic} = 'MAGIC:'.$opt{Magic};
371      } elsif ($opt{Name}) {
372        $return{Name} = 'MAGIC:'.$opt{Name}.'/*';
373        $return{Magic} = 'MAGIC:'.$opt{Name}.'/'.$opt{Version} if $opt{Version};
374      }
375      if ($opt{URIReference}) {
376        $return{URIReference} = $opt{URIReference};
377      }
378      my $flag = '##';
379      $flag .= 'f' if $opt{IsFragment};
380      $flag .= 'p' if $opt{IsPlaceholder};
381      for (qw/URIReference Type Magic Name/) {
382        $return{$_} .= $flag if $return{$_};
383      }
384      $return{_} = $return{URIReference} || $return{Type}
385                || $return{Magic} || $return{Name};
386      \%return;
387    }
388    
389    
390  sub make_function ($$) {  sub make_function ($$) {
391    my ($src, $Info) = @_;    my ($src, $Info) = @_;
392    ## TODO: support of ARGV property    ## TODO: support of ARGV property
# Line 335  EOH Line 405  EOH
405  sub register_plugin_const ($$) {  sub register_plugin_const ($$) {
406    my ($src, $Info) = @_;    my ($src, $Info) = @_;
407    for (@{$src->child_nodes}) {    for (@{$src->child_nodes}) {
408      $Info->{const}->{$_->local_name} = $_->value;      $Info->{const}->{$_->local_name} = literal_or_code $Info, $_->value;
409    }    }
410  }  }
411    
412  sub make_resdef ($$) {  sub make_resdef ($$) {
413    my ($src, $Info) = @_;    my ($src, $Info) = @_;
414    my $r = change_package $Info, 'SuikaWiki::Plugin::Resource';    my $r = change_package $Info, 'SuikaWiki::Plugin::Resource';
415      local $Info->{-message_error_used} = 0;  
416    $r .= qq{our \$BaseResource;\n};    $r .= qq{our \$BaseResource;\n};
417    for (@{$src->child_nodes}) {    for (@{$src->child_nodes}) {
418      if ($_->node_type eq '#element') {      if ($_->node_type eq '#element') {
# Line 405  push \@SuikaWiki::View::Implementation:: Line 476  push \@SuikaWiki::View::Implementation::
476  @{[change_package $Info, $ViewProp->{pack_name}]}  @{[change_package $Info, $ViewProp->{pack_name}]}
477  our \@ISA = q#SuikaWiki::View::template#;  our \@ISA = q#SuikaWiki::View::template#;
478  EOH  EOH
479      local $Info->{-message_error_used} = 0;  
480      my $use = $src->get_attribute ('Use');
481      if (ref $use) {
482        $r .= line $Info, node_path => "ViewDefinition[Mode='$ViewProp->{Name}']/Use";
483        $r .= code $Info, $use->inner_text;
484        $r .= "\n\n";
485      }
486      
487    for (@{$src->child_nodes}) {    for (@{$src->child_nodes}) {
488      if ($_->local_name eq 'template') {      if ($_->local_name eq 'template') {
489        $r .= make_view_template_method ($_, $Info, $ViewProp);        $r .= make_view_template_method ($_, $Info, $ViewProp);
# Line 430  EOH Line 509  EOH
509    
510  sub make_view_template_method ($$) {  sub make_view_template_method ($$) {
511    my ($src, $Info, $ViewProp) = @_;    my ($src, $Info, $ViewProp) = @_;
512      my $media_type = $src->get_attribute_value
513                                ('media-type',
514                                 default => q<application/octet-stream>);
515    my $r = <<EOH;    my $r = <<EOH;
516    
517  sub main (\$\$\$) {  sub main (\$\$\$) {
# Line 445  sub main (\$\$\$) { Line 527  sub main (\$\$\$) {
527        
528    \$opt2->{template} = @{[literal $src->get_attribute ('body', make_new_node => 1)->inner_text]};    \$opt2->{template} = @{[literal $src->get_attribute ('body', make_new_node => 1)->inner_text]};
529    \$opt2->{o} = bless {    \$opt2->{o} = bless {
                      ## Compatible options for SuikaWiki 2 WikiPlugin interface  
                        param => \\\%main::form,  
                        page => \$main::form{mypage},  
                        #toc => [],  
                        #magic  
                        #content  
                        #use_anchor_name  
                        media => {@{[hash  
     type => ($src->get_attribute ('media-type',make_new_node=>1)->inner_text  
              || 'application/octet-stream'),  
     charset => ($src->get_attribute ('use-media-type-charset',make_new_node=>1)  
                     ->inner_text || 0),  
     ## In fact, this value is not referred from any SuikaWiki 2 WikiPlugin rule.  
     #expires => ($src->get_attribute ('expires',make_new_node=>1)->inner_text  
     #                             || 0)  
     ]}},  
530                        ## SuikaWiki 3 WikiPlugin interface                        ## SuikaWiki 3 WikiPlugin interface
531                          wiki => \$self->{view}->{wiki},                          wiki => \$self->{view}->{wiki},
532                          plugin => \$self->{view}->{wiki}->{plugin},                          plugin => \$self->{view}->{wiki}->{plugin},
# Line 470  sub main (\$\$\$) { Line 536  sub main (\$\$\$) {
536       $x?q{$opt2->{output}->{status_code} = }.(0 + $x).q{;}:q{}}]}       $x?q{$opt2->{output}->{status_code} = }.(0 + $x).q{;}:q{}}]}
537    @{[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;
538       $x?q{$opt2->{output}->{status_phrase} = }.literal($x).q{;}:q{}}]}       $x?q{$opt2->{output}->{status_phrase} = }.literal($x).q{;}:q{}}]}
539    \$opt2->{output}->{entity}->{media_type} = @{[literal    \$opt2->{output}->{entity}->{media_type} = @{[literal $media_type]};
540                             $src->get_attribute ('media-type',make_new_node=>1)  
                                ->inner_text || 'application/octet-stream']};  
541    @{[($src->get_attribute ('use-media-type-charset',make_new_node=>1)    @{[($src->get_attribute ('use-media-type-charset',make_new_node=>1)
542              ->inner_text || 0) ?              ->inner_text || 0) ?
543       q{$opt2->{output}->{entity}->{charset} = $self->{view}->{wiki}->{config}->{charset}->{output};}:       q{$opt2->{output}->{entity}->{charset} = $self->{view}->{wiki}->{config}->{charset}->{output};}:
# Line 484  sub main (\$\$\$) { Line 549  sub main (\$\$\$) {
549              qq{\$opt2->{output}->set_expires (delta => @{[0 + $x]});};              qq{\$opt2->{output}->set_expires (delta => @{[0 + $x]});};
550            }            }
551        }]}        }]}
552      \$opt2->{output}->{entity}->{body_is_octet_stream} = @{[
553        $src->get_attribute ('body')->get_attribute_value ('is-octet-stream', default_value => 0)
554        or 0
555      ]};
556        
557    \$self->{view}->{wiki}->init_db;    \$self->{view}->{wiki}->init_db;
558    \$self->main_pre (\$opt, \$opt2);    \$self->main_pre (\$opt, \$opt2);
559        
560      @{[$media_type eq 'text/html' ? q{require Message::Markup::XML::Serialize::HTML;} : '']}
561    use Message::Util::Error;    use Message::Util::Error;
562    try {    try {
563      \$opt2->{output}->{entity}->{body}      \$opt2->{output}->{entity}->{body}
564        = SuikaWiki::Plugin->formatter ('view')        = @{[$media_type eq 'text/html' ? q{Message::Markup::XML::Serialize::HTML::html_simple} : '']}
565          ->replace (\$opt2->{template}, param => \$opt2->{o});          (SuikaWiki::Plugin->formatter ('view')
566            ->replace (\$opt2->{template}, param => \$opt2->{o}));
567    } \$self->{view}->{wiki}->{config}->{catch}->{ @{[    } \$self->{view}->{wiki}->{config}->{catch}->{ @{[
568         $ViewProp->{Name} eq '-error' ? 'formatter_view_error'         $ViewProp->{Name} eq '-error' ? 'formatter_view_error'
569                                       : 'formatter_view' ]} };                                       : 'formatter_view' ]} };
# Line 521  sub make_rule ($$) { Line 592  sub make_rule ($$) {
592                "FormattingRule[name()='@{[list $type]}/$name']/".$codename->[0])                "FormattingRule[name()='@{[list $type]}/$name']/".$codename->[0])
593            . $main;            . $main;
594            
595      $main = q{my ($f, $rule_name, $p, $o, %opt) = @_;}."\n".$main      if ( $main =~ /\$f\b/
       if $main =~ /\$f\b/  
596        or $main =~ /\$rule_name\b/        or $main =~ /\$rule_name\b/
597        or $main =~ /\$[opr]\b/        or $main =~ /\$[opr]\b/
598        or $main =~ /[%\$]opt\b/;        or $main =~ /[%\$]opt\b/
599          or $main =~ /\$param_(?:name|value)\n/) {
600          if ($codename->[0] ne 'Attribute') {
601            $main = q{my ($f, $rule_name, $p, $o, %opt) = @_;}."\n".$main;
602          } else {
603            $main = q{my ($f, $rule_name, $p, $o, $param_name => $param_value, %opt) = @_;}."\n".$main;
604          }
605        }
606      if ($main =~ /\$r\b/) {      if ($main =~ /\$r\b/) {
607        warn qq(Rule @{[list $type]}/$name: Use of \$r is deprecated);        warn qq(Rule @{[list $type]}/$name: Use of \$r is deprecated);
608        $main = q{my $r = '';} . "\n" . $main . "\n"        $main = q{my $r = '';} . "\n" . $main . "\n"
# Line 573  my  $amain = <<EOH; Line 650  my  $amain = <<EOH;
650  }  }
651  EOH  EOH
652    my $r = change_package $Info, $Info->{module_name};    my $r = change_package $Info, $Info->{module_name};
653      local $Info->{-message_error_used} = 0;  
654    if (@$type == 1) {    if (@$type == 1) {
655      $type->[0] =~ tr/-/_/;      $type->[0] =~ tr/-/_/;
656      $r .= qq{\$SuikaWiki::Plugin::Rule{$type->[0]}->{$name} = $main;\n};      $r .= qq{\$SuikaWiki::Plugin::Rule{$type->[0]}->{$name} = $main;\n};
# Line 589  EOH Line 667  EOH
667    $r;    $r;
668  }  }
669    
670    =item FormattingRuleAlias
671    
672    Generating an alias name for a formatting rule that is already loaded.
673    Example:
674    
675      FormattingRuleAlias:
676        @Category[list]:
677          category-1
678          category-2
679          ...
680        @Name: new-rule-name
681        @Reference:
682          @@Category: one-of-category
683          @@Name: one-of-name
684    
685    associates C<(I<category-1>, I<new-rule-name>)>,
686    C<(I<category-2>, I<new-rule-name>)>, ...
687    with C<(I<one-of-category>, I<one-of-name>)>.
688    
689    =cut
690    
691    sub make_rule_alias ($$) {
692      my ($src, $Info) = @_;
693      my $type = $src->get_attribute ('Category', make_new_node => 1)->value || [];
694      my $name = $src->get_attribute ('Name', make_new_node => 1)->value;
695      
696      my $ref = $src->get_attribute ('Reference', make_new_node => 1);
697      my $c = $ref->get_attribute_value ('Category');
698      my $n = $ref->get_attribute_value ('Name');
699      
700      s/(?<=.)-/_/g for $n, $name;
701      tr/-/_/ for $c, @$type;
702      
703      my $def = qq{\$SuikaWiki::Plugin::Rule{@{[literal $c]}}->{@{[literal $n]}} or warn qq{Formatting rule "$c/$n" not defined}};
704      
705      my $r = change_package $Info, $Info->{module_name};
706      for my $type (@$type) {
707        $r .= qq{\$SuikaWiki::Plugin::Rule{@{[literal $type]}}->{@{[literal $name]}} = $def;\n};
708        push @{$Info->{provide}->{rule}->{$type}}, $name;
709      }
710      $r;
711    }
712    
713    
714  sub random_module_name ($;$) {  sub random_module_name ($;$) {
715    my ($Info, $subname) = @_;    my ($Info, $subname) = @_;
# Line 599  sub random_module_name ($;$) { Line 720  sub random_module_name ($;$) {
720      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]),
721      join ('', @rand[rand@rand,rand@rand,rand@rand,rand@rand]);      join ('', @rand[rand@rand,rand@rand,rand@rand,rand@rand]);
722  }  }
723    
724    =head1 NAME
725    
726    mkplugin2.pl - SuikaWiki: WikiPlugin Generator
727    
728    =head1 SYNOPSIS
729    
730      mkplugin2.pl pluginsrc.wp2 > plugin.pm
731    
732    =head1 DESCRIPTION
733    
734    C<mkplugin2.pl> generates WikiPlugin module as a Perl module file
735    from WikiPlugin source description.  WikiPlugin source description
736    is described in SuikaWikiConfig/2.0 format and it contains
737    definitions of wiki constructions (such as formatting rules and
738    WikiView definitions) as both machine understandable code and
739    human readable documentation.  For more information, see
740    <http://suika.fam.cx/~wakaba/-temp/wiki/wiki?WikiPlugin>.
741    
742    This script is part of SuikaWiki.
743    
744    =head1 HISTORY AND COMPATIBILITY
745    
746    C<mkplugin2.pl> introduced as part of SuikaWiki 3.
747    It converts SuikaWiki 3 WikiPlugin source descriptions
748    (in SuikaWikiConfig/2.0) into Perl modules with SuikaWiki 3 interface.
749    
750    SuikaWiki 2 has C<mkplugin.pl>.  It also converts WikiPlugin
751    source descriptions into Perl modules.  But it support
752    SuikaWiki 2 format of WikiPlugin source description that differs from
753    SuikaWiki 3 format.  Wiki programming interface (not limited to
754    WikiPlugin related one) of SuikaWiki 3 also incompatible with that
755    of SuikaWiki 2 so that it is impossible to use SuikaWiki 2 WikiPlugin
756    module with SuikaWiki 3 and vice versa.
757    
758    =head1 SEE ALSO
759    
760    C<SuikaWiki::Plugin>, SuikaWiki:WikiPlugin
761    <http://suika.fam.cx/~wakaba/-temp/wiki/wiki?WikiPlugin>.
762    
763    =head1 LICENSE
764    
765    Copyright 2003-2004 Wakaba <w@suika.fam.cx>.  All rights reserved.
766    
767    This program is free software; you can redistribute it and/or
768    modify it under the same terms as Perl itself.
769    
770    =cut
771    
772    1; # $Date$
Legend:
Removed from v.1.10  
changed lines
  Added in v.1.18
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24