/[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.10 by wakaba, Fri Jan 16 08:06:06 2004 UTC revision 1.19 by wakaba, Sun Jul 25 06:54:28 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      $code =~ s/__FUNCPACK{([^{}]+)}__/(\$SuikaWiki::Plugin::Registry::Info{@{[literal $1]}}->{module_name} || SuikaWiki::Plugin->module_package (@{[literal $1]}))/g;
63      $code =~ s{<Q:([^:]+):([^>]+)>}{
64        if ($Info->{Namespace}->{$1}) {
65          literal $Info->{Namespace}->{$1}.$2;
66        } else {
67          warn qq(Namespace prefix "$1" not defined);
68          literal $2;
69        }
70      }ge;
71      
72      $Info->{-message_error_used} = 1 if $code =~ /\buse\s+Message::Util::Error\b/;
73      if (not $Info->{-message_error_used} and
74         ($code =~ /\btry\s*\{/ or $code =~ /\bcatch\s*\{/)) {
75        warn "Message::Util::Error MUST be 'use'd before 'try'...'catch' block used";
76      }
77    $code;    $code;
78  }  }
79  sub change_package ($$) {  sub change_package ($$) {
# Line 102  sub literal_or_code ($$) { Line 117  sub literal_or_code ($$) {
117    substr ($s, 0, 1) ne '{' ? literal ($s)    substr ($s, 0, 1) ne '{' ? literal ($s)
118                             : code ($Info, substr ($s, 1, length ($s) - 2));                             : code ($Info, substr ($s, 1, length ($s) - 2));
119  }  }
120    sub expanded_uri ($$$) {
121      my ($Info, $prefix, $lname) = @_;
122      warn "$0: $prefix: Namespace prefix not declared";
123      $Info->{Namespace}->{$prefix} . $lname;
124    }
125    
126  my $parser = Message::Markup::SuikaWikiConfig20::Parser->new;  my $parser = Message::Markup::SuikaWikiConfig20::Parser->new;
127  my $plugins = $parser->parse_text ($src);  my $plugins = $parser->parse_text ($src);
# Line 128  our \%Info; Line 148  our \%Info;
148  \$Info{$Info{name_literal}}->{Name} = $Info{name_literal};  \$Info{$Info{name_literal}}->{Name} = $Info{name_literal};
149  EOH  EOH
150  for (qw/Version InterfaceVersion mkpluginVersion module_name/) {  for (qw/Version InterfaceVersion mkpluginVersion module_name/) {
151    print qq{\$Info{$Info{name_literal}}->{$_} = @{[literal $Info{$_}]};\n};    print qq{\$Info{$Info{name_literal}}->{@{[literal $_]}} = @{[literal $Info{$_}]};\n};
152  }  }
153  for (qw/LastModified/) {  for (qw/LastModified Date.RCS/) {
154    $Info{$_} = n11n $meta->get_attribute ($_,make_new_node=>1)->value;    $Info{$_} = n11n $meta->get_attribute ($_,make_new_node=>1)->value;
155    next unless length $Info{$_};    next unless length $Info{$_};
156    print qq{\$Info{$Info{name_literal}}->{$_} = } . literal $Info{$_};    print qq{\$Info{$Info{name_literal}}->{@{[literal $_]}} = } . literal $Info{$_};
157    print ";\n";    print ";\n";
158  }  }
159  for (qw/RequiredPlugin RequiredModule/) {  for (qw/RequiredPlugin RequiredModule/) {
# Line 158  print qq{\$Info{$Info{name_literal}}->{A Line 178  print qq{\$Info{$Info{name_literal}}->{A
178  } grep { $_->local_name eq 'Author' } @{$meta->child_nodes}  } grep { $_->local_name eq 'Author' } @{$meta->child_nodes}
179  ). qq{];\n};  ). qq{];\n};
180    
181    for (@{$meta->get_attribute ('Namespace', make_new_node => 1)->child_nodes}) {
182      $Info{Namespace}->{$_->local_name} = $_->value;
183    }
184    
185  my $use = $meta->get_attribute ('Use');  my $use = $meta->get_attribute ('Use');
186  if (ref $use) {  if (ref $use) {
187    print change_package \%Info, $Info{module_name};    print change_package \%Info, $Info{module_name};
188    print line \%Info, node_path => 'Plugin/Use';    print line \%Info, node_path => 'Plugin/Use';
189    print $use->inner_text, "\n";    print code \%Info, $use->inner_text;
190    print line \%Info, reset => 1;    print line \%Info, reset => 1;
191  }  }
192    
# Line 181  for (@{$plugins->child_nodes}) { Line 205  for (@{$plugins->child_nodes}) {
205      register_plugin_const ($_, \%Info);      register_plugin_const ($_, \%Info);
206    } elsif ($_->local_name eq 'Format') {    } elsif ($_->local_name eq 'Format') {
207      print "\n", make_format ($_, \%Info);      print "\n", make_format ($_, \%Info);
208      } elsif ($_->local_name eq 'FormattingRuleAlias') {
209        print "\n", make_rule_alias ($_, \%Info);
210  # Parameter  # Parameter
211  # PluginCategory  # PluginCategory
212    }    }
# Line 198  sub make_format ($$) { Line 224  sub make_format ($$) {
224    my ($src, $Info) = @_;    my ($src, $Info) = @_;
225    my $module_name = 'SuikaWiki::Format::Definition::'.$src->get_attribute_value ('ModuleName');    my $module_name = 'SuikaWiki::Format::Definition::'.$src->get_attribute_value ('ModuleName');
226    my $r = change_package $Info, $module_name;    my $r = change_package $Info, $module_name;
227      local $Info->{-message_error_used} = 0;  
228    $r .= qq{our \@ISA;\n};    $r .= qq{our \@ISA;\n};
229    if (my $isa = $src->get_attribute_value ('Inherit')) {    if (my $isa = $src->get_attribute_value ('Inherit')) {
230      for (@$isa) {      for (@$isa) {
# Line 207  sub make_format ($$) { Line 234  sub make_format ($$) {
234      $r .= qq{push \@ISA, 'SuikaWiki::Format::Definition::template';\n};          $r .= qq{push \@ISA, 'SuikaWiki::Format::Definition::template';\n};    
235    }    }
236    if (my $name = $src->get_attribute_value ('Name')) {    if (my $name = $src->get_attribute_value ('Name')) {
237      $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};
238    }    }
239    if (my $type = $src->get_attribute_value ('Type')) {    if (my $type = $src->get_attribute_value ('Type')) {
240      $type .= join '', map {      $type .= join '', map {
# Line 215  sub make_format ($$) { Line 242  sub make_format ($$) {
242               } sort {               } sort {
243                 $a->local_name cmp $b->local_name                 $a->local_name cmp $b->local_name
244               } @{$src->get_attribute ('Type')->child_nodes};               } @{$src->get_attribute ('Type')->child_nodes};
245      $r .= qq{\$SuikaWiki::Format::Definition::Class{@{[literal $type.'//']}} = '$module_name';\n};      $r .= qq{\$SuikaWiki::Format::Definition::Class{@{[literal 'IMT:'.$type.'##']}} = '$module_name';\n};
246    }    }
247        
248    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 250  sub make_format ($$) {
250  our $Converter;  our $Converter;
251  sub convert ($$;%) {  sub convert ($$;%) {
252    my ($self, $source, %opt) = @_;    my ($self, $source, %opt) = @_;
253    my $converter;    my $t = SuikaWiki::Format::Definition->serialize_media_type (%opt);
254    my $flag = '//';    my $converter = $Converter->{$t->{_}};
255    $flag .= 'f' if $opt{IsFragment};    return ($converter->{$opt{return_type} or 'Main'} or
256    $flag .= 'p' if $opt{IsPlaceholder};            CORE::die "Buggy implementation: $t->{_}/@{[$opt{return_type} or 'Main']} not defined")
257    if ($Converter->{$opt{Type}.$flag}) {           ->($self, $source, \%opt)
258      $converter = $Converter->{$opt{Type}.$flag};      if $converter;
   } elsif ($Converter->{$opt{Name}.'/'.$opt{Version}.$flag}) {  
     $converter = $Converter->{'/'.$opt{Name}.'/'.$opt{Version}.$flag};  
   }  
   return $converter->{Main}->($self, $source, \%opt) if $converter;  
259    $self->SUPER::convert ($source, %opt);    $self->SUPER::convert ($source, %opt);
260  }  }
261  EOH  EOH
# Line 251  EOH Line 274  EOH
274        $r .= code $Info, $_->get_attribute_value ('Main');        $r .= code $Info, $_->get_attribute_value ('Main');
275        $r .= line $Info, reset => 1;        $r .= line $Info, reset => 1;
276        $r .= qq(}\n);        $r .= qq(}\n);
277        } elsif ($_->local_name eq 'HeadSummary') {
278          $r .= q(sub headsummary {)."\n".q(my ($self, $source, %opt) = @_;);
279          $r .= line $Info, node_path => qq(Format[module-name()=$module_name]/HeadSummary);
280          $r .= code $Info, $_->get_attribute_value ('Main');
281          $r .= line $Info, reset => 1;
282          $r .= qq(}\n);
283      } elsif ($_->local_name eq 'NextIndex') {      } elsif ($_->local_name eq 'NextIndex') {
284        my $name = $_->get_attribute_value ('Name', default => '');        my $name = $_->get_attribute_value ('Name', default => '');
285        $r .= q(sub next_index_for_).$name        $r .= q(sub next_index_for_).$name
# Line 259  EOH Line 288  EOH
288        $r .= code $Info, $_->get_attribute_value ('Main');        $r .= code $Info, $_->get_attribute_value ('Main');
289        $r .= line $Info, reset => 1;        $r .= line $Info, reset => 1;
290        $r .= qq(}\n);        $r .= qq(}\n);
291        } elsif ({qw/content_written 1 content_removed 1 content_type_changed_from 1
292                     content_prop_modified 1/}
293                 ->{my $node_name = $_->local_name}) {
294          $r .= q(sub ).$node_name
295             .  q( {)."\n".q(my ($self, %opt) = @_;)
296             .  line $Info, node_path => qq(Format[module-name()=$module_name]/$node_name]);
297          $r .= code $Info, $_->get_attribute_value ('Main');
298          $r .= line $Info, reset => 1;
299          $r .= qq(}\n);
300      } elsif ($_->local_name eq 'Use') {      } elsif ($_->local_name eq 'Use') {
301        $r .= line $Info, node_path => qq(Format[module-name()=$module_name]/Use);        $r .= line $Info, node_path => qq(Format[module-name()=$module_name]/Use);
302        $r .= $_->inner_text;        $r .= code $Info, $_->inner_text;
303        } elsif ($_->local_name eq 'Prop') {
304          $r .= q<sub prop ($$;%) { my ($self, $name, %opt) = @_;>;
305          my $f = 0;
306          for my $prop (@{$_->child_nodes}) {
307            if ($prop->local_name =~ /^([^:]+):([^:]+)$/) {
308              $r .= qq{if (\$name eq @{[literal expanded_uri $Info, $1, $2]}) { return @{[literal $prop->value]} } els};
309              $f = 1;
310            }
311          }
312          $r .= q<e {> if $f;
313          $r .= q{$self->SUPER::prop ($name, %opt);};
314          $r .= q<}> if $f;
315          $r .= qq<\n}\n>;
316      }      }
317    }    }
318    $r;    $r;
# Line 270  EOH Line 321  EOH
321  sub make_format_converter ($$) {  sub make_format_converter ($$) {
322    my ($src, $Info) = @_;    my ($src, $Info) = @_;
323    my %def;    my %def;
324    $def{Type} = $src->get_attribute ('Type');    for (qw/Type Name Version TypeURIReference IsFragment IsPlaceholder/) {
325    if (ref $def{Type}) {      $def{$_} = $src->get_attribute_value ($_);
326      $def{Type} = $def{Type}->inner_text      delete $def{$_} unless defined $def{$_};
327            . join '', map {    }
328                ';'. $_->local_name .'='. quoted_string $_->inner_text    $def{Type_param} = {map {$_->local_name => $_->value}
329              } sort {                                @{$src->get_attribute ('Type', make_new_node => 1)
330                $a->local_name cmp $b->local_name                                    ->child_nodes}};
331              } @{$def{Type}->child_nodes};    my $type = serialize_media_type ($Info,
332    } else {                 Type => $def{Type},
333      delete $def{Type};                 Type_param => $def{Type_param},
334                   Name => $def{Name},
335                   Version => $def{Version},
336                   URIReference => $def{TypeURIReference},
337                   IsFragment => $def{IsFragment},
338                   IsPlaceholder => $def{IsPlaceholder});
339      $def{serialized_type} = $type->{_};
340      
341      for (qw/Main ToString ToOctetStream/) {
342        my $def = $src->get_attribute_value ($_);
343        next unless $def;
344        $def{$_} = line ($Info, node_path => '//Converter/'.$_)
345                   . $def
346                   . line ($Info, reset => 1);
347        if ($def{$_} =~ /\$r\b/) {
348          $def{$_} = 'my $r;'."\n".$def{$_}."\n".'$r';
349        }
350        $def{$_} = barecode code $Info,
351                     'sub {my ($self, $source, $opt) = @_;'
352                   . $def{$_} . '}';
353    }    }
   $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} . '}';  
354        
355    my $r = list %def;    my $r = list %def;
356    if ($def{Type}) {    if ($type->{Type}) {
357      $r = qq{\$Converter->{@{[literal $def{Type}.$flag]}} = {$r};\n};      $r = qq{\$Converter->{@{[literal $type->{Type}]}} = {$r};\n};
358      $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}
359        if $def{Name};        if $type->{Magic};
360    } elsif ($def{Name}) {      $r .= qq{\$Converter->{@{[literal $type->{URIReference}]}} = \$Converter->{@{[literal $type->{Type}]}};\n}
361      $r = qq{\$Converter->{@{[literal '/'.$def{Name}.'/'.$def{Version}.$flag]}} = {$r};\n};        if $type->{URIReference};
362      } elsif ($type->{Magic}) {
363        $r = qq{\$Converter->{@{[literal $type->{Magic}]}} = {$r};\n};
364        $r .= qq{\$Converter->{@{[literal $type->{URIReference}]}} = \$Converter->{@{[literal $type->{Magic}]}};\n}
365          if $type->{URIReference};
366      } elsif ($type->{URIReference}) {
367        $r = qq{\$Converter->{@{[literal $type->{URIReference}]}} = {$r};\n};
368    } else {    } else {
369      $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" }';
370    }    }
371    $r;    $r;
372  }  }
373    
374    sub serialize_media_type ($%) {
375      my ($Info, %opt) = @_;
376      my %return;
377      if ($opt{Type}) {
378        $return{Type} = 'IMT:'.$opt{Type};
379        if ($opt{Type_param}) {
380          $return{Type} .= join '', map {my $s;
381                             ';'. $_ .'="'
382                           . (($s = $opt{Type_param}->{$_}) =~ s/([\\"])/\\$1/g, $s)
383                           . '"'
384                           } sort {
385                             $a cmp $b
386                           } keys %{$opt{Type_param}};
387        }
388      }
389      if ($opt{Magic}) {
390        $return{Magic} = 'MAGIC:'.$opt{Magic};
391      } elsif ($opt{Name}) {
392        $return{Name} = 'MAGIC:'.$opt{Name}.'/*';
393        $return{Magic} = 'MAGIC:'.$opt{Name}.'/'.$opt{Version} if $opt{Version};
394      }
395      if ($opt{URIReference}) {
396        $return{URIReference} = $opt{URIReference};
397      }
398      my $flag = '##';
399      $flag .= 'f' if $opt{IsFragment};
400      $flag .= 'p' if $opt{IsPlaceholder};
401      for (qw/URIReference Type Magic Name/) {
402        $return{$_} .= $flag if $return{$_};
403      }
404      $return{_} = $return{URIReference} || $return{Type}
405                || $return{Magic} || $return{Name};
406      \%return;
407    }
408    
409    
410  sub make_function ($$) {  sub make_function ($$) {
411    my ($src, $Info) = @_;    my ($src, $Info) = @_;
412    ## TODO: support of ARGV property    ## TODO: support of ARGV property
# Line 335  EOH Line 425  EOH
425  sub register_plugin_const ($$) {  sub register_plugin_const ($$) {
426    my ($src, $Info) = @_;    my ($src, $Info) = @_;
427    for (@{$src->child_nodes}) {    for (@{$src->child_nodes}) {
428      $Info->{const}->{$_->local_name} = $_->value;      $Info->{const}->{$_->local_name} = literal_or_code $Info, $_->value;
429    }    }
430  }  }
431    
432  sub make_resdef ($$) {  sub make_resdef ($$) {
433    my ($src, $Info) = @_;    my ($src, $Info) = @_;
434    my $r = change_package $Info, 'SuikaWiki::Plugin::Resource';    my $r = change_package $Info, 'SuikaWiki::Plugin::Resource';
435      local $Info->{-message_error_used} = 0;  
436    $r .= qq{our \$BaseResource;\n};    $r .= qq{our \$BaseResource;\n};
437    for (@{$src->child_nodes}) {    for (@{$src->child_nodes}) {
438      if ($_->node_type eq '#element') {      if ($_->node_type eq '#element') {
# Line 405  push \@SuikaWiki::View::Implementation:: Line 496  push \@SuikaWiki::View::Implementation::
496  @{[change_package $Info, $ViewProp->{pack_name}]}  @{[change_package $Info, $ViewProp->{pack_name}]}
497  our \@ISA = q#SuikaWiki::View::template#;  our \@ISA = q#SuikaWiki::View::template#;
498  EOH  EOH
499      local $Info->{-message_error_used} = 0;  
500      my $use = $src->get_attribute ('Use');
501      if (ref $use) {
502        $r .= line $Info, node_path => "ViewDefinition[Mode='$ViewProp->{Name}']/Use";
503        $r .= code $Info, $use->inner_text;
504        $r .= "\n\n";
505      }
506      
507    for (@{$src->child_nodes}) {    for (@{$src->child_nodes}) {
508      if ($_->local_name eq 'template') {      if ($_->local_name eq 'template') {
509        $r .= make_view_template_method ($_, $Info, $ViewProp);        $r .= make_view_template_method ($_, $Info, $ViewProp);
# Line 430  EOH Line 529  EOH
529    
530  sub make_view_template_method ($$) {  sub make_view_template_method ($$) {
531    my ($src, $Info, $ViewProp) = @_;    my ($src, $Info, $ViewProp) = @_;
532      my $media_type = $src->get_attribute_value
533                                ('media-type',
534                                 default => q<application/octet-stream>);
535    my $r = <<EOH;    my $r = <<EOH;
536    
537  sub main (\$\$\$) {  sub main (\$\$\$) {
# Line 445  sub main (\$\$\$) { Line 547  sub main (\$\$\$) {
547        
548    \$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]};
549    \$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)  
     ]}},  
550                        ## SuikaWiki 3 WikiPlugin interface                        ## SuikaWiki 3 WikiPlugin interface
551                          wiki => \$self->{view}->{wiki},                          wiki => \$self->{view}->{wiki},
552                          plugin => \$self->{view}->{wiki}->{plugin},                          plugin => \$self->{view}->{wiki}->{plugin},
# Line 470  sub main (\$\$\$) { Line 556  sub main (\$\$\$) {
556       $x?q{$opt2->{output}->{status_code} = }.(0 + $x).q{;}:q{}}]}       $x?q{$opt2->{output}->{status_code} = }.(0 + $x).q{;}:q{}}]}
557    @{[do{my $x=$src->get_attribute('http-status-phrase',make_new_node=>1)->inner_text;    @{[do{my $x=$src->get_attribute('http-status-phrase',make_new_node=>1)->inner_text;
558       $x?q{$opt2->{output}->{status_phrase} = }.literal($x).q{;}:q{}}]}       $x?q{$opt2->{output}->{status_phrase} = }.literal($x).q{;}:q{}}]}
559    \$opt2->{output}->{entity}->{media_type} = @{[literal    \$opt2->{output}->{entity}->{media_type} = @{[literal $media_type]};
560                             $src->get_attribute ('media-type',make_new_node=>1)  
                                ->inner_text || 'application/octet-stream']};  
561    @{[($src->get_attribute ('use-media-type-charset',make_new_node=>1)    @{[($src->get_attribute ('use-media-type-charset',make_new_node=>1)
562              ->inner_text || 0) ?              ->inner_text || 0) ?
563       q{$opt2->{output}->{entity}->{charset} = $self->{view}->{wiki}->{config}->{charset}->{output};}:       q{$opt2->{output}->{entity}->{charset} = $self->{view}->{wiki}->{config}->{charset}->{output};}:
# Line 484  sub main (\$\$\$) { Line 569  sub main (\$\$\$) {
569              qq{\$opt2->{output}->set_expires (delta => @{[0 + $x]});};              qq{\$opt2->{output}->set_expires (delta => @{[0 + $x]});};
570            }            }
571        }]}        }]}
572      \$opt2->{output}->{entity}->{body_is_octet_stream} = @{[
573        $src->get_attribute ('body')->get_attribute_value ('is-octet-stream', default_value => 0)
574        or 0
575      ]};
576        
577    \$self->{view}->{wiki}->init_db;    \$self->{view}->{wiki}->init_db;
578    \$self->main_pre (\$opt, \$opt2);    \$self->main_pre (\$opt, \$opt2);
579        
580      @{[$media_type eq 'text/html' ? q{require Message::Markup::XML::Serialize::HTML;} : '']}
581    use Message::Util::Error;    use Message::Util::Error;
582    try {    try {
583      \$opt2->{output}->{entity}->{body}      \$opt2->{output}->{entity}->{body}
584        = SuikaWiki::Plugin->formatter ('view')        = @{[$media_type eq 'text/html' ? q{Message::Markup::XML::Serialize::HTML::html_simple} : '']}
585          ->replace (\$opt2->{template}, param => \$opt2->{o});          (SuikaWiki::Plugin->formatter ('view')
586            ->replace (\$opt2->{template}, param => \$opt2->{o}));
587    } \$self->{view}->{wiki}->{config}->{catch}->{ @{[    } \$self->{view}->{wiki}->{config}->{catch}->{ @{[
588         $ViewProp->{Name} eq '-error' ? 'formatter_view_error'         $ViewProp->{Name} eq '-error' ? 'formatter_view_error'
589                                       : 'formatter_view' ]} };                                       : 'formatter_view' ]} };
# Line 521  sub make_rule ($$) { Line 612  sub make_rule ($$) {
612                "FormattingRule[name()='@{[list $type]}/$name']/".$codename->[0])                "FormattingRule[name()='@{[list $type]}/$name']/".$codename->[0])
613            . $main;            . $main;
614            
615      $main = q{my ($f, $rule_name, $p, $o, %opt) = @_;}."\n".$main      if ( $main =~ /\$f\b/
       if $main =~ /\$f\b/  
616        or $main =~ /\$rule_name\b/        or $main =~ /\$rule_name\b/
617        or $main =~ /\$[opr]\b/        or $main =~ /\$[opr]\b/
618        or $main =~ /[%\$]opt\b/;        or $main =~ /[%\$]opt\b/
619          or $main =~ /\$param_(?:name|value)\n/) {
620          if ($codename->[0] ne 'Attribute') {
621            $main = q{my ($f, $rule_name, $p, $o, %opt) = @_;}."\n".$main;
622          } else {
623            $main = q{my ($f, $rule_name, $p, $o, $param_name => $param_value, %opt) = @_;}."\n".$main;
624          }
625        }
626      if ($main =~ /\$r\b/) {      if ($main =~ /\$r\b/) {
627        warn qq(Rule @{[list $type]}/$name: Use of \$r is deprecated);        warn qq(Rule @{[list $type]}/$name: Use of \$r is deprecated);
628        $main = q{my $r = '';} . "\n" . $main . "\n"        $main = q{my $r = '';} . "\n" . $main . "\n"
# Line 573  my  $amain = <<EOH; Line 670  my  $amain = <<EOH;
670  }  }
671  EOH  EOH
672    my $r = change_package $Info, $Info->{module_name};    my $r = change_package $Info, $Info->{module_name};
673      local $Info->{-message_error_used} = 0;  
674    if (@$type == 1) {    if (@$type == 1) {
675      $type->[0] =~ tr/-/_/;      $type->[0] =~ tr/-/_/;
676      $r .= qq{\$SuikaWiki::Plugin::Rule{$type->[0]}->{$name} = $main;\n};      $r .= qq{\$SuikaWiki::Plugin::Rule{$type->[0]}->{$name} = $main;\n};
# Line 589  EOH Line 687  EOH
687    $r;    $r;
688  }  }
689    
690    =item FormattingRuleAlias
691    
692    Generating an alias name for a formatting rule that is already loaded.
693    Example:
694    
695      FormattingRuleAlias:
696        @Category[list]:
697          category-1
698          category-2
699          ...
700        @Name: new-rule-name
701        @Reference:
702          @@Category: one-of-category
703          @@Name: one-of-name
704    
705    associates C<(I<category-1>, I<new-rule-name>)>,
706    C<(I<category-2>, I<new-rule-name>)>, ...
707    with C<(I<one-of-category>, I<one-of-name>)>.
708    
709    =cut
710    
711    sub make_rule_alias ($$) {
712      my ($src, $Info) = @_;
713      my $type = $src->get_attribute ('Category', make_new_node => 1)->value || [];
714      my $name = $src->get_attribute ('Name', make_new_node => 1)->value;
715      
716      my $ref = $src->get_attribute ('Reference', make_new_node => 1);
717      my $c = $ref->get_attribute_value ('Category');
718      my $n = $ref->get_attribute_value ('Name');
719      
720      s/(?<=.)-/_/g for $n, $name;
721      tr/-/_/ for $c, @$type;
722      
723      my $def = qq{\$SuikaWiki::Plugin::Rule{@{[literal $c]}}->{@{[literal $n]}} or warn qq{Formatting rule "$c/$n" not defined}};
724      
725      my $r = change_package $Info, $Info->{module_name};
726      for my $type (@$type) {
727        $r .= qq{\$SuikaWiki::Plugin::Rule{@{[literal $type]}}->{@{[literal $name]}} = $def;\n};
728        push @{$Info->{provide}->{rule}->{$type}}, $name;
729      }
730      $r;
731    }
732    
733    
734  sub random_module_name ($;$) {  sub random_module_name ($;$) {
735    my ($Info, $subname) = @_;    my ($Info, $subname) = @_;
# Line 599  sub random_module_name ($;$) { Line 740  sub random_module_name ($;$) {
740      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]),
741      join ('', @rand[rand@rand,rand@rand,rand@rand,rand@rand]);      join ('', @rand[rand@rand,rand@rand,rand@rand,rand@rand]);
742  }  }
743    
744    =head1 NAME
745    
746    mkplugin2.pl - SuikaWiki: WikiPlugin Generator
747    
748    =head1 SYNOPSIS
749    
750      mkplugin2.pl pluginsrc.wp2 > plugin.pm
751    
752    =head1 DESCRIPTION
753    
754    C<mkplugin2.pl> generates WikiPlugin module as a Perl module file
755    from WikiPlugin source description.  WikiPlugin source description
756    is described in SuikaWikiConfig/2.0 format and it contains
757    definitions of wiki constructions (such as formatting rules and
758    WikiView definitions) as both machine understandable code and
759    human readable documentation.  For more information, see
760    <http://suika.fam.cx/~wakaba/-temp/wiki/wiki?WikiPlugin>.
761    
762    This script is part of SuikaWiki.
763    
764    =head1 HISTORY AND COMPATIBILITY
765    
766    C<mkplugin2.pl> introduced as part of SuikaWiki 3.
767    It converts SuikaWiki 3 WikiPlugin source descriptions
768    (in SuikaWikiConfig/2.0) into Perl modules with SuikaWiki 3 interface.
769    
770    SuikaWiki 2 has C<mkplugin.pl>.  It also converts WikiPlugin
771    source descriptions into Perl modules.  But it support
772    SuikaWiki 2 format of WikiPlugin source description that differs from
773    SuikaWiki 3 format.  Wiki programming interface (not limited to
774    WikiPlugin related one) of SuikaWiki 3 also incompatible with that
775    of SuikaWiki 2 so that it is impossible to use SuikaWiki 2 WikiPlugin
776    module with SuikaWiki 3 and vice versa.
777    
778    =head1 SEE ALSO
779    
780    C<SuikaWiki::Plugin>, SuikaWiki:WikiPlugin
781    <http://suika.fam.cx/~wakaba/-temp/wiki/wiki?WikiPlugin>.
782    
783    =head1 LICENSE
784    
785    Copyright 2003-2004 Wakaba <w@suika.fam.cx>.  All rights reserved.
786    
787    This program is free software; you can redistribute it and/or
788    modify it under the same terms as Perl itself.
789    
790    =cut
791    
792    1; # $Date$
Legend:
Removed from v.1.10  
changed lines
  Added in v.1.19
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24