/[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.9 by wakaba, Fri Dec 26 06:53:48 2003 UTC revision 1.14 by wakaba, Thu Mar 11 04:04:06 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 128  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 162  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 198  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 210  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 222  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 240  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 274  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 316  EOH Line 357  EOH
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 370  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 385  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 425  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 464  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 488  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'));  
530        
531    my $reg_block;    my $reg_block;
532    $reg_block = qr/[^{}]*(?>[^{}]+|{(??{$reg_block})})*/;    $reg_block = qr/[^{}]*(?>[^{}]+|{(??{$reg_block})})*/;
533        my %code;
534    $main = q{my ($f, $rule_name, $p, $o, %opt) = @_;}."\n".$main    for my $codename ([qw/Formatting main/], [qw/After after/],
535      if $main =~ /\$f\b/                      [qw/Before before/], [qw/Pre pre/], [qw/Post post/],
536      or $main =~ /\$rule_name\b/                      [qw/Attribute attr/]) {
537      or $main =~ /\$[opr]\b/      my $main = code $Info, $src->get_attribute_value ($codename->[0]);
538      or $main =~ /[%\$]opt\b/;      next unless $main;
539    if ($main =~ /\$r\b/) {      $main = line ($Info, node_path =>
540      warn qq(Rule @{[list $type]}/$name: Use of \$r is deprecated);                "FormattingRule[name()='@{[list $type]}/$name']/".$codename->[0])
541      $main = q{my $r = '';} . "\n" . $main . "\n"            . $main;
542            . q{$p->{-parent}->append_node ($r, node_or_text => 1);};      
543    }      if ( $main =~ /\$f\b/
544    $main =~ s{__ATTR(TEXT|NODE)?:%(\w+|{$reg_block})(?:->{($reg_block)})?__;}        or $main =~ /\$rule_name\b/
545              {($1 eq 'TEXT' ? '$p->{'.literal_or_code($Info, $2)        or $main =~ /\$[opr]\b/
546                                      .'} = do { my $r = ' : '')        or $main =~ /[%\$]opt\b/
547               .'$f->parse_attr ($p=>'.literal_or_code($Info, $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    $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)]}  @{[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};
# Line 560  sub random_module_name ($;$) { Line 625  sub random_module_name ($;$) {
625      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]),
626      join ('', @rand[rand@rand,rand@rand,rand@rand,rand@rand]);      join ('', @rand[rand@rand,rand@rand,rand@rand,rand@rand]);
627  }  }
628    
629    =head1 NAME
630    
631    mkplugin2.pl - SuikaWiki: WikiPlugin Generator
632    
633    =head1 SYNOPSIS
634    
635      mkplugin2.pl pluginsrc.wp2 > plugin.pm
636    
637    =head1 DESCRIPTION
638    
639    C<mkplugin2.pl> generates WikiPlugin module as a Perl module file
640    from WikiPlugin source description.  WikiPlugin source description
641    is described in SuikaWikiConfig/2.0 format and it contains
642    definitions of wiki constructions (such as formatting rules and
643    WikiView definitions) as both machine understandable code and
644    human readable documentation.  For more information, see
645    <http://suika.fam.cx/~wakaba/-temp/wiki/wiki?WikiPlugin>.
646    
647    This script is part of SuikaWiki.
648    
649    =head1 HISTORY AND COMPATIBILITY
650    
651    C<mkplugin2.pl> introduced as part of SuikaWiki 3.
652    It converts SuikaWiki 3 WikiPlugin source descriptions
653    (in SuikaWikiConfig/2.0) into Perl modules with SuikaWiki 3 interface.
654    
655    SuikaWiki 2 has C<mkplugin.pl>.  It also converts WikiPlugin
656    source descriptions into Perl modules.  But it support
657    SuikaWiki 2 format of WikiPlugin source description that differs from
658    SuikaWiki 3 format.  Wiki programming interface (not limited to
659    WikiPlugin related one) of SuikaWiki 3 also incompatible with that
660    of SuikaWiki 2 so that it is impossible to use SuikaWiki 2 WikiPlugin
661    module with SuikaWiki 3 and vice versa.
662    
663    =head1 SEE ALSO
664    
665    C<SuikaWiki::Plugin>, SuikaWiki:WikiPlugin
666    <http://suika.fam.cx/~wakaba/-temp/wiki/wiki?WikiPlugin>.
667    
668    =head1 LICENSE
669    
670    Copyright 2003-2004 Wakaba <w@suika.fam.cx>.  All rights reserved.
671    
672    This program is free software; you can redistribute it and/or
673    modify it under the same terms as Perl itself.
674    
675    =cut
676    
677    1; # $Date$
Legend:
Removed from v.1.9  
changed lines
  Added in v.1.14
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24