/[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.11 by wakaba, Sun Feb 1 12:07:08 2004 UTC revision 1.17 by wakaba, Sat May 1 03:55:05 2004 UTC
# Line 59  sub code ($$) { Line 59  sub code ($$) {
59      $code =~ s/\$$_\b/$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    my $type = $opt{Type} ?           ->($self, $source, \%opt)
252                  $opt{Type} .      if $converter;
                 SuikaWiki::Format::Definition->__get_param_string  
                   ($opt{Type_param}) : undef;  
   if ($Converter->{$type.$flag}) {  
     $converter = $Converter->{$type.$flag};  
   } 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 271  EOH Line 284  EOH
284        $r .= qq(}\n);        $r .= qq(}\n);
285      } elsif ($_->local_name eq 'Use') {      } elsif ($_->local_name eq 'Use') {
286        $r .= line $Info, node_path => qq(Format[module-name()=$module_name]/Use);        $r .= line $Info, node_path => qq(Format[module-name()=$module_name]/Use);
287        $r .= $_->inner_text;        $r .= code $Info, $_->inner_text;
288      }      }
289    }    }
290    $r;    $r;
# Line 280  EOH Line 293  EOH
293  sub make_format_converter ($$) {  sub make_format_converter ($$) {
294    my ($src, $Info) = @_;    my ($src, $Info) = @_;
295    my %def;    my %def;
296    $def{Type} = $src->get_attribute ('Type');    for (qw/Type Name Version TypeURIReference IsFragment IsPlaceholder/) {
297    if (ref $def{Type}) {      $def{$_} = $src->get_attribute_value ($_);
298      $def{Type} = $def{Type}->inner_text      delete $def{$_} unless defined $def{$_};
299            . join '', map {    }
300                ';'. $_->local_name .'='. quoted_string $_->inner_text    $def{Type_param} = {map {$_->local_name => $_->value}
301              } sort {                                @{$src->get_attribute ('Type', make_new_node => 1)
302                $a->local_name cmp $b->local_name                                    ->child_nodes}};
303              } @{$def{Type}->child_nodes};    my $type = serialize_media_type ($Info,
304    } else {                 Type => $def{Type},
305      delete $def{Type};                 Type_param => $def{Type_param},
306                   Name => $def{Name},
307                   Version => $def{Version},
308                   URIReference => $def{TypeURIReference},
309                   IsFragment => $def{IsFragment},
310                   IsPlaceholder => $def{IsPlaceholder});
311      $def{serialized_type} = $type->{_};
312      
313      for (qw/Main ToString ToOctetStream/) {
314        my $def = $src->get_attribute_value ($_);
315        next unless $def;
316        $def{$_} = line ($Info, node_path => '//Converter/'.$_)
317                   . $def
318                   . line ($Info, reset => 1);
319        if ($def{$_} =~ /\$r\b/) {
320          $def{$_} = 'my $r;'."\n".$def{$_}."\n".'$r';
321        }
322        $def{$_} = barecode code $Info,
323                     'sub {my ($self, $source, $opt) = @_;'
324                   . $def{$_} . '}';
325    }    }
   $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} . '}';  
326        
327    my $r = list %def;    my $r = list %def;
328    if ($def{Type}) {    if ($type->{Type}) {
329      $r = qq{\$Converter->{@{[literal $def{Type}.$flag]}} = {$r};\n};      $r = qq{\$Converter->{@{[literal $type->{Type}]}} = {$r};\n};
330      $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}
331        if $def{Name};        if $type->{Magic};
332    } elsif ($def{Name}) {      $r .= qq{\$Converter->{@{[literal $type->{URIReference}]}} = \$Converter->{@{[literal $type->{Type}]}};\n}
333      $r = qq{\$Converter->{@{[literal '/'.$def{Name}.'/'.$def{Version}.$flag]}} = {$r};\n};        if $type->{URIReference};
334      } elsif ($type->{Magic}) {
335        $r = qq{\$Converter->{@{[literal $type->{Magic}]}} = {$r};\n};
336        $r .= qq{\$Converter->{@{[literal $type->{URIReference}]}} = \$Converter->{@{[literal $type->{Magic}]}};\n}
337          if $type->{URIReference};
338      } elsif ($type->{URIReference}) {
339        $r = qq{\$Converter->{@{[literal $type->{URIReference}]}} = {$r};\n};
340    } else {    } else {
341      $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" }';
342    }    }
343    $r;    $r;
344  }  }
345    
346    sub serialize_media_type ($%) {
347      my ($Info, %opt) = @_;
348      my %return;
349      if ($opt{Type}) {
350        $return{Type} = 'IMT:'.$opt{Type};
351        if ($opt{Type_param}) {
352          $return{Type} .= join '', map {my $s;
353                             ';'. $_ .'="'
354                           . (($s = $opt{Type_param}->{$_}) =~ s/([\\"])/\\$1/g, $s)
355                           . '"'
356                           } sort {
357                             $a cmp $b
358                           } keys %{$opt{Type_param}};
359        }
360      }
361      if ($opt{Magic}) {
362        $return{Magic} = 'MAGIC:'.$opt{Magic};
363      } elsif ($opt{Name}) {
364        $return{Name} = 'MAGIC:'.$opt{Name}.'/*';
365        $return{Magic} = 'MAGIC:'.$opt{Name}.'/'.$opt{Version} if $opt{Version};
366      }
367      if ($opt{URIReference}) {
368        $return{URIReference} = $opt{URIReference};
369      }
370      my $flag = '##';
371      $flag .= 'f' if $opt{IsFragment};
372      $flag .= 'p' if $opt{IsPlaceholder};
373      for (qw/URIReference Type Magic Name/) {
374        $return{$_} .= $flag if $return{$_};
375      }
376      $return{_} = $return{URIReference} || $return{Type}
377                || $return{Magic} || $return{Name};
378      \%return;
379    }
380    
381    
382  sub make_function ($$) {  sub make_function ($$) {
383    my ($src, $Info) = @_;    my ($src, $Info) = @_;
384    ## TODO: support of ARGV property    ## TODO: support of ARGV property
# Line 352  sub register_plugin_const ($$) { Line 404  sub register_plugin_const ($$) {
404  sub make_resdef ($$) {  sub make_resdef ($$) {
405    my ($src, $Info) = @_;    my ($src, $Info) = @_;
406    my $r = change_package $Info, 'SuikaWiki::Plugin::Resource';    my $r = change_package $Info, 'SuikaWiki::Plugin::Resource';
407      local $Info->{-message_error_used} = 0;  
408    $r .= qq{our \$BaseResource;\n};    $r .= qq{our \$BaseResource;\n};
409    for (@{$src->child_nodes}) {    for (@{$src->child_nodes}) {
410      if ($_->node_type eq '#element') {      if ($_->node_type eq '#element') {
# Line 415  push \@SuikaWiki::View::Implementation:: Line 468  push \@SuikaWiki::View::Implementation::
468  @{[change_package $Info, $ViewProp->{pack_name}]}  @{[change_package $Info, $ViewProp->{pack_name}]}
469  our \@ISA = q#SuikaWiki::View::template#;  our \@ISA = q#SuikaWiki::View::template#;
470  EOH  EOH
471        local $Info->{-message_error_used} = 0;  
472    my $use = $src->get_attribute ('Use');    my $use = $src->get_attribute ('Use');
473    if (ref $use) {    if (ref $use) {
474      $r .= line $Info, node_path => "ViewDefinition[Mode='$ViewProp->{Name}']/Use";      $r .= line $Info, node_path => "ViewDefinition[Mode='$ViewProp->{Name}']/Use";
475      $r .= $use->inner_text . "\n\n";      $r .= code $Info, $use->inner_text;
476        $r .= "\n\n";
477    }    }
478        
479    for (@{$src->child_nodes}) {    for (@{$src->child_nodes}) {
# Line 462  sub main (\$\$\$) { Line 516  sub main (\$\$\$) {
516        
517    \$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]};
518    \$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)  
     ]}},  
519                        ## SuikaWiki 3 WikiPlugin interface                        ## SuikaWiki 3 WikiPlugin interface
520                          wiki => \$self->{view}->{wiki},                          wiki => \$self->{view}->{wiki},
521                          plugin => \$self->{view}->{wiki}->{plugin},                          plugin => \$self->{view}->{wiki}->{plugin},
# Line 501  sub main (\$\$\$) { Line 539  sub main (\$\$\$) {
539              qq{\$opt2->{output}->set_expires (delta => @{[0 + $x]});};              qq{\$opt2->{output}->set_expires (delta => @{[0 + $x]});};
540            }            }
541        }]}        }]}
542      \$opt2->{output}->{entity}->{body_is_octet_stream} = @{[
543        $src->get_attribute ('body')->get_attribute_value ('is-octet-stream', default_value => 0)
544        or 0
545      ]};
546        
547    \$self->{view}->{wiki}->init_db;    \$self->{view}->{wiki}->init_db;
548    \$self->main_pre (\$opt, \$opt2);    \$self->main_pre (\$opt, \$opt2);
# Line 596  my  $amain = <<EOH; Line 638  my  $amain = <<EOH;
638  }  }
639  EOH  EOH
640    my $r = change_package $Info, $Info->{module_name};    my $r = change_package $Info, $Info->{module_name};
641      local $Info->{-message_error_used} = 0;  
642    if (@$type == 1) {    if (@$type == 1) {
643      $type->[0] =~ tr/-/_/;      $type->[0] =~ tr/-/_/;
644      $r .= qq{\$SuikaWiki::Plugin::Rule{$type->[0]}->{$name} = $main;\n};      $r .= qq{\$SuikaWiki::Plugin::Rule{$type->[0]}->{$name} = $main;\n};
# Line 612  EOH Line 655  EOH
655    $r;    $r;
656  }  }
657    
658    =item FormattingRuleAlias
659    
660    Generating an alias name for a formatting rule that is already loaded.
661    Example:
662    
663      FormattingRuleAlias:
664        @Category[list]:
665          category-1
666          category-2
667          ...
668        @Name: new-rule-name
669        @Reference:
670          @@Category: one-of-category
671          @@Name: one-of-name
672    
673    associates C<(I<category-1>, I<new-rule-name>)>,
674    C<(I<category-2>, I<new-rule-name>)>, ...
675    with C<(I<one-of-category>, I<one-of-name>)>.
676    
677    =cut
678    
679    sub make_rule_alias ($$) {
680      my ($src, $Info) = @_;
681      my $type = $src->get_attribute ('Category', make_new_node => 1)->value || [];
682      my $name = $src->get_attribute ('Name', make_new_node => 1)->value;
683      
684      my $ref = $src->get_attribute ('Reference', make_new_node => 1);
685      my $c = $ref->get_attribute_value ('Category');
686      my $n = $ref->get_attribute_value ('Name');
687      
688      s/(?<=.)-/_/g for $n, $name;
689      tr/-/_/ for $c, @$type;
690      
691      my $def = qq{\$SuikaWiki::Plugin::Rule{@{[literal $c]}}->{@{[literal $n]}} or warn qq{Formatting rule "$c/$n" not defined}};
692      
693      my $r = change_package $Info, $Info->{module_name};
694      for my $type (@$type) {
695        $r .= qq{\$SuikaWiki::Plugin::Rule{@{[literal $type]}}->{@{[literal $name]}} = $def;\n};
696        push @{$Info->{provide}->{rule}->{$type}}, $name;
697      }
698      $r;
699    }
700    
701    
702  sub random_module_name ($;$) {  sub random_module_name ($;$) {
703    my ($Info, $subname) = @_;    my ($Info, $subname) = @_;
# Line 622  sub random_module_name ($;$) { Line 708  sub random_module_name ($;$) {
708      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]),
709      join ('', @rand[rand@rand,rand@rand,rand@rand,rand@rand]);      join ('', @rand[rand@rand,rand@rand,rand@rand,rand@rand]);
710  }  }
711    
712    =head1 NAME
713    
714    mkplugin2.pl - SuikaWiki: WikiPlugin Generator
715    
716    =head1 SYNOPSIS
717    
718      mkplugin2.pl pluginsrc.wp2 > plugin.pm
719    
720    =head1 DESCRIPTION
721    
722    C<mkplugin2.pl> generates WikiPlugin module as a Perl module file
723    from WikiPlugin source description.  WikiPlugin source description
724    is described in SuikaWikiConfig/2.0 format and it contains
725    definitions of wiki constructions (such as formatting rules and
726    WikiView definitions) as both machine understandable code and
727    human readable documentation.  For more information, see
728    <http://suika.fam.cx/~wakaba/-temp/wiki/wiki?WikiPlugin>.
729    
730    This script is part of SuikaWiki.
731    
732    =head1 HISTORY AND COMPATIBILITY
733    
734    C<mkplugin2.pl> introduced as part of SuikaWiki 3.
735    It converts SuikaWiki 3 WikiPlugin source descriptions
736    (in SuikaWikiConfig/2.0) into Perl modules with SuikaWiki 3 interface.
737    
738    SuikaWiki 2 has C<mkplugin.pl>.  It also converts WikiPlugin
739    source descriptions into Perl modules.  But it support
740    SuikaWiki 2 format of WikiPlugin source description that differs from
741    SuikaWiki 3 format.  Wiki programming interface (not limited to
742    WikiPlugin related one) of SuikaWiki 3 also incompatible with that
743    of SuikaWiki 2 so that it is impossible to use SuikaWiki 2 WikiPlugin
744    module with SuikaWiki 3 and vice versa.
745    
746    =head1 SEE ALSO
747    
748    C<SuikaWiki::Plugin>, SuikaWiki:WikiPlugin
749    <http://suika.fam.cx/~wakaba/-temp/wiki/wiki?WikiPlugin>.
750    
751    =head1 LICENSE
752    
753    Copyright 2003-2004 Wakaba <w@suika.fam.cx>.  All rights reserved.
754    
755    This program is free software; you can redistribute it and/or
756    modify it under the same terms as Perl itself.
757    
758    =cut
759    
760    1; # $Date$
Legend:
Removed from v.1.11  
changed lines
  Added in v.1.17
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24