/[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.5 by wakaba, Tue Nov 25 12:47:19 2003 UTC revision 1.10 by wakaba, Fri Jan 16 08:06:06 2004 UTC
# Line 75  sub quoted_string ($) { Line 75  sub quoted_string ($) {
75    $s =~ s/([\\"])/\\$1/g;    $s =~ s/([\\"])/\\$1/g;
76    '"'.$s.'"';    '"'.$s.'"';
77  }  }
78    sub line ($;%) {
79      my ($Info, %opt) = @_;
80      
81      unless ($opt{file}) {
82        if ($opt{reset}) {
83          $opt{file} = sprintf '(WikiPlugin module %s, chunk %d)',
84                               $Info->{Name},
85                               ++$Info->{chunk_count};
86        } elsif ($opt{realfile}) {
87          $opt{file} = sprintf '(WikiPlugin module %s, chunk from %s)',
88                               $Info->{Name},
89                               $opt{realfile};
90        } else {
91          $opt{file} = sprintf '(WikiPlugin module source %s, block %s)',
92                               $Info->{source_file},
93                               $opt{node_path};
94        }
95      }
96      
97      $opt{file} =~ s/"/''/g;
98      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 82  my $meta = $plugins->get_attribute ('Plu Line 109  my $meta = $plugins->get_attribute ('Plu
109            or die "$0: Required 'Plugin' section not found";            or die "$0: Required 'Plugin' section not found";
110  my %Info = (provide => {},  my %Info = (provide => {},
111              Name => n11n $meta->get_attribute ('Name')->value);              Name => n11n $meta->get_attribute ('Name')->value);
112    $Info{source_file} = $srcfile;
113  $Info{name_literal} = literal $Info{Name};  $Info{name_literal} = literal $Info{Name};
114  my @date = gmtime;  my @date = gmtime;
115  $Info{LastModified} = sprintf '%04d-%02d-%02dT%02d:%02d:%02d+00:00',  $Info{LastModified} = sprintf '%04d-%02d-%02dT%02d:%02d:%02d+00:00',
# Line 133  print qq{\$Info{$Info{name_literal}}->{A Line 161  print qq{\$Info{$Info{name_literal}}->{A
161  my $use = $meta->get_attribute ('Use');  my $use = $meta->get_attribute ('Use');
162  if (ref $use) {  if (ref $use) {
163    print change_package \%Info, $Info{module_name};    print change_package \%Info, $Info{module_name};
164    print $use->inner_text;    print line \%Info, node_path => 'Plugin/Use';
165      print $use->inner_text, "\n";
166      print line \%Info, reset => 1;
167  }  }
168    
169  for (@{$plugins->child_nodes}) {  for (@{$plugins->child_nodes}) {
# Line 151  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 178  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 .= <<'EOH';    my $convert = line $Info, line_no => __LINE__ + 2, realfile => __FILE__;
222      $convert .= <<'EOH';
223  our $Converter;  our $Converter;
224  sub convert ($$;%) {  sub convert ($$;%) {
225    my ($self, $source, %opt) = @_;    my ($self, $source, %opt) = @_;
# Line 201  EOH Line 239  EOH
239        
240    for (@{$src->child_nodes}) {    for (@{$src->child_nodes}) {
241      if ($_->local_name eq 'Converter') {      if ($_->local_name eq 'Converter') {
242          if ($convert) {
243            $r .= $convert;
244            $r .= line $Info, reset => 1;
245            undef $convert;
246          }
247        $r .= make_format_converter ($_, $Info);        $r .= make_format_converter ($_, $Info);
248        } elsif ($_->local_name eq 'WikiForm') {
249          $r .= q(sub wikiform {)."\n".q(my ($self, $source, %opt) = @_;);
250          $r .= line $Info, node_path => qq(Format[module-name()=$module_name]/WikiForm);
251          $r .= code $Info, $_->get_attribute_value ('Main');
252          $r .= line $Info, reset => 1;
253          $r .= qq(}\n);
254        } elsif ($_->local_name eq 'NextIndex') {
255          my $name = $_->get_attribute_value ('Name', default => '');
256          $r .= q(sub next_index_for_).$name
257             .  q( {)."\n".q(my ($self, $source, %opt) = @_;)
258             .  line $Info, node_path => qq(Format[module-name()=$module_name]/NextIndex[Name=$name]);
259          $r .= code $Info, $_->get_attribute_value ('Main');
260          $r .= line $Info, reset => 1;
261          $r .= qq(}\n);
262      } elsif ($_->local_name eq 'Use') {      } elsif ($_->local_name eq 'Use') {
263          $r .= line $Info, node_path => qq(Format[module-name()=$module_name]/Use);
264        $r .= $_->inner_text;        $r .= $_->inner_text;
265      }      }
266    }    }
     
267    $r;    $r;
268  }  }
269    
# Line 237  sub make_format_converter ($$) { Line 294  sub make_format_converter ($$) {
294      if $src->get_attribute_value ('IsPlaceholder');      if $src->get_attribute_value ('IsPlaceholder');
295        
296    $def{Main} = $src->get_attribute_value ('Main');    $def{Main} = $src->get_attribute_value ('Main');
297    $def{Main} = 'my $r;'.$def{Main}.'$r' if $def{Main} =~ /\$r\b/;    $def{Main} = line ($Info, node_path => '//Converter/Main')
298                 . $def{Main}
299                 . line ($Info, reset => 1);
300      if ($def{Main} =~ /\$r\b/) {
301        $def{Main} = 'my $r;'."\n".$def{Main}."\n".'$r';
302      }
303    $def{Main} = barecode code $Info,    $def{Main} = barecode code $Info,
304                 'sub {my ($self, $source, $opt) = @_;'                 'sub {my ($self, $source, $opt) = @_;'
305               . $def{Main} . '}';               . $def{Main} . '}';
# Line 249  sub make_format_converter ($$) { Line 311  sub make_format_converter ($$) {
311        if $def{Name};        if $def{Name};
312    } elsif ($def{Name}) {    } elsif ($def{Name}) {
313      $r = qq{\$Converter->{@{[literal '/'.$def{Name}.'/'.$def{Version}.$flag]}} = {$r};\n};      $r = qq{\$Converter->{@{[literal '/'.$def{Name}.'/'.$def{Version}.$flag]}} = {$r};\n};
314      $r    } else {
315        $r = 'BEGIN { die "Invalid Syntax of Converter: Type or Name property required" }';
316    }    }
317    $r;    $r;
318  }  }
# Line 257  sub make_format_converter ($$) { Line 320  sub make_format_converter ($$) {
320  sub make_function ($$) {  sub make_function ($$) {
321    my ($src, $Info) = @_;    my ($src, $Info) = @_;
322    ## TODO: support of ARGV property    ## TODO: support of ARGV property
323      my $name;
324    my $r = <<EOH;    my $r = <<EOH;
325  @{[change_package $Info, $Info->{module_name}]}  @{[change_package $Info, $Info->{module_name}]}
326  sub @{[$src->get_attribute_value ('Name')]} {  sub @{[$name = $src->get_attribute_value ('Name')]} {
327    @{[code $Info, $src->get_attribute_value ('Main')]}  @{[line $Info, node_path => "Function[Name='$name']/Main"]}@{[
328      code $Info, $src->get_attribute_value ('Main')
329    ]}
330  }  }
331    @{[line $Info, reset => 1]}
332  EOH  EOH
333  }  }
334    
# Line 321  sub make_viewdef ($$) { Line 388  sub make_viewdef ($$) {
388    my ($src, $Info) = @_;    my ($src, $Info) = @_;
389    my $ViewProp = {};    my $ViewProp = {};
390    my $r = '';    my $r = '';
391    $ViewProp->{Name} = n11n $src->get_attribute ('Mode')->value;    $ViewProp->{Name} = n11n $src->get_attribute_value ('Mode');
392      $ViewProp->{Name} =~ s/(?<=.)-/_/g;
393    $ViewProp->{pack_name} = random_module_name ($Info, $ViewProp->{Name});    $ViewProp->{pack_name} = random_module_name ($Info, $ViewProp->{Name});
394        
395    $ViewProp->{condition_stringified} = hash    $ViewProp->{condition_stringified} = hash
# Line 339  our \@ISA = q#SuikaWiki::View::template# Line 407  our \@ISA = q#SuikaWiki::View::template#
407  EOH  EOH
408    for (@{$src->child_nodes}) {    for (@{$src->child_nodes}) {
409      if ($_->local_name eq 'template') {      if ($_->local_name eq 'template') {
410        $r .= make_view_template_method ($_, $Info);        $r .= make_view_template_method ($_, $Info, $ViewProp);
411      } elsif ($_->local_name eq 'method') {      } elsif ($_->local_name eq 'method') {
412          my $method_name = $_->get_attribute_value ('Name');
413        $r .= ({        $r .= ({
414                main => q(sub main ($$) {)."\n".q(my ($self, $opt) = @_;)."\n",                main => q(sub main ($$) {)."\n".q(my ($self, $opt, $opt2) = @_;)."\n",
415                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",
416                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",                    
417               }->{$_->get_attribute ('Name')->value}               }->{$method_name}
418               ||qq(sub @{[$_->get_attribute ('Name')->value]} {\n))               ||qq(sub @{[$method_name]} {\n))
419             . line ($Info, node_path => "ViewDefinition[Mode='$ViewProp->{Name}']/method[Name='$method_name']")
420           . code ($Info, $_->value)           . code ($Info, $_->value)
421           . qq(\n}\n);           . qq(}\n)
422             . line ($Info, reset => 1);
423      }      }
424    }    }
425    my $prop = {Name => $ViewProp->{Name},    my $prop = {Name => $ViewProp->{Name},
# Line 358  EOH Line 429  EOH
429  }  }
430    
431  sub make_view_template_method ($$) {  sub make_view_template_method ($$) {
432    my ($src, $info) = @_;    my ($src, $Info, $ViewProp) = @_;
433    my $r = <<EOH;    my $r = <<EOH;
434    
435  sub main (\$\$\$) {  sub main (\$\$\$) {
# Line 377  sub main (\$\$\$) { Line 448  sub main (\$\$\$) {
448                       ## Compatible options for SuikaWiki 2 WikiPlugin interface                       ## Compatible options for SuikaWiki 2 WikiPlugin interface
449                         param => \\\%main::form,                         param => \\\%main::form,
450                         page => \$main::form{mypage},                         page => \$main::form{mypage},
451                         toc => [],                         #toc => [],
452                         #magic                         #magic
453                         #content                         #content
454                         #use_anchor_name                         #use_anchor_name
# Line 398  sub main (\$\$\$) { Line 469  sub main (\$\$\$) {
469    @{[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;
470       $x?q{$opt2->{output}->{status_code} = }.(0 + $x).q{;}:q{}}]}       $x?q{$opt2->{output}->{status_code} = }.(0 + $x).q{;}:q{}}]}
471    @{[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;
472       $x?q{$opt2->{output}->{reason_phrase} = }.literal($x).q{;}:q{}}]}       $x?q{$opt2->{output}->{status_phrase} = }.literal($x).q{;}:q{}}]}
473    \$opt2->{output}->{entity}->{media_type} = @{[literal    \$opt2->{output}->{entity}->{media_type} = @{[literal
474                             $src->get_attribute ('media-type',make_new_node=>1)                             $src->get_attribute ('media-type',make_new_node=>1)
475                                 ->inner_text || 'application/octet-stream']};                                 ->inner_text || 'application/octet-stream']};
# Line 417  sub main (\$\$\$) { Line 488  sub main (\$\$\$) {
488    \$self->{view}->{wiki}->init_db;    \$self->{view}->{wiki}->init_db;
489    \$self->main_pre (\$opt, \$opt2);    \$self->main_pre (\$opt, \$opt2);
490        
491    my \$fmt = SuikaWiki::Plugin->formatter ('view');    use Message::Util::Error;
492    \$opt2->{output}->{entity}->{body}    try {
493      = \$fmt->replace (\$opt2->{template}, param => \$opt2->{o});      \$opt2->{output}->{entity}->{body}
494          = SuikaWiki::Plugin->formatter ('view')
495            ->replace (\$opt2->{template}, param => \$opt2->{o});
496      } \$self->{view}->{wiki}->{config}->{catch}->{ @{[
497           $ViewProp->{Name} eq '-error' ? 'formatter_view_error'
498                                         : 'formatter_view' ]} };
499    \$opt2->{output}->output (output => 'http-cgi');    \$opt2->{output}->output (output => 'http-cgi');
500        
501    \$self->main_post (\$opt, \$opt2);    \$self->main_post (\$opt, \$opt2);
# Line 432  sub make_rule ($$) { Line 508  sub make_rule ($$) {
508    my $type = $src->get_attribute ('Category', make_new_node => 1)->value || [];    my $type = $src->get_attribute ('Category', make_new_node => 1)->value || [];
509    my $name = $src->get_attribute ('Name', make_new_node => 1)->value;    my $name = $src->get_attribute ('Name', make_new_node => 1)->value;
510    $name =~ s/(?<=.)-/_/g;    $name =~ s/(?<=.)-/_/g;
   my $main = code $Info, $src->get_attribute_value ('Formatting');  
511        
512    my $reg_block;    my $reg_block;
513    $reg_block = qr/[^{}]*(?>[^{}]+|{(??{$reg_block})})*/;    $reg_block = qr/[^{}]*(?>[^{}]+|{(??{$reg_block})})*/;
514    my $reg_attr = qr/__ATTR(TEXT|NODE)?:%(\w+)(?:->{($reg_block)})?__;/;    my %code;
515        for my $codename ([qw/Formatting main/], [qw/After after/],
516    $main = q{my ($f, $rule_name, $p, $o, %opt) = @_;}."\n".$main                      [qw/Before before/], [qw/Pre pre/], [qw/Post post/],
517      if $main =~ /\$f\b/                      [qw/Attribute attr/]) {
518      or $main =~ /\$rule_name\b/      my $main = code $Info, $src->get_attribute_value ($codename->[0]);
519      or $main =~ /\$[opr]\b/      next unless $main;
520      or $main =~ /[%\$]opt\b/;      $main = line ($Info, node_path =>
521    if ($main =~ /\$r\b/) {                "FormattingRule[name()='@{[list $type]}/$name']/".$codename->[0])
522      warn qq(Rule @{[list $type]}/$name: Use of \$r is deprecated);            . $main;
523      $main = q{my $r = '';} . "\n" . $main . "\n"      
524            . q{$p->{-parent}->append_node ($r, node_or_text => 1);};      $main = q{my ($f, $rule_name, $p, $o, %opt) = @_;}."\n".$main
525    }        if $main =~ /\$f\b/
526    $main =~ s{$reg_attr}        or $main =~ /\$rule_name\b/
527              {($1 eq 'TEXT' ? '$p->{'.literal($2).'} = do { my $r = ' : '')        or $main =~ /\$[opr]\b/
528               .'$f->parse_attr ($p=>'.literal($2).', $o, '        or $main =~ /[%\$]opt\b/;
529                               .($3?'-parent => '.$3.', ':'')      if ($main =~ /\$r\b/) {
530                               .($1?'-non_parsed_to_node => 1, ':'')        warn qq(Rule @{[list $type]}/$name: Use of \$r is deprecated);
531                               .'%opt)'        $main = q{my $r = '';} . "\n" . $main . "\n"
532                               .($1 eq 'TEXT' ? '; ref $r?$r->inner_text:$r}' : '')              . q{$p->{-parent}->append_node ($r, node_or_text => 1);};
533                               .';'}ge;      }
534          $main =~ s{__ATTR(TEXT|NODE)?:%(\w+|{$reg_block})(?:->{($reg_block)})?__;}
535    my $main = <<EOH;                {($1 eq 'TEXT' ? '$p->{'.literal_or_code($Info, $2)
536                                          .'} = do { my $r = ' : '')
537                   .'$f->parse_attr ($p=>'.literal_or_code($Info, $2).', $o, '
538                                   .($3?'-parent => '.$3.', ':'')
539                                   .($1?'-non_parsed_to_node => 1, ':'')
540                                   .'%opt)'
541                                   .($1 eq 'TEXT' ? '; ref $r?$r->inner_text:$r}'
542                                                  : '')
543                                   .';'}ge;
544        $code{$codename->[1]} = barecode "sub {$main}";
545      }
546      
547      my $main = literal {
548        Description => [barecode m13ed_val_list $src, 'Description'],
549        Parameter => {do {
550          my @r;
551          for (@{$src->child_nodes}) {
552            if ($_->local_name eq 'Parameter') {
553              push @r, $_->get_attribute_value ('Name')
554                       => {Type => $_->get_attribute_value ('Type'),
555                           Default => $_->get_attribute_value ('Default'),
556                           Description => [barecode m13ed_val_list $_, 'Description']};
557            }
558          }
559          @r;
560        }},
561        %code,
562      };
563      $main .= line $Info, reset => 1;
564    
565    
566    my  $amain = <<EOH;
567  {  {
568    main => sub {$main},    main => sub {$main},
569    @{[line ($Info, reset => 1)]}
570    Description => [@{[m13ed_val_list $src, 'Description']}],    Description => [@{[m13ed_val_list $src, 'Description']}],
571    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;  
572    }]}},    }]}},
573  }  }
574  EOH  EOH
Legend:
Removed from v.1.5  
changed lines
  Added in v.1.10
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24