/[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.7 by wakaba, Thu Nov 27 05:50:02 2003 UTC revision 1.11 by wakaba, Sun Feb 1 12:07:08 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;    $code;
# Line 97  sub line ($;%) { Line 97  sub line ($;%) {
97    $opt{file} =~ s/"/''/g;    $opt{file} =~ s/"/''/g;
98    sprintf '%s#line %d "%s"%s', "\n", $opt{line_no} || 1, $opt{file}, "\n";    sprintf '%s#line %d "%s"%s', "\n", $opt{line_no} || 1, $opt{file}, "\n";
99  }  }
100    sub literal_or_code ($$) {
101      my ($Info, $s) = @_;
102      substr ($s, 0, 1) ne '{' ? literal ($s)
103                               : code ($Info, substr ($s, 1, length ($s) - 2));
104    }
105    
106  my $parser = Message::Markup::SuikaWikiConfig20::Parser->new;  my $parser = Message::Markup::SuikaWikiConfig20::Parser->new;
107  my $plugins = $parser->parse_text ($src);  my $plugins = $parser->parse_text ($src);
# Line 176  for (@{$plugins->child_nodes}) { Line 181  for (@{$plugins->child_nodes}) {
181      register_plugin_const ($_, \%Info);      register_plugin_const ($_, \%Info);
182    } elsif ($_->local_name eq 'Format') {    } elsif ($_->local_name eq 'Format') {
183      print "\n", make_format ($_, \%Info);      print "\n", make_format ($_, \%Info);
184    # Parameter
185    # PluginCategory
186    }    }
187  }  }
188    
# Line 203  sub make_format ($$) { Line 210  sub make_format ($$) {
210      $r .= qq{\$SuikaWiki::Format::Definition::Class{@{[literal '/'.$name.'/'.$src->get_attribute_value ('Version', default => '').'//']}} = '$module_name';\n};      $r .= qq{\$SuikaWiki::Format::Definition::Class{@{[literal '/'.$name.'/'.$src->get_attribute_value ('Version', default => '').'//']}} = '$module_name';\n};
211    }    }
212    if (my $type = $src->get_attribute_value ('Type')) {    if (my $type = $src->get_attribute_value ('Type')) {
213        $type .= join '', map {
214                   ';'. $_->local_name .'='. quoted_string $_->inner_text
215                 } sort {
216                   $a->local_name cmp $b->local_name
217                 } @{$src->get_attribute ('Type')->child_nodes};
218      $r .= qq{\$SuikaWiki::Format::Definition::Class{@{[literal $type.'//']}} = '$module_name';\n};      $r .= qq{\$SuikaWiki::Format::Definition::Class{@{[literal $type.'//']}} = '$module_name';\n};
219    }    }
220        
221    $r .= line $Info, line_no => __LINE__ + 2, realfile => __FILE__;    my $convert = line $Info, line_no => __LINE__ + 2, realfile => __FILE__;
222    $r .= <<'EOH';    $convert .= <<'EOH';
223  our $Converter;  our $Converter;
224  sub convert ($$;%) {  sub convert ($$;%) {
225    my ($self, $source, %opt) = @_;    my ($self, $source, %opt) = @_;
# Line 215  sub convert ($$;%) { Line 227  sub convert ($$;%) {
227    my $flag = '//';    my $flag = '//';
228    $flag .= 'f' if $opt{IsFragment};    $flag .= 'f' if $opt{IsFragment};
229    $flag .= 'p' if $opt{IsPlaceholder};    $flag .= 'p' if $opt{IsPlaceholder};
230    if ($Converter->{$opt{Type}.$flag}) {    my $type = $opt{Type} ?
231      $converter = $Converter->{$opt{Type}.$flag};                  $opt{Type} .
232                    SuikaWiki::Format::Definition->__get_param_string
233                      ($opt{Type_param}) : undef;
234      if ($Converter->{$type.$flag}) {
235        $converter = $Converter->{$type.$flag};
236    } elsif ($Converter->{$opt{Name}.'/'.$opt{Version}.$flag}) {    } elsif ($Converter->{$opt{Name}.'/'.$opt{Version}.$flag}) {
237      $converter = $Converter->{'/'.$opt{Name}.'/'.$opt{Version}.$flag};      $converter = $Converter->{'/'.$opt{Name}.'/'.$opt{Version}.$flag};
238    }    }
# Line 225  sub convert ($$;%) { Line 241  sub convert ($$;%) {
241  }  }
242  EOH  EOH
243        
   my $reset = 0;  
244    for (@{$src->child_nodes}) {    for (@{$src->child_nodes}) {
245      if ($_->local_name eq 'Converter') {      if ($_->local_name eq 'Converter') {
246        $r .= line $Info, reset => 1 unless $reset;        if ($convert) {
247            $r .= $convert;
248            $r .= line $Info, reset => 1;
249            undef $convert;
250          }
251        $r .= make_format_converter ($_, $Info);        $r .= make_format_converter ($_, $Info);
252        $reset = 1;      } elsif ($_->local_name eq 'WikiForm') {
253          $r .= q(sub wikiform {)."\n".q(my ($self, $source, %opt) = @_;);
254          $r .= line $Info, node_path => qq(Format[module-name()=$module_name]/WikiForm);
255          $r .= code $Info, $_->get_attribute_value ('Main');
256          $r .= line $Info, reset => 1;
257          $r .= qq(}\n);
258        } elsif ($_->local_name eq 'HeadSummary') {
259          $r .= q(sub headsummary {)."\n".q(my ($self, $source, %opt) = @_;);
260          $r .= line $Info, node_path => qq(Format[module-name()=$module_name]/HeadSummary);
261          $r .= code $Info, $_->get_attribute_value ('Main');
262          $r .= line $Info, reset => 1;
263          $r .= qq(}\n);
264        } elsif ($_->local_name eq 'NextIndex') {
265          my $name = $_->get_attribute_value ('Name', default => '');
266          $r .= q(sub next_index_for_).$name
267             .  q( {)."\n".q(my ($self, $source, %opt) = @_;)
268             .  line $Info, node_path => qq(Format[module-name()=$module_name]/NextIndex[Name=$name]);
269          $r .= code $Info, $_->get_attribute_value ('Main');
270          $r .= line $Info, reset => 1;
271          $r .= qq(}\n);
272      } elsif ($_->local_name eq 'Use') {      } elsif ($_->local_name eq 'Use') {
273        $r .= line $Info, node_path => qq(Format[module-name()=$module_name]/Use);        $r .= line $Info, node_path => qq(Format[module-name()=$module_name]/Use);
274        $r .= $_->inner_text;        $r .= $_->inner_text;
       $reset = 0;  
275      }      }
276    }    }
   $r .= line $Info, reset => 1 unless $reset;  
     
277    $r;    $r;
278  }  }
279    
# Line 286  sub make_format_converter ($$) { Line 321  sub make_format_converter ($$) {
321        if $def{Name};        if $def{Name};
322    } elsif ($def{Name}) {    } elsif ($def{Name}) {
323      $r = qq{\$Converter->{@{[literal '/'.$def{Name}.'/'.$def{Version}.$flag]}} = {$r};\n};      $r = qq{\$Converter->{@{[literal '/'.$def{Name}.'/'.$def{Version}.$flag]}} = {$r};\n};
324      $r    } else {
325        $r = 'BEGIN { die "Invalid Syntax of Converter: Type or Name property required" }';
326    }    }
327    $r;    $r;
328  }  }
# Line 300  sub make_function ($$) { Line 336  sub make_function ($$) {
336  sub @{[$name = $src->get_attribute_value ('Name')]} {  sub @{[$name = $src->get_attribute_value ('Name')]} {
337  @{[line $Info, node_path => "Function[Name='$name']/Main"]}@{[  @{[line $Info, node_path => "Function[Name='$name']/Main"]}@{[
338    code $Info, $src->get_attribute_value ('Main')    code $Info, $src->get_attribute_value ('Main')
339  ]}@{[line $Info, reset => 1]}  ]}
340  }  }
341    @{[line $Info, reset => 1]}
342  EOH  EOH
343  }  }
344    
345  sub register_plugin_const ($$) {  sub register_plugin_const ($$) {
346    my ($src, $Info) = @_;    my ($src, $Info) = @_;
347    for (@{$src->child_nodes}) {    for (@{$src->child_nodes}) {
348      $Info->{const}->{$_->local_name} = $_->value;      $Info->{const}->{$_->local_name} = literal_or_code $Info, $_->value;
349    }    }
350  }  }
351    
# Line 362  sub make_viewdef ($$) { Line 399  sub make_viewdef ($$) {
399    my $ViewProp = {};    my $ViewProp = {};
400    my $r = '';    my $r = '';
401    $ViewProp->{Name} = n11n $src->get_attribute_value ('Mode');    $ViewProp->{Name} = n11n $src->get_attribute_value ('Mode');
402      $ViewProp->{Name} =~ s/(?<=.)-/_/g;
403    $ViewProp->{pack_name} = random_module_name ($Info, $ViewProp->{Name});    $ViewProp->{pack_name} = random_module_name ($Info, $ViewProp->{Name});
404        
405    $ViewProp->{condition_stringified} = hash    $ViewProp->{condition_stringified} = hash
# Line 377  push \@SuikaWiki::View::Implementation:: Line 415  push \@SuikaWiki::View::Implementation::
415  @{[change_package $Info, $ViewProp->{pack_name}]}  @{[change_package $Info, $ViewProp->{pack_name}]}
416  our \@ISA = q#SuikaWiki::View::template#;  our \@ISA = q#SuikaWiki::View::template#;
417  EOH  EOH
418      
419      my $use = $src->get_attribute ('Use');
420      if (ref $use) {
421        $r .= line $Info, node_path => "ViewDefinition[Mode='$ViewProp->{Name}']/Use";
422        $r .= $use->inner_text . "\n\n";
423      }
424      
425    for (@{$src->child_nodes}) {    for (@{$src->child_nodes}) {
426      if ($_->local_name eq 'template') {      if ($_->local_name eq 'template') {
427        $r .= make_view_template_method ($_, $Info);        $r .= make_view_template_method ($_, $Info, $ViewProp);
428      } elsif ($_->local_name eq 'method') {      } elsif ($_->local_name eq 'method') {
429        my $method_name = $_->get_attribute_value ('Name');        my $method_name = $_->get_attribute_value ('Name');
430        $r .= ({        $r .= ({
431                main => q(sub main ($$) {)."\n".q(my ($self, $opt) = @_;)."\n",                main => q(sub main ($$) {)."\n".q(my ($self, $opt, $opt2) = @_;)."\n",
432                main_pre => q(sub main_pre ($$$) {)."\n".q(my ($self, $opt, $opt2) = @_;)."\n",                main_pre => q(sub main_pre ($$$) {)."\n".q(my ($self, $opt, $opt2) = @_;)."\n",
433                main_post => q(sub main_post ($$$) {)."\n".q(my ($self, $opt, $opt2) = @_;)."\n",                                    main_post => q(sub main_post ($$$) {)."\n".q(my ($self, $opt, $opt2) = @_;)."\n",                    
434               }->{$method_name}               }->{$method_name}
435               ||qq(sub @{[$method_name]} {\n))               ||qq(sub @{[$method_name]} {\n))
436           . line ($Info, node_path => "ViewDefinition[Mode='$ViewProp->{Name}']/method[Name='$method_name']")           . line ($Info, node_path => "ViewDefinition[Mode='$ViewProp->{Name}']/method[Name='$method_name']")
437           . code ($Info, $_->value)           . code ($Info, $_->value)
438           . line ($Info, reset => 1)           . qq(}\n)
439           . qq(}\n);           . line ($Info, reset => 1);
440      }      }
441    }    }
442    my $prop = {Name => $ViewProp->{Name},    my $prop = {Name => $ViewProp->{Name},
# Line 401  EOH Line 446  EOH
446  }  }
447    
448  sub make_view_template_method ($$) {  sub make_view_template_method ($$) {
449    my ($src, $info) = @_;    my ($src, $Info, $ViewProp) = @_;
450    my $r = <<EOH;    my $r = <<EOH;
451    
452  sub main (\$\$\$) {  sub main (\$\$\$) {
# Line 420  sub main (\$\$\$) { Line 465  sub main (\$\$\$) {
465                       ## Compatible options for SuikaWiki 2 WikiPlugin interface                       ## Compatible options for SuikaWiki 2 WikiPlugin interface
466                         param => \\\%main::form,                         param => \\\%main::form,
467                         page => \$main::form{mypage},                         page => \$main::form{mypage},
468                         toc => [],                         #toc => [],
469                         #magic                         #magic
470                         #content                         #content
471                         #use_anchor_name                         #use_anchor_name
# Line 441  sub main (\$\$\$) { Line 486  sub main (\$\$\$) {
486    @{[do{my $x=$src->get_attribute('http-status-code',make_new_node=>1)->inner_text;    @{[do{my $x=$src->get_attribute('http-status-code',make_new_node=>1)->inner_text;
487       $x?q{$opt2->{output}->{status_code} = }.(0 + $x).q{;}:q{}}]}       $x?q{$opt2->{output}->{status_code} = }.(0 + $x).q{;}:q{}}]}
488    @{[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;
489       $x?q{$opt2->{output}->{reason_phrase} = }.literal($x).q{;}:q{}}]}       $x?q{$opt2->{output}->{status_phrase} = }.literal($x).q{;}:q{}}]}
490    \$opt2->{output}->{entity}->{media_type} = @{[literal    \$opt2->{output}->{entity}->{media_type} = @{[literal
491                             $src->get_attribute ('media-type',make_new_node=>1)                             $src->get_attribute ('media-type',make_new_node=>1)
492                                 ->inner_text || 'application/octet-stream']};                                 ->inner_text || 'application/octet-stream']};
# Line 460  sub main (\$\$\$) { Line 505  sub main (\$\$\$) {
505    \$self->{view}->{wiki}->init_db;    \$self->{view}->{wiki}->init_db;
506    \$self->main_pre (\$opt, \$opt2);    \$self->main_pre (\$opt, \$opt2);
507        
508    my \$fmt = SuikaWiki::Plugin->formatter ('view');    use Message::Util::Error;
509    \$opt2->{output}->{entity}->{body}    try {
510      = \$fmt->replace (\$opt2->{template}, param => \$opt2->{o});      \$opt2->{output}->{entity}->{body}
511          = SuikaWiki::Plugin->formatter ('view')
512            ->replace (\$opt2->{template}, param => \$opt2->{o});
513      } \$self->{view}->{wiki}->{config}->{catch}->{ @{[
514           $ViewProp->{Name} eq '-error' ? 'formatter_view_error'
515                                         : 'formatter_view' ]} };
516    \$opt2->{output}->output (output => 'http-cgi');    \$opt2->{output}->output (output => 'http-cgi');
517        
518    \$self->main_post (\$opt, \$opt2);    \$self->main_post (\$opt, \$opt2);
# Line 475  sub make_rule ($$) { Line 525  sub make_rule ($$) {
525    my $type = $src->get_attribute ('Category', make_new_node => 1)->value || [];    my $type = $src->get_attribute ('Category', make_new_node => 1)->value || [];
526    my $name = $src->get_attribute ('Name', make_new_node => 1)->value;    my $name = $src->get_attribute ('Name', make_new_node => 1)->value;
527    $name =~ s/(?<=.)-/_/g;    $name =~ s/(?<=.)-/_/g;
   my $main = line ($Info, node_path => "FormattingRule[name()='@{[list $type]}/$name']/Formatting")  
            . code ($Info, $src->get_attribute_value ('Formatting'))  
            . line ($Info, reset => 1);  
528        
529    my $reg_block;    my $reg_block;
530    $reg_block = qr/[^{}]*(?>[^{}]+|{(??{$reg_block})})*/;    $reg_block = qr/[^{}]*(?>[^{}]+|{(??{$reg_block})})*/;
531    my $reg_attr = qr/__ATTR(TEXT|NODE)?:%(\w+)(?:->{($reg_block)})?__;/;    my %code;
532        for my $codename ([qw/Formatting main/], [qw/After after/],
533    $main = q{my ($f, $rule_name, $p, $o, %opt) = @_;}."\n".$main                      [qw/Before before/], [qw/Pre pre/], [qw/Post post/],
534      if $main =~ /\$f\b/                      [qw/Attribute attr/]) {
535      or $main =~ /\$rule_name\b/      my $main = code $Info, $src->get_attribute_value ($codename->[0]);
536      or $main =~ /\$[opr]\b/      next unless $main;
537      or $main =~ /[%\$]opt\b/;      $main = line ($Info, node_path =>
538    if ($main =~ /\$r\b/) {                "FormattingRule[name()='@{[list $type]}/$name']/".$codename->[0])
539      warn qq(Rule @{[list $type]}/$name: Use of \$r is deprecated);            . $main;
540      $main = q{my $r = '';} . "\n" . $main . "\n"      
541            . q{$p->{-parent}->append_node ($r, node_or_text => 1);};      if ( $main =~ /\$f\b/
542    }        or $main =~ /\$rule_name\b/
543    $main =~ s{$reg_attr}        or $main =~ /\$[opr]\b/
544              {($1 eq 'TEXT' ? '$p->{'.literal($2).'} = do { my $r = ' : '')        or $main =~ /[%\$]opt\b/
545               .'$f->parse_attr ($p=>'.literal($2).', $o, '        or $main =~ /\$param_(?:name|value)\n/) {
546                               .($3?'-parent => '.$3.', ':'')        if ($codename->[0] ne 'Attribute') {
547                               .($1?'-non_parsed_to_node => 1, ':'')          $main = q{my ($f, $rule_name, $p, $o, %opt) = @_;}."\n".$main;
548                               .'%opt)'        } else {
549                               .($1 eq 'TEXT' ? '; ref $r?$r->inner_text:$r}' : '')          $main = q{my ($f, $rule_name, $p, $o, $param_name => $param_value, %opt) = @_;}."\n".$main;
550                               .';'}ge;        }
551          }
552    my $main = <<EOH;      if ($main =~ /\$r\b/) {
553          warn qq(Rule @{[list $type]}/$name: Use of \$r is deprecated);
554          $main = q{my $r = '';} . "\n" . $main . "\n"
555                . q{$p->{-parent}->append_node ($r, node_or_text => 1);};
556        }
557        $main =~ s{__ATTR(TEXT|NODE)?:%(\w+|{$reg_block})(?:->{($reg_block)})?__;}
558                  {($1 eq 'TEXT' ? '$p->{'.literal_or_code($Info, $2)
559                                          .'} = do { my $r = ' : '')
560                   .'$f->parse_attr ($p=>'.literal_or_code($Info, $2).', $o, '
561                                   .($3?'-parent => '.$3.', ':'')
562                                   .($1?'-non_parsed_to_node => 1, ':'')
563                                   .'%opt)'
564                                   .($1 eq 'TEXT' ? '; ref $r?$r->inner_text:$r}'
565                                                  : '')
566                                   .';'}ge;
567        $code{$codename->[1]} = barecode "sub {$main}";
568      }
569      
570      my $main = literal {
571        Description => [barecode m13ed_val_list $src, 'Description'],
572        Parameter => {do {
573          my @r;
574          for (@{$src->child_nodes}) {
575            if ($_->local_name eq 'Parameter') {
576              push @r, $_->get_attribute_value ('Name')
577                       => {Type => $_->get_attribute_value ('Type'),
578                           Default => $_->get_attribute_value ('Default'),
579                           Description => [barecode m13ed_val_list $_, 'Description']};
580            }
581          }
582          @r;
583        }},
584        %code,
585      };
586      $main .= line $Info, reset => 1;
587    
588    
589    my  $amain = <<EOH;
590  {  {
591    main => sub {$main},    main => sub {$main},
592    @{[line ($Info, reset => 1)]}
593    Description => [@{[m13ed_val_list $src, 'Description']}],    Description => [@{[m13ed_val_list $src, 'Description']}],
594    Parameter => {@{[do{    Parameter => {@{[do{
     my @r;  
     for (@{$src->child_nodes}) {  
       if ($_->local_name eq 'Parameter') {  
         push @r, $_->get_attribute_value ('Name')  
                  => {Type => $_->get_attribute_value ('Type'),  
                      Default => $_->get_attribute_value ('Default'),  
                      Description => [barecode m13ed_val_list $_, 'Description']};  
       }  
     }  
     list @r;  
595    }]}},    }]}},
596  }  }
597  EOH  EOH
Legend:
Removed from v.1.7  
changed lines
  Added in v.1.11
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24