/[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.8 by wakaba, Mon Dec 1 07:46:42 2003 UTC revision 1.13 by wakaba, Sat Feb 14 10:59:55 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      $Info->{-message_error_used} = 1 if $code =~ /\buse\s+Message::Util::Error\b/;
63      if (not $Info->{-message_error_used} and
64         ($code =~ /\btry\s*\{/ or $code =~ /\bcatch\s*\{/)) {
65        warn "Message::Util::Error MUST be 'use'd before 'try'...'catch' block used";
66      }
67    $code;    $code;
68  }  }
69  sub change_package ($$) {  sub change_package ($$) {
# Line 97  sub line ($;%) { Line 102  sub line ($;%) {
102    $opt{file} =~ s/"/''/g;    $opt{file} =~ s/"/''/g;
103    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";
104  }  }
105    sub literal_or_code ($$) {
106      my ($Info, $s) = @_;
107      substr ($s, 0, 1) ne '{' ? literal ($s)
108                               : code ($Info, substr ($s, 1, length ($s) - 2));
109    }
110    
111  my $parser = Message::Markup::SuikaWikiConfig20::Parser->new;  my $parser = Message::Markup::SuikaWikiConfig20::Parser->new;
112  my $plugins = $parser->parse_text ($src);  my $plugins = $parser->parse_text ($src);
# Line 123  our \%Info; Line 133  our \%Info;
133  \$Info{$Info{name_literal}}->{Name} = $Info{name_literal};  \$Info{$Info{name_literal}}->{Name} = $Info{name_literal};
134  EOH  EOH
135  for (qw/Version InterfaceVersion mkpluginVersion module_name/) {  for (qw/Version InterfaceVersion mkpluginVersion module_name/) {
136    print qq{\$Info{$Info{name_literal}}->{$_} = @{[literal $Info{$_}]};\n};    print qq{\$Info{$Info{name_literal}}->{@{[literal $_]}} = @{[literal $Info{$_}]};\n};
137  }  }
138  for (qw/LastModified/) {  for (qw/LastModified Date.RCS/) {
139    $Info{$_} = n11n $meta->get_attribute ($_,make_new_node=>1)->value;    $Info{$_} = n11n $meta->get_attribute ($_,make_new_node=>1)->value;
140    next unless length $Info{$_};    next unless length $Info{$_};
141    print qq{\$Info{$Info{name_literal}}->{$_} = } . literal $Info{$_};    print qq{\$Info{$Info{name_literal}}->{@{[literal $_]}} = } . literal $Info{$_};
142    print ";\n";    print ";\n";
143  }  }
144  for (qw/RequiredPlugin RequiredModule/) {  for (qw/RequiredPlugin RequiredModule/) {
# Line 157  my $use = $meta->get_attribute ('Use'); Line 167  my $use = $meta->get_attribute ('Use');
167  if (ref $use) {  if (ref $use) {
168    print change_package \%Info, $Info{module_name};    print change_package \%Info, $Info{module_name};
169    print line \%Info, node_path => 'Plugin/Use';    print line \%Info, node_path => 'Plugin/Use';
170    print $use->inner_text, "\n";    print code \%Info, $use->inner_text;
171    print line \%Info, reset => 1;    print line \%Info, reset => 1;
172  }  }
173    
# Line 176  for (@{$plugins->child_nodes}) { Line 186  for (@{$plugins->child_nodes}) {
186      register_plugin_const ($_, \%Info);      register_plugin_const ($_, \%Info);
187    } elsif ($_->local_name eq 'Format') {    } elsif ($_->local_name eq 'Format') {
188      print "\n", make_format ($_, \%Info);      print "\n", make_format ($_, \%Info);
189    # Parameter
190    # PluginCategory
191    }    }
192  }  }
193    
# Line 191  sub make_format ($$) { Line 203  sub make_format ($$) {
203    my ($src, $Info) = @_;    my ($src, $Info) = @_;
204    my $module_name = 'SuikaWiki::Format::Definition::'.$src->get_attribute_value ('ModuleName');    my $module_name = 'SuikaWiki::Format::Definition::'.$src->get_attribute_value ('ModuleName');
205    my $r = change_package $Info, $module_name;    my $r = change_package $Info, $module_name;
206      local $Info->{-message_error_used} = 0;  
207    $r .= qq{our \@ISA;\n};    $r .= qq{our \@ISA;\n};
208    if (my $isa = $src->get_attribute_value ('Inherit')) {    if (my $isa = $src->get_attribute_value ('Inherit')) {
209      for (@$isa) {      for (@$isa) {
# Line 203  sub make_format ($$) { Line 216  sub make_format ($$) {
216      $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};
217    }    }
218    if (my $type = $src->get_attribute_value ('Type')) {    if (my $type = $src->get_attribute_value ('Type')) {
219        $type .= join '', map {
220                   ';'. $_->local_name .'='. quoted_string $_->inner_text
221                 } sort {
222                   $a->local_name cmp $b->local_name
223                 } @{$src->get_attribute ('Type')->child_nodes};
224      $r .= qq{\$SuikaWiki::Format::Definition::Class{@{[literal $type.'//']}} = '$module_name';\n};      $r .= qq{\$SuikaWiki::Format::Definition::Class{@{[literal $type.'//']}} = '$module_name';\n};
225    }    }
226        
# Line 215  sub convert ($$;%) { Line 233  sub convert ($$;%) {
233    my $flag = '//';    my $flag = '//';
234    $flag .= 'f' if $opt{IsFragment};    $flag .= 'f' if $opt{IsFragment};
235    $flag .= 'p' if $opt{IsPlaceholder};    $flag .= 'p' if $opt{IsPlaceholder};
236    if ($Converter->{$opt{Type}.$flag}) {    my $type = $opt{Type} ?
237      $converter = $Converter->{$opt{Type}.$flag};                  $opt{Type} .
238                    SuikaWiki::Format::Definition->__get_param_string
239                      ($opt{Type_param}) : undef;
240      if ($Converter->{$type.$flag}) {
241        $converter = $Converter->{$type.$flag};
242    } elsif ($Converter->{$opt{Name}.'/'.$opt{Version}.$flag}) {    } elsif ($Converter->{$opt{Name}.'/'.$opt{Version}.$flag}) {
243      $converter = $Converter->{'/'.$opt{Name}.'/'.$opt{Version}.$flag};      $converter = $Converter->{'/'.$opt{Name}.'/'.$opt{Version}.$flag};
244    }    }
245    return $converter->{Main}->($self, $source, \%opt) if $converter;    return ($converter->{$opt{return_type} or 'Main'} or
246              CORE::die "Buggy implementation: $type $opt{Name}/$opt{Version}$flag/@{[$opt{return_type} or 'Main']} not defined")
247             ->($self, $source, \%opt)
248        if $converter;
249    $self->SUPER::convert ($source, %opt);    $self->SUPER::convert ($source, %opt);
250  }  }
251  EOH  EOH
# Line 233  EOH Line 258  EOH
258          undef $convert;          undef $convert;
259        }        }
260        $r .= make_format_converter ($_, $Info);        $r .= make_format_converter ($_, $Info);
261        } elsif ($_->local_name eq 'WikiForm') {
262          $r .= q(sub wikiform {)."\n".q(my ($self, $source, %opt) = @_;);
263          $r .= line $Info, node_path => qq(Format[module-name()=$module_name]/WikiForm);
264          $r .= code $Info, $_->get_attribute_value ('Main');
265          $r .= line $Info, reset => 1;
266          $r .= qq(}\n);
267        } elsif ($_->local_name eq 'HeadSummary') {
268          $r .= q(sub headsummary {)."\n".q(my ($self, $source, %opt) = @_;);
269          $r .= line $Info, node_path => qq(Format[module-name()=$module_name]/HeadSummary);
270          $r .= code $Info, $_->get_attribute_value ('Main');
271          $r .= line $Info, reset => 1;
272          $r .= qq(}\n);
273        } elsif ($_->local_name eq 'NextIndex') {
274          my $name = $_->get_attribute_value ('Name', default => '');
275          $r .= q(sub next_index_for_).$name
276             .  q( {)."\n".q(my ($self, $source, %opt) = @_;)
277             .  line $Info, node_path => qq(Format[module-name()=$module_name]/NextIndex[Name=$name]);
278          $r .= code $Info, $_->get_attribute_value ('Main');
279          $r .= line $Info, reset => 1;
280          $r .= qq(}\n);
281      } elsif ($_->local_name eq 'Use') {      } elsif ($_->local_name eq 'Use') {
282        $r .= line $Info, node_path => qq(Format[module-name()=$module_name]/Use);        $r .= line $Info, node_path => qq(Format[module-name()=$module_name]/Use);
283        $r .= $_->inner_text;        $r .= code $Info, $_->inner_text;
284      }      }
285    }    }
286    $r;    $r;
# Line 267  sub make_format_converter ($$) { Line 312  sub make_format_converter ($$) {
312    $flag .= 'p' and $def{IsPlaceholder} = 1    $flag .= 'p' and $def{IsPlaceholder} = 1
313      if $src->get_attribute_value ('IsPlaceholder');      if $src->get_attribute_value ('IsPlaceholder');
314        
315    $def{Main} = $src->get_attribute_value ('Main');    for (qw/Main ToString ToOctetStream/) {
316    $def{Main} = line ($Info, node_path => '//Converter/Main')      my $def = $src->get_attribute_value ($_);
317               . $def{Main}      next unless $def;
318               . line ($Info, reset => 1);      $def{$_} = line ($Info, node_path => '//Converter/'.$_)
319    if ($def{Main} =~ /\$r\b/) {                 . $def
320      $def{Main} = 'my $r;'."\n".$def{Main}."\n".'$r';                 . line ($Info, reset => 1);
321    }      if ($def{$_} =~ /\$r\b/) {
322    $def{Main} = barecode code $Info,        $def{$_} = 'my $r;'."\n".$def{$_}."\n".'$r';
323                 'sub {my ($self, $source, $opt) = @_;'      }
324               . $def{Main} . '}';      $def{$_} = barecode code $Info,
325                     'sub {my ($self, $source, $opt) = @_;'
326                   . $def{$_} . '}';
327      }
328        
329    my $r = list %def;    my $r = list %def;
330    if ($def{Type}) {    if ($def{Type}) {
# Line 285  sub make_format_converter ($$) { Line 333  sub make_format_converter ($$) {
333        if $def{Name};        if $def{Name};
334    } elsif ($def{Name}) {    } elsif ($def{Name}) {
335      $r = qq{\$Converter->{@{[literal '/'.$def{Name}.'/'.$def{Version}.$flag]}} = {$r};\n};      $r = qq{\$Converter->{@{[literal '/'.$def{Name}.'/'.$def{Version}.$flag]}} = {$r};\n};
336      $r    } else {
337        $r = 'BEGIN { die "Invalid Syntax of Converter: Type or Name property required" }';
338    }    }
339    $r;    $r;
340  }  }
# Line 299  sub make_function ($$) { Line 348  sub make_function ($$) {
348  sub @{[$name = $src->get_attribute_value ('Name')]} {  sub @{[$name = $src->get_attribute_value ('Name')]} {
349  @{[line $Info, node_path => "Function[Name='$name']/Main"]}@{[  @{[line $Info, node_path => "Function[Name='$name']/Main"]}@{[
350    code $Info, $src->get_attribute_value ('Main')    code $Info, $src->get_attribute_value ('Main')
351  ]}@{[line $Info, reset => 1]}  ]}
352  }  }
353    @{[line $Info, reset => 1]}
354  EOH  EOH
355  }  }
356    
357  sub register_plugin_const ($$) {  sub register_plugin_const ($$) {
358    my ($src, $Info) = @_;    my ($src, $Info) = @_;
359    for (@{$src->child_nodes}) {    for (@{$src->child_nodes}) {
360      $Info->{const}->{$_->local_name} = $_->value;      $Info->{const}->{$_->local_name} = literal_or_code $Info, $_->value;
361    }    }
362  }  }
363    
364  sub make_resdef ($$) {  sub make_resdef ($$) {
365    my ($src, $Info) = @_;    my ($src, $Info) = @_;
366    my $r = change_package $Info, 'SuikaWiki::Plugin::Resource';    my $r = change_package $Info, 'SuikaWiki::Plugin::Resource';
367      local $Info->{-message_error_used} = 0;  
368    $r .= qq{our \$BaseResource;\n};    $r .= qq{our \$BaseResource;\n};
369    for (@{$src->child_nodes}) {    for (@{$src->child_nodes}) {
370      if ($_->node_type eq '#element') {      if ($_->node_type eq '#element') {
# Line 361  sub make_viewdef ($$) { Line 412  sub make_viewdef ($$) {
412    my $ViewProp = {};    my $ViewProp = {};
413    my $r = '';    my $r = '';
414    $ViewProp->{Name} = n11n $src->get_attribute_value ('Mode');    $ViewProp->{Name} = n11n $src->get_attribute_value ('Mode');
415      $ViewProp->{Name} =~ s/(?<=.)-/_/g;
416    $ViewProp->{pack_name} = random_module_name ($Info, $ViewProp->{Name});    $ViewProp->{pack_name} = random_module_name ($Info, $ViewProp->{Name});
417        
418    $ViewProp->{condition_stringified} = hash    $ViewProp->{condition_stringified} = hash
# Line 376  push \@SuikaWiki::View::Implementation:: Line 428  push \@SuikaWiki::View::Implementation::
428  @{[change_package $Info, $ViewProp->{pack_name}]}  @{[change_package $Info, $ViewProp->{pack_name}]}
429  our \@ISA = q#SuikaWiki::View::template#;  our \@ISA = q#SuikaWiki::View::template#;
430  EOH  EOH
431      local $Info->{-message_error_used} = 0;  
432      my $use = $src->get_attribute ('Use');
433      if (ref $use) {
434        $r .= line $Info, node_path => "ViewDefinition[Mode='$ViewProp->{Name}']/Use";
435        $r .= code $Info, $use->inner_text;
436        $r .= "\n\n";
437      }
438      
439    for (@{$src->child_nodes}) {    for (@{$src->child_nodes}) {
440      if ($_->local_name eq 'template') {      if ($_->local_name eq 'template') {
441        $r .= make_view_template_method ($_, $Info, $ViewProp);        $r .= make_view_template_method ($_, $Info, $ViewProp);
# Line 389  EOH Line 449  EOH
449               ||qq(sub @{[$method_name]} {\n))               ||qq(sub @{[$method_name]} {\n))
450           . line ($Info, node_path => "ViewDefinition[Mode='$ViewProp->{Name}']/method[Name='$method_name']")           . line ($Info, node_path => "ViewDefinition[Mode='$ViewProp->{Name}']/method[Name='$method_name']")
451           . code ($Info, $_->value)           . code ($Info, $_->value)
452           . line ($Info, reset => 1)           . qq(}\n)
453           . qq(}\n);           . line ($Info, reset => 1);
454      }      }
455    }    }
456    my $prop = {Name => $ViewProp->{Name},    my $prop = {Name => $ViewProp->{Name},
# Line 416  sub main (\$\$\$) { Line 476  sub main (\$\$\$) {
476        
477    \$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]};
478    \$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)  
     ]}},  
479                        ## SuikaWiki 3 WikiPlugin interface                        ## SuikaWiki 3 WikiPlugin interface
480                          wiki => \$self->{view}->{wiki},                          wiki => \$self->{view}->{wiki},
481                          plugin => \$self->{view}->{wiki}->{plugin},                          plugin => \$self->{view}->{wiki}->{plugin},
# Line 455  sub main (\$\$\$) { Line 499  sub main (\$\$\$) {
499              qq{\$opt2->{output}->set_expires (delta => @{[0 + $x]});};              qq{\$opt2->{output}->set_expires (delta => @{[0 + $x]});};
500            }            }
501        }]}        }]}
502      \$opt2->{output}->{entity}->{body_is_octet_stream} = @{[
503        $src->get_attribute ('body')->get_attribute_value ('is-octet-stream', default_value => 0)
504        or 0
505      ]};
506        
507    \$self->{view}->{wiki}->init_db;    \$self->{view}->{wiki}->init_db;
508    \$self->main_pre (\$opt, \$opt2);    \$self->main_pre (\$opt, \$opt2);
# Line 479  sub make_rule ($$) { Line 527  sub make_rule ($$) {
527    my $type = $src->get_attribute ('Category', make_new_node => 1)->value || [];    my $type = $src->get_attribute ('Category', make_new_node => 1)->value || [];
528    my $name = $src->get_attribute ('Name', make_new_node => 1)->value;    my $name = $src->get_attribute ('Name', make_new_node => 1)->value;
529    $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);  
530        
531    my $reg_block;    my $reg_block;
532    $reg_block = qr/[^{}]*(?>[^{}]+|{(??{$reg_block})})*/;    $reg_block = qr/[^{}]*(?>[^{}]+|{(??{$reg_block})})*/;
533    my $reg_attr = qr/__ATTR(TEXT|NODE)?:%(\w+)(?:->{($reg_block)})?__;/;    my %code;
534        for my $codename ([qw/Formatting main/], [qw/After after/],
535    $main = q{my ($f, $rule_name, $p, $o, %opt) = @_;}."\n".$main                      [qw/Before before/], [qw/Pre pre/], [qw/Post post/],
536      if $main =~ /\$f\b/                      [qw/Attribute attr/]) {
537      or $main =~ /\$rule_name\b/      my $main = code $Info, $src->get_attribute_value ($codename->[0]);
538      or $main =~ /\$[opr]\b/      next unless $main;
539      or $main =~ /[%\$]opt\b/;      $main = line ($Info, node_path =>
540    if ($main =~ /\$r\b/) {                "FormattingRule[name()='@{[list $type]}/$name']/".$codename->[0])
541      warn qq(Rule @{[list $type]}/$name: Use of \$r is deprecated);            . $main;
542      $main = q{my $r = '';} . "\n" . $main . "\n"      
543            . q{$p->{-parent}->append_node ($r, node_or_text => 1);};      if ( $main =~ /\$f\b/
544    }        or $main =~ /\$rule_name\b/
545    $main =~ s{$reg_attr}        or $main =~ /\$[opr]\b/
546              {($1 eq 'TEXT' ? '$p->{'.literal($2).'} = do { my $r = ' : '')        or $main =~ /[%\$]opt\b/
547               .'$f->parse_attr ($p=>'.literal($2).', $o, '        or $main =~ /\$param_(?:name|value)\n/) {
548                               .($3?'-parent => '.$3.', ':'')        if ($codename->[0] ne 'Attribute') {
549                               .($1?'-non_parsed_to_node => 1, ':'')          $main = q{my ($f, $rule_name, $p, $o, %opt) = @_;}."\n".$main;
550                               .'%opt)'        } else {
551                               .($1 eq 'TEXT' ? '; ref $r?$r->inner_text:$r}' : '')          $main = q{my ($f, $rule_name, $p, $o, $param_name => $param_value, %opt) = @_;}."\n".$main;
552                               .';'}ge;        }
553          }
554    my $main = <<EOH;      if ($main =~ /\$r\b/) {
555          warn qq(Rule @{[list $type]}/$name: Use of \$r is deprecated);
556          $main = q{my $r = '';} . "\n" . $main . "\n"
557                . q{$p->{-parent}->append_node ($r, node_or_text => 1);};
558        }
559        $main =~ s{__ATTR(TEXT|NODE)?:%(\w+|{$reg_block})(?:->{($reg_block)})?__;}
560                  {($1 eq 'TEXT' ? '$p->{'.literal_or_code($Info, $2)
561                                          .'} = do { my $r = ' : '')
562                   .'$f->parse_attr ($p=>'.literal_or_code($Info, $2).', $o, '
563                                   .($3?'-parent => '.$3.', ':'')
564                                   .($1?'-non_parsed_to_node => 1, ':'')
565                                   .'%opt)'
566                                   .($1 eq 'TEXT' ? '; ref $r?$r->inner_text:$r}'
567                                                  : '')
568                                   .';'}ge;
569        $code{$codename->[1]} = barecode "sub {$main}";
570      }
571      
572      my $main = literal {
573        Description => [barecode m13ed_val_list $src, 'Description'],
574        Parameter => {do {
575          my @r;
576          for (@{$src->child_nodes}) {
577            if ($_->local_name eq 'Parameter') {
578              push @r, $_->get_attribute_value ('Name')
579                       => {Type => $_->get_attribute_value ('Type'),
580                           Default => $_->get_attribute_value ('Default'),
581                           Description => [barecode m13ed_val_list $_, 'Description']};
582            }
583          }
584          @r;
585        }},
586        %code,
587      };
588      $main .= line $Info, reset => 1;
589    
590    
591    my  $amain = <<EOH;
592  {  {
593    main => sub {$main},    main => sub {$main},
594    @{[line ($Info, reset => 1)]}
595    Description => [@{[m13ed_val_list $src, 'Description']}],    Description => [@{[m13ed_val_list $src, 'Description']}],
596    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;  
597    }]}},    }]}},
598  }  }
599  EOH  EOH
600    my $r = change_package $Info, $Info->{module_name};    my $r = change_package $Info, $Info->{module_name};
601      local $Info->{-message_error_used} = 0;  
602    if (@$type == 1) {    if (@$type == 1) {
603      $type->[0] =~ tr/-/_/;      $type->[0] =~ tr/-/_/;
604      $r .= qq{\$SuikaWiki::Plugin::Rule{$type->[0]}->{$name} = $main;\n};      $r .= qq{\$SuikaWiki::Plugin::Rule{$type->[0]}->{$name} = $main;\n};
Legend:
Removed from v.1.8  
changed lines
  Added in v.1.13
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24