/[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.16 by wakaba, Sun Apr 25 07:06:50 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:([^:]+):([^>]+)>/literal $Info->{Namespace}->{$1}.$2/ge;
63      
64      $Info->{-message_error_used} = 1 if $code =~ /\buse\s+Message::Util::Error\b/;
65      if (not $Info->{-message_error_used} and
66         ($code =~ /\btry\s*\{/ or $code =~ /\bcatch\s*\{/)) {
67        warn "Message::Util::Error MUST be 'use'd before 'try'...'catch' block used";
68      }
69    $code;    $code;
70  }  }
71  sub change_package ($$) {  sub change_package ($$) {
# Line 128  our \%Info; Line 135  our \%Info;
135  \$Info{$Info{name_literal}}->{Name} = $Info{name_literal};  \$Info{$Info{name_literal}}->{Name} = $Info{name_literal};
136  EOH  EOH
137  for (qw/Version InterfaceVersion mkpluginVersion module_name/) {  for (qw/Version InterfaceVersion mkpluginVersion module_name/) {
138    print qq{\$Info{$Info{name_literal}}->{$_} = @{[literal $Info{$_}]};\n};    print qq{\$Info{$Info{name_literal}}->{@{[literal $_]}} = @{[literal $Info{$_}]};\n};
139  }  }
140  for (qw/LastModified/) {  for (qw/LastModified Date.RCS/) {
141    $Info{$_} = n11n $meta->get_attribute ($_,make_new_node=>1)->value;    $Info{$_} = n11n $meta->get_attribute ($_,make_new_node=>1)->value;
142    next unless length $Info{$_};    next unless length $Info{$_};
143    print qq{\$Info{$Info{name_literal}}->{$_} = } . literal $Info{$_};    print qq{\$Info{$Info{name_literal}}->{@{[literal $_]}} = } . literal $Info{$_};
144    print ";\n";    print ";\n";
145  }  }
146  for (qw/RequiredPlugin RequiredModule/) {  for (qw/RequiredPlugin RequiredModule/) {
# Line 158  print qq{\$Info{$Info{name_literal}}->{A Line 165  print qq{\$Info{$Info{name_literal}}->{A
165  } grep { $_->local_name eq 'Author' } @{$meta->child_nodes}  } grep { $_->local_name eq 'Author' } @{$meta->child_nodes}
166  ). qq{];\n};  ). qq{];\n};
167    
168    for (@{$meta->get_attribute ('Namespace', make_new_node => 1)->child_nodes}) {
169      $Info{Namespace}->{$_->local_name} = $_->value;
170    }
171    
172  my $use = $meta->get_attribute ('Use');  my $use = $meta->get_attribute ('Use');
173  if (ref $use) {  if (ref $use) {
174    print change_package \%Info, $Info{module_name};    print change_package \%Info, $Info{module_name};
175    print line \%Info, node_path => 'Plugin/Use';    print line \%Info, node_path => 'Plugin/Use';
176    print $use->inner_text, "\n";    print code \%Info, $use->inner_text;
177    print line \%Info, reset => 1;    print line \%Info, reset => 1;
178  }  }
179    
# Line 181  for (@{$plugins->child_nodes}) { Line 192  for (@{$plugins->child_nodes}) {
192      register_plugin_const ($_, \%Info);      register_plugin_const ($_, \%Info);
193    } elsif ($_->local_name eq 'Format') {    } elsif ($_->local_name eq 'Format') {
194      print "\n", make_format ($_, \%Info);      print "\n", make_format ($_, \%Info);
195      } elsif ($_->local_name eq 'FormattingRuleAlias') {
196        print "\n", make_rule_alias ($_, \%Info);
197  # Parameter  # Parameter
198  # PluginCategory  # PluginCategory
199    }    }
# Line 198  sub make_format ($$) { Line 211  sub make_format ($$) {
211    my ($src, $Info) = @_;    my ($src, $Info) = @_;
212    my $module_name = 'SuikaWiki::Format::Definition::'.$src->get_attribute_value ('ModuleName');    my $module_name = 'SuikaWiki::Format::Definition::'.$src->get_attribute_value ('ModuleName');
213    my $r = change_package $Info, $module_name;    my $r = change_package $Info, $module_name;
214      local $Info->{-message_error_used} = 0;  
215    $r .= qq{our \@ISA;\n};    $r .= qq{our \@ISA;\n};
216    if (my $isa = $src->get_attribute_value ('Inherit')) {    if (my $isa = $src->get_attribute_value ('Inherit')) {
217      for (@$isa) {      for (@$isa) {
# Line 207  sub make_format ($$) { Line 221  sub make_format ($$) {
221      $r .= qq{push \@ISA, 'SuikaWiki::Format::Definition::template';\n};          $r .= qq{push \@ISA, 'SuikaWiki::Format::Definition::template';\n};    
222    }    }
223    if (my $name = $src->get_attribute_value ('Name')) {    if (my $name = $src->get_attribute_value ('Name')) {
224      $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};
225    }    }
226    if (my $type = $src->get_attribute_value ('Type')) {    if (my $type = $src->get_attribute_value ('Type')) {
227      $type .= join '', map {      $type .= join '', map {
# Line 215  sub make_format ($$) { Line 229  sub make_format ($$) {
229               } sort {               } sort {
230                 $a->local_name cmp $b->local_name                 $a->local_name cmp $b->local_name
231               } @{$src->get_attribute ('Type')->child_nodes};               } @{$src->get_attribute ('Type')->child_nodes};
232      $r .= qq{\$SuikaWiki::Format::Definition::Class{@{[literal $type.'//']}} = '$module_name';\n};      $r .= qq{\$SuikaWiki::Format::Definition::Class{@{[literal 'IMT:'.$type.'##']}} = '$module_name';\n};
233    }    }
234        
235    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 237  sub make_format ($$) {
237  our $Converter;  our $Converter;
238  sub convert ($$;%) {  sub convert ($$;%) {
239    my ($self, $source, %opt) = @_;    my ($self, $source, %opt) = @_;
240    my $converter;    my $t = SuikaWiki::Format::Definition->serialize_media_type (%opt);
241    my $flag = '//';    my $converter = $Converter->{$t->{_}};
242    $flag .= 'f' if $opt{IsFragment};    return ($converter->{$opt{return_type} or 'Main'} or
243    $flag .= 'p' if $opt{IsPlaceholder};            CORE::die "Buggy implementation: $t->{_}/@{[$opt{return_type} or 'Main']} not defined")
244    my $type = $opt{Type} ?           ->($self, $source, \%opt)
245                  $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;  
246    $self->SUPER::convert ($source, %opt);    $self->SUPER::convert ($source, %opt);
247  }  }
248  EOH  EOH
# Line 271  EOH Line 277  EOH
277        $r .= qq(}\n);        $r .= qq(}\n);
278      } elsif ($_->local_name eq 'Use') {      } elsif ($_->local_name eq 'Use') {
279        $r .= line $Info, node_path => qq(Format[module-name()=$module_name]/Use);        $r .= line $Info, node_path => qq(Format[module-name()=$module_name]/Use);
280        $r .= $_->inner_text;        $r .= code $Info, $_->inner_text;
281      }      }
282    }    }
283    $r;    $r;
# Line 280  EOH Line 286  EOH
286  sub make_format_converter ($$) {  sub make_format_converter ($$) {
287    my ($src, $Info) = @_;    my ($src, $Info) = @_;
288    my %def;    my %def;
289    $def{Type} = $src->get_attribute ('Type');    for (qw/Type Name Version TypeURIReference IsFragment IsPlaceholder/) {
290    if (ref $def{Type}) {      $def{$_} = $src->get_attribute_value ($_);
291      $def{Type} = $def{Type}->inner_text      delete $def{$_} unless defined $def{$_};
292            . join '', map {    }
293                ';'. $_->local_name .'='. quoted_string $_->inner_text    $def{Type_param} = {map {$_->local_name => $_->value}
294              } sort {                                @{$src->get_attribute ('Type', make_new_node => 1)
295                $a->local_name cmp $b->local_name                                    ->child_nodes}};
296              } @{$def{Type}->child_nodes};    my $type = serialize_media_type ($Info,
297    } else {                 Type => $def{Type},
298      delete $def{Type};                 Type_param => $def{Type_param},
299                   Name => $def{Name},
300                   Version => $def{Version},
301                   URIReference => $def{TypeURIReference},
302                   IsFragment => $def{IsFragment},
303                   IsPlaceholder => $def{IsPlaceholder});
304      $def{serialized_type} = $type->{_};
305      
306      for (qw/Main ToString ToOctetStream/) {
307        my $def = $src->get_attribute_value ($_);
308        next unless $def;
309        $def{$_} = line ($Info, node_path => '//Converter/'.$_)
310                   . $def
311                   . line ($Info, reset => 1);
312        if ($def{$_} =~ /\$r\b/) {
313          $def{$_} = 'my $r;'."\n".$def{$_}."\n".'$r';
314        }
315        $def{$_} = barecode code $Info,
316                     'sub {my ($self, $source, $opt) = @_;'
317                   . $def{$_} . '}';
318    }    }
   $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} . '}';  
319        
320    my $r = list %def;    my $r = list %def;
321    if ($def{Type}) {    if ($type->{Type}) {
322      $r = qq{\$Converter->{@{[literal $def{Type}.$flag]}} = {$r};\n};      $r = qq{\$Converter->{@{[literal $type->{Type}]}} = {$r};\n};
323      $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}
324        if $def{Name};        if $type->{Magic};
325    } elsif ($def{Name}) {      $r .= qq{\$Converter->{@{[literal $type->{URIReference}]}} = \$Converter->{@{[literal $type->{Type}]}};\n}
326      $r = qq{\$Converter->{@{[literal '/'.$def{Name}.'/'.$def{Version}.$flag]}} = {$r};\n};        if $type->{URIReference};
327      } elsif ($type->{Magic}) {
328        $r = qq{\$Converter->{@{[literal $type->{Magic}]}} = {$r};\n};
329        $r .= qq{\$Converter->{@{[literal $type->{URIReference}]}} = \$Converter->{@{[literal $type->{Magic}]}};\n}
330          if $type->{URIReference};
331      } elsif ($type->{URIReference}) {
332        $r = qq{\$Converter->{@{[literal $type->{URIReference}]}} = {$r};\n};
333    } else {    } else {
334      $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" }';
335    }    }
336    $r;    $r;
337  }  }
338    
339    sub serialize_media_type ($%) {
340      my ($Info, %opt) = @_;
341      my %return;
342      if ($opt{Type}) {
343        $return{Type} = 'IMT:'.$opt{Type};
344        if ($opt{Type_param}) {
345          $return{Type} .= join '', map {my $s;
346                             ';'. $_ .'="'
347                           . (($s = $opt{Type_param}->{$_}) =~ s/([\\"])/\\$1/g, $s)
348                           . '"'
349                           } sort {
350                             $a cmp $b
351                           } keys %{$opt{Type_param}};
352        }
353      }
354      if ($opt{Magic}) {
355        $return{Magic} = 'MAGIC:'.$opt{Magic};
356      } elsif ($opt{Name}) {
357        $return{Name} = 'MAGIC:'.$opt{Name}.'/*';
358        $return{Magic} = 'MAGIC:'.$opt{Name}.'/'.$opt{Version} if $opt{Version};
359      }
360      if ($opt{URIReference}) {
361        $return{URIReference} = $opt{URIReference};
362      }
363      my $flag = '##';
364      $flag .= 'f' if $opt{IsFragment};
365      $flag .= 'p' if $opt{IsPlaceholder};
366      for (qw/URIReference Type Magic Name/) {
367        $return{$_} .= $flag if $return{$_};
368      }
369      $return{_} = $return{URIReference} || $return{Type}
370                || $return{Magic} || $return{Name};
371      \%return;
372    }
373    
374    
375  sub make_function ($$) {  sub make_function ($$) {
376    my ($src, $Info) = @_;    my ($src, $Info) = @_;
377    ## TODO: support of ARGV property    ## TODO: support of ARGV property
# Line 352  sub register_plugin_const ($$) { Line 397  sub register_plugin_const ($$) {
397  sub make_resdef ($$) {  sub make_resdef ($$) {
398    my ($src, $Info) = @_;    my ($src, $Info) = @_;
399    my $r = change_package $Info, 'SuikaWiki::Plugin::Resource';    my $r = change_package $Info, 'SuikaWiki::Plugin::Resource';
400      local $Info->{-message_error_used} = 0;  
401    $r .= qq{our \$BaseResource;\n};    $r .= qq{our \$BaseResource;\n};
402    for (@{$src->child_nodes}) {    for (@{$src->child_nodes}) {
403      if ($_->node_type eq '#element') {      if ($_->node_type eq '#element') {
# Line 415  push \@SuikaWiki::View::Implementation:: Line 461  push \@SuikaWiki::View::Implementation::
461  @{[change_package $Info, $ViewProp->{pack_name}]}  @{[change_package $Info, $ViewProp->{pack_name}]}
462  our \@ISA = q#SuikaWiki::View::template#;  our \@ISA = q#SuikaWiki::View::template#;
463  EOH  EOH
464        local $Info->{-message_error_used} = 0;  
465    my $use = $src->get_attribute ('Use');    my $use = $src->get_attribute ('Use');
466    if (ref $use) {    if (ref $use) {
467      $r .= line $Info, node_path => "ViewDefinition[Mode='$ViewProp->{Name}']/Use";      $r .= line $Info, node_path => "ViewDefinition[Mode='$ViewProp->{Name}']/Use";
468      $r .= $use->inner_text . "\n\n";      $r .= code $Info, $use->inner_text;
469        $r .= "\n\n";
470    }    }
471        
472    for (@{$src->child_nodes}) {    for (@{$src->child_nodes}) {
# Line 462  sub main (\$\$\$) { Line 509  sub main (\$\$\$) {
509        
510    \$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]};
511    \$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)  
     ]}},  
512                        ## SuikaWiki 3 WikiPlugin interface                        ## SuikaWiki 3 WikiPlugin interface
513                          wiki => \$self->{view}->{wiki},                          wiki => \$self->{view}->{wiki},
514                          plugin => \$self->{view}->{wiki}->{plugin},                          plugin => \$self->{view}->{wiki}->{plugin},
# Line 501  sub main (\$\$\$) { Line 532  sub main (\$\$\$) {
532              qq{\$opt2->{output}->set_expires (delta => @{[0 + $x]});};              qq{\$opt2->{output}->set_expires (delta => @{[0 + $x]});};
533            }            }
534        }]}        }]}
535      \$opt2->{output}->{entity}->{body_is_octet_stream} = @{[
536        $src->get_attribute ('body')->get_attribute_value ('is-octet-stream', default_value => 0)
537        or 0
538      ]};
539        
540    \$self->{view}->{wiki}->init_db;    \$self->{view}->{wiki}->init_db;
541    \$self->main_pre (\$opt, \$opt2);    \$self->main_pre (\$opt, \$opt2);
# Line 596  my  $amain = <<EOH; Line 631  my  $amain = <<EOH;
631  }  }
632  EOH  EOH
633    my $r = change_package $Info, $Info->{module_name};    my $r = change_package $Info, $Info->{module_name};
634      local $Info->{-message_error_used} = 0;  
635    if (@$type == 1) {    if (@$type == 1) {
636      $type->[0] =~ tr/-/_/;      $type->[0] =~ tr/-/_/;
637      $r .= qq{\$SuikaWiki::Plugin::Rule{$type->[0]}->{$name} = $main;\n};      $r .= qq{\$SuikaWiki::Plugin::Rule{$type->[0]}->{$name} = $main;\n};
# Line 612  EOH Line 648  EOH
648    $r;    $r;
649  }  }
650    
651    =item FormattingRuleAlias
652    
653    Generating an alias name for a formatting rule that is already loaded.
654    Example:
655    
656      FormattingRuleAlias:
657        @Category[list]:
658          category-1
659          category-2
660          ...
661        @Name: new-rule-name
662        @Reference:
663          @@Category: one-of-category
664          @@Name: one-of-name
665    
666    associates C<(I<category-1>, I<new-rule-name>)>,
667    C<(I<category-2>, I<new-rule-name>)>, ...
668    with C<(I<one-of-category>, I<one-of-name>)>.
669    
670    =cut
671    
672    sub make_rule_alias ($$) {
673      my ($src, $Info) = @_;
674      my $type = $src->get_attribute ('Category', make_new_node => 1)->value || [];
675      my $name = $src->get_attribute ('Name', make_new_node => 1)->value;
676      
677      my $ref = $src->get_attribute ('Reference', make_new_node => 1);
678      my $c = $ref->get_attribute_value ('Category');
679      my $n = $ref->get_attribute_value ('Name');
680      
681      s/(?<=.)-/_/g for $n, $name;
682      tr/-/_/ for $c, @$type;
683      
684      my $def = qq{\$SuikaWiki::Plugin::Rule{@{[literal $c]}}->{@{[literal $n]}} or warn qq{Formatting rule "$c/$n" not defined}};
685      
686      my $r = change_package $Info, $Info->{module_name};
687      for my $type (@$type) {
688        $r .= qq{\$SuikaWiki::Plugin::Rule{@{[literal $type]}}->{@{[literal $name]}} = $def;\n};
689        push @{$Info->{provide}->{rule}->{$type}}, $name;
690      }
691      $r;
692    }
693    
694    
695  sub random_module_name ($;$) {  sub random_module_name ($;$) {
696    my ($Info, $subname) = @_;    my ($Info, $subname) = @_;
# Line 622  sub random_module_name ($;$) { Line 701  sub random_module_name ($;$) {
701      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]),
702      join ('', @rand[rand@rand,rand@rand,rand@rand,rand@rand]);      join ('', @rand[rand@rand,rand@rand,rand@rand,rand@rand]);
703  }  }
704    
705    =head1 NAME
706    
707    mkplugin2.pl - SuikaWiki: WikiPlugin Generator
708    
709    =head1 SYNOPSIS
710    
711      mkplugin2.pl pluginsrc.wp2 > plugin.pm
712    
713    =head1 DESCRIPTION
714    
715    C<mkplugin2.pl> generates WikiPlugin module as a Perl module file
716    from WikiPlugin source description.  WikiPlugin source description
717    is described in SuikaWikiConfig/2.0 format and it contains
718    definitions of wiki constructions (such as formatting rules and
719    WikiView definitions) as both machine understandable code and
720    human readable documentation.  For more information, see
721    <http://suika.fam.cx/~wakaba/-temp/wiki/wiki?WikiPlugin>.
722    
723    This script is part of SuikaWiki.
724    
725    =head1 HISTORY AND COMPATIBILITY
726    
727    C<mkplugin2.pl> introduced as part of SuikaWiki 3.
728    It converts SuikaWiki 3 WikiPlugin source descriptions
729    (in SuikaWikiConfig/2.0) into Perl modules with SuikaWiki 3 interface.
730    
731    SuikaWiki 2 has C<mkplugin.pl>.  It also converts WikiPlugin
732    source descriptions into Perl modules.  But it support
733    SuikaWiki 2 format of WikiPlugin source description that differs from
734    SuikaWiki 3 format.  Wiki programming interface (not limited to
735    WikiPlugin related one) of SuikaWiki 3 also incompatible with that
736    of SuikaWiki 2 so that it is impossible to use SuikaWiki 2 WikiPlugin
737    module with SuikaWiki 3 and vice versa.
738    
739    =head1 SEE ALSO
740    
741    C<SuikaWiki::Plugin>, SuikaWiki:WikiPlugin
742    <http://suika.fam.cx/~wakaba/-temp/wiki/wiki?WikiPlugin>.
743    
744    =head1 LICENSE
745    
746    Copyright 2003-2004 Wakaba <w@suika.fam.cx>.  All rights reserved.
747    
748    This program is free software; you can redistribute it and/or
749    modify it under the same terms as Perl itself.
750    
751    =cut
752    
753    1; # $Date$
Legend:
Removed from v.1.11  
changed lines
  Added in v.1.16
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24