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