/[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.5 by wakaba, Tue Nov 25 12:47:19 2003 UTC revision 1.14 by wakaba, Thu Mar 11 04:04:06 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 75  sub quoted_string ($) { Line 80  sub quoted_string ($) {
80    $s =~ s/([\\"])/\\$1/g;    $s =~ s/([\\"])/\\$1/g;
81    '"'.$s.'"';    '"'.$s.'"';
82  }  }
83    sub line ($;%) {
84      my ($Info, %opt) = @_;
85      
86      unless ($opt{file}) {
87        if ($opt{reset}) {
88          $opt{file} = sprintf '(WikiPlugin module %s, chunk %d)',
89                               $Info->{Name},
90                               ++$Info->{chunk_count};
91        } elsif ($opt{realfile}) {
92          $opt{file} = sprintf '(WikiPlugin module %s, chunk from %s)',
93                               $Info->{Name},
94                               $opt{realfile};
95        } else {
96          $opt{file} = sprintf '(WikiPlugin module source %s, block %s)',
97                               $Info->{source_file},
98                               $opt{node_path};
99        }
100      }
101      
102      $opt{file} =~ s/"/''/g;
103      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 82  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 100  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 133  print qq{\$Info{$Info{name_literal}}->{A Line 166  print qq{\$Info{$Info{name_literal}}->{A
166  my $use = $meta->get_attribute ('Use');  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 $use->inner_text;    print line \%Info, node_path => 'Plugin/Use';
170      print code \%Info, $use->inner_text;
171      print line \%Info, reset => 1;
172  }  }
173    
174  for (@{$plugins->child_nodes}) {  for (@{$plugins->child_nodes}) {
# Line 151  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    # Parameter
190    # PluginCategory
191    }    }
192  }  }
193    
# Line 166  sub make_format ($$) { Line 203  sub make_format ($$) {
203    my ($src, $Info) = @_;    my ($src, $Info) = @_;
204    my $module_name = 'SuikaWiki::Format::Definition::'.$src->get_attribute_value ('ModuleName');    my $module_name = 'SuikaWiki::Format::Definition::'.$src->get_attribute_value ('ModuleName');
205    my $r = change_package $Info, $module_name;    my $r = change_package $Info, $module_name;
206      local $Info->{-message_error_used} = 0;  
207    $r .= qq{our \@ISA;\n};    $r .= qq{our \@ISA;\n};
208    if (my $isa = $src->get_attribute_value ('Inherit')) {    if (my $isa = $src->get_attribute_value ('Inherit')) {
209      for (@$isa) {      for (@$isa) {
# Line 178  sub make_format ($$) { Line 216  sub make_format ($$) {
216      $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};
217    }    }
218    if (my $type = $src->get_attribute_value ('Type')) {    if (my $type = $src->get_attribute_value ('Type')) {
219        $type .= join '', map {
220                   ';'. $_->local_name .'='. quoted_string $_->inner_text
221                 } sort {
222                   $a->local_name cmp $b->local_name
223                 } @{$src->get_attribute ('Type')->child_nodes};
224      $r .= qq{\$SuikaWiki::Format::Definition::Class{@{[literal $type.'//']}} = '$module_name';\n};      $r .= qq{\$SuikaWiki::Format::Definition::Class{@{[literal $type.'//']}} = '$module_name';\n};
225    }    }
226        
227    $r .= <<'EOH';    my $convert = line $Info, line_no => __LINE__ + 2, realfile => __FILE__;
228      $convert .= <<'EOH';
229  our $Converter;  our $Converter;
230  sub convert ($$;%) {  sub convert ($$;%) {
231    my ($self, $source, %opt) = @_;    my ($self, $source, %opt) = @_;
# Line 189  sub convert ($$;%) { Line 233  sub convert ($$;%) {
233    my $flag = '//';    my $flag = '//';
234    $flag .= 'f' if $opt{IsFragment};    $flag .= 'f' if $opt{IsFragment};
235    $flag .= 'p' if $opt{IsPlaceholder};    $flag .= 'p' if $opt{IsPlaceholder};
236    if ($Converter->{$opt{Type}.$flag}) {    my $type = $opt{Type} ?
237      $converter = $Converter->{$opt{Type}.$flag};                  $opt{Type} .
238                    SuikaWiki::Format::Definition->__get_param_string
239                      ($opt{Type_param}) : undef;
240      if ($Converter->{$type.$flag}) {
241        $converter = $Converter->{$type.$flag};
242    } elsif ($Converter->{$opt{Name}.'/'.$opt{Version}.$flag}) {    } elsif ($Converter->{$opt{Name}.'/'.$opt{Version}.$flag}) {
243      $converter = $Converter->{'/'.$opt{Name}.'/'.$opt{Version}.$flag};      $converter = $Converter->{'/'.$opt{Name}.'/'.$opt{Version}.$flag};
244    }    }
245    return $converter->{Main}->($self, $source, \%opt) if $converter;    return ($converter->{$opt{return_type} or 'Main'} or
246              CORE::die "Buggy implementation: $type $opt{Name}/$opt{Version}$flag/@{[$opt{return_type} or 'Main']} not defined")
247             ->($self, $source, \%opt)
248        if $converter;
249    $self->SUPER::convert ($source, %opt);    $self->SUPER::convert ($source, %opt);
250  }  }
251  EOH  EOH
252        
253    for (@{$src->child_nodes}) {    for (@{$src->child_nodes}) {
254      if ($_->local_name eq 'Converter') {      if ($_->local_name eq 'Converter') {
255          if ($convert) {
256            $r .= $convert;
257            $r .= line $Info, reset => 1;
258            undef $convert;
259          }
260        $r .= make_format_converter ($_, $Info);        $r .= make_format_converter ($_, $Info);
261        } elsif ($_->local_name eq 'WikiForm') {
262          $r .= q(sub wikiform {)."\n".q(my ($self, $source, %opt) = @_;);
263          $r .= line $Info, node_path => qq(Format[module-name()=$module_name]/WikiForm);
264          $r .= code $Info, $_->get_attribute_value ('Main');
265          $r .= line $Info, reset => 1;
266          $r .= qq(}\n);
267        } elsif ($_->local_name eq 'HeadSummary') {
268          $r .= q(sub headsummary {)."\n".q(my ($self, $source, %opt) = @_;);
269          $r .= line $Info, node_path => qq(Format[module-name()=$module_name]/HeadSummary);
270          $r .= code $Info, $_->get_attribute_value ('Main');
271          $r .= line $Info, reset => 1;
272          $r .= qq(}\n);
273        } elsif ($_->local_name eq 'NextIndex') {
274          my $name = $_->get_attribute_value ('Name', default => '');
275          $r .= q(sub next_index_for_).$name
276             .  q( {)."\n".q(my ($self, $source, %opt) = @_;)
277             .  line $Info, node_path => qq(Format[module-name()=$module_name]/NextIndex[Name=$name]);
278          $r .= code $Info, $_->get_attribute_value ('Main');
279          $r .= line $Info, reset => 1;
280          $r .= qq(}\n);
281      } elsif ($_->local_name eq 'Use') {      } elsif ($_->local_name eq 'Use') {
282        $r .= $_->inner_text;        $r .= line $Info, node_path => qq(Format[module-name()=$module_name]/Use);
283          $r .= code $Info, $_->inner_text;
284      }      }
285    }    }
     
286    $r;    $r;
287  }  }
288    
# Line 236  sub make_format_converter ($$) { Line 312  sub make_format_converter ($$) {
312    $flag .= 'p' and $def{IsPlaceholder} = 1    $flag .= 'p' and $def{IsPlaceholder} = 1
313      if $src->get_attribute_value ('IsPlaceholder');      if $src->get_attribute_value ('IsPlaceholder');
314        
315    $def{Main} = $src->get_attribute_value ('Main');    for (qw/Main ToString ToOctetStream/) {
316    $def{Main} = 'my $r;'.$def{Main}.'$r' if $def{Main} =~ /\$r\b/;      my $def = $src->get_attribute_value ($_);
317    $def{Main} = barecode code $Info,      next unless $def;
318                 'sub {my ($self, $source, $opt) = @_;'      $def{$_} = line ($Info, node_path => '//Converter/'.$_)
319               . $def{Main} . '}';                 . $def
320                   . line ($Info, reset => 1);
321        if ($def{$_} =~ /\$r\b/) {
322          $def{$_} = 'my $r;'."\n".$def{$_}."\n".'$r';
323        }
324        $def{$_} = barecode code $Info,
325                     'sub {my ($self, $source, $opt) = @_;'
326                   . $def{$_} . '}';
327      }
328        
329    my $r = list %def;    my $r = list %def;
330    if ($def{Type}) {    if ($def{Type}) {
# Line 249  sub make_format_converter ($$) { Line 333  sub make_format_converter ($$) {
333        if $def{Name};        if $def{Name};
334    } elsif ($def{Name}) {    } elsif ($def{Name}) {
335      $r = qq{\$Converter->{@{[literal '/'.$def{Name}.'/'.$def{Version}.$flag]}} = {$r};\n};      $r = qq{\$Converter->{@{[literal '/'.$def{Name}.'/'.$def{Version}.$flag]}} = {$r};\n};
336      $r    } else {
337        $r = 'BEGIN { die "Invalid Syntax of Converter: Type or Name property required" }';
338    }    }
339    $r;    $r;
340  }  }
# Line 257  sub make_format_converter ($$) { Line 342  sub make_format_converter ($$) {
342  sub make_function ($$) {  sub make_function ($$) {
343    my ($src, $Info) = @_;    my ($src, $Info) = @_;
344    ## TODO: support of ARGV property    ## TODO: support of ARGV property
345      my $name;
346    my $r = <<EOH;    my $r = <<EOH;
347  @{[change_package $Info, $Info->{module_name}]}  @{[change_package $Info, $Info->{module_name}]}
348  sub @{[$src->get_attribute_value ('Name')]} {  sub @{[$name = $src->get_attribute_value ('Name')]} {
349    @{[code $Info, $src->get_attribute_value ('Main')]}  @{[line $Info, node_path => "Function[Name='$name']/Main"]}@{[
350      code $Info, $src->get_attribute_value ('Main')
351    ]}
352  }  }
353    @{[line $Info, reset => 1]}
354  EOH  EOH
355  }  }
356    
357  sub register_plugin_const ($$) {  sub register_plugin_const ($$) {
358    my ($src, $Info) = @_;    my ($src, $Info) = @_;
359    for (@{$src->child_nodes}) {    for (@{$src->child_nodes}) {
360      $Info->{const}->{$_->local_name} = $_->value;      $Info->{const}->{$_->local_name} = literal_or_code $Info, $_->value;
361    }    }
362  }  }
363    
364  sub make_resdef ($$) {  sub make_resdef ($$) {
365    my ($src, $Info) = @_;    my ($src, $Info) = @_;
366    my $r = change_package $Info, 'SuikaWiki::Plugin::Resource';    my $r = change_package $Info, 'SuikaWiki::Plugin::Resource';
367      local $Info->{-message_error_used} = 0;  
368    $r .= qq{our \$BaseResource;\n};    $r .= qq{our \$BaseResource;\n};
369    for (@{$src->child_nodes}) {    for (@{$src->child_nodes}) {
370      if ($_->node_type eq '#element') {      if ($_->node_type eq '#element') {
# Line 321  sub make_viewdef ($$) { Line 411  sub make_viewdef ($$) {
411    my ($src, $Info) = @_;    my ($src, $Info) = @_;
412    my $ViewProp = {};    my $ViewProp = {};
413    my $r = '';    my $r = '';
414    $ViewProp->{Name} = n11n $src->get_attribute ('Mode')->value;    $ViewProp->{Name} = n11n $src->get_attribute_value ('Mode');
415      $ViewProp->{Name} =~ s/(?<=.)-/_/g;
416    $ViewProp->{pack_name} = random_module_name ($Info, $ViewProp->{Name});    $ViewProp->{pack_name} = random_module_name ($Info, $ViewProp->{Name});
417        
418    $ViewProp->{condition_stringified} = hash    $ViewProp->{condition_stringified} = hash
# Line 337  push \@SuikaWiki::View::Implementation:: Line 428  push \@SuikaWiki::View::Implementation::
428  @{[change_package $Info, $ViewProp->{pack_name}]}  @{[change_package $Info, $ViewProp->{pack_name}]}
429  our \@ISA = q#SuikaWiki::View::template#;  our \@ISA = q#SuikaWiki::View::template#;
430  EOH  EOH
431      local $Info->{-message_error_used} = 0;  
432      my $use = $src->get_attribute ('Use');
433      if (ref $use) {
434        $r .= line $Info, node_path => "ViewDefinition[Mode='$ViewProp->{Name}']/Use";
435        $r .= code $Info, $use->inner_text;
436        $r .= "\n\n";
437      }
438      
439    for (@{$src->child_nodes}) {    for (@{$src->child_nodes}) {
440      if ($_->local_name eq 'template') {      if ($_->local_name eq 'template') {
441        $r .= make_view_template_method ($_, $Info);        $r .= make_view_template_method ($_, $Info, $ViewProp);
442      } elsif ($_->local_name eq 'method') {      } elsif ($_->local_name eq 'method') {
443          my $method_name = $_->get_attribute_value ('Name');
444        $r .= ({        $r .= ({
445                main => q(sub main ($$) {)."\n".q(my ($self, $opt) = @_;)."\n",                main => q(sub main ($$) {)."\n".q(my ($self, $opt, $opt2) = @_;)."\n",
446                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",
447                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",                    
448               }->{$_->get_attribute ('Name')->value}               }->{$method_name}
449               ||qq(sub @{[$_->get_attribute ('Name')->value]} {\n))               ||qq(sub @{[$method_name]} {\n))
450             . line ($Info, node_path => "ViewDefinition[Mode='$ViewProp->{Name}']/method[Name='$method_name']")
451           . code ($Info, $_->value)           . code ($Info, $_->value)
452           . qq(\n}\n);           . qq(}\n)
453             . line ($Info, reset => 1);
454      }      }
455    }    }
456    my $prop = {Name => $ViewProp->{Name},    my $prop = {Name => $ViewProp->{Name},
# Line 358  EOH Line 460  EOH
460  }  }
461    
462  sub make_view_template_method ($$) {  sub make_view_template_method ($$) {
463    my ($src, $info) = @_;    my ($src, $Info, $ViewProp) = @_;
464    my $r = <<EOH;    my $r = <<EOH;
465    
466  sub main (\$\$\$) {  sub main (\$\$\$) {
# Line 374  sub main (\$\$\$) { Line 476  sub main (\$\$\$) {
476        
477    \$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]};
478    \$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)  
     ]}},  
479                        ## SuikaWiki 3 WikiPlugin interface                        ## SuikaWiki 3 WikiPlugin interface
480                          wiki => \$self->{view}->{wiki},                          wiki => \$self->{view}->{wiki},
481                          plugin => \$self->{view}->{wiki}->{plugin},                          plugin => \$self->{view}->{wiki}->{plugin},
# Line 398  sub main (\$\$\$) { Line 484  sub main (\$\$\$) {
484    @{[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;
485       $x?q{$opt2->{output}->{status_code} = }.(0 + $x).q{;}:q{}}]}       $x?q{$opt2->{output}->{status_code} = }.(0 + $x).q{;}:q{}}]}
486    @{[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;
487       $x?q{$opt2->{output}->{reason_phrase} = }.literal($x).q{;}:q{}}]}       $x?q{$opt2->{output}->{status_phrase} = }.literal($x).q{;}:q{}}]}
488    \$opt2->{output}->{entity}->{media_type} = @{[literal    \$opt2->{output}->{entity}->{media_type} = @{[literal
489                             $src->get_attribute ('media-type',make_new_node=>1)                             $src->get_attribute ('media-type',make_new_node=>1)
490                                 ->inner_text || 'application/octet-stream']};                                 ->inner_text || 'application/octet-stream']};
# Line 413  sub main (\$\$\$) { Line 499  sub main (\$\$\$) {
499              qq{\$opt2->{output}->set_expires (delta => @{[0 + $x]});};              qq{\$opt2->{output}->set_expires (delta => @{[0 + $x]});};
500            }            }
501        }]}        }]}
502      \$opt2->{output}->{entity}->{body_is_octet_stream} = @{[
503        $src->get_attribute ('body')->get_attribute_value ('is-octet-stream', default_value => 0)
504        or 0
505      ]};
506        
507    \$self->{view}->{wiki}->init_db;    \$self->{view}->{wiki}->init_db;
508    \$self->main_pre (\$opt, \$opt2);    \$self->main_pre (\$opt, \$opt2);
509        
510    my \$fmt = SuikaWiki::Plugin->formatter ('view');    use Message::Util::Error;
511    \$opt2->{output}->{entity}->{body}    try {
512      = \$fmt->replace (\$opt2->{template}, param => \$opt2->{o});      \$opt2->{output}->{entity}->{body}
513          = SuikaWiki::Plugin->formatter ('view')
514            ->replace (\$opt2->{template}, param => \$opt2->{o});
515      } \$self->{view}->{wiki}->{config}->{catch}->{ @{[
516           $ViewProp->{Name} eq '-error' ? 'formatter_view_error'
517                                         : 'formatter_view' ]} };
518    \$opt2->{output}->output (output => 'http-cgi');    \$opt2->{output}->output (output => 'http-cgi');
519        
520    \$self->main_post (\$opt, \$opt2);    \$self->main_post (\$opt, \$opt2);
# Line 432  sub make_rule ($$) { Line 527  sub make_rule ($$) {
527    my $type = $src->get_attribute ('Category', make_new_node => 1)->value || [];    my $type = $src->get_attribute ('Category', make_new_node => 1)->value || [];
528    my $name = $src->get_attribute ('Name', make_new_node => 1)->value;    my $name = $src->get_attribute ('Name', make_new_node => 1)->value;
529    $name =~ s/(?<=.)-/_/g;    $name =~ s/(?<=.)-/_/g;
   my $main = code $Info, $src->get_attribute_value ('Formatting');  
530        
531    my $reg_block;    my $reg_block;
532    $reg_block = qr/[^{}]*(?>[^{}]+|{(??{$reg_block})})*/;    $reg_block = qr/[^{}]*(?>[^{}]+|{(??{$reg_block})})*/;
533    my $reg_attr = qr/__ATTR(TEXT|NODE)?:%(\w+)(?:->{($reg_block)})?__;/;    my %code;
534        for my $codename ([qw/Formatting main/], [qw/After after/],
535    $main = q{my ($f, $rule_name, $p, $o, %opt) = @_;}."\n".$main                      [qw/Before before/], [qw/Pre pre/], [qw/Post post/],
536      if $main =~ /\$f\b/                      [qw/Attribute attr/]) {
537      or $main =~ /\$rule_name\b/      my $main = code $Info, $src->get_attribute_value ($codename->[0]);
538      or $main =~ /\$[opr]\b/      next unless $main;
539      or $main =~ /[%\$]opt\b/;      $main = line ($Info, node_path =>
540    if ($main =~ /\$r\b/) {                "FormattingRule[name()='@{[list $type]}/$name']/".$codename->[0])
541      warn qq(Rule @{[list $type]}/$name: Use of \$r is deprecated);            . $main;
542      $main = q{my $r = '';} . "\n" . $main . "\n"      
543            . q{$p->{-parent}->append_node ($r, node_or_text => 1);};      if ( $main =~ /\$f\b/
544    }        or $main =~ /\$rule_name\b/
545    $main =~ s{$reg_attr}        or $main =~ /\$[opr]\b/
546              {($1 eq 'TEXT' ? '$p->{'.literal($2).'} = do { my $r = ' : '')        or $main =~ /[%\$]opt\b/
547               .'$f->parse_attr ($p=>'.literal($2).', $o, '        or $main =~ /\$param_(?:name|value)\n/) {
548                               .($3?'-parent => '.$3.', ':'')        if ($codename->[0] ne 'Attribute') {
549                               .($1?'-non_parsed_to_node => 1, ':'')          $main = q{my ($f, $rule_name, $p, $o, %opt) = @_;}."\n".$main;
550                               .'%opt)'        } else {
551                               .($1 eq 'TEXT' ? '; ref $r?$r->inner_text:$r}' : '')          $main = q{my ($f, $rule_name, $p, $o, $param_name => $param_value, %opt) = @_;}."\n".$main;
552                               .';'}ge;        }
553          }
554    my $main = <<EOH;      if ($main =~ /\$r\b/) {
555          warn qq(Rule @{[list $type]}/$name: Use of \$r is deprecated);
556          $main = q{my $r = '';} . "\n" . $main . "\n"
557                . q{$p->{-parent}->append_node ($r, node_or_text => 1);};
558        }
559        $main =~ s{__ATTR(TEXT|NODE)?:%(\w+|{$reg_block})(?:->{($reg_block)})?__;}
560                  {($1 eq 'TEXT' ? '$p->{'.literal_or_code($Info, $2)
561                                          .'} = do { my $r = ' : '')
562                   .'$f->parse_attr ($p=>'.literal_or_code($Info, $2).', $o, '
563                                   .($3?'-parent => '.$3.', ':'')
564                                   .($1?'-non_parsed_to_node => 1, ':'')
565                                   .'%opt)'
566                                   .($1 eq 'TEXT' ? '; ref $r?$r->inner_text:$r}'
567                                                  : '')
568                                   .';'}ge;
569        $code{$codename->[1]} = barecode "sub {$main}";
570      }
571      
572      my $main = literal {
573        Description => [barecode m13ed_val_list $src, 'Description'],
574        Parameter => {do {
575          my @r;
576          for (@{$src->child_nodes}) {
577            if ($_->local_name eq 'Parameter') {
578              push @r, $_->get_attribute_value ('Name')
579                       => {Type => $_->get_attribute_value ('Type'),
580                           Default => $_->get_attribute_value ('Default'),
581                           Description => [barecode m13ed_val_list $_, 'Description']};
582            }
583          }
584          @r;
585        }},
586        %code,
587      };
588      $main .= line $Info, reset => 1;
589    
590    
591    my  $amain = <<EOH;
592  {  {
593    main => sub {$main},    main => sub {$main},
594    @{[line ($Info, reset => 1)]}
595    Description => [@{[m13ed_val_list $src, 'Description']}],    Description => [@{[m13ed_val_list $src, 'Description']}],
596    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;  
597    }]}},    }]}},
598  }  }
599  EOH  EOH
600    my $r = change_package $Info, $Info->{module_name};    my $r = change_package $Info, $Info->{module_name};
601      local $Info->{-message_error_used} = 0;  
602    if (@$type == 1) {    if (@$type == 1) {
603      $type->[0] =~ tr/-/_/;      $type->[0] =~ tr/-/_/;
604      $r .= qq{\$SuikaWiki::Plugin::Rule{$type->[0]}->{$name} = $main;\n};      $r .= qq{\$SuikaWiki::Plugin::Rule{$type->[0]}->{$name} = $main;\n};
# Line 502  sub random_module_name ($;$) { Line 625  sub random_module_name ($;$) {
625      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]),
626      join ('', @rand[rand@rand,rand@rand,rand@rand,rand@rand]);      join ('', @rand[rand@rand,rand@rand,rand@rand,rand@rand]);
627  }  }
628    
629    =head1 NAME
630    
631    mkplugin2.pl - SuikaWiki: WikiPlugin Generator
632    
633    =head1 SYNOPSIS
634    
635      mkplugin2.pl pluginsrc.wp2 > plugin.pm
636    
637    =head1 DESCRIPTION
638    
639    C<mkplugin2.pl> generates WikiPlugin module as a Perl module file
640    from WikiPlugin source description.  WikiPlugin source description
641    is described in SuikaWikiConfig/2.0 format and it contains
642    definitions of wiki constructions (such as formatting rules and
643    WikiView definitions) as both machine understandable code and
644    human readable documentation.  For more information, see
645    <http://suika.fam.cx/~wakaba/-temp/wiki/wiki?WikiPlugin>.
646    
647    This script is part of SuikaWiki.
648    
649    =head1 HISTORY AND COMPATIBILITY
650    
651    C<mkplugin2.pl> introduced as part of SuikaWiki 3.
652    It converts SuikaWiki 3 WikiPlugin source descriptions
653    (in SuikaWikiConfig/2.0) into Perl modules with SuikaWiki 3 interface.
654    
655    SuikaWiki 2 has C<mkplugin.pl>.  It also converts WikiPlugin
656    source descriptions into Perl modules.  But it support
657    SuikaWiki 2 format of WikiPlugin source description that differs from
658    SuikaWiki 3 format.  Wiki programming interface (not limited to
659    WikiPlugin related one) of SuikaWiki 3 also incompatible with that
660    of SuikaWiki 2 so that it is impossible to use SuikaWiki 2 WikiPlugin
661    module with SuikaWiki 3 and vice versa.
662    
663    =head1 SEE ALSO
664    
665    C<SuikaWiki::Plugin>, SuikaWiki:WikiPlugin
666    <http://suika.fam.cx/~wakaba/-temp/wiki/wiki?WikiPlugin>.
667    
668    =head1 LICENSE
669    
670    Copyright 2003-2004 Wakaba <w@suika.fam.cx>.  All rights reserved.
671    
672    This program is free software; you can redistribute it and/or
673    modify it under the same terms as Perl itself.
674    
675    =cut
676    
677    1; # $Date$
Legend:
Removed from v.1.5  
changed lines
  Added in v.1.14
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24