/[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.3 by wakaba, Sat Oct 25 02:22:06 2003 UTC revision 1.6 by wakaba, Wed Nov 26 09:11:01 2003 UTC
# Line 1  Line 1 
1  #!/usr/bin/perl  #!/usr/bin/perl
2  use strict;  use strict;
3  our $VERSION = do{my @r=(q$Revision$=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};  our $VERSION = do{my @r=(q$Revision$=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};
4  require SuikaWiki::Markup::SuikaWikiConfig20::Parser;  require Message::Markup::SuikaWikiConfig20::Parser;
5    
6  {  {
7  my $src = '';  my $src = '';
# Line 61  sub code ($$) { Line 61  sub code ($$) {
61    $code =~ s/__FUNCPACK__/$Info->{module_name}/g;    $code =~ s/__FUNCPACK__/$Info->{module_name}/g;
62    $code;    $code;
63  }  }
64    sub change_package ($$) {
65      my ($Info, $pack) = @_;
66      unless ($Info->{current_package} eq $pack) {
67        $Info->{current_package} = $pack;
68        return qq{package $pack;\n\n};
69      } else {
70        return '';
71      }
72    }
73    sub quoted_string ($) {
74      my $s = shift;
75      $s =~ s/([\\"])/\\$1/g;
76      '"'.$s.'"';
77    }
78    sub line ($;%) {
79      my ($Info, %opt) = @_;
80      
81      unless ($opt{file}) {
82        if ($opt{reset}) {
83          $opt{file} = sprintf '(WikiPlugin module %s, chunk %d)',
84                               $Info->{Name},
85                               ++$Info->{chunk_count};
86        } elsif ($opt{realfile}) {
87          $opt{file} = sprintf '(WikiPlugin module %s, chunk from %s)',
88                               $Info->{Name},
89                               $opt{realfile};
90        } else {
91          $opt{file} = sprintf '(WikiPlugin module %s, block %s)',
92                               $Info->{Name},
93                               $opt{node_path};
94        }
95      }
96      
97      $opt{file} =~ s/"/''/g;
98      sprintf '%s#line %d "%s"%s', "\n", $opt{line_no} || 1, $opt{file}, "\n";
99    }
100    
101  my $parser = SuikaWiki::Markup::SuikaWikiConfig20::Parser->new;  my $parser = Message::Markup::SuikaWikiConfig20::Parser->new;
102  my $plugins = $parser->parse_text ($src);  my $plugins = $parser->parse_text ($src);
103  my $meta = $plugins->get_attribute ('Plugin')  my $meta = $plugins->get_attribute ('Plugin')
104            or die "$0: Required 'Plugin' section not found";            or die "$0: Required 'Plugin' section not found";
# Line 81  $Info{module_name} = random_module_name Line 117  $Info{module_name} = random_module_name
117    
118  print <<EOH;  print <<EOH;
119  use strict;  use strict;
120  package SuikaWiki::Plugin::Registry;  @{[change_package \%Info, 'SuikaWiki::Plugin::Registry']}
121  our \%Info;  our \%Info;
122  \$Info{$Info{name_literal}}->{Name} = $Info{name_literal};  \$Info{$Info{name_literal}}->{Name} = $Info{name_literal};
123  EOH  EOH
124  for (qw/Version InterfaceVersion mkpluginVersion/) {  for (qw/Version InterfaceVersion mkpluginVersion module_name/) {
125    print qq{\$Info{$Info{name_literal}}->{$_} = v$Info{$_};\n};    print qq{\$Info{$Info{name_literal}}->{$_} = @{[literal $Info{$_}]};\n};
126  }  }
127  for (qw/LastModified/) {  for (qw/LastModified/) {
128    $Info{$_} = n11n $meta->get_attribute ($_,make_new_node=>1)->value;    $Info{$_} = n11n $meta->get_attribute ($_,make_new_node=>1)->value;
# Line 116  print qq{\$Info{$Info{name_literal}}->{A Line 152  print qq{\$Info{$Info{name_literal}}->{A
152  } grep { $_->local_name eq 'Author' } @{$meta->child_nodes}  } grep { $_->local_name eq 'Author' } @{$meta->child_nodes}
153  ). qq{];\n};  ). qq{];\n};
154    
155    my $use = $meta->get_attribute ('Use');
156    if (ref $use) {
157      print change_package \%Info, $Info{module_name};
158      print line \%Info, node_path => 'Plugin/Use';
159      print $use->inner_text, "\n";
160      print line \%Info, reset => 1;
161    }
162    
163  for (@{$plugins->child_nodes}) {  for (@{$plugins->child_nodes}) {
164    if ($_->local_name eq 'FormattingRule') {    if ($_->local_name eq 'FormattingRule') {
165      print "\n", make_rule ($_, \%Info);      print "\n", make_rule ($_, \%Info);
# Line 129  for (@{$plugins->child_nodes}) { Line 173  for (@{$plugins->child_nodes}) {
173      print "\n", make_resdef ($_, \%Info);      print "\n", make_resdef ($_, \%Info);
174    } elsif ($_->local_name eq 'PluginConst') {    } elsif ($_->local_name eq 'PluginConst') {
175      register_plugin_const ($_, \%Info);      register_plugin_const ($_, \%Info);
176      } elsif ($_->local_name eq 'Format') {
177        print "\n", make_format ($_, \%Info);
178    }    }
179  }  }
180    
181  print qq{\npackage SuikaWiki::Plugin::Registry;\n\n};  print change_package \%Info, q(SuikaWiki::Plugin::Registry);
182  print qq{\$Info{$Info{name_literal}}->{provide} = } . literal $Info{provide};  print qq{\$Info{$Info{name_literal}}->{provide} = } . literal $Info{provide};
183  print qq{;\n};  print qq{;\n};
184    
# Line 140  print "\n1;\n"; Line 186  print "\n1;\n";
186  exit;  exit;
187  }  }
188    
189    sub make_format ($$) {
190      my ($src, $Info) = @_;
191      my $module_name = 'SuikaWiki::Format::Definition::'.$src->get_attribute_value ('ModuleName');
192      my $r = change_package $Info, $module_name;
193      $r .= qq{our \@ISA;\n};
194      if (my $isa = $src->get_attribute_value ('Inherit')) {
195        for (@$isa) {
196          $r .= qq{push \@ISA, @{[literal 'SuikaWiki::Format::Definition::'.$_]};\n};
197        }
198      } else {
199        $r .= qq{push \@ISA, 'SuikaWiki::Format::Definition::template';\n};    
200      }
201      if (my $name = $src->get_attribute_value ('Name')) {
202        $r .= qq{\$SuikaWiki::Format::Definition::Class{@{[literal '/'.$name.'/'.$src->get_attribute_value ('Version', default => '').'//']}} = '$module_name';\n};
203      }
204      if (my $type = $src->get_attribute_value ('Type')) {
205        $r .= qq{\$SuikaWiki::Format::Definition::Class{@{[literal $type.'//']}} = '$module_name';\n};
206      }
207      
208      $r .= line $Info, line_no => __LINE__ + 2, realfile => __FILE__;
209      $r .= <<'EOH';
210    our $Converter;
211    sub convert ($$;%) {
212      my ($self, $source, %opt) = @_;
213      my $converter;
214      my $flag = '//';
215      $flag .= 'f' if $opt{IsFragment};
216      $flag .= 'p' if $opt{IsPlaceholder};
217      if ($Converter->{$opt{Type}.$flag}) {
218        $converter = $Converter->{$opt{Type}.$flag};
219      } elsif ($Converter->{$opt{Name}.'/'.$opt{Version}.$flag}) {
220        $converter = $Converter->{'/'.$opt{Name}.'/'.$opt{Version}.$flag};
221      }
222      return $converter->{Main}->($self, $source, \%opt) if $converter;
223      $self->SUPER::convert ($source, %opt);
224    }
225    EOH
226      
227      my $reset = 0;
228      for (@{$src->child_nodes}) {
229        if ($_->local_name eq 'Converter') {
230          $r .= line $Info, reset => 1 unless $reset;
231          $r .= make_format_converter ($_, $Info);
232          $reset = 1;
233        } elsif ($_->local_name eq 'Use') {
234          $r .= line $Info, node_path => qq(Format[module-name()=$module_name]/Use);
235          $r .= $_->inner_text;
236          $reset = 0;
237        }
238      }
239      $r .= line $Info, reset => 1 unless $reset;
240      
241      $r;
242    }
243    
244    sub make_format_converter ($$) {
245      my ($src, $Info) = @_;
246      my %def;
247      $def{Type} = $src->get_attribute ('Type');
248      if (ref $def{Type}) {
249        $def{Type} = $def{Type}->inner_text
250              . join '', map {
251                  ';'. $_->local_name .'='. quoted_string $_->inner_text
252                } sort {
253                  $a->local_name cmp $b->local_name
254                } @{$def{Type}->child_nodes};
255      } else {
256        delete $def{Type};
257      }
258      $def{Name} = $src->get_attribute_value ('Name');
259      delete $def{Name} unless defined $def{Name};
260      $def{Version} = $src->get_attribute_value ('Version');
261      delete $def{Version} if not defined $def{Version} or
262                              not defined $def{Name};
263      
264      my $flag = '//';
265      $flag .= 'f' and $def{IsFragment} = 1
266        if $src->get_attribute_value ('IsFragment');
267      $flag .= 'p' and $def{IsPlaceholder} = 1
268        if $src->get_attribute_value ('IsPlaceholder');
269      
270      $def{Main} = $src->get_attribute_value ('Main');
271      $def{Main} = line ($Info, node_path => '//Converter/Main')
272                 . $def{Main}
273                 . line ($Info, reset => 1);
274      if ($def{Main} =~ /\$r\b/) {
275        $def{Main} = 'my $r;'."\n".$def{Main}."\n".'$r';
276      }
277      $def{Main} = barecode code $Info,
278                   'sub {my ($self, $source, $opt) = @_;'
279                 . $def{Main} . '}';
280      
281      my $r = list %def;
282      if ($def{Type}) {
283        $r = qq{\$Converter->{@{[literal $def{Type}.$flag]}} = {$r};\n};
284        $r .= qq{\$Converter->{@{[literal '/'.$def{Name}.'/'.$def{Version}.$flag]}} = \$Converter->{@{[literal $def{Type}.$flag]}};\n}
285          if $def{Name};
286      } elsif ($def{Name}) {
287        $r = qq{\$Converter->{@{[literal '/'.$def{Name}.'/'.$def{Version}.$flag]}} = {$r};\n};
288        $r
289      }
290      $r;
291    }
292    
293  sub make_function ($$) {  sub make_function ($$) {
294    my ($src, $Info) = @_;    my ($src, $Info) = @_;
295    ## TODO: support of ARGV property    ## TODO: support of ARGV property
296      my $name;
297    my $r = <<EOH;    my $r = <<EOH;
298  package $Info->{module_name};  @{[change_package $Info, $Info->{module_name}]}
299  sub @{[$src->get_attribute_value ('Name')]} {  sub @{[$name = $src->get_attribute_value ('Name')]} {
300    @{[code $Info, $src->get_attribute_value ('Main')]}  @{[line $Info, node_path => "Function[Name='$name']/Main"]}@{[
301      code $Info, $src->get_attribute_value ('Main')
302    ]}@{[line $Info, reset => 1]}
303  }  }
304  EOH  EOH
305  }  }
# Line 160  sub register_plugin_const ($$) { Line 313  sub register_plugin_const ($$) {
313    
314  sub make_resdef ($$) {  sub make_resdef ($$) {
315    my ($src, $Info) = @_;    my ($src, $Info) = @_;
316    my $r = qq{package SuikaWiki::Plugin::Resource;\nour \$BaseResource;\n};    my $r = change_package $Info, 'SuikaWiki::Plugin::Resource';
317      $r .= qq{our \$BaseResource;\n};
318    for (@{$src->child_nodes}) {    for (@{$src->child_nodes}) {
319      if ($_->node_type eq '#element') {      if ($_->node_type eq '#element') {
320        my $lang = literal ($_->get_attribute_value ('lang') || 'und');        my $lang = literal ($_->get_attribute_value ('lang') || 'und');
# Line 176  sub make_resdef ($$) { Line 330  sub make_resdef ($$) {
330  sub make_viewfragment ($$) {  sub make_viewfragment ($$) {
331    my ($src, $Info) = @_;    my ($src, $Info) = @_;
332    my $r = '';    my $r = '';
333    my $name = $src->get_attribute_value ('Name');    my $body = <<EOH;
334    $name =~ tr/-/_/;    {
   ## SuikaWiki 2 Interface  
 #    $r .= qq(SuikaWiki::View->template (@{[literal $name]})  
 #                            ->add_line (@{[literal $src->get_attribute_value ('Formatting')]});\n);  
   ## SuikaWiki 3 Interface  
     $r .= <<EOH;  
   push \@{\$SuikaWiki::View::Implementation::TemplateFragment{@{[literal $name]}}}, {  
335      Main => @{[literal $src->get_attribute_value ('Formatting')]},      Main => @{[literal $src->get_attribute_value ('Formatting')]},
336      Order => @{[0+$src->get_attribute_value ('Order')]},      Order => @{[0+$src->get_attribute_value ('Order')]},
337      Description => [@{[m13ed_val_list $src, 'Description']}],      Description => [@{[m13ed_val_list $src, 'Description']}],
338    };    };
339  EOH  EOH
340    push @{$Info->{provide}->{viewfragment}},    ## Recommended format
341         {Name => $src->get_attribute ('Name')->value};    my $name = $src->get_attribute_value ('Template');
342      if (ref ($name) and @$name > 1) {
343        $r .= qq({my \$def = $body;\n);
344        for (@$name) {
345          my $name = $_; $name =~ tr/-/_/;
346          $r .= qq(push \@{\$SuikaWiki::View::Implementation::TemplateFragment{@{[literal $name]}}}, \$def;\n);
347          push @{$Info->{provide}->{viewfragment}}, {Name => $name};
348        }
349        $r .= qq(}\n);
350      } else {                           ## Obsoleted format
351        $name = ref $name ? $name->[0] : $src->get_attribute_value ('Name');
352        $name =~ tr/-/_/;
353        $r .= qq(push \@{\$SuikaWiki::View::Implementation::TemplateFragment{@{[literal $name]}}}, $body);
354        push @{$Info->{provide}->{viewfragment}}, {Name => $name};
355      }
356    $r;    $r;
357  }  }
358    
# Line 198  sub make_viewdef ($$) { Line 360  sub make_viewdef ($$) {
360    my ($src, $Info) = @_;    my ($src, $Info) = @_;
361    my $ViewProp = {};    my $ViewProp = {};
362    my $r = '';    my $r = '';
363    $ViewProp->{Name} = n11n $src->get_attribute ('Mode')->value;    $ViewProp->{Name} = n11n $src->get_attribute_value ('Mode');
364    $ViewProp->{pack_name} = random_module_name ($Info, $ViewProp->{Name});    $ViewProp->{pack_name} = random_module_name ($Info, $ViewProp->{Name});
365        
366    $ViewProp->{condition_stringified} = hash    $ViewProp->{condition_stringified} = hash
# Line 211  push \@SuikaWiki::View::Implementation:: Line 373  push \@SuikaWiki::View::Implementation::
373    condition => {$ViewProp->{condition_stringified}},    condition => {$ViewProp->{condition_stringified}},
374    object_class => q#$ViewProp->{pack_name}#,    object_class => q#$ViewProp->{pack_name}#,
375  };  };
376  package $ViewProp->{pack_name};  @{[change_package $Info, $ViewProp->{pack_name}]}
377  our \@ISA = q#SuikaWiki::View::template#;  our \@ISA = q#SuikaWiki::View::template#;
378  EOH  EOH
379    for (@{$src->child_nodes}) {    for (@{$src->child_nodes}) {
380      if ($_->local_name eq 'template') {      if ($_->local_name eq 'template') {
381        $r .= make_view_template_method ($_, $Info);        $r .= make_view_template_method ($_, $Info);
382      } elsif ($_->local_name eq 'method') {      } elsif ($_->local_name eq 'method') {
383          my $method_name = $_->get_attribute_value ('Name');
384        $r .= ({        $r .= ({
385                main => q(sub main ($$) {)."\n".q(my ($self, $opt) = @_;)."\n",                main => q(sub main ($$) {)."\n".q(my ($self, $opt) = @_;)."\n",
386                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",
387                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",                    
388               }->{$_->get_attribute ('Name')->value}               }->{$method_name}
389               ||qq(sub @{[$_->get_attribute ('Name')->value]} {\n))               ||qq(sub @{[$method_name]} {\n))
390             . line ($Info, node_path => "ViewDefinition[Mode='$ViewProp->{Name}']/method[Name='$method_name']")
391           . code ($Info, $_->value)           . code ($Info, $_->value)
392           . qq(\n}\n);           . line ($Info, reset => 1)
393             . qq(}\n);
394      }      }
395    }    }
396    my $prop = {Name => $ViewProp->{Name},    my $prop = {Name => $ViewProp->{Name},
# Line 294  sub main (\$\$\$) { Line 459  sub main (\$\$\$) {
459    \$self->{view}->{wiki}->init_db;    \$self->{view}->{wiki}->init_db;
460    \$self->main_pre (\$opt, \$opt2);    \$self->main_pre (\$opt, \$opt2);
461        
   ## TODO: formal SuikaWiki 3 interface  
462    my \$fmt = SuikaWiki::Plugin->formatter ('view');    my \$fmt = SuikaWiki::Plugin->formatter ('view');
463    \$opt2->{output}->{entity}->{body}    \$opt2->{output}->{entity}->{body}
464      = \$fmt->replace (\$opt2->{template} => \$opt2->{o},      = \$fmt->replace (\$opt2->{template}, param => \$opt2->{o});
                       {formatter => \$fmt});  
465    \$opt2->{output}->output (output => 'http-cgi');    \$opt2->{output}->output (output => 'http-cgi');
466        
467    \$self->main_post (\$opt, \$opt2);    \$self->main_post (\$opt, \$opt2);
# Line 306  sub main (\$\$\$) { Line 469  sub main (\$\$\$) {
469  EOH  EOH
470  }  }
471    
 ## TODO: Implements SuikaWiki 3 interface  
472  sub make_rule ($$) {  sub make_rule ($$) {
473    my ($src, $Info) = @_;    my ($src, $Info) = @_;
474    my $type = $src->get_attribute ('Category', make_new_node => 1)->value || [];    my $type = $src->get_attribute ('Category', make_new_node => 1)->value || [];
475    my $name = $src->get_attribute ('Name', make_new_node => 1)->value;    my $name = $src->get_attribute ('Name', make_new_node => 1)->value;
476    $name =~ s/(?=.)-/_/g;    $name =~ s/(?<=.)-/_/g;
477    my $main = code $Info, $src->get_attribute_value ('Formatting');    my $main = line ($Info, node_path => "FormattingRule[name()='@{[list $type]}/$name']/Formatting")
478    $main = q{my ($p, $o) = @_;}."\n" . $main             . code ($Info, $src->get_attribute_value ('Formatting'))
479      if $main =~ /\$p/ || $main =~ /\$o/;             . line ($Info, reset => 1);
480    if ($main =~ /\$r/) {    
481      $main = q{my $r = '';} . "\n" . $main;    my $reg_block;
482      $main .= q{$r};    $reg_block = qr/[^{}]*(?>[^{}]+|{(??{$reg_block})})*/;
483      my $reg_attr = qr/__ATTR(TEXT|NODE)?:%(\w+)(?:->{($reg_block)})?__;/;
484      
485      $main = q{my ($f, $rule_name, $p, $o, %opt) = @_;}."\n".$main
486        if $main =~ /\$f\b/
487        or $main =~ /\$rule_name\b/
488        or $main =~ /\$[opr]\b/
489        or $main =~ /[%\$]opt\b/;
490      if ($main =~ /\$r\b/) {
491        warn qq(Rule @{[list $type]}/$name: Use of \$r is deprecated);
492        $main = q{my $r = '';} . "\n" . $main . "\n"
493              . q{$p->{-parent}->append_node ($r, node_or_text => 1);};
494    }    }
495      $main =~ s{$reg_attr}
496                {($1 eq 'TEXT' ? '$p->{'.literal($2).'} = do { my $r = ' : '')
497                 .'$f->parse_attr ($p=>'.literal($2).', $o, '
498                                 .($3?'-parent => '.$3.', ':'')
499                                 .($1?'-non_parsed_to_node => 1, ':'')
500                                 .'%opt)'
501                                 .($1 eq 'TEXT' ? '; ref $r?$r->inner_text:$r}' : '')
502                                 .';'}ge;
503        
504    my $main = <<EOH;    my $main = <<EOH;
505  {  {
506    Formatting => sub {$main},    main => sub {$main},
507    Description => [@{[m13ed_val_list $src, 'Description']}],    Description => [@{[m13ed_val_list $src, 'Description']}],
508    Parameter => {@{[do{    Parameter => {@{[do{
509      my @r;      my @r;
# Line 338  sub make_rule ($$) { Line 519  sub make_rule ($$) {
519    }]}},    }]}},
520  }  }
521  EOH  EOH
522    my $r;    my $r = change_package $Info, $Info->{module_name};
523    if (@$type == 1) {    if (@$type == 1) {
524      $type->[0] =~ tr/-/_/;      $type->[0] =~ tr/-/_/;
525      $r = qq{\$SuikaWiki::Plugin::Rule{$type->[0]}->{$name} = $main;\n};      $r .= qq{\$SuikaWiki::Plugin::Rule{$type->[0]}->{$name} = $main;\n};
526      push @{$Info->{provide}->{rule}->{$type->[0]}}, $name;      push @{$Info->{provide}->{rule}->{$type->[0]}}, $name;
527    } else {    } else {
528      $r = qq({my \$def = $main;\n);      $r .= qq({my \$def = $main;\n);
529      for my $type (@$type) {      for my $type (@$type) {
530        $type =~ tr/-/_/;        $type =~ tr/-/_/;
531        $r .= qq{\$SuikaWiki::Plugin::Rule{$type}->{$name} = \$def;\n};        $r .= qq{\$SuikaWiki::Plugin::Rule{$type}->{$name} = \$def;\n};
Legend:
Removed from v.1.3  
changed lines
  Added in v.1.6
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24