/[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.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/;    $Info->{-message_error_used} = 1 if $code =~ /\buse\s+Message::Util::Error\b/;
72    if (not $Info->{-message_error_used} and    if (not $Info->{-message_error_used} and
73       ($code =~ /\btry\s*\{/ or $code =~ /\bcatch\s*\{/)) {       ($code =~ /\btry\s*\{/ or $code =~ /\bcatch\s*\{/)) {
# Line 163  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};
# Line 186  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 213  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 221  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 229  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->{_}};
   $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};  
   }  
249    return ($converter->{$opt{return_type} or 'Main'} or    return ($converter->{$opt{return_type} or 'Main'} or
250            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")
251           ->($self, $source, \%opt)           ->($self, $source, \%opt)
252      if $converter;      if $converter;
253    $self->SUPER::convert ($source, %opt);    $self->SUPER::convert ($source, %opt);
# Line 289  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    $def{Name} = $src->get_attribute_value ('Name');                 Version => $def{Version},
308    delete $def{Name} unless defined $def{Name};                 URIReference => $def{TypeURIReference},
309    $def{Version} = $src->get_attribute_value ('Version');                 IsFragment => $def{IsFragment},
310    delete $def{Version} if not defined $def{Version} or                 IsPlaceholder => $def{IsPlaceholder});
311                            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');  
312        
313    for (qw/Main ToString ToOctetStream/) {    for (qw/Main ToString ToOctetStream/) {
314      my $def = $src->get_attribute_value ($_);      my $def = $src->get_attribute_value ($_);
# Line 327  sub make_format_converter ($$) { Line 325  sub make_format_converter ($$) {
325    }    }
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 615  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 625  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.13  
changed lines
  Added in v.1.17
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24