/[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.2 by wakaba, Sat Oct 18 07:08:34 2003 UTC revision 1.12 by wakaba, Sun Feb 8 08:58:24 2004 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 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    $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 source %s, block %s)',
92                               $Info->{source_file},
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    sub literal_or_code ($$) {
101      my ($Info, $s) = @_;
102      substr ($s, 0, 1) ne '{' ? literal ($s)
103                               : code ($Info, substr ($s, 1, length ($s) - 2));
104    }
105    
106  my $parser = SuikaWiki::Markup::SuikaWikiConfig20::Parser->new;  my $parser = Message::Markup::SuikaWikiConfig20::Parser->new;
107  my $plugins = $parser->parse_text ($src);  my $plugins = $parser->parse_text ($src);
108  my $meta = $plugins->get_attribute ('Plugin')  my $meta = $plugins->get_attribute ('Plugin')
109            or die "$0: Required 'Plugin' section not found";            or die "$0: Required 'Plugin' section not found";
110  my %Info = (provide => {},  my %Info = (provide => {},
111              Name => n11n $meta->get_attribute ('Name')->value);              Name => n11n $meta->get_attribute ('Name')->value);
112    $Info{source_file} = $srcfile;
113  $Info{name_literal} = literal $Info{Name};  $Info{name_literal} = literal $Info{Name};
114  my @date = gmtime;  my @date = gmtime;
115  $Info{LastModified} = sprintf '%04d-%02d-%02dT%02d:%02d:%02d+00:00',  $Info{LastModified} = sprintf '%04d-%02d-%02dT%02d:%02d:%02d+00:00',
# Line 81  $Info{module_name} = random_module_name Line 123  $Info{module_name} = random_module_name
123    
124  print <<EOH;  print <<EOH;
125  use strict;  use strict;
126  package SuikaWiki::Plugin::Registry;  @{[change_package \%Info, 'SuikaWiki::Plugin::Registry']}
127  our \%Info;  our \%Info;
128  \$Info{$Info{name_literal}}->{Name} = $Info{name_literal};  \$Info{$Info{name_literal}}->{Name} = $Info{name_literal};
129  EOH  EOH
130  for (qw/Version InterfaceVersion mkpluginVersion/) {  for (qw/Version InterfaceVersion mkpluginVersion module_name/) {
131    print qq{\$Info{$Info{name_literal}}->{$_} = v$Info{$_};\n};    print qq{\$Info{$Info{name_literal}}->{$_} = @{[literal $Info{$_}]};\n};
132  }  }
133  for (qw/LastModified/) {  for (qw/LastModified/) {
134    $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 158  print qq{\$Info{$Info{name_literal}}->{A
158  } grep { $_->local_name eq 'Author' } @{$meta->child_nodes}  } grep { $_->local_name eq 'Author' } @{$meta->child_nodes}
159  ). qq{];\n};  ). qq{];\n};
160    
161    my $use = $meta->get_attribute ('Use');
162    if (ref $use) {
163      print change_package \%Info, $Info{module_name};
164      print line \%Info, node_path => 'Plugin/Use';
165      print $use->inner_text, "\n";
166      print line \%Info, reset => 1;
167    }
168    
169  for (@{$plugins->child_nodes}) {  for (@{$plugins->child_nodes}) {
170    if ($_->local_name eq 'FormattingRule') {    if ($_->local_name eq 'FormattingRule') {
171      print "\n", make_rule ($_, \%Info);      print "\n", make_rule ($_, \%Info);
# Line 129  for (@{$plugins->child_nodes}) { Line 179  for (@{$plugins->child_nodes}) {
179      print "\n", make_resdef ($_, \%Info);      print "\n", make_resdef ($_, \%Info);
180    } elsif ($_->local_name eq 'PluginConst') {    } elsif ($_->local_name eq 'PluginConst') {
181      register_plugin_const ($_, \%Info);      register_plugin_const ($_, \%Info);
182      } elsif ($_->local_name eq 'Format') {
183        print "\n", make_format ($_, \%Info);
184    # Parameter
185    # PluginCategory
186    }    }
187  }  }
188    
189  print qq{\npackage SuikaWiki::Plugin::Registry;\n\n};  print change_package \%Info, q(SuikaWiki::Plugin::Registry);
190  print qq{\$Info{$Info{name_literal}}->{provide} = } . literal $Info{provide};  print qq{\$Info{$Info{name_literal}}->{provide} = } . literal $Info{provide};
191  print qq{;\n};  print qq{;\n};
192    
# Line 140  print "\n1;\n"; Line 194  print "\n1;\n";
194  exit;  exit;
195  }  }
196    
197    sub make_format ($$) {
198      my ($src, $Info) = @_;
199      my $module_name = 'SuikaWiki::Format::Definition::'.$src->get_attribute_value ('ModuleName');
200      my $r = change_package $Info, $module_name;
201      $r .= qq{our \@ISA;\n};
202      if (my $isa = $src->get_attribute_value ('Inherit')) {
203        for (@$isa) {
204          $r .= qq{push \@ISA, @{[literal 'SuikaWiki::Format::Definition::'.$_]};\n};
205        }
206      } else {
207        $r .= qq{push \@ISA, 'SuikaWiki::Format::Definition::template';\n};    
208      }
209      if (my $name = $src->get_attribute_value ('Name')) {
210        $r .= qq{\$SuikaWiki::Format::Definition::Class{@{[literal '/'.$name.'/'.$src->get_attribute_value ('Version', default => '').'//']}} = '$module_name';\n};
211      }
212      if (my $type = $src->get_attribute_value ('Type')) {
213        $type .= join '', map {
214                   ';'. $_->local_name .'='. quoted_string $_->inner_text
215                 } sort {
216                   $a->local_name cmp $b->local_name
217                 } @{$src->get_attribute ('Type')->child_nodes};
218        $r .= qq{\$SuikaWiki::Format::Definition::Class{@{[literal $type.'//']}} = '$module_name';\n};
219      }
220      
221      my $convert = line $Info, line_no => __LINE__ + 2, realfile => __FILE__;
222      $convert .= <<'EOH';
223    our $Converter;
224    sub convert ($$;%) {
225      my ($self, $source, %opt) = @_;
226      my $converter;
227      my $flag = '//';
228      $flag .= 'f' if $opt{IsFragment};
229      $flag .= 'p' if $opt{IsPlaceholder};
230      my $type = $opt{Type} ?
231                    $opt{Type} .
232                    SuikaWiki::Format::Definition->__get_param_string
233                      ($opt{Type_param}) : undef;
234      if ($Converter->{$type.$flag}) {
235        $converter = $Converter->{$type.$flag};
236      } elsif ($Converter->{$opt{Name}.'/'.$opt{Version}.$flag}) {
237        $converter = $Converter->{'/'.$opt{Name}.'/'.$opt{Version}.$flag};
238      }
239      return ($converter->{$opt{return_type} or 'Main'} or
240              CORE::die "Buggy implementation: $type $opt{Name}/$opt{Version}$flag/@{[$opt{return_type} or 'Main']} not defined")
241             ->($self, $source, \%opt)
242        if $converter;
243      $self->SUPER::convert ($source, %opt);
244    }
245    EOH
246      
247      for (@{$src->child_nodes}) {
248        if ($_->local_name eq 'Converter') {
249          if ($convert) {
250            $r .= $convert;
251            $r .= line $Info, reset => 1;
252            undef $convert;
253          }
254          $r .= make_format_converter ($_, $Info);
255        } elsif ($_->local_name eq 'WikiForm') {
256          $r .= q(sub wikiform {)."\n".q(my ($self, $source, %opt) = @_;);
257          $r .= line $Info, node_path => qq(Format[module-name()=$module_name]/WikiForm);
258          $r .= code $Info, $_->get_attribute_value ('Main');
259          $r .= line $Info, reset => 1;
260          $r .= qq(}\n);
261        } elsif ($_->local_name eq 'HeadSummary') {
262          $r .= q(sub headsummary {)."\n".q(my ($self, $source, %opt) = @_;);
263          $r .= line $Info, node_path => qq(Format[module-name()=$module_name]/HeadSummary);
264          $r .= code $Info, $_->get_attribute_value ('Main');
265          $r .= line $Info, reset => 1;
266          $r .= qq(}\n);
267        } elsif ($_->local_name eq 'NextIndex') {
268          my $name = $_->get_attribute_value ('Name', default => '');
269          $r .= q(sub next_index_for_).$name
270             .  q( {)."\n".q(my ($self, $source, %opt) = @_;)
271             .  line $Info, node_path => qq(Format[module-name()=$module_name]/NextIndex[Name=$name]);
272          $r .= code $Info, $_->get_attribute_value ('Main');
273          $r .= line $Info, reset => 1;
274          $r .= qq(}\n);
275        } elsif ($_->local_name eq 'Use') {
276          $r .= line $Info, node_path => qq(Format[module-name()=$module_name]/Use);
277          $r .= $_->inner_text;
278        }
279      }
280      $r;
281    }
282    
283    sub make_format_converter ($$) {
284      my ($src, $Info) = @_;
285      my %def;
286      $def{Type} = $src->get_attribute ('Type');
287      if (ref $def{Type}) {
288        $def{Type} = $def{Type}->inner_text
289              . join '', map {
290                  ';'. $_->local_name .'='. quoted_string $_->inner_text
291                } sort {
292                  $a->local_name cmp $b->local_name
293                } @{$def{Type}->child_nodes};
294      } else {
295        delete $def{Type};
296      }
297      $def{Name} = $src->get_attribute_value ('Name');
298      delete $def{Name} unless defined $def{Name};
299      $def{Version} = $src->get_attribute_value ('Version');
300      delete $def{Version} if not defined $def{Version} or
301                              not defined $def{Name};
302      
303      my $flag = '//';
304      $flag .= 'f' and $def{IsFragment} = 1
305        if $src->get_attribute_value ('IsFragment');
306      $flag .= 'p' and $def{IsPlaceholder} = 1
307        if $src->get_attribute_value ('IsPlaceholder');
308      
309      for (qw/Main ToString ToOctetStream/) {
310        my $def = $src->get_attribute_value ($_);
311        next unless $def;
312        $def{$_} = line ($Info, node_path => '//Converter/'.$_)
313                   . $def
314                   . line ($Info, reset => 1);
315        if ($def{$_} =~ /\$r\b/) {
316          $def{$_} = 'my $r;'."\n".$def{$_}."\n".'$r';
317        }
318        $def{$_} = barecode code $Info,
319                     'sub {my ($self, $source, $opt) = @_;'
320                   . $def{$_} . '}';
321      }
322      
323      my $r = list %def;
324      if ($def{Type}) {
325        $r = qq{\$Converter->{@{[literal $def{Type}.$flag]}} = {$r};\n};
326        $r .= qq{\$Converter->{@{[literal '/'.$def{Name}.'/'.$def{Version}.$flag]}} = \$Converter->{@{[literal $def{Type}.$flag]}};\n}
327          if $def{Name};
328      } elsif ($def{Name}) {
329        $r = qq{\$Converter->{@{[literal '/'.$def{Name}.'/'.$def{Version}.$flag]}} = {$r};\n};
330      } else {
331        $r = 'BEGIN { die "Invalid Syntax of Converter: Type or Name property required" }';
332      }
333      $r;
334    }
335    
336  sub make_function ($$) {  sub make_function ($$) {
337    my ($src, $Info) = @_;    my ($src, $Info) = @_;
338    ## TODO: support of ARGV property    ## TODO: support of ARGV property
339      my $name;
340    my $r = <<EOH;    my $r = <<EOH;
341  package $Info->{module_name};  @{[change_package $Info, $Info->{module_name}]}
342  sub @{[$src->get_attribute_value ('Name')]} {  sub @{[$name = $src->get_attribute_value ('Name')]} {
343    @{[code $Info, $src->get_attribute_value ('Main')]}  @{[line $Info, node_path => "Function[Name='$name']/Main"]}@{[
344      code $Info, $src->get_attribute_value ('Main')
345    ]}
346  }  }
347    @{[line $Info, reset => 1]}
348  EOH  EOH
349  }  }
350    
351  sub register_plugin_const ($$) {  sub register_plugin_const ($$) {
352    my ($src, $Info) = @_;    my ($src, $Info) = @_;
353    for (@{$src->child_nodes}) {    for (@{$src->child_nodes}) {
354      $Info->{const}->{$_->local_name} = $_->value;      $Info->{const}->{$_->local_name} = literal_or_code $Info, $_->value;
355    }    }
356  }  }
357    
358  sub make_resdef ($$) {  sub make_resdef ($$) {
359    my ($src, $Info) = @_;    my ($src, $Info) = @_;
360    my $r = qq{package SuikaWiki::Plugin::Resource;\nour \$BaseResource;\n};    my $r = change_package $Info, 'SuikaWiki::Plugin::Resource';
361      $r .= qq{our \$BaseResource;\n};
362    for (@{$src->child_nodes}) {    for (@{$src->child_nodes}) {
363      if ($_->node_type eq '#element') {      if ($_->node_type eq '#element') {
364        my $lang = literal ($_->get_attribute_value ('lang') || 'und');        my $lang = literal ($_->get_attribute_value ('lang') || 'und');
# Line 176  sub make_resdef ($$) { Line 374  sub make_resdef ($$) {
374  sub make_viewfragment ($$) {  sub make_viewfragment ($$) {
375    my ($src, $Info) = @_;    my ($src, $Info) = @_;
376    my $r = '';    my $r = '';
377    my $name = $src->get_attribute_value ('Name');    my $body = <<EOH;
378    $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]}}}, {  
379      Main => @{[literal $src->get_attribute_value ('Formatting')]},      Main => @{[literal $src->get_attribute_value ('Formatting')]},
380      Order => @{[0+$src->get_attribute_value ('Order')]},      Order => @{[0+$src->get_attribute_value ('Order')]},
381      Description => [@{[m13ed_val_list $src, 'Description']}],      Description => [@{[m13ed_val_list $src, 'Description']}],
382    };    };
383  EOH  EOH
384    push @{$Info->{provide}->{viewfragment}},    ## Recommended format
385         {Name => $src->get_attribute ('Name')->value};    my $name = $src->get_attribute_value ('Template');
386      if (ref ($name) and @$name > 1) {
387        $r .= qq({my \$def = $body;\n);
388        for (@$name) {
389          my $name = $_; $name =~ tr/-/_/;
390          $r .= qq(push \@{\$SuikaWiki::View::Implementation::TemplateFragment{@{[literal $name]}}}, \$def;\n);
391          push @{$Info->{provide}->{viewfragment}}, {Name => $name};
392        }
393        $r .= qq(}\n);
394      } else {                           ## Obsoleted format
395        $name = ref $name ? $name->[0] : $src->get_attribute_value ('Name');
396        $name =~ tr/-/_/;
397        $r .= qq(push \@{\$SuikaWiki::View::Implementation::TemplateFragment{@{[literal $name]}}}, $body);
398        push @{$Info->{provide}->{viewfragment}}, {Name => $name};
399      }
400    $r;    $r;
401  }  }
402    
# Line 198  sub make_viewdef ($$) { Line 404  sub make_viewdef ($$) {
404    my ($src, $Info) = @_;    my ($src, $Info) = @_;
405    my $ViewProp = {};    my $ViewProp = {};
406    my $r = '';    my $r = '';
407    $ViewProp->{Name} = n11n $src->get_attribute ('Mode')->value;    $ViewProp->{Name} = n11n $src->get_attribute_value ('Mode');
408      $ViewProp->{Name} =~ s/(?<=.)-/_/g;
409    $ViewProp->{pack_name} = random_module_name ($Info, $ViewProp->{Name});    $ViewProp->{pack_name} = random_module_name ($Info, $ViewProp->{Name});
410        
411    $ViewProp->{condition_stringified} = hash    $ViewProp->{condition_stringified} = hash
# Line 211  push \@SuikaWiki::View::Implementation:: Line 418  push \@SuikaWiki::View::Implementation::
418    condition => {$ViewProp->{condition_stringified}},    condition => {$ViewProp->{condition_stringified}},
419    object_class => q#$ViewProp->{pack_name}#,    object_class => q#$ViewProp->{pack_name}#,
420  };  };
421  package $ViewProp->{pack_name};  @{[change_package $Info, $ViewProp->{pack_name}]}
422  our \@ISA = q#SuikaWiki::View::template#;  our \@ISA = q#SuikaWiki::View::template#;
423  EOH  EOH
424      
425      my $use = $src->get_attribute ('Use');
426      if (ref $use) {
427        $r .= line $Info, node_path => "ViewDefinition[Mode='$ViewProp->{Name}']/Use";
428        $r .= $use->inner_text . "\n\n";
429      }
430      
431    for (@{$src->child_nodes}) {    for (@{$src->child_nodes}) {
432      if ($_->local_name eq 'template') {      if ($_->local_name eq 'template') {
433        $r .= make_view_template_method ($_, $Info);        $r .= make_view_template_method ($_, $Info, $ViewProp);
434      } elsif ($_->local_name eq 'method') {      } elsif ($_->local_name eq 'method') {
435          my $method_name = $_->get_attribute_value ('Name');
436        $r .= ({        $r .= ({
437                main => q(sub main ($$) {)."\n".q(my ($self, $opt) = @_;)."\n",                main => q(sub main ($$) {)."\n".q(my ($self, $opt, $opt2) = @_;)."\n",
438                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",
439                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",                    
440               }->{$_->get_attribute ('Name')->value}               }->{$method_name}
441               ||qq(sub @{[$_->get_attribute ('Name')->value]} {\n))               ||qq(sub @{[$method_name]} {\n))
442             . line ($Info, node_path => "ViewDefinition[Mode='$ViewProp->{Name}']/method[Name='$method_name']")
443           . code ($Info, $_->value)           . code ($Info, $_->value)
444           . qq(\n}\n);           . qq(}\n)
445             . line ($Info, reset => 1);
446      }      }
447    }    }
448    my $prop = {Name => $ViewProp->{Name},    my $prop = {Name => $ViewProp->{Name},
# Line 235  EOH Line 452  EOH
452  }  }
453    
454  sub make_view_template_method ($$) {  sub make_view_template_method ($$) {
455    my ($src, $info) = @_;    my ($src, $Info, $ViewProp) = @_;
456    my $r = <<EOH;    my $r = <<EOH;
457    
458  sub main (\$\$\$) {  sub main (\$\$\$) {
# Line 251  sub main (\$\$\$) { Line 468  sub main (\$\$\$) {
468        
469    \$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]};
470    \$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)  
     ]}},  
471                        ## SuikaWiki 3 WikiPlugin interface                        ## SuikaWiki 3 WikiPlugin interface
472                          wiki => \$self->{view}->{wiki},                          wiki => \$self->{view}->{wiki},
473                          plugin => \$self->{view}->{wiki}->{plugin},                          plugin => \$self->{view}->{wiki}->{plugin},
# Line 275  sub main (\$\$\$) { Line 476  sub main (\$\$\$) {
476    @{[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;
477       $x?q{$opt2->{output}->{status_code} = }.(0 + $x).q{;}:q{}}]}       $x?q{$opt2->{output}->{status_code} = }.(0 + $x).q{;}:q{}}]}
478    @{[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;
479       $x?q{$opt2->{output}->{reason_phrase} = }.literal($x).q{;}:q{}}]}       $x?q{$opt2->{output}->{status_phrase} = }.literal($x).q{;}:q{}}]}
480    \$opt2->{output}->{entity}->{media_type} = @{[literal    \$opt2->{output}->{entity}->{media_type} = @{[literal
481                             $src->get_attribute ('media-type',make_new_node=>1)                             $src->get_attribute ('media-type',make_new_node=>1)
482                                 ->inner_text || 'application/octet-stream']};                                 ->inner_text || 'application/octet-stream']};
# Line 290  sub main (\$\$\$) { Line 491  sub main (\$\$\$) {
491              qq{\$opt2->{output}->set_expires (delta => @{[0 + $x]});};              qq{\$opt2->{output}->set_expires (delta => @{[0 + $x]});};
492            }            }
493        }]}        }]}
494      \$opt2->{output}->{entity}->{body_is_octet_stream} = @{[
495        $src->get_attribute ('body')->get_attribute_value ('is-octet-stream', default_value => 0)
496        or 0
497      ]};
498        
499    \$self->{view}->{wiki}->init_db;    \$self->{view}->{wiki}->init_db;
500    \$self->main_pre (\$opt, \$opt2);    \$self->main_pre (\$opt, \$opt2);
501        
502    ## TODO: formal SuikaWiki 3 interface    use Message::Util::Error;
503    my \$fmt = SuikaWiki::Plugin->formatter ('view');    try {
504    \$opt2->{output}->{entity}->{body}      \$opt2->{output}->{entity}->{body}
505      = \$fmt->replace (\$opt2->{template} => \$opt2->{o},        = SuikaWiki::Plugin->formatter ('view')
506                        {formatter => \$fmt});          ->replace (\$opt2->{template}, param => \$opt2->{o});
507      } \$self->{view}->{wiki}->{config}->{catch}->{ @{[
508           $ViewProp->{Name} eq '-error' ? 'formatter_view_error'
509                                         : 'formatter_view' ]} };
510    \$opt2->{output}->output (output => 'http-cgi');    \$opt2->{output}->output (output => 'http-cgi');
511        
512    \$self->main_post (\$opt, \$opt2);    \$self->main_post (\$opt, \$opt2);
# Line 306  sub main (\$\$\$) { Line 514  sub main (\$\$\$) {
514  EOH  EOH
515  }  }
516    
 ## TODO: Implements SuikaWiki 3 interface  
517  sub make_rule ($$) {  sub make_rule ($$) {
518    my ($src, $Info) = @_;    my ($src, $Info) = @_;
519    my $type = $src->get_attribute ('Category', make_new_node => 1)->value || [];    my $type = $src->get_attribute ('Category', make_new_node => 1)->value || [];
520    my $name = $src->get_attribute ('Name', make_new_node => 1)->value;    my $name = $src->get_attribute ('Name', make_new_node => 1)->value;
521    $name =~ s/(?=.)-/_/g;    $name =~ s/(?<=.)-/_/g;
522    my $main = code $Info, $src->get_attribute_value ('Formatting');    
523    $main = q{my ($p, $o) = @_;}."\n" . $main    my $reg_block;
524      if $main =~ /\$p/ || $main =~ /\$o/;    $reg_block = qr/[^{}]*(?>[^{}]+|{(??{$reg_block})})*/;
525    if ($main =~ /\$r/) {    my %code;
526      $main = q{my $r = '';} . "\n" . $main;    for my $codename ([qw/Formatting main/], [qw/After after/],
527      $main .= q{$r};                      [qw/Before before/], [qw/Pre pre/], [qw/Post post/],
528                        [qw/Attribute attr/]) {
529        my $main = code $Info, $src->get_attribute_value ($codename->[0]);
530        next unless $main;
531        $main = line ($Info, node_path =>
532                  "FormattingRule[name()='@{[list $type]}/$name']/".$codename->[0])
533              . $main;
534        
535        if ( $main =~ /\$f\b/
536          or $main =~ /\$rule_name\b/
537          or $main =~ /\$[opr]\b/
538          or $main =~ /[%\$]opt\b/
539          or $main =~ /\$param_(?:name|value)\n/) {
540          if ($codename->[0] ne 'Attribute') {
541            $main = q{my ($f, $rule_name, $p, $o, %opt) = @_;}."\n".$main;
542          } else {
543            $main = q{my ($f, $rule_name, $p, $o, $param_name => $param_value, %opt) = @_;}."\n".$main;
544          }
545        }
546        if ($main =~ /\$r\b/) {
547          warn qq(Rule @{[list $type]}/$name: Use of \$r is deprecated);
548          $main = q{my $r = '';} . "\n" . $main . "\n"
549                . q{$p->{-parent}->append_node ($r, node_or_text => 1);};
550        }
551        $main =~ s{__ATTR(TEXT|NODE)?:%(\w+|{$reg_block})(?:->{($reg_block)})?__;}
552                  {($1 eq 'TEXT' ? '$p->{'.literal_or_code($Info, $2)
553                                          .'} = do { my $r = ' : '')
554                   .'$f->parse_attr ($p=>'.literal_or_code($Info, $2).', $o, '
555                                   .($3?'-parent => '.$3.', ':'')
556                                   .($1?'-non_parsed_to_node => 1, ':'')
557                                   .'%opt)'
558                                   .($1 eq 'TEXT' ? '; ref $r?$r->inner_text:$r}'
559                                                  : '')
560                                   .';'}ge;
561        $code{$codename->[1]} = barecode "sub {$main}";
562    }    }
563        
564    my $main = <<EOH;    my $main = literal {
565        Description => [barecode m13ed_val_list $src, 'Description'],
566        Parameter => {do {
567          my @r;
568          for (@{$src->child_nodes}) {
569            if ($_->local_name eq 'Parameter') {
570              push @r, $_->get_attribute_value ('Name')
571                       => {Type => $_->get_attribute_value ('Type'),
572                           Default => $_->get_attribute_value ('Default'),
573                           Description => [barecode m13ed_val_list $_, 'Description']};
574            }
575          }
576          @r;
577        }},
578        %code,
579      };
580      $main .= line $Info, reset => 1;
581    
582    
583    my  $amain = <<EOH;
584  {  {
585    Formatting => sub {$main},    main => sub {$main},
586    @{[line ($Info, reset => 1)]}
587    Description => [@{[m13ed_val_list $src, 'Description']}],    Description => [@{[m13ed_val_list $src, 'Description']}],
588    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;  
589    }]}},    }]}},
590  }  }
591  EOH  EOH
592    my $r;    my $r = change_package $Info, $Info->{module_name};
593    if (@$type == 1) {    if (@$type == 1) {
594      $type->[0] =~ tr/-/_/;      $type->[0] =~ tr/-/_/;
595      $r = qq{\$SuikaWiki::Plugin::Rule{$type->[0]}->{$name} = $main;\n};      $r .= qq{\$SuikaWiki::Plugin::Rule{$type->[0]}->{$name} = $main;\n};
596      push @{$Info->{provide}->{rule}->{$type->[0]}}, $name;      push @{$Info->{provide}->{rule}->{$type->[0]}}, $name;
597    } else {    } else {
598      $r = qq({my \$def = $main;\n);      $r .= qq({my \$def = $main;\n);
599      for my $type (@$type) {      for my $type (@$type) {
600        $type =~ tr/-/_/;        $type =~ tr/-/_/;
601        $r .= qq{\$SuikaWiki::Plugin::Rule{$type}->{$name} = \$def;\n};        $r .= qq{\$SuikaWiki::Plugin::Rule{$type}->{$name} = \$def;\n};
Legend:
Removed from v.1.2  
changed lines
  Added in v.1.12
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24