/[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.13 by wakaba, Sat Feb 14 10:59:55 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/;    $Info->{-message_error_used} = 1 if $code =~ /\buse\s+Message::Util::Error\b/;
65    if (not $Info->{-message_error_used} and    if (not $Info->{-message_error_used} and
66       ($code =~ /\btry\s*\{/ or $code =~ /\bcatch\s*\{/)) {       ($code =~ /\btry\s*\{/ or $code =~ /\bcatch\s*\{/)) {
# Line 163  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};
# Line 186  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 213  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 221  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 229  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->{_}};
   $flag .= 'f' if $opt{IsFragment};  
   $flag .= 'p' if $opt{IsPlaceholder};  
   my $type = $opt{Type} ?  
                 $opt{Type} .  
                 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};  
   }  
242    return ($converter->{$opt{return_type} or 'Main'} or    return ($converter->{$opt{return_type} or 'Main'} or
243            CORE::die "Buggy implementation: $type $opt{Name}/$opt{Version}$flag/@{[$opt{return_type} or 'Main']} not defined")            CORE::die "Buggy implementation: $t->{_}/@{[$opt{return_type} or 'Main']} not defined")
244           ->($self, $source, \%opt)           ->($self, $source, \%opt)
245      if $converter;      if $converter;
246    $self->SUPER::convert ($source, %opt);    $self->SUPER::convert ($source, %opt);
# Line 289  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    $def{Name} = $src->get_attribute_value ('Name');                 Version => $def{Version},
301    delete $def{Name} unless defined $def{Name};                 URIReference => $def{TypeURIReference},
302    $def{Version} = $src->get_attribute_value ('Version');                 IsFragment => $def{IsFragment},
303    delete $def{Version} if not defined $def{Version} or                 IsPlaceholder => $def{IsPlaceholder});
304                            not defined $def{Name};    $def{serialized_type} = $type->{_};
     
   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');  
305        
306    for (qw/Main ToString ToOctetStream/) {    for (qw/Main ToString ToOctetStream/) {
307      my $def = $src->get_attribute_value ($_);      my $def = $src->get_attribute_value ($_);
# Line 327  sub make_format_converter ($$) { Line 318  sub make_format_converter ($$) {
318    }    }
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 615  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 625  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.13  
changed lines
  Added in v.1.16
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24