/[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.1 by wakaba, Sun Oct 5 11:11:13 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  require SuikaWiki::Markup::SuikaWikiConfig20::Parser;  our $VERSION = do{my @r=(q$Revision$=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};
4    require Message::Markup::SuikaWikiConfig20::Parser;
5    
6    {
7  my $src = '';  my $src = '';
8  my $srcfile = shift;  my $srcfile = shift;
9  open SRC, $srcfile or die "$0: $!"; {  open SRC, $srcfile or die "$0: $!"; {
# Line 11  open SRC, $srcfile or die "$0: $!"; { Line 13  open SRC, $srcfile or die "$0: $!"; {
13    
14  sub literal ($) {  sub literal ($) {
15    my $s = shift;    my $s = shift;
16    $s =~ s/([#\\])/\\$1/g;    if (ref ($s) eq 'ARRAY') {
17    q<q#> . $s . q<#>;      q<[> . list (@$s) . q<]>;
18      } elsif (ref ($s) eq 'HASH') {
19        q<{> . hash (%$s) . q<}>;
20      } elsif (ref ($s) eq 'bare') {
21        $$s;
22      } else {
23        $s =~ s/([#\\])/\\$1/g;
24        q<q#> . $s . q<#>;
25      }
26    }
27    sub list (@) {
28      join ', ', map {literal $_} @_;
29    }
30    sub hash (%) {
31      my $i = 0;
32      list map {($i++ % 2) ? $_ : do {my $s = $_; $s =~ s/(?<=.)-/_/; $s}} @_;
33  }  }
34  sub n11n ($) {  sub n11n ($) {
35    my $s = shift;    my $s = shift;
36    $s =~ s/\s+/ /g;    $s =~ s/\s+/ /g;
37    $s;    $s;
38  }  }
39    sub m13ed_val_list ($$) {
40      my ($src, $key) = @_;
41      my @r;
42      for (@{$src->child_nodes}) {
43        if ($_->local_name eq $key) {
44          push @r, [scalar $_->inner_text,
45                    scalar $_->get_attribute ('lang', make_new_node => 1)
46                             ->inner_text,
47                    scalar $_->get_attribute ('script', make_new_node => 1)
48                             ->inner_text];
49        }
50      }
51      list @r;
52    }
53    sub barecode ($) {
54      bless \$_[0], 'bare';
55    }
56    sub code ($$) {
57      my ($Info, $code) = @_;
58      for (keys %{$Info->{const}}) {
59        $code =~ s/\$$_\b/literal $Info->{const}->{$_}/ge;
60      }
61      $code =~ s/__FUNCPACK__/$Info->{module_name}/g;
62      $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";
83  my %Info = (Name => n11n $meta->get_attribute ('Name')->value);  my %Info = (provide => {},
84                Name => n11n $meta->get_attribute ('Name')->value);
85  $Info{name_literal} = literal $Info{Name};  $Info{name_literal} = literal $Info{Name};
86  my @date = gmtime;  my @date = gmtime;
87  $Info{LastModified} = sprintf '%04d-%02d-%02dT%02d:%02d:%02d+00:00',  $Info{LastModified} = sprintf '%04d-%02d-%02dT%02d:%02d:%02d+00:00',
88                                $date[5] + 1900, $date[4] + 1, @date[3,2,1,0];                                $date[5] + 1900, $date[4] + 1, @date[3,2,1,0];
89  $Info{Version} = sprintf '%04d.%02d%02d.%02d%02d',  $Info{Version} = sprintf '%04d.%02d%02d.%02d%02d',
90                           $date[5] + 1900, $date[4] + 1, @date[3,2,1];                           $date[5] + 1900, $date[4] + 1, @date[3,2,1];
91    $Info{InterfaceVersion} = '2.9.1';
92    $Info{mkpluginVersion} = '2.'.$VERSION;
93  $Info{module_name} = q#SuikaWiki::Plugin::plugin#;  $Info{module_name} = q#SuikaWiki::Plugin::plugin#;
94  $Info{module_name} = random_module_name (\%Info, $Info{Name});  $Info{module_name} = random_module_name (\%Info, $Info{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};
 \$Info{$Info{name_literal}}->{Version} = q#$Info{Version}#;  
101  EOH  EOH
102  for (qw/Description LastModified License/) {  for (qw/Version InterfaceVersion mkpluginVersion module_name/) {
103      print qq{\$Info{$Info{name_literal}}->{$_} = @{[literal $Info{$_}]};\n};
104    }
105    for (qw/LastModified/) {
106    $Info{$_} = n11n $meta->get_attribute ($_,make_new_node=>1)->value;    $Info{$_} = n11n $meta->get_attribute ($_,make_new_node=>1)->value;
107    next unless length $Info{$_};    next unless length $Info{$_};
108    print qq{\$Info{$Info{name_literal}}->{$_} = } . literal $Info{$_};    print qq{\$Info{$Info{name_literal}}->{$_} = } . literal $Info{$_};
109    print ";\n";    print ";\n";
110  }  }
111  for (qw/Author RelatedURI RelatedWikiPage RequiredPlugin RequiredModule/) {  for (qw/RequiredPlugin RequiredModule/) {
112    $Info{$_} = $meta->get_attribute ($_);    $Info{$_} = $meta->get_attribute ($_);
113    next unless ref $Info{$_}; $Info{$_} = $Info{$_}->value;    next unless ref $Info{$_}; $Info{$_} = $Info{$_}->value;
114    print qq{\$Info{$Info{name_literal}}->{$_} = [};    print qq{\$Info{$Info{name_literal}}->{$_} = [};
115    print join ', ', map {literal $_} @{$Info{$_}};    print join ', ', map {literal $_} @{$Info{$_}};
116    print "];\n";    print "];\n";
117  }  }
118    for (qw/Description License RelatedWikiPage RelatedURI/) {
119      my $r = m13ed_val_list $meta, $_;
120      next unless $r;
121      print qq{\$Info{$Info{name_literal}}->{$_} = [$r];\n};
122    }
123    
124    print qq{\$Info{$Info{name_literal}}->{Author} = [} .( list map {
125            [
126              [ barecode m13ed_val_list ($_, 'Name') ],
127              [ $_->get_attribute ('Mail', make_new_node => 1)->value ],
128              [ $_->get_attribute ('URI', make_new_node => 1)->value ],
129            ]
130    } grep { $_->local_name eq 'Author' } @{$meta->child_nodes}
131    ). 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 'ViewDefinition') {    if ($_->local_name eq 'FormattingRule') {
141        print "\n", make_rule ($_, \%Info);
142      } elsif ($_->local_name eq 'ViewDefinition') {
143      print "\n", make_viewdef ($_, \%Info);      print "\n", make_viewdef ($_, \%Info);
144    } elsif ($_->local_name eq 'ViewFragment') {    } elsif ($_->local_name eq 'ViewFragment') {
145      print "\n", make_viewfragment ($_, \%Info);      print "\n", make_viewfragment ($_, \%Info);
146      } elsif ($_->local_name eq 'Function') {
147        print "\n", make_function ($_, \%Info);
148      } elsif ($_->local_name eq 'Resource') {
149        print "\n", make_resdef ($_, \%Info);
150      } elsif ($_->local_name eq 'PluginConst') {
151        register_plugin_const ($_, \%Info);
152      } elsif ($_->local_name eq 'Format') {
153        print "\n", make_format ($_, \%Info);
154    }    }
155  }  }
156    
157    print change_package \%Info, q(SuikaWiki::Plugin::Registry);
158    print qq{\$Info{$Info{name_literal}}->{provide} = } . literal $Info{provide};
159    print qq{;\n};
160    
161  print "\n1;\n";  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 ($$) {
258      my ($src, $Info) = @_;
259      ## TODO: support of ARGV property
260      my $r = <<EOH;
261    @{[change_package $Info, $Info->{module_name}]}
262    sub @{[$src->get_attribute_value ('Name')]} {
263      @{[code $Info, $src->get_attribute_value ('Main')]}
264    }
265    EOH
266    }
267    
268    sub register_plugin_const ($$) {
269      my ($src, $Info) = @_;
270      for (@{$src->child_nodes}) {
271        $Info->{const}->{$_->local_name} = $_->value;
272      }
273    }
274    
275    sub make_resdef ($$) {
276      my ($src, $Info) = @_;
277      my $r = change_package $Info, 'SuikaWiki::Plugin::Resource';
278      $r .= qq{our \$BaseResource;\n};
279      for (@{$src->child_nodes}) {
280        if ($_->node_type eq '#element') {
281          my $lang = literal ($_->get_attribute_value ('lang') || 'und');
282          my $script = literal $_->get_attribute_value ('script');
283          my $name = literal $_->local_name;
284          my $val = literal n11n $_->value;
285          $r .= qq{\$BaseResource->{$lang}->{$script}->{$name} = $val;\n};
286        }
287      }
288      $r;
289    }
290    
291  sub make_viewfragment ($$) {  sub make_viewfragment ($$) {
292    my ($src, $Info) = @_;    my ($src, $Info) = @_;
293    my $r = '';    my $r = '';
294    for (@{$src->child_nodes}) {    my $body = <<EOH;
295      ## TODO: use SuikaWiki2 interface    {
296      $r .= qq(SuikaWiki::View->template (@{[literal $_->local_name]})->add_line (@{[literal $_->value]});\n);      Main => @{[literal $src->get_attribute_value ('Formatting')]},
297        Order => @{[0+$src->get_attribute_value ('Order')]},
298        Description => [@{[m13ed_val_list $src, 'Description']}],
299      };
300    EOH
301      ## Recommended format
302      my $name = $src->get_attribute_value ('Template');
303      if (ref ($name) and @$name > 1) {
304        $r .= qq({my \$def = $body;\n);
305        for (@$name) {
306          my $name = $_; $name =~ tr/-/_/;
307          $r .= qq(push \@{\$SuikaWiki::View::Implementation::TemplateFragment{@{[literal $name]}}}, \$def;\n);
308          push @{$Info->{provide}->{viewfragment}}, {Name => $name};
309        }
310        $r .= qq(}\n);
311      } else {                           ## Obsoleted format
312        $name = ref $name ? $name->[0] : $src->get_attribute_value ('Name');
313        $name =~ tr/-/_/;
314        $r .= qq(push \@{\$SuikaWiki::View::Implementation::TemplateFragment{@{[literal $name]}}}, $body);
315        push @{$Info->{provide}->{viewfragment}}, {Name => $name};
316    }    }
317    $r;    $r;
318  }  }
# Line 83  sub make_viewdef ($$) { Line 324  sub make_viewdef ($$) {
324    $ViewProp->{Name} = n11n $src->get_attribute ('Mode')->value;    $ViewProp->{Name} = n11n $src->get_attribute ('Mode')->value;
325    $ViewProp->{pack_name} = random_module_name ($Info, $ViewProp->{Name});    $ViewProp->{pack_name} = random_module_name ($Info, $ViewProp->{Name});
326        
327    $ViewProp->{condition_stringified} = join ', ', map {literal $_}    $ViewProp->{condition_stringified} = hash
328      mode => $ViewProp->{Name},      mode => $ViewProp->{Name},
329      map {($_->local_name => $_->value)}      map {($_->local_name => $_->value)}
330        @{$src->get_attribute ('Condition',make_new_node=>1)->child_nodes};        @{$src->get_attribute ('Condition',make_new_node=>1)->child_nodes};
# Line 93  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}) {
341      if ($_->local_name eq 'method') {      if ($_->local_name eq 'template') {
342          $r .= make_view_template_method ($_, $Info);
343        } elsif ($_->local_name eq 'method') {
344        $r .= ({        $r .= ({
345                main => q(sub main ($$) {)."\n".q(my ($self, $opt) = @_;)."\n",                main => q(sub main ($$) {)."\n".q(my ($self, $opt) = @_;)."\n",
346                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",
347                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",                    
348               }->{$_->get_attribute ('Name')->value}               }->{$_->get_attribute ('Name')->value}
349               ||qq(sub @{[$_->get_attribute ('Name')->value]} {\n))               ||qq(sub @{[$_->get_attribute ('Name')->value]} {\n))
350           . $_->inner_text           . code ($Info, $_->value)
351           . qq(\n}\n);           . qq(\n}\n);
352      }      }
353    }    }
354      my $prop = {Name => $ViewProp->{Name},
355                  Description => barecode m13ed_val_list $_, 'Description'};
356      push @{$Info->{provide}->{viewdef}}, $prop;
357      $r;
358    }
359    
360    sub make_view_template_method ($$) {
361      my ($src, $info) = @_;
362      my $r = <<EOH;
363    
364    sub main (\$\$\$) {
365      my (\$self, \$opt, \$opt2) = \@_;
366      require SuikaWiki::Output::HTTP;
367      \$opt2->{output} = SuikaWiki::Output::HTTP->new
368        (wiki => \$self->{view}->{wiki},
369         view => \$self->{view}, viewobj => \$self);
370      for (\@{\$self->{view}->{wiki}->{var}->{client}->{used_for_negotiate}},
371           'Accept-Language') {
372        \$opt2->{output}->add_negotiate_header_field (\$_);
373      }
374      
375      \$opt2->{template} = @{[literal $src->get_attribute ('body', make_new_node => 1)->inner_text]};
376      \$opt2->{o} = bless {
377                         ## Compatible options for SuikaWiki 2 WikiPlugin interface
378                           param => \\\%main::form,
379                           page => \$main::form{mypage},
380                           toc => [],
381                           #magic
382                           #content
383                           #use_anchor_name
384                           media => {@{[hash
385        type => ($src->get_attribute ('media-type',make_new_node=>1)->inner_text
386                 || 'application/octet-stream'),
387        charset => ($src->get_attribute ('use-media-type-charset',make_new_node=>1)
388                        ->inner_text || 0),
389        ## In fact, this value is not referred from any SuikaWiki 2 WikiPlugin rule.
390        #expires => ($src->get_attribute ('expires',make_new_node=>1)->inner_text
391        #                             || 0)
392        ]}},
393                          ## SuikaWiki 3 WikiPlugin interface
394                            wiki => \$self->{view}->{wiki},
395                            plugin => \$self->{view}->{wiki}->{plugin},
396                            var => {},
397                          }, 'SuikaWiki::Plugin';  
398      @{[do{my $x=$src->get_attribute('http-status-code',make_new_node=>1)->inner_text;
399         $x?q{$opt2->{output}->{status_code} = }.(0 + $x).q{;}:q{}}]}
400      @{[do{my $x=$src->get_attribute('http-status-phrase',make_new_node=>1)->inner_text;
401         $x?q{$opt2->{output}->{reason_phrase} = }.literal($x).q{;}:q{}}]}
402      \$opt2->{output}->{entity}->{media_type} = @{[literal
403                               $src->get_attribute ('media-type',make_new_node=>1)
404                                   ->inner_text || 'application/octet-stream']};
405      @{[($src->get_attribute ('use-media-type-charset',make_new_node=>1)
406                ->inner_text || 0) ?
407         q{$opt2->{output}->{entity}->{charset} = $self->{view}->{wiki}->{config}->{charset}->{output};}:
408         q{}]}
409      @{[do{my $x = $src->get_attribute ('expires',make_new_node=>1)->inner_text;
410              if ($x =~ /%%(\w+)%%/) {
411                qq{\$opt2->{output}->set_expires (%{\$self->{view}->{wiki}->{config}->{entity}->{expires}->{@{[literal $1]}}});};
412              } else {
413                qq{\$opt2->{output}->set_expires (delta => @{[0 + $x]});};
414              }
415          }]}
416      
417      \$self->{view}->{wiki}->init_db;
418      \$self->main_pre (\$opt, \$opt2);
419      
420      my \$fmt = SuikaWiki::Plugin->formatter ('view');
421      \$opt2->{output}->{entity}->{body}
422        = \$fmt->replace (\$opt2->{template}, param => \$opt2->{o});
423      \$opt2->{output}->output (output => 'http-cgi');
424      
425      \$self->main_post (\$opt, \$opt2);
426    }
427    EOH
428    }
429    
430    sub make_rule ($$) {
431      my ($src, $Info) = @_;
432      my $type = $src->get_attribute ('Category', make_new_node => 1)->value || [];
433      my $name = $src->get_attribute ('Name', make_new_node => 1)->value;
434      $name =~ s/(?<=.)-/_/g;
435      my $main = code $Info, $src->get_attribute_value ('Formatting');
436      
437      my $reg_block;
438      $reg_block = qr/[^{}]*(?>[^{}]+|{(??{$reg_block})})*/;
439      my $reg_attr = qr/__ATTR(TEXT|NODE)?:%(\w+)(?:->{($reg_block)})?__;/;
440      
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;
461    {
462      main => sub {$main},
463      Description => [@{[m13ed_val_list $src, 'Description']}],
464      Parameter => {@{[do{
465        my @r;
466        for (@{$src->child_nodes}) {
467          if ($_->local_name eq 'Parameter') {
468            push @r, $_->get_attribute_value ('Name')
469                     => {Type => $_->get_attribute_value ('Type'),
470                         Default => $_->get_attribute_value ('Default'),
471                         Description => [barecode m13ed_val_list $_, 'Description']};
472          }
473        }
474        list @r;
475      }]}},
476    }
477    EOH
478      my $r = change_package $Info, $Info->{module_name};
479      if (@$type == 1) {
480        $type->[0] =~ tr/-/_/;
481        $r .= qq{\$SuikaWiki::Plugin::Rule{$type->[0]}->{$name} = $main;\n};
482        push @{$Info->{provide}->{rule}->{$type->[0]}}, $name;
483      } else {
484        $r .= qq({my \$def = $main;\n);
485        for my $type (@$type) {
486          $type =~ tr/-/_/;
487          $r .= qq{\$SuikaWiki::Plugin::Rule{$type}->{$name} = \$def;\n};
488          push @{$Info->{provide}->{rule}->{$type}}, $name;
489        }
490        $r .= qq(};\n);
491      }
492    $r;    $r;
493  }  }
494    
# Line 117  sub random_module_name ($;$) { Line 498  sub random_module_name ($;$) {
498    $subname =~ s/[^0-9A-Za-z_:]//g;    $subname =~ s/[^0-9A-Za-z_:]//g;
499    my @date = gmtime;    my @date = gmtime;
500    my @rand = ('A'..'Z','a'..'z',0..9,'_');    my @rand = ('A'..'Z','a'..'z',0..9,'_');
501    sprintf '%s::%s%s%s', $Info{module_name}, $subname,    sprintf '%s::%s%s%s', $Info->{module_name}, $subname,
502      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]),
503      join ('', @rand[rand@rand,rand@rand,rand@rand,rand@rand]);      join ('', @rand[rand@rand,rand@rand,rand@rand,rand@rand]);
504  }  }
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.5
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24