/[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.4 by wakaba, Thu Oct 30 07:48:04 2003 UTC revision 1.5 by wakaba, Tue Nov 25 12:47:19 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    
79  my $parser = SuikaWiki::Markup::SuikaWikiConfig20::Parser->new;  my $parser = Message::Markup::SuikaWikiConfig20::Parser->new;
80  my $plugins = $parser->parse_text ($src);  my $plugins = $parser->parse_text ($src);
81  my $meta = $plugins->get_attribute ('Plugin')  my $meta = $plugins->get_attribute ('Plugin')
82            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 95  $Info{module_name} = random_module_name
95    
96  print <<EOH;  print <<EOH;
97  use strict;  use strict;
98  package SuikaWiki::Plugin::Registry;  @{[change_package \%Info, 'SuikaWiki::Plugin::Registry']}
99  our \%Info;  our \%Info;
100  \$Info{$Info{name_literal}}->{Name} = $Info{name_literal};  \$Info{$Info{name_literal}}->{Name} = $Info{name_literal};
101  EOH  EOH
102  for (qw/Version InterfaceVersion mkpluginVersion/) {  for (qw/Version InterfaceVersion mkpluginVersion module_name/) {
103    print qq{\$Info{$Info{name_literal}}->{$_} = v$Info{$_};\n};    print qq{\$Info{$Info{name_literal}}->{$_} = @{[literal $Info{$_}]};\n};
104  }  }
105  for (qw/LastModified/) {  for (qw/LastModified/) {
106    $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 130  print qq{\$Info{$Info{name_literal}}->{A
130  } grep { $_->local_name eq 'Author' } @{$meta->child_nodes}  } grep { $_->local_name eq 'Author' } @{$meta->child_nodes}
131  ). qq{];\n};  ). qq{];\n};
132    
133    my $use = $meta->get_attribute ('Use');
134    if (ref $use) {
135      print change_package \%Info, $Info{module_name};
136      print $use->inner_text;
137    }
138    
139  for (@{$plugins->child_nodes}) {  for (@{$plugins->child_nodes}) {
140    if ($_->local_name eq 'FormattingRule') {    if ($_->local_name eq 'FormattingRule') {
141      print "\n", make_rule ($_, \%Info);      print "\n", make_rule ($_, \%Info);
# Line 129  for (@{$plugins->child_nodes}) { Line 149  for (@{$plugins->child_nodes}) {
149      print "\n", make_resdef ($_, \%Info);      print "\n", make_resdef ($_, \%Info);
150    } elsif ($_->local_name eq 'PluginConst') {    } elsif ($_->local_name eq 'PluginConst') {
151      register_plugin_const ($_, \%Info);      register_plugin_const ($_, \%Info);
152      } elsif ($_->local_name eq 'Format') {
153        print "\n", make_format ($_, \%Info);
154    }    }
155  }  }
156    
157  print qq{\npackage SuikaWiki::Plugin::Registry;\n\n};  print change_package \%Info, q(SuikaWiki::Plugin::Registry);
158  print qq{\$Info{$Info{name_literal}}->{provide} = } . literal $Info{provide};  print qq{\$Info{$Info{name_literal}}->{provide} = } . literal $Info{provide};
159  print qq{;\n};  print qq{;\n};
160    
# Line 140  print "\n1;\n"; Line 162  print "\n1;\n";
162  exit;  exit;
163  }  }
164    
165    sub make_format ($$) {
166      my ($src, $Info) = @_;
167      my $module_name = 'SuikaWiki::Format::Definition::'.$src->get_attribute_value ('ModuleName');
168      my $r = change_package $Info, $module_name;
169      $r .= qq{our \@ISA;\n};
170      if (my $isa = $src->get_attribute_value ('Inherit')) {
171        for (@$isa) {
172          $r .= qq{push \@ISA, @{[literal 'SuikaWiki::Format::Definition::'.$_]};\n};
173        }
174      } else {
175        $r .= qq{push \@ISA, 'SuikaWiki::Format::Definition::template';\n};    
176      }
177      if (my $name = $src->get_attribute_value ('Name')) {
178        $r .= qq{\$SuikaWiki::Format::Definition::Class{@{[literal '/'.$name.'/'.$src->get_attribute_value ('Version', default => '').'//']}} = '$module_name';\n};
179      }
180      if (my $type = $src->get_attribute_value ('Type')) {
181        $r .= qq{\$SuikaWiki::Format::Definition::Class{@{[literal $type.'//']}} = '$module_name';\n};
182      }
183      
184      $r .= <<'EOH';
185    our $Converter;
186    sub convert ($$;%) {
187      my ($self, $source, %opt) = @_;
188      my $converter;
189      my $flag = '//';
190      $flag .= 'f' if $opt{IsFragment};
191      $flag .= 'p' if $opt{IsPlaceholder};
192      if ($Converter->{$opt{Type}.$flag}) {
193        $converter = $Converter->{$opt{Type}.$flag};
194      } elsif ($Converter->{$opt{Name}.'/'.$opt{Version}.$flag}) {
195        $converter = $Converter->{'/'.$opt{Name}.'/'.$opt{Version}.$flag};
196      }
197      return $converter->{Main}->($self, $source, \%opt) if $converter;
198      $self->SUPER::convert ($source, %opt);
199    }
200    EOH
201      
202      for (@{$src->child_nodes}) {
203        if ($_->local_name eq 'Converter') {
204          $r .= make_format_converter ($_, $Info);
205        } elsif ($_->local_name eq 'Use') {
206          $r .= $_->inner_text;
207        }
208      }
209      
210      $r;
211    }
212    
213    sub make_format_converter ($$) {
214      my ($src, $Info) = @_;
215      my %def;
216      $def{Type} = $src->get_attribute ('Type');
217      if (ref $def{Type}) {
218        $def{Type} = $def{Type}->inner_text
219              . join '', map {
220                  ';'. $_->local_name .'='. quoted_string $_->inner_text
221                } sort {
222                  $a->local_name cmp $b->local_name
223                } @{$def{Type}->child_nodes};
224      } else {
225        delete $def{Type};
226      }
227      $def{Name} = $src->get_attribute_value ('Name');
228      delete $def{Name} unless defined $def{Name};
229      $def{Version} = $src->get_attribute_value ('Version');
230      delete $def{Version} if not defined $def{Version} or
231                              not defined $def{Name};
232      
233      my $flag = '//';
234      $flag .= 'f' and $def{IsFragment} = 1
235        if $src->get_attribute_value ('IsFragment');
236      $flag .= 'p' and $def{IsPlaceholder} = 1
237        if $src->get_attribute_value ('IsPlaceholder');
238      
239      $def{Main} = $src->get_attribute_value ('Main');
240      $def{Main} = 'my $r;'.$def{Main}.'$r' if $def{Main} =~ /\$r\b/;
241      $def{Main} = barecode code $Info,
242                   'sub {my ($self, $source, $opt) = @_;'
243                 . $def{Main} . '}';
244      
245      my $r = list %def;
246      if ($def{Type}) {
247        $r = qq{\$Converter->{@{[literal $def{Type}.$flag]}} = {$r};\n};
248        $r .= qq{\$Converter->{@{[literal '/'.$def{Name}.'/'.$def{Version}.$flag]}} = \$Converter->{@{[literal $def{Type}.$flag]}};\n}
249          if $def{Name};
250      } elsif ($def{Name}) {
251        $r = qq{\$Converter->{@{[literal '/'.$def{Name}.'/'.$def{Version}.$flag]}} = {$r};\n};
252        $r
253      }
254      $r;
255    }
256    
257  sub make_function ($$) {  sub make_function ($$) {
258    my ($src, $Info) = @_;    my ($src, $Info) = @_;
259    ## TODO: support of ARGV property    ## TODO: support of ARGV property
260    my $r = <<EOH;    my $r = <<EOH;
261  package $Info->{module_name};  @{[change_package $Info, $Info->{module_name}]}
262  sub @{[$src->get_attribute_value ('Name')]} {  sub @{[$src->get_attribute_value ('Name')]} {
263    @{[code $Info, $src->get_attribute_value ('Main')]}    @{[code $Info, $src->get_attribute_value ('Main')]}
264  }  }
# Line 160  sub register_plugin_const ($$) { Line 274  sub register_plugin_const ($$) {
274    
275  sub make_resdef ($$) {  sub make_resdef ($$) {
276    my ($src, $Info) = @_;    my ($src, $Info) = @_;
277    my $r = qq{package SuikaWiki::Plugin::Resource;\nour \$BaseResource;\n};    my $r = change_package $Info, 'SuikaWiki::Plugin::Resource';
278      $r .= qq{our \$BaseResource;\n};
279    for (@{$src->child_nodes}) {    for (@{$src->child_nodes}) {
280      if ($_->node_type eq '#element') {      if ($_->node_type eq '#element') {
281        my $lang = literal ($_->get_attribute_value ('lang') || 'und');        my $lang = literal ($_->get_attribute_value ('lang') || 'und');
# Line 219  push \@SuikaWiki::View::Implementation:: Line 334  push \@SuikaWiki::View::Implementation::
334    condition => {$ViewProp->{condition_stringified}},    condition => {$ViewProp->{condition_stringified}},
335    object_class => q#$ViewProp->{pack_name}#,    object_class => q#$ViewProp->{pack_name}#,
336  };  };
337  package $ViewProp->{pack_name};  @{[change_package $Info, $ViewProp->{pack_name}]}
338  our \@ISA = q#SuikaWiki::View::template#;  our \@ISA = q#SuikaWiki::View::template#;
339  EOH  EOH
340    for (@{$src->child_nodes}) {    for (@{$src->child_nodes}) {
# Line 302  sub main (\$\$\$) { Line 417  sub main (\$\$\$) {
417    \$self->{view}->{wiki}->init_db;    \$self->{view}->{wiki}->init_db;
418    \$self->main_pre (\$opt, \$opt2);    \$self->main_pre (\$opt, \$opt2);
419        
   ## TODO: formal SuikaWiki 3 interface  
420    my \$fmt = SuikaWiki::Plugin->formatter ('view');    my \$fmt = SuikaWiki::Plugin->formatter ('view');
421    \$opt2->{output}->{entity}->{body}    \$opt2->{output}->{entity}->{body}
422      = \$fmt->replace (\$opt2->{template} => \$opt2->{o},      = \$fmt->replace (\$opt2->{template}, param => \$opt2->{o});
                       {formatter => \$fmt});  
423    \$opt2->{output}->output (output => 'http-cgi');    \$opt2->{output}->output (output => 'http-cgi');
424        
425    \$self->main_post (\$opt, \$opt2);    \$self->main_post (\$opt, \$opt2);
# Line 314  sub main (\$\$\$) { Line 427  sub main (\$\$\$) {
427  EOH  EOH
428  }  }
429    
 ## TODO: Implements SuikaWiki 3 interface  
430  sub make_rule ($$) {  sub make_rule ($$) {
431    my ($src, $Info) = @_;    my ($src, $Info) = @_;
432    my $type = $src->get_attribute ('Category', make_new_node => 1)->value || [];    my $type = $src->get_attribute ('Category', make_new_node => 1)->value || [];
433    my $name = $src->get_attribute ('Name', make_new_node => 1)->value;    my $name = $src->get_attribute ('Name', make_new_node => 1)->value;
434    $name =~ s/(?=.)-/_/g;    $name =~ s/(?<=.)-/_/g;
435    my $main = code $Info, $src->get_attribute_value ('Formatting');    my $main = code $Info, $src->get_attribute_value ('Formatting');
436    $main = q{my ($p, $o) = @_;}."\n" . $main    
437      if $main =~ /\$p/ || $main =~ /\$o/;    my $reg_block;
438    if ($main =~ /\$r/) {    $reg_block = qr/[^{}]*(?>[^{}]+|{(??{$reg_block})})*/;
439      $main = q{my $r = '';} . "\n" . $main;    my $reg_attr = qr/__ATTR(TEXT|NODE)?:%(\w+)(?:->{($reg_block)})?__;/;
440      $main .= q{$r};    
441      $main = q{my ($f, $rule_name, $p, $o, %opt) = @_;}."\n".$main
442        if $main =~ /\$f\b/
443        or $main =~ /\$rule_name\b/
444        or $main =~ /\$[opr]\b/
445        or $main =~ /[%\$]opt\b/;
446      if ($main =~ /\$r\b/) {
447        warn qq(Rule @{[list $type]}/$name: Use of \$r is deprecated);
448        $main = q{my $r = '';} . "\n" . $main . "\n"
449              . q{$p->{-parent}->append_node ($r, node_or_text => 1);};
450    }    }
451      $main =~ s{$reg_attr}
452                {($1 eq 'TEXT' ? '$p->{'.literal($2).'} = do { my $r = ' : '')
453                 .'$f->parse_attr ($p=>'.literal($2).', $o, '
454                                 .($3?'-parent => '.$3.', ':'')
455                                 .($1?'-non_parsed_to_node => 1, ':'')
456                                 .'%opt)'
457                                 .($1 eq 'TEXT' ? '; ref $r?$r->inner_text:$r}' : '')
458                                 .';'}ge;
459        
460    my $main = <<EOH;    my $main = <<EOH;
461  {  {
462    Formatting => sub {$main},    main => sub {$main},
463    Description => [@{[m13ed_val_list $src, 'Description']}],    Description => [@{[m13ed_val_list $src, 'Description']}],
464    Parameter => {@{[do{    Parameter => {@{[do{
465      my @r;      my @r;
# Line 346  sub make_rule ($$) { Line 475  sub make_rule ($$) {
475    }]}},    }]}},
476  }  }
477  EOH  EOH
478    my $r;    my $r = change_package $Info, $Info->{module_name};
479    if (@$type == 1) {    if (@$type == 1) {
480      $type->[0] =~ tr/-/_/;      $type->[0] =~ tr/-/_/;
481      $r = qq{\$SuikaWiki::Plugin::Rule{$type->[0]}->{$name} = $main;\n};      $r .= qq{\$SuikaWiki::Plugin::Rule{$type->[0]}->{$name} = $main;\n};
482      push @{$Info->{provide}->{rule}->{$type->[0]}}, $name;      push @{$Info->{provide}->{rule}->{$type->[0]}}, $name;
483    } else {    } else {
484      $r = qq({my \$def = $main;\n);      $r .= qq({my \$def = $main;\n);
485      for my $type (@$type) {      for my $type (@$type) {
486        $type =~ tr/-/_/;        $type =~ tr/-/_/;
487        $r .= qq{\$SuikaWiki::Plugin::Rule{$type}->{$name} = \$def;\n};        $r .= qq{\$SuikaWiki::Plugin::Rule{$type}->{$name} = \$def;\n};
Legend:
Removed from v.1.4  
changed lines
  Added in v.1.5
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24