/[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.14 by wakaba, Thu Mar 11 04:04:06 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      $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 ($$) {
70      my ($Info, $pack) = @_;
71      unless ($Info->{current_package} eq $pack) {
72        $Info->{current_package} = $pack;
73        return qq{package $pack;\n\n};
74      } else {
75        return '';
76      }
77    }
78    sub quoted_string ($) {
79      my $s = shift;
80      $s =~ s/([\\"])/\\$1/g;
81      '"'.$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 = SuikaWiki::Markup::SuikaWikiConfig20::Parser->new;  my $parser = Message::Markup::SuikaWikiConfig20::Parser->new;
112  my $plugins = $parser->parse_text ($src);  my $plugins = $parser->parse_text ($src);
113  my $meta = $plugins->get_attribute ('Plugin')  my $meta = $plugins->get_attribute ('Plugin')
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 81  $Info{module_name} = random_module_name Line 128  $Info{module_name} = random_module_name
128    
129  print <<EOH;  print <<EOH;
130  use strict;  use strict;
131  package SuikaWiki::Plugin::Registry;  @{[change_package \%Info, 'SuikaWiki::Plugin::Registry']}
132  our \%Info;  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/) {  for (qw/Version InterfaceVersion mkpluginVersion module_name/) {
136    print qq{\$Info{$Info{name_literal}}->{$_} = v$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 116  print qq{\$Info{$Info{name_literal}}->{A Line 163  print qq{\$Info{$Info{name_literal}}->{A
163  } grep { $_->local_name eq 'Author' } @{$meta->child_nodes}  } grep { $_->local_name eq 'Author' } @{$meta->child_nodes}
164  ). qq{];\n};  ). qq{];\n};
165    
166    my $use = $meta->get_attribute ('Use');
167    if (ref $use) {
168      print change_package \%Info, $Info{module_name};
169      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}) {
175    if ($_->local_name eq 'FormattingRule') {    if ($_->local_name eq 'FormattingRule') {
176      print "\n", make_rule ($_, \%Info);      print "\n", make_rule ($_, \%Info);
# Line 129  for (@{$plugins->child_nodes}) { Line 184  for (@{$plugins->child_nodes}) {
184      print "\n", make_resdef ($_, \%Info);      print "\n", make_resdef ($_, \%Info);
185    } elsif ($_->local_name eq 'PluginConst') {    } elsif ($_->local_name eq 'PluginConst') {
186      register_plugin_const ($_, \%Info);      register_plugin_const ($_, \%Info);
187      } elsif ($_->local_name eq 'Format') {
188        print "\n", make_format ($_, \%Info);
189    # Parameter
190    # PluginCategory
191    }    }
192  }  }
193    
194  print qq{\npackage SuikaWiki::Plugin::Registry;\n\n};  print change_package \%Info, q(SuikaWiki::Plugin::Registry);
195  print qq{\$Info{$Info{name_literal}}->{provide} = } . literal $Info{provide};  print qq{\$Info{$Info{name_literal}}->{provide} = } . literal $Info{provide};
196  print qq{;\n};  print qq{;\n};
197    
# Line 140  print "\n1;\n"; Line 199  print "\n1;\n";
199  exit;  exit;
200  }  }
201    
202    sub make_format ($$) {
203      my ($src, $Info) = @_;
204      my $module_name = 'SuikaWiki::Format::Definition::'.$src->get_attribute_value ('ModuleName');
205      my $r = change_package $Info, $module_name;
206      local $Info->{-message_error_used} = 0;  
207      $r .= qq{our \@ISA;\n};
208      if (my $isa = $src->get_attribute_value ('Inherit')) {
209        for (@$isa) {
210          $r .= qq{push \@ISA, @{[literal 'SuikaWiki::Format::Definition::'.$_]};\n};
211        }
212      } else {
213        $r .= qq{push \@ISA, 'SuikaWiki::Format::Definition::template';\n};    
214      }
215      if (my $name = $src->get_attribute_value ('Name')) {
216        $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')) {
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};
225      }
226      
227      my $convert = line $Info, line_no => __LINE__ + 2, realfile => __FILE__;
228      $convert .= <<'EOH';
229    our $Converter;
230    sub convert ($$;%) {
231      my ($self, $source, %opt) = @_;
232      my $converter;
233      my $flag = '//';
234      $flag .= 'f' if $opt{IsFragment};
235      $flag .= 'p' if $opt{IsPlaceholder};
236      my $type = $opt{Type} ?
237                    $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}) {
243        $converter = $Converter->{'/'.$opt{Name}.'/'.$opt{Version}.$flag};
244      }
245      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);
250    }
251    EOH
252      
253      for (@{$src->child_nodes}) {
254        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);
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') {
282          $r .= line $Info, node_path => qq(Format[module-name()=$module_name]/Use);
283          $r .= code $Info, $_->inner_text;
284        }
285      }
286      $r;
287    }
288    
289    sub make_format_converter ($$) {
290      my ($src, $Info) = @_;
291      my %def;
292      $def{Type} = $src->get_attribute ('Type');
293      if (ref $def{Type}) {
294        $def{Type} = $def{Type}->inner_text
295              . join '', map {
296                  ';'. $_->local_name .'='. quoted_string $_->inner_text
297                } sort {
298                  $a->local_name cmp $b->local_name
299                } @{$def{Type}->child_nodes};
300      } else {
301        delete $def{Type};
302      }
303      $def{Name} = $src->get_attribute_value ('Name');
304      delete $def{Name} unless defined $def{Name};
305      $def{Version} = $src->get_attribute_value ('Version');
306      delete $def{Version} if not defined $def{Version} or
307                              not defined $def{Name};
308      
309      my $flag = '//';
310      $flag .= 'f' and $def{IsFragment} = 1
311        if $src->get_attribute_value ('IsFragment');
312      $flag .= 'p' and $def{IsPlaceholder} = 1
313        if $src->get_attribute_value ('IsPlaceholder');
314      
315      for (qw/Main ToString ToOctetStream/) {
316        my $def = $src->get_attribute_value ($_);
317        next unless $def;
318        $def{$_} = line ($Info, node_path => '//Converter/'.$_)
319                   . $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;
330      if ($def{Type}) {
331        $r = qq{\$Converter->{@{[literal $def{Type}.$flag]}} = {$r};\n};
332        $r .= qq{\$Converter->{@{[literal '/'.$def{Name}.'/'.$def{Version}.$flag]}} = \$Converter->{@{[literal $def{Type}.$flag]}};\n}
333          if $def{Name};
334      } elsif ($def{Name}) {
335        $r = qq{\$Converter->{@{[literal '/'.$def{Name}.'/'.$def{Version}.$flag]}} = {$r};\n};
336      } else {
337        $r = 'BEGIN { die "Invalid Syntax of Converter: Type or Name property required" }';
338      }
339      $r;
340    }
341    
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  package $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 = qq{package SuikaWiki::Plugin::Resource;\nour \$BaseResource;\n};    my $r = change_package $Info, 'SuikaWiki::Plugin::Resource';
367      local $Info->{-message_error_used} = 0;  
368      $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') {
371        my $lang = literal ($_->get_attribute_value ('lang') || 'und');        my $lang = literal ($_->get_attribute_value ('lang') || 'und');
# Line 176  sub make_resdef ($$) { Line 381  sub make_resdef ($$) {
381  sub make_viewfragment ($$) {  sub make_viewfragment ($$) {
382    my ($src, $Info) = @_;    my ($src, $Info) = @_;
383    my $r = '';    my $r = '';
384    my $name = $src->get_attribute_value ('Name');    my $body = <<EOH;
385    $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]}}}, {  
386      Main => @{[literal $src->get_attribute_value ('Formatting')]},      Main => @{[literal $src->get_attribute_value ('Formatting')]},
387      Order => @{[0+$src->get_attribute_value ('Order')]},      Order => @{[0+$src->get_attribute_value ('Order')]},
388      Description => [@{[m13ed_val_list $src, 'Description']}],      Description => [@{[m13ed_val_list $src, 'Description']}],
389    };    };
390  EOH  EOH
391    push @{$Info->{provide}->{viewfragment}},    ## Recommended format
392         {Name => $src->get_attribute ('Name')->value};    my $name = $src->get_attribute_value ('Template');
393      if (ref ($name) and @$name > 1) {
394        $r .= qq({my \$def = $body;\n);
395        for (@$name) {
396          my $name = $_; $name =~ tr/-/_/;
397          $r .= qq(push \@{\$SuikaWiki::View::Implementation::TemplateFragment{@{[literal $name]}}}, \$def;\n);
398          push @{$Info->{provide}->{viewfragment}}, {Name => $name};
399        }
400        $r .= qq(}\n);
401      } else {                           ## Obsoleted format
402        $name = ref $name ? $name->[0] : $src->get_attribute_value ('Name');
403        $name =~ tr/-/_/;
404        $r .= qq(push \@{\$SuikaWiki::View::Implementation::TemplateFragment{@{[literal $name]}}}, $body);
405        push @{$Info->{provide}->{viewfragment}}, {Name => $name};
406      }
407    $r;    $r;
408  }  }
409    
# Line 198  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 211  push \@SuikaWiki::View::Implementation:: Line 425  push \@SuikaWiki::View::Implementation::
425    condition => {$ViewProp->{condition_stringified}},    condition => {$ViewProp->{condition_stringified}},
426    object_class => q#$ViewProp->{pack_name}#,    object_class => q#$ViewProp->{pack_name}#,
427  };  };
428  package $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 235  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 251  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 275  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 290  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    ## TODO: formal SuikaWiki 3 interface    use Message::Util::Error;
511    my \$fmt = SuikaWiki::Plugin->formatter ('view');    try {
512    \$opt2->{output}->{entity}->{body}      \$opt2->{output}->{entity}->{body}
513      = \$fmt->replace (\$opt2->{template} => \$opt2->{o},        = SuikaWiki::Plugin->formatter ('view')
514                        {formatter => \$fmt});          ->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 306  sub main (\$\$\$) { Line 522  sub main (\$\$\$) {
522  EOH  EOH
523  }  }
524    
 ## TODO: Implements SuikaWiki 3 interface  
525  sub make_rule ($$) {  sub make_rule ($$) {
526    my ($src, $Info) = @_;    my ($src, $Info) = @_;
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;
530    my $main = code $Info, $src->get_attribute_value ('Formatting');    
531    $main = q{my ($p, $o) = @_;}."\n" . $main    my $reg_block;
532      if $main =~ /\$p/ || $main =~ /\$o/;    $reg_block = qr/[^{}]*(?>[^{}]+|{(??{$reg_block})})*/;
533    if ($main =~ /\$r/) {    my %code;
534      $main = q{my $r = '';} . "\n" . $main;    for my $codename ([qw/Formatting main/], [qw/After after/],
535      $main .= q{$r};                      [qw/Before before/], [qw/Pre pre/], [qw/Post post/],
536                        [qw/Attribute attr/]) {
537        my $main = code $Info, $src->get_attribute_value ($codename->[0]);
538        next unless $main;
539        $main = line ($Info, node_path =>
540                  "FormattingRule[name()='@{[list $type]}/$name']/".$codename->[0])
541              . $main;
542        
543        if ( $main =~ /\$f\b/
544          or $main =~ /\$rule_name\b/
545          or $main =~ /\$[opr]\b/
546          or $main =~ /[%\$]opt\b/
547          or $main =~ /\$param_(?:name|value)\n/) {
548          if ($codename->[0] ne 'Attribute') {
549            $main = q{my ($f, $rule_name, $p, $o, %opt) = @_;}."\n".$main;
550          } else {
551            $main = q{my ($f, $rule_name, $p, $o, $param_name => $param_value, %opt) = @_;}."\n".$main;
552          }
553        }
554        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 = <<EOH;    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    Formatting => 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;    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};
605      push @{$Info->{provide}->{rule}->{$type->[0]}}, $name;      push @{$Info->{provide}->{rule}->{$type->[0]}}, $name;
606    } else {    } else {
607      $r = qq({my \$def = $main;\n);      $r .= qq({my \$def = $main;\n);
608      for my $type (@$type) {      for my $type (@$type) {
609        $type =~ tr/-/_/;        $type =~ tr/-/_/;
610        $r .= qq{\$SuikaWiki::Plugin::Rule{$type}->{$name} = \$def;\n};        $r .= qq{\$SuikaWiki::Plugin::Rule{$type}->{$name} = \$def;\n};
# Line 365  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.3  
changed lines
  Added in v.1.14
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24