/[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.6 by wakaba, Wed Nov 26 09:11:01 2003 UTC revision 1.15 by wakaba, Fri Mar 19 03:46:22 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      $Info->{-message_error_used} = 1 if $code =~ /\buse\s+Message::Util::Error\b/;
63      if (not $Info->{-message_error_used} and
64         ($code =~ /\btry\s*\{/ or $code =~ /\bcatch\s*\{/)) {
65        warn "Message::Util::Error MUST be 'use'd before 'try'...'catch' block used";
66      }
67    $code;    $code;
68  }  }
69  sub change_package ($$) {  sub change_package ($$) {
# Line 88  sub line ($;%) { Line 93  sub line ($;%) {
93                             $Info->{Name},                             $Info->{Name},
94                             $opt{realfile};                             $opt{realfile};
95      } else {      } else {
96        $opt{file} = sprintf '(WikiPlugin module %s, block %s)',        $opt{file} = sprintf '(WikiPlugin module source %s, block %s)',
97                             $Info->{Name},                             $Info->{source_file},
98                             $opt{node_path};                             $opt{node_path};
99      }      }
100    }    }
# Line 97  sub line ($;%) { Line 102  sub line ($;%) {
102    $opt{file} =~ s/"/''/g;    $opt{file} =~ s/"/''/g;
103    sprintf '%s#line %d "%s"%s', "\n", $opt{line_no} || 1, $opt{file}, "\n";    sprintf '%s#line %d "%s"%s', "\n", $opt{line_no} || 1, $opt{file}, "\n";
104  }  }
105    sub literal_or_code ($$) {
106      my ($Info, $s) = @_;
107      substr ($s, 0, 1) ne '{' ? literal ($s)
108                               : code ($Info, substr ($s, 1, length ($s) - 2));
109    }
110    
111  my $parser = Message::Markup::SuikaWikiConfig20::Parser->new;  my $parser = Message::Markup::SuikaWikiConfig20::Parser->new;
112  my $plugins = $parser->parse_text ($src);  my $plugins = $parser->parse_text ($src);
# Line 104  my $meta = $plugins->get_attribute ('Plu Line 114  my $meta = $plugins->get_attribute ('Plu
114            or die "$0: Required 'Plugin' section not found";            or die "$0: Required 'Plugin' section not found";
115  my %Info = (provide => {},  my %Info = (provide => {},
116              Name => n11n $meta->get_attribute ('Name')->value);              Name => n11n $meta->get_attribute ('Name')->value);
117    $Info{source_file} = $srcfile;
118  $Info{name_literal} = literal $Info{Name};  $Info{name_literal} = literal $Info{Name};
119  my @date = gmtime;  my @date = gmtime;
120  $Info{LastModified} = sprintf '%04d-%02d-%02dT%02d:%02d:%02d+00:00',  $Info{LastModified} = sprintf '%04d-%02d-%02dT%02d:%02d:%02d+00:00',
# Line 122  our \%Info; Line 133  our \%Info;
133  \$Info{$Info{name_literal}}->{Name} = $Info{name_literal};  \$Info{$Info{name_literal}}->{Name} = $Info{name_literal};
134  EOH  EOH
135  for (qw/Version InterfaceVersion mkpluginVersion module_name/) {  for (qw/Version InterfaceVersion mkpluginVersion module_name/) {
136    print qq{\$Info{$Info{name_literal}}->{$_} = @{[literal $Info{$_}]};\n};    print qq{\$Info{$Info{name_literal}}->{@{[literal $_]}} = @{[literal $Info{$_}]};\n};
137  }  }
138  for (qw/LastModified/) {  for (qw/LastModified Date.RCS/) {
139    $Info{$_} = n11n $meta->get_attribute ($_,make_new_node=>1)->value;    $Info{$_} = n11n $meta->get_attribute ($_,make_new_node=>1)->value;
140    next unless length $Info{$_};    next unless length $Info{$_};
141    print qq{\$Info{$Info{name_literal}}->{$_} = } . literal $Info{$_};    print qq{\$Info{$Info{name_literal}}->{@{[literal $_]}} = } . literal $Info{$_};
142    print ";\n";    print ";\n";
143  }  }
144  for (qw/RequiredPlugin RequiredModule/) {  for (qw/RequiredPlugin RequiredModule/) {
# Line 156  my $use = $meta->get_attribute ('Use'); Line 167  my $use = $meta->get_attribute ('Use');
167  if (ref $use) {  if (ref $use) {
168    print change_package \%Info, $Info{module_name};    print change_package \%Info, $Info{module_name};
169    print line \%Info, node_path => 'Plugin/Use';    print line \%Info, node_path => 'Plugin/Use';
170    print $use->inner_text, "\n";    print code \%Info, $use->inner_text;
171    print line \%Info, reset => 1;    print line \%Info, reset => 1;
172  }  }
173    
# Line 175  for (@{$plugins->child_nodes}) { Line 186  for (@{$plugins->child_nodes}) {
186      register_plugin_const ($_, \%Info);      register_plugin_const ($_, \%Info);
187    } elsif ($_->local_name eq 'Format') {    } elsif ($_->local_name eq 'Format') {
188      print "\n", make_format ($_, \%Info);      print "\n", make_format ($_, \%Info);
189      } elsif ($_->local_name eq 'FormattingRuleAlias') {
190        print "\n", make_rule_alias ($_, \%Info);
191    # Parameter
192    # PluginCategory
193    }    }
194  }  }
195    
# Line 190  sub make_format ($$) { Line 205  sub make_format ($$) {
205    my ($src, $Info) = @_;    my ($src, $Info) = @_;
206    my $module_name = 'SuikaWiki::Format::Definition::'.$src->get_attribute_value ('ModuleName');    my $module_name = 'SuikaWiki::Format::Definition::'.$src->get_attribute_value ('ModuleName');
207    my $r = change_package $Info, $module_name;    my $r = change_package $Info, $module_name;
208      local $Info->{-message_error_used} = 0;  
209    $r .= qq{our \@ISA;\n};    $r .= qq{our \@ISA;\n};
210    if (my $isa = $src->get_attribute_value ('Inherit')) {    if (my $isa = $src->get_attribute_value ('Inherit')) {
211      for (@$isa) {      for (@$isa) {
# Line 202  sub make_format ($$) { Line 218  sub make_format ($$) {
218      $r .= qq{\$SuikaWiki::Format::Definition::Class{@{[literal '/'.$name.'/'.$src->get_attribute_value ('Version', default => '').'//']}} = '$module_name';\n};      $r .= qq{\$SuikaWiki::Format::Definition::Class{@{[literal '/'.$name.'/'.$src->get_attribute_value ('Version', default => '').'//']}} = '$module_name';\n};
219    }    }
220    if (my $type = $src->get_attribute_value ('Type')) {    if (my $type = $src->get_attribute_value ('Type')) {
221        $type .= join '', map {
222                   ';'. $_->local_name .'='. quoted_string $_->inner_text
223                 } sort {
224                   $a->local_name cmp $b->local_name
225                 } @{$src->get_attribute ('Type')->child_nodes};
226      $r .= qq{\$SuikaWiki::Format::Definition::Class{@{[literal $type.'//']}} = '$module_name';\n};      $r .= qq{\$SuikaWiki::Format::Definition::Class{@{[literal $type.'//']}} = '$module_name';\n};
227    }    }
228        
229    $r .= line $Info, line_no => __LINE__ + 2, realfile => __FILE__;    my $convert = line $Info, line_no => __LINE__ + 2, realfile => __FILE__;
230    $r .= <<'EOH';    $convert .= <<'EOH';
231  our $Converter;  our $Converter;
232  sub convert ($$;%) {  sub convert ($$;%) {
233    my ($self, $source, %opt) = @_;    my ($self, $source, %opt) = @_;
# Line 214  sub convert ($$;%) { Line 235  sub convert ($$;%) {
235    my $flag = '//';    my $flag = '//';
236    $flag .= 'f' if $opt{IsFragment};    $flag .= 'f' if $opt{IsFragment};
237    $flag .= 'p' if $opt{IsPlaceholder};    $flag .= 'p' if $opt{IsPlaceholder};
238    if ($Converter->{$opt{Type}.$flag}) {    my $type = $opt{Type} ?
239      $converter = $Converter->{$opt{Type}.$flag};                  $opt{Type} .
240                    SuikaWiki::Format::Definition->__get_param_string
241                      ($opt{Type_param}) : undef;
242      if ($Converter->{$type.$flag}) {
243        $converter = $Converter->{$type.$flag};
244    } elsif ($Converter->{$opt{Name}.'/'.$opt{Version}.$flag}) {    } elsif ($Converter->{$opt{Name}.'/'.$opt{Version}.$flag}) {
245      $converter = $Converter->{'/'.$opt{Name}.'/'.$opt{Version}.$flag};      $converter = $Converter->{'/'.$opt{Name}.'/'.$opt{Version}.$flag};
246    }    }
247    return $converter->{Main}->($self, $source, \%opt) if $converter;    return ($converter->{$opt{return_type} or 'Main'} or
248              CORE::die "Buggy implementation: $type $opt{Name}/$opt{Version}$flag/@{[$opt{return_type} or 'Main']} not defined")
249             ->($self, $source, \%opt)
250        if $converter;
251    $self->SUPER::convert ($source, %opt);    $self->SUPER::convert ($source, %opt);
252  }  }
253  EOH  EOH
254        
   my $reset = 0;  
255    for (@{$src->child_nodes}) {    for (@{$src->child_nodes}) {
256      if ($_->local_name eq 'Converter') {      if ($_->local_name eq 'Converter') {
257        $r .= line $Info, reset => 1 unless $reset;        if ($convert) {
258            $r .= $convert;
259            $r .= line $Info, reset => 1;
260            undef $convert;
261          }
262        $r .= make_format_converter ($_, $Info);        $r .= make_format_converter ($_, $Info);
263        $reset = 1;      } elsif ($_->local_name eq 'WikiForm') {
264          $r .= q(sub wikiform {)."\n".q(my ($self, $source, %opt) = @_;);
265          $r .= line $Info, node_path => qq(Format[module-name()=$module_name]/WikiForm);
266          $r .= code $Info, $_->get_attribute_value ('Main');
267          $r .= line $Info, reset => 1;
268          $r .= qq(}\n);
269        } elsif ($_->local_name eq 'HeadSummary') {
270          $r .= q(sub headsummary {)."\n".q(my ($self, $source, %opt) = @_;);
271          $r .= line $Info, node_path => qq(Format[module-name()=$module_name]/HeadSummary);
272          $r .= code $Info, $_->get_attribute_value ('Main');
273          $r .= line $Info, reset => 1;
274          $r .= qq(}\n);
275        } elsif ($_->local_name eq 'NextIndex') {
276          my $name = $_->get_attribute_value ('Name', default => '');
277          $r .= q(sub next_index_for_).$name
278             .  q( {)."\n".q(my ($self, $source, %opt) = @_;)
279             .  line $Info, node_path => qq(Format[module-name()=$module_name]/NextIndex[Name=$name]);
280          $r .= code $Info, $_->get_attribute_value ('Main');
281          $r .= line $Info, reset => 1;
282          $r .= qq(}\n);
283      } elsif ($_->local_name eq 'Use') {      } elsif ($_->local_name eq 'Use') {
284        $r .= line $Info, node_path => qq(Format[module-name()=$module_name]/Use);        $r .= line $Info, node_path => qq(Format[module-name()=$module_name]/Use);
285        $r .= $_->inner_text;        $r .= code $Info, $_->inner_text;
       $reset = 0;  
286      }      }
287    }    }
   $r .= line $Info, reset => 1 unless $reset;  
     
288    $r;    $r;
289  }  }
290    
# Line 267  sub make_format_converter ($$) { Line 314  sub make_format_converter ($$) {
314    $flag .= 'p' and $def{IsPlaceholder} = 1    $flag .= 'p' and $def{IsPlaceholder} = 1
315      if $src->get_attribute_value ('IsPlaceholder');      if $src->get_attribute_value ('IsPlaceholder');
316        
317    $def{Main} = $src->get_attribute_value ('Main');    for (qw/Main ToString ToOctetStream/) {
318    $def{Main} = line ($Info, node_path => '//Converter/Main')      my $def = $src->get_attribute_value ($_);
319               . $def{Main}      next unless $def;
320               . line ($Info, reset => 1);      $def{$_} = line ($Info, node_path => '//Converter/'.$_)
321    if ($def{Main} =~ /\$r\b/) {                 . $def
322      $def{Main} = 'my $r;'."\n".$def{Main}."\n".'$r';                 . line ($Info, reset => 1);
323    }      if ($def{$_} =~ /\$r\b/) {
324    $def{Main} = barecode code $Info,        $def{$_} = 'my $r;'."\n".$def{$_}."\n".'$r';
325                 'sub {my ($self, $source, $opt) = @_;'      }
326               . $def{Main} . '}';      $def{$_} = barecode code $Info,
327                     'sub {my ($self, $source, $opt) = @_;'
328                   . $def{$_} . '}';
329      }
330        
331    my $r = list %def;    my $r = list %def;
332    if ($def{Type}) {    if ($def{Type}) {
# Line 285  sub make_format_converter ($$) { Line 335  sub make_format_converter ($$) {
335        if $def{Name};        if $def{Name};
336    } elsif ($def{Name}) {    } elsif ($def{Name}) {
337      $r = qq{\$Converter->{@{[literal '/'.$def{Name}.'/'.$def{Version}.$flag]}} = {$r};\n};      $r = qq{\$Converter->{@{[literal '/'.$def{Name}.'/'.$def{Version}.$flag]}} = {$r};\n};
338      $r    } else {
339        $r = 'BEGIN { die "Invalid Syntax of Converter: Type or Name property required" }';
340    }    }
341    $r;    $r;
342  }  }
# Line 299  sub make_function ($$) { Line 350  sub make_function ($$) {
350  sub @{[$name = $src->get_attribute_value ('Name')]} {  sub @{[$name = $src->get_attribute_value ('Name')]} {
351  @{[line $Info, node_path => "Function[Name='$name']/Main"]}@{[  @{[line $Info, node_path => "Function[Name='$name']/Main"]}@{[
352    code $Info, $src->get_attribute_value ('Main')    code $Info, $src->get_attribute_value ('Main')
353  ]}@{[line $Info, reset => 1]}  ]}
354  }  }
355    @{[line $Info, reset => 1]}
356  EOH  EOH
357  }  }
358    
359  sub register_plugin_const ($$) {  sub register_plugin_const ($$) {
360    my ($src, $Info) = @_;    my ($src, $Info) = @_;
361    for (@{$src->child_nodes}) {    for (@{$src->child_nodes}) {
362      $Info->{const}->{$_->local_name} = $_->value;      $Info->{const}->{$_->local_name} = literal_or_code $Info, $_->value;
363    }    }
364  }  }
365    
366  sub make_resdef ($$) {  sub make_resdef ($$) {
367    my ($src, $Info) = @_;    my ($src, $Info) = @_;
368    my $r = change_package $Info, 'SuikaWiki::Plugin::Resource';    my $r = change_package $Info, 'SuikaWiki::Plugin::Resource';
369      local $Info->{-message_error_used} = 0;  
370    $r .= qq{our \$BaseResource;\n};    $r .= qq{our \$BaseResource;\n};
371    for (@{$src->child_nodes}) {    for (@{$src->child_nodes}) {
372      if ($_->node_type eq '#element') {      if ($_->node_type eq '#element') {
# Line 361  sub make_viewdef ($$) { Line 414  sub make_viewdef ($$) {
414    my $ViewProp = {};    my $ViewProp = {};
415    my $r = '';    my $r = '';
416    $ViewProp->{Name} = n11n $src->get_attribute_value ('Mode');    $ViewProp->{Name} = n11n $src->get_attribute_value ('Mode');
417      $ViewProp->{Name} =~ s/(?<=.)-/_/g;
418    $ViewProp->{pack_name} = random_module_name ($Info, $ViewProp->{Name});    $ViewProp->{pack_name} = random_module_name ($Info, $ViewProp->{Name});
419        
420    $ViewProp->{condition_stringified} = hash    $ViewProp->{condition_stringified} = hash
# Line 376  push \@SuikaWiki::View::Implementation:: Line 430  push \@SuikaWiki::View::Implementation::
430  @{[change_package $Info, $ViewProp->{pack_name}]}  @{[change_package $Info, $ViewProp->{pack_name}]}
431  our \@ISA = q#SuikaWiki::View::template#;  our \@ISA = q#SuikaWiki::View::template#;
432  EOH  EOH
433      local $Info->{-message_error_used} = 0;  
434      my $use = $src->get_attribute ('Use');
435      if (ref $use) {
436        $r .= line $Info, node_path => "ViewDefinition[Mode='$ViewProp->{Name}']/Use";
437        $r .= code $Info, $use->inner_text;
438        $r .= "\n\n";
439      }
440      
441    for (@{$src->child_nodes}) {    for (@{$src->child_nodes}) {
442      if ($_->local_name eq 'template') {      if ($_->local_name eq 'template') {
443        $r .= make_view_template_method ($_, $Info);        $r .= make_view_template_method ($_, $Info, $ViewProp);
444      } elsif ($_->local_name eq 'method') {      } elsif ($_->local_name eq 'method') {
445        my $method_name = $_->get_attribute_value ('Name');        my $method_name = $_->get_attribute_value ('Name');
446        $r .= ({        $r .= ({
447                main => q(sub main ($$) {)."\n".q(my ($self, $opt) = @_;)."\n",                main => q(sub main ($$) {)."\n".q(my ($self, $opt, $opt2) = @_;)."\n",
448                main_pre => q(sub main_pre ($$$) {)."\n".q(my ($self, $opt, $opt2) = @_;)."\n",                main_pre => q(sub main_pre ($$$) {)."\n".q(my ($self, $opt, $opt2) = @_;)."\n",
449                main_post => q(sub main_post ($$$) {)."\n".q(my ($self, $opt, $opt2) = @_;)."\n",                                    main_post => q(sub main_post ($$$) {)."\n".q(my ($self, $opt, $opt2) = @_;)."\n",                    
450               }->{$method_name}               }->{$method_name}
451               ||qq(sub @{[$method_name]} {\n))               ||qq(sub @{[$method_name]} {\n))
452           . line ($Info, node_path => "ViewDefinition[Mode='$ViewProp->{Name}']/method[Name='$method_name']")           . line ($Info, node_path => "ViewDefinition[Mode='$ViewProp->{Name}']/method[Name='$method_name']")
453           . code ($Info, $_->value)           . code ($Info, $_->value)
454           . line ($Info, reset => 1)           . qq(}\n)
455           . qq(}\n);           . line ($Info, reset => 1);
456      }      }
457    }    }
458    my $prop = {Name => $ViewProp->{Name},    my $prop = {Name => $ViewProp->{Name},
# Line 400  EOH Line 462  EOH
462  }  }
463    
464  sub make_view_template_method ($$) {  sub make_view_template_method ($$) {
465    my ($src, $info) = @_;    my ($src, $Info, $ViewProp) = @_;
466    my $r = <<EOH;    my $r = <<EOH;
467    
468  sub main (\$\$\$) {  sub main (\$\$\$) {
# Line 416  sub main (\$\$\$) { Line 478  sub main (\$\$\$) {
478        
479    \$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]};
480    \$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)  
     ]}},  
481                        ## SuikaWiki 3 WikiPlugin interface                        ## SuikaWiki 3 WikiPlugin interface
482                          wiki => \$self->{view}->{wiki},                          wiki => \$self->{view}->{wiki},
483                          plugin => \$self->{view}->{wiki}->{plugin},                          plugin => \$self->{view}->{wiki}->{plugin},
# Line 440  sub main (\$\$\$) { Line 486  sub main (\$\$\$) {
486    @{[do{my $x=$src->get_attribute('http-status-code',make_new_node=>1)->inner_text;    @{[do{my $x=$src->get_attribute('http-status-code',make_new_node=>1)->inner_text;
487       $x?q{$opt2->{output}->{status_code} = }.(0 + $x).q{;}:q{}}]}       $x?q{$opt2->{output}->{status_code} = }.(0 + $x).q{;}:q{}}]}
488    @{[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;
489       $x?q{$opt2->{output}->{reason_phrase} = }.literal($x).q{;}:q{}}]}       $x?q{$opt2->{output}->{status_phrase} = }.literal($x).q{;}:q{}}]}
490    \$opt2->{output}->{entity}->{media_type} = @{[literal    \$opt2->{output}->{entity}->{media_type} = @{[literal
491                             $src->get_attribute ('media-type',make_new_node=>1)                             $src->get_attribute ('media-type',make_new_node=>1)
492                                 ->inner_text || 'application/octet-stream']};                                 ->inner_text || 'application/octet-stream']};
# Line 455  sub main (\$\$\$) { Line 501  sub main (\$\$\$) {
501              qq{\$opt2->{output}->set_expires (delta => @{[0 + $x]});};              qq{\$opt2->{output}->set_expires (delta => @{[0 + $x]});};
502            }            }
503        }]}        }]}
504      \$opt2->{output}->{entity}->{body_is_octet_stream} = @{[
505        $src->get_attribute ('body')->get_attribute_value ('is-octet-stream', default_value => 0)
506        or 0
507      ]};
508        
509    \$self->{view}->{wiki}->init_db;    \$self->{view}->{wiki}->init_db;
510    \$self->main_pre (\$opt, \$opt2);    \$self->main_pre (\$opt, \$opt2);
511        
512    my \$fmt = SuikaWiki::Plugin->formatter ('view');    use Message::Util::Error;
513    \$opt2->{output}->{entity}->{body}    try {
514      = \$fmt->replace (\$opt2->{template}, param => \$opt2->{o});      \$opt2->{output}->{entity}->{body}
515          = SuikaWiki::Plugin->formatter ('view')
516            ->replace (\$opt2->{template}, param => \$opt2->{o});
517      } \$self->{view}->{wiki}->{config}->{catch}->{ @{[
518           $ViewProp->{Name} eq '-error' ? 'formatter_view_error'
519                                         : 'formatter_view' ]} };
520    \$opt2->{output}->output (output => 'http-cgi');    \$opt2->{output}->output (output => 'http-cgi');
521        
522    \$self->main_post (\$opt, \$opt2);    \$self->main_post (\$opt, \$opt2);
# Line 474  sub make_rule ($$) { Line 529  sub make_rule ($$) {
529    my $type = $src->get_attribute ('Category', make_new_node => 1)->value || [];    my $type = $src->get_attribute ('Category', make_new_node => 1)->value || [];
530    my $name = $src->get_attribute ('Name', make_new_node => 1)->value;    my $name = $src->get_attribute ('Name', make_new_node => 1)->value;
531    $name =~ s/(?<=.)-/_/g;    $name =~ s/(?<=.)-/_/g;
   my $main = line ($Info, node_path => "FormattingRule[name()='@{[list $type]}/$name']/Formatting")  
            . code ($Info, $src->get_attribute_value ('Formatting'))  
            . line ($Info, reset => 1);  
532        
533    my $reg_block;    my $reg_block;
534    $reg_block = qr/[^{}]*(?>[^{}]+|{(??{$reg_block})})*/;    $reg_block = qr/[^{}]*(?>[^{}]+|{(??{$reg_block})})*/;
535    my $reg_attr = qr/__ATTR(TEXT|NODE)?:%(\w+)(?:->{($reg_block)})?__;/;    my %code;
536        for my $codename ([qw/Formatting main/], [qw/After after/],
537    $main = q{my ($f, $rule_name, $p, $o, %opt) = @_;}."\n".$main                      [qw/Before before/], [qw/Pre pre/], [qw/Post post/],
538      if $main =~ /\$f\b/                      [qw/Attribute attr/]) {
539      or $main =~ /\$rule_name\b/      my $main = code $Info, $src->get_attribute_value ($codename->[0]);
540      or $main =~ /\$[opr]\b/      next unless $main;
541      or $main =~ /[%\$]opt\b/;      $main = line ($Info, node_path =>
542    if ($main =~ /\$r\b/) {                "FormattingRule[name()='@{[list $type]}/$name']/".$codename->[0])
543      warn qq(Rule @{[list $type]}/$name: Use of \$r is deprecated);            . $main;
544      $main = q{my $r = '';} . "\n" . $main . "\n"      
545            . q{$p->{-parent}->append_node ($r, node_or_text => 1);};      if ( $main =~ /\$f\b/
546    }        or $main =~ /\$rule_name\b/
547    $main =~ s{$reg_attr}        or $main =~ /\$[opr]\b/
548              {($1 eq 'TEXT' ? '$p->{'.literal($2).'} = do { my $r = ' : '')        or $main =~ /[%\$]opt\b/
549               .'$f->parse_attr ($p=>'.literal($2).', $o, '        or $main =~ /\$param_(?:name|value)\n/) {
550                               .($3?'-parent => '.$3.', ':'')        if ($codename->[0] ne 'Attribute') {
551                               .($1?'-non_parsed_to_node => 1, ':'')          $main = q{my ($f, $rule_name, $p, $o, %opt) = @_;}."\n".$main;
552                               .'%opt)'        } else {
553                               .($1 eq 'TEXT' ? '; ref $r?$r->inner_text:$r}' : '')          $main = q{my ($f, $rule_name, $p, $o, $param_name => $param_value, %opt) = @_;}."\n".$main;
554                               .';'}ge;        }
555          }
556    my $main = <<EOH;      if ($main =~ /\$r\b/) {
557          warn qq(Rule @{[list $type]}/$name: Use of \$r is deprecated);
558          $main = q{my $r = '';} . "\n" . $main . "\n"
559                . q{$p->{-parent}->append_node ($r, node_or_text => 1);};
560        }
561        $main =~ s{__ATTR(TEXT|NODE)?:%(\w+|{$reg_block})(?:->{($reg_block)})?__;}
562                  {($1 eq 'TEXT' ? '$p->{'.literal_or_code($Info, $2)
563                                          .'} = do { my $r = ' : '')
564                   .'$f->parse_attr ($p=>'.literal_or_code($Info, $2).', $o, '
565                                   .($3?'-parent => '.$3.', ':'')
566                                   .($1?'-non_parsed_to_node => 1, ':'')
567                                   .'%opt)'
568                                   .($1 eq 'TEXT' ? '; ref $r?$r->inner_text:$r}'
569                                                  : '')
570                                   .';'}ge;
571        $code{$codename->[1]} = barecode "sub {$main}";
572      }
573      
574      my $main = literal {
575        Description => [barecode m13ed_val_list $src, 'Description'],
576        Parameter => {do {
577          my @r;
578          for (@{$src->child_nodes}) {
579            if ($_->local_name eq 'Parameter') {
580              push @r, $_->get_attribute_value ('Name')
581                       => {Type => $_->get_attribute_value ('Type'),
582                           Default => $_->get_attribute_value ('Default'),
583                           Description => [barecode m13ed_val_list $_, 'Description']};
584            }
585          }
586          @r;
587        }},
588        %code,
589      };
590      $main .= line $Info, reset => 1;
591    
592    
593    my  $amain = <<EOH;
594  {  {
595    main => sub {$main},    main => sub {$main},
596    @{[line ($Info, reset => 1)]}
597    Description => [@{[m13ed_val_list $src, 'Description']}],    Description => [@{[m13ed_val_list $src, 'Description']}],
598    Parameter => {@{[do{    Parameter => {@{[do{
     my @r;  
     for (@{$src->child_nodes}) {  
       if ($_->local_name eq 'Parameter') {  
         push @r, $_->get_attribute_value ('Name')  
                  => {Type => $_->get_attribute_value ('Type'),  
                      Default => $_->get_attribute_value ('Default'),  
                      Description => [barecode m13ed_val_list $_, 'Description']};  
       }  
     }  
     list @r;  
599    }]}},    }]}},
600  }  }
601  EOH  EOH
602    my $r = change_package $Info, $Info->{module_name};    my $r = change_package $Info, $Info->{module_name};
603      local $Info->{-message_error_used} = 0;  
604    if (@$type == 1) {    if (@$type == 1) {
605      $type->[0] =~ tr/-/_/;      $type->[0] =~ tr/-/_/;
606      $r .= qq{\$SuikaWiki::Plugin::Rule{$type->[0]}->{$name} = $main;\n};      $r .= qq{\$SuikaWiki::Plugin::Rule{$type->[0]}->{$name} = $main;\n};
# Line 536  EOH Line 617  EOH
617    $r;    $r;
618  }  }
619    
620    =item FormattingRuleAlias
621    
622    Generating an alias name for a formatting rule that is already loaded.
623    Example:
624    
625      FormattingRuleAlias:
626        @Category[list]:
627          category-1
628          category-2
629          ...
630        @Name: new-rule-name
631        @Reference:
632          @@Category: one-of-category
633          @@Name: one-of-name
634    
635    associates C<(I<category-1>, I<new-rule-name>)>,
636    C<(I<category-2>, I<new-rule-name>)>, ...
637    with C<(I<one-of-category>, I<one-of-name>)>.
638    
639    =cut
640    
641    sub make_rule_alias ($$) {
642      my ($src, $Info) = @_;
643      my $type = $src->get_attribute ('Category', make_new_node => 1)->value || [];
644      my $name = $src->get_attribute ('Name', make_new_node => 1)->value;
645      
646      my $ref = $src->get_attribute ('Reference', make_new_node => 1);
647      my $c = $ref->get_attribute_value ('Category');
648      my $n = $ref->get_attribute_value ('Name');
649      
650      s/(?<=.)-/_/g for $n, $name;
651      tr/-/_/ for $c, @$type;
652      
653      my $def = qq{\$SuikaWiki::Plugin::Rule{@{[literal $c]}}->{@{[literal $n]}} or warn qq{Formatting rule "$c/$n" not defined}};
654      
655      my $r = change_package $Info, $Info->{module_name};
656      for my $type (@$type) {
657        $r .= qq{\$SuikaWiki::Plugin::Rule{@{[literal $type]}}->{@{[literal $name]}} = $def;\n};
658        push @{$Info->{provide}->{rule}->{$type}}, $name;
659      }
660      $r;
661    }
662    
663    
664  sub random_module_name ($;$) {  sub random_module_name ($;$) {
665    my ($Info, $subname) = @_;    my ($Info, $subname) = @_;
# Line 546  sub random_module_name ($;$) { Line 670  sub random_module_name ($;$) {
670      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]),
671      join ('', @rand[rand@rand,rand@rand,rand@rand,rand@rand]);      join ('', @rand[rand@rand,rand@rand,rand@rand,rand@rand]);
672  }  }
673    
674    =head1 NAME
675    
676    mkplugin2.pl - SuikaWiki: WikiPlugin Generator
677    
678    =head1 SYNOPSIS
679    
680      mkplugin2.pl pluginsrc.wp2 > plugin.pm
681    
682    =head1 DESCRIPTION
683    
684    C<mkplugin2.pl> generates WikiPlugin module as a Perl module file
685    from WikiPlugin source description.  WikiPlugin source description
686    is described in SuikaWikiConfig/2.0 format and it contains
687    definitions of wiki constructions (such as formatting rules and
688    WikiView definitions) as both machine understandable code and
689    human readable documentation.  For more information, see
690    <http://suika.fam.cx/~wakaba/-temp/wiki/wiki?WikiPlugin>.
691    
692    This script is part of SuikaWiki.
693    
694    =head1 HISTORY AND COMPATIBILITY
695    
696    C<mkplugin2.pl> introduced as part of SuikaWiki 3.
697    It converts SuikaWiki 3 WikiPlugin source descriptions
698    (in SuikaWikiConfig/2.0) into Perl modules with SuikaWiki 3 interface.
699    
700    SuikaWiki 2 has C<mkplugin.pl>.  It also converts WikiPlugin
701    source descriptions into Perl modules.  But it support
702    SuikaWiki 2 format of WikiPlugin source description that differs from
703    SuikaWiki 3 format.  Wiki programming interface (not limited to
704    WikiPlugin related one) of SuikaWiki 3 also incompatible with that
705    of SuikaWiki 2 so that it is impossible to use SuikaWiki 2 WikiPlugin
706    module with SuikaWiki 3 and vice versa.
707    
708    =head1 SEE ALSO
709    
710    C<SuikaWiki::Plugin>, SuikaWiki:WikiPlugin
711    <http://suika.fam.cx/~wakaba/-temp/wiki/wiki?WikiPlugin>.
712    
713    =head1 LICENSE
714    
715    Copyright 2003-2004 Wakaba <w@suika.fam.cx>.  All rights reserved.
716    
717    This program is free software; you can redistribute it and/or
718    modify it under the same terms as Perl itself.
719    
720    =cut
721    
722    1; # $Date$
Legend:
Removed from v.1.6  
changed lines
  Added in v.1.15
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24