/[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.15 by wakaba, Fri Mar 19 03:46:22 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      } elsif ($_->local_name eq 'FormattingRuleAlias') {
190        print "\n", make_rule_alias ($_, \%Info);
191    # Parameter
192    # PluginCategory
193    }    }
194  }  }
195    
196  print qq{\npackage SuikaWiki::Plugin::Registry;\n\n};  print change_package \%Info, q(SuikaWiki::Plugin::Registry);
197  print qq{\$Info{$Info{name_literal}}->{provide} = } . literal $Info{provide};  print qq{\$Info{$Info{name_literal}}->{provide} = } . literal $Info{provide};
198  print qq{;\n};  print qq{;\n};
199    
# Line 140  print "\n1;\n"; Line 201  print "\n1;\n";
201  exit;  exit;
202  }  }
203    
204    sub make_format ($$) {
205      my ($src, $Info) = @_;
206      my $module_name = 'SuikaWiki::Format::Definition::'.$src->get_attribute_value ('ModuleName');
207      my $r = change_package $Info, $module_name;
208      local $Info->{-message_error_used} = 0;  
209      $r .= qq{our \@ISA;\n};
210      if (my $isa = $src->get_attribute_value ('Inherit')) {
211        for (@$isa) {
212          $r .= qq{push \@ISA, @{[literal 'SuikaWiki::Format::Definition::'.$_]};\n};
213        }
214      } else {
215        $r .= qq{push \@ISA, 'SuikaWiki::Format::Definition::template';\n};    
216      }
217      if (my $name = $src->get_attribute_value ('Name')) {
218        $r .= qq{\$SuikaWiki::Format::Definition::Class{@{[literal '/'.$name.'/'.$src->get_attribute_value ('Version', default => '').'//']}} = '$module_name';\n};
219      }
220      if (my $type = $src->get_attribute_value ('Type')) {
221        $type .= join '', map {
222                   ';'. $_->local_name .'='. quoted_string $_->inner_text
223                 } sort {
224                   $a->local_name cmp $b->local_name
225                 } @{$src->get_attribute ('Type')->child_nodes};
226        $r .= qq{\$SuikaWiki::Format::Definition::Class{@{[literal $type.'//']}} = '$module_name';\n};
227      }
228      
229      my $convert = line $Info, line_no => __LINE__ + 2, realfile => __FILE__;
230      $convert .= <<'EOH';
231    our $Converter;
232    sub convert ($$;%) {
233      my ($self, $source, %opt) = @_;
234      my $converter;
235      my $flag = '//';
236      $flag .= 'f' if $opt{IsFragment};
237      $flag .= 'p' if $opt{IsPlaceholder};
238      my $type = $opt{Type} ?
239                    $opt{Type} .
240                    SuikaWiki::Format::Definition->__get_param_string
241                      ($opt{Type_param}) : undef;
242      if ($Converter->{$type.$flag}) {
243        $converter = $Converter->{$type.$flag};
244      } elsif ($Converter->{$opt{Name}.'/'.$opt{Version}.$flag}) {
245        $converter = $Converter->{'/'.$opt{Name}.'/'.$opt{Version}.$flag};
246      }
247      return ($converter->{$opt{return_type} or 'Main'} or
248              CORE::die "Buggy implementation: $type $opt{Name}/$opt{Version}$flag/@{[$opt{return_type} or 'Main']} not defined")
249             ->($self, $source, \%opt)
250        if $converter;
251      $self->SUPER::convert ($source, %opt);
252    }
253    EOH
254      
255      for (@{$src->child_nodes}) {
256        if ($_->local_name eq 'Converter') {
257          if ($convert) {
258            $r .= $convert;
259            $r .= line $Info, reset => 1;
260            undef $convert;
261          }
262          $r .= make_format_converter ($_, $Info);
263        } elsif ($_->local_name eq 'WikiForm') {
264          $r .= q(sub wikiform {)."\n".q(my ($self, $source, %opt) = @_;);
265          $r .= line $Info, node_path => qq(Format[module-name()=$module_name]/WikiForm);
266          $r .= code $Info, $_->get_attribute_value ('Main');
267          $r .= line $Info, reset => 1;
268          $r .= qq(}\n);
269        } elsif ($_->local_name eq 'HeadSummary') {
270          $r .= q(sub headsummary {)."\n".q(my ($self, $source, %opt) = @_;);
271          $r .= line $Info, node_path => qq(Format[module-name()=$module_name]/HeadSummary);
272          $r .= code $Info, $_->get_attribute_value ('Main');
273          $r .= line $Info, reset => 1;
274          $r .= qq(}\n);
275        } elsif ($_->local_name eq 'NextIndex') {
276          my $name = $_->get_attribute_value ('Name', default => '');
277          $r .= q(sub next_index_for_).$name
278             .  q( {)."\n".q(my ($self, $source, %opt) = @_;)
279             .  line $Info, node_path => qq(Format[module-name()=$module_name]/NextIndex[Name=$name]);
280          $r .= code $Info, $_->get_attribute_value ('Main');
281          $r .= line $Info, reset => 1;
282          $r .= qq(}\n);
283        } elsif ($_->local_name eq 'Use') {
284          $r .= line $Info, node_path => qq(Format[module-name()=$module_name]/Use);
285          $r .= code $Info, $_->inner_text;
286        }
287      }
288      $r;
289    }
290    
291    sub make_format_converter ($$) {
292      my ($src, $Info) = @_;
293      my %def;
294      $def{Type} = $src->get_attribute ('Type');
295      if (ref $def{Type}) {
296        $def{Type} = $def{Type}->inner_text
297              . join '', map {
298                  ';'. $_->local_name .'='. quoted_string $_->inner_text
299                } sort {
300                  $a->local_name cmp $b->local_name
301                } @{$def{Type}->child_nodes};
302      } else {
303        delete $def{Type};
304      }
305      $def{Name} = $src->get_attribute_value ('Name');
306      delete $def{Name} unless defined $def{Name};
307      $def{Version} = $src->get_attribute_value ('Version');
308      delete $def{Version} if not defined $def{Version} or
309                              not defined $def{Name};
310      
311      my $flag = '//';
312      $flag .= 'f' and $def{IsFragment} = 1
313        if $src->get_attribute_value ('IsFragment');
314      $flag .= 'p' and $def{IsPlaceholder} = 1
315        if $src->get_attribute_value ('IsPlaceholder');
316      
317      for (qw/Main ToString ToOctetStream/) {
318        my $def = $src->get_attribute_value ($_);
319        next unless $def;
320        $def{$_} = line ($Info, node_path => '//Converter/'.$_)
321                   . $def
322                   . line ($Info, reset => 1);
323        if ($def{$_} =~ /\$r\b/) {
324          $def{$_} = 'my $r;'."\n".$def{$_}."\n".'$r';
325        }
326        $def{$_} = barecode code $Info,
327                     'sub {my ($self, $source, $opt) = @_;'
328                   . $def{$_} . '}';
329      }
330      
331      my $r = list %def;
332      if ($def{Type}) {
333        $r = qq{\$Converter->{@{[literal $def{Type}.$flag]}} = {$r};\n};
334        $r .= qq{\$Converter->{@{[literal '/'.$def{Name}.'/'.$def{Version}.$flag]}} = \$Converter->{@{[literal $def{Type}.$flag]}};\n}
335          if $def{Name};
336      } elsif ($def{Name}) {
337        $r = qq{\$Converter->{@{[literal '/'.$def{Name}.'/'.$def{Version}.$flag]}} = {$r};\n};
338      } else {
339        $r = 'BEGIN { die "Invalid Syntax of Converter: Type or Name property required" }';
340      }
341      $r;
342    }
343    
344  sub make_function ($$) {  sub make_function ($$) {
345    my ($src, $Info) = @_;    my ($src, $Info) = @_;
346    ## TODO: support of ARGV property    ## TODO: support of ARGV property
347      my $name;
348    my $r = <<EOH;    my $r = <<EOH;
349  package $Info->{module_name};  @{[change_package $Info, $Info->{module_name}]}
350  sub @{[$src->get_attribute_value ('Name')]} {  sub @{[$name = $src->get_attribute_value ('Name')]} {
351    @{[code $Info, $src->get_attribute_value ('Main')]}  @{[line $Info, node_path => "Function[Name='$name']/Main"]}@{[
352      code $Info, $src->get_attribute_value ('Main')
353    ]}
354  }  }
355    @{[line $Info, reset => 1]}
356  EOH  EOH
357  }  }
358    
359  sub register_plugin_const ($$) {  sub register_plugin_const ($$) {
360    my ($src, $Info) = @_;    my ($src, $Info) = @_;
361    for (@{$src->child_nodes}) {    for (@{$src->child_nodes}) {
362      $Info->{const}->{$_->local_name} = $_->value;      $Info->{const}->{$_->local_name} = literal_or_code $Info, $_->value;
363    }    }
364  }  }
365    
366  sub make_resdef ($$) {  sub make_resdef ($$) {
367    my ($src, $Info) = @_;    my ($src, $Info) = @_;
368    my $r = qq{package SuikaWiki::Plugin::Resource;\nour \$BaseResource;\n};    my $r = change_package $Info, 'SuikaWiki::Plugin::Resource';
369      local $Info->{-message_error_used} = 0;  
370      $r .= qq{our \$BaseResource;\n};
371    for (@{$src->child_nodes}) {    for (@{$src->child_nodes}) {
372      if ($_->node_type eq '#element') {      if ($_->node_type eq '#element') {
373        my $lang = literal ($_->get_attribute_value ('lang') || 'und');        my $lang = literal ($_->get_attribute_value ('lang') || 'und');
# Line 176  sub make_resdef ($$) { Line 383  sub make_resdef ($$) {
383  sub make_viewfragment ($$) {  sub make_viewfragment ($$) {
384    my ($src, $Info) = @_;    my ($src, $Info) = @_;
385    my $r = '';    my $r = '';
386    my $name = $src->get_attribute_value ('Name');    my $body = <<EOH;
387    $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]}}}, {  
388      Main => @{[literal $src->get_attribute_value ('Formatting')]},      Main => @{[literal $src->get_attribute_value ('Formatting')]},
389      Order => @{[0+$src->get_attribute_value ('Order')]},      Order => @{[0+$src->get_attribute_value ('Order')]},
390      Description => [@{[m13ed_val_list $src, 'Description']}],      Description => [@{[m13ed_val_list $src, 'Description']}],
391    };    };
392  EOH  EOH
393    push @{$Info->{provide}->{viewfragment}},    ## Recommended format
394         {Name => $src->get_attribute ('Name')->value};    my $name = $src->get_attribute_value ('Template');
395      if (ref ($name) and @$name > 1) {
396        $r .= qq({my \$def = $body;\n);
397        for (@$name) {
398          my $name = $_; $name =~ tr/-/_/;
399          $r .= qq(push \@{\$SuikaWiki::View::Implementation::TemplateFragment{@{[literal $name]}}}, \$def;\n);
400          push @{$Info->{provide}->{viewfragment}}, {Name => $name};
401        }
402        $r .= qq(}\n);
403      } else {                           ## Obsoleted format
404        $name = ref $name ? $name->[0] : $src->get_attribute_value ('Name');
405        $name =~ tr/-/_/;
406        $r .= qq(push \@{\$SuikaWiki::View::Implementation::TemplateFragment{@{[literal $name]}}}, $body);
407        push @{$Info->{provide}->{viewfragment}}, {Name => $name};
408      }
409    $r;    $r;
410  }  }
411    
# Line 198  sub make_viewdef ($$) { Line 413  sub make_viewdef ($$) {
413    my ($src, $Info) = @_;    my ($src, $Info) = @_;
414    my $ViewProp = {};    my $ViewProp = {};
415    my $r = '';    my $r = '';
416    $ViewProp->{Name} = n11n $src->get_attribute ('Mode')->value;    $ViewProp->{Name} = n11n $src->get_attribute_value ('Mode');
417      $ViewProp->{Name} =~ s/(?<=.)-/_/g;
418    $ViewProp->{pack_name} = random_module_name ($Info, $ViewProp->{Name});    $ViewProp->{pack_name} = random_module_name ($Info, $ViewProp->{Name});
419        
420    $ViewProp->{condition_stringified} = hash    $ViewProp->{condition_stringified} = hash
# Line 211  push \@SuikaWiki::View::Implementation:: Line 427  push \@SuikaWiki::View::Implementation::
427    condition => {$ViewProp->{condition_stringified}},    condition => {$ViewProp->{condition_stringified}},
428    object_class => q#$ViewProp->{pack_name}#,    object_class => q#$ViewProp->{pack_name}#,
429  };  };
430  package $ViewProp->{pack_name};  @{[change_package $Info, $ViewProp->{pack_name}]}
431  our \@ISA = q#SuikaWiki::View::template#;  our \@ISA = q#SuikaWiki::View::template#;
432  EOH  EOH
433      local $Info->{-message_error_used} = 0;  
434      my $use = $src->get_attribute ('Use');
435      if (ref $use) {
436        $r .= line $Info, node_path => "ViewDefinition[Mode='$ViewProp->{Name}']/Use";
437        $r .= code $Info, $use->inner_text;
438        $r .= "\n\n";
439      }
440      
441    for (@{$src->child_nodes}) {    for (@{$src->child_nodes}) {
442      if ($_->local_name eq 'template') {      if ($_->local_name eq 'template') {
443        $r .= make_view_template_method ($_, $Info);        $r .= make_view_template_method ($_, $Info, $ViewProp);
444      } elsif ($_->local_name eq 'method') {      } elsif ($_->local_name eq 'method') {
445          my $method_name = $_->get_attribute_value ('Name');
446        $r .= ({        $r .= ({
447                main => q(sub main ($$) {)."\n".q(my ($self, $opt) = @_;)."\n",                main => q(sub main ($$) {)."\n".q(my ($self, $opt, $opt2) = @_;)."\n",
448                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",
449                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",                    
450               }->{$_->get_attribute ('Name')->value}               }->{$method_name}
451               ||qq(sub @{[$_->get_attribute ('Name')->value]} {\n))               ||qq(sub @{[$method_name]} {\n))
452             . line ($Info, node_path => "ViewDefinition[Mode='$ViewProp->{Name}']/method[Name='$method_name']")
453           . code ($Info, $_->value)           . code ($Info, $_->value)
454           . qq(\n}\n);           . qq(}\n)
455             . line ($Info, reset => 1);
456      }      }
457    }    }
458    my $prop = {Name => $ViewProp->{Name},    my $prop = {Name => $ViewProp->{Name},
# Line 235  EOH Line 462  EOH
462  }  }
463    
464  sub make_view_template_method ($$) {  sub make_view_template_method ($$) {
465    my ($src, $info) = @_;    my ($src, $Info, $ViewProp) = @_;
466    my $r = <<EOH;    my $r = <<EOH;
467    
468  sub main (\$\$\$) {  sub main (\$\$\$) {
# Line 251  sub main (\$\$\$) { Line 478  sub main (\$\$\$) {
478        
479    \$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]};
480    \$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)  
     ]}},  
481                        ## SuikaWiki 3 WikiPlugin interface                        ## SuikaWiki 3 WikiPlugin interface
482                          wiki => \$self->{view}->{wiki},                          wiki => \$self->{view}->{wiki},
483                          plugin => \$self->{view}->{wiki}->{plugin},                          plugin => \$self->{view}->{wiki}->{plugin},
# Line 275  sub main (\$\$\$) { Line 486  sub main (\$\$\$) {
486    @{[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;
487       $x?q{$opt2->{output}->{status_code} = }.(0 + $x).q{;}:q{}}]}       $x?q{$opt2->{output}->{status_code} = }.(0 + $x).q{;}:q{}}]}
488    @{[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;
489       $x?q{$opt2->{output}->{reason_phrase} = }.literal($x).q{;}:q{}}]}       $x?q{$opt2->{output}->{status_phrase} = }.literal($x).q{;}:q{}}]}
490    \$opt2->{output}->{entity}->{media_type} = @{[literal    \$opt2->{output}->{entity}->{media_type} = @{[literal
491                             $src->get_attribute ('media-type',make_new_node=>1)                             $src->get_attribute ('media-type',make_new_node=>1)
492                                 ->inner_text || 'application/octet-stream']};                                 ->inner_text || 'application/octet-stream']};
# Line 290  sub main (\$\$\$) { Line 501  sub main (\$\$\$) {
501              qq{\$opt2->{output}->set_expires (delta => @{[0 + $x]});};              qq{\$opt2->{output}->set_expires (delta => @{[0 + $x]});};
502            }            }
503        }]}        }]}
504      \$opt2->{output}->{entity}->{body_is_octet_stream} = @{[
505        $src->get_attribute ('body')->get_attribute_value ('is-octet-stream', default_value => 0)
506        or 0
507      ]};
508        
509    \$self->{view}->{wiki}->init_db;    \$self->{view}->{wiki}->init_db;
510    \$self->main_pre (\$opt, \$opt2);    \$self->main_pre (\$opt, \$opt2);
511        
512    ## TODO: formal SuikaWiki 3 interface    use Message::Util::Error;
513    my \$fmt = SuikaWiki::Plugin->formatter ('view');    try {
514    \$opt2->{output}->{entity}->{body}      \$opt2->{output}->{entity}->{body}
515      = \$fmt->replace (\$opt2->{template} => \$opt2->{o},        = SuikaWiki::Plugin->formatter ('view')
516                        {formatter => \$fmt});          ->replace (\$opt2->{template}, param => \$opt2->{o});
517      } \$self->{view}->{wiki}->{config}->{catch}->{ @{[
518           $ViewProp->{Name} eq '-error' ? 'formatter_view_error'
519                                         : 'formatter_view' ]} };
520    \$opt2->{output}->output (output => 'http-cgi');    \$opt2->{output}->output (output => 'http-cgi');
521        
522    \$self->main_post (\$opt, \$opt2);    \$self->main_post (\$opt, \$opt2);
# Line 306  sub main (\$\$\$) { Line 524  sub main (\$\$\$) {
524  EOH  EOH
525  }  }
526    
 ## TODO: Implements SuikaWiki 3 interface  
527  sub make_rule ($$) {  sub make_rule ($$) {
528    my ($src, $Info) = @_;    my ($src, $Info) = @_;
529    my $type = $src->get_attribute ('Category', make_new_node => 1)->value || [];    my $type = $src->get_attribute ('Category', make_new_node => 1)->value || [];
530    my $name = $src->get_attribute ('Name', make_new_node => 1)->value;    my $name = $src->get_attribute ('Name', make_new_node => 1)->value;
531    $name =~ s/(?=.)-/_/g;    $name =~ s/(?<=.)-/_/g;
532    my $main = code $Info, $src->get_attribute_value ('Formatting');    
533    $main = q{my ($p, $o) = @_;}."\n" . $main    my $reg_block;
534      if $main =~ /\$p/ || $main =~ /\$o/;    $reg_block = qr/[^{}]*(?>[^{}]+|{(??{$reg_block})})*/;
535    if ($main =~ /\$r/) {    my %code;
536      $main = q{my $r = '';} . "\n" . $main;    for my $codename ([qw/Formatting main/], [qw/After after/],
537      $main .= q{$r};                      [qw/Before before/], [qw/Pre pre/], [qw/Post post/],
538                        [qw/Attribute attr/]) {
539        my $main = code $Info, $src->get_attribute_value ($codename->[0]);
540        next unless $main;
541        $main = line ($Info, node_path =>
542                  "FormattingRule[name()='@{[list $type]}/$name']/".$codename->[0])
543              . $main;
544        
545        if ( $main =~ /\$f\b/
546          or $main =~ /\$rule_name\b/
547          or $main =~ /\$[opr]\b/
548          or $main =~ /[%\$]opt\b/
549          or $main =~ /\$param_(?:name|value)\n/) {
550          if ($codename->[0] ne 'Attribute') {
551            $main = q{my ($f, $rule_name, $p, $o, %opt) = @_;}."\n".$main;
552          } else {
553            $main = q{my ($f, $rule_name, $p, $o, $param_name => $param_value, %opt) = @_;}."\n".$main;
554          }
555        }
556        if ($main =~ /\$r\b/) {
557          warn qq(Rule @{[list $type]}/$name: Use of \$r is deprecated);
558          $main = q{my $r = '';} . "\n" . $main . "\n"
559                . q{$p->{-parent}->append_node ($r, node_or_text => 1);};
560        }
561        $main =~ s{__ATTR(TEXT|NODE)?:%(\w+|{$reg_block})(?:->{($reg_block)})?__;}
562                  {($1 eq 'TEXT' ? '$p->{'.literal_or_code($Info, $2)
563                                          .'} = do { my $r = ' : '')
564                   .'$f->parse_attr ($p=>'.literal_or_code($Info, $2).', $o, '
565                                   .($3?'-parent => '.$3.', ':'')
566                                   .($1?'-non_parsed_to_node => 1, ':'')
567                                   .'%opt)'
568                                   .($1 eq 'TEXT' ? '; ref $r?$r->inner_text:$r}'
569                                                  : '')
570                                   .';'}ge;
571        $code{$codename->[1]} = barecode "sub {$main}";
572    }    }
573        
574    my $main = <<EOH;    my $main = literal {
575        Description => [barecode m13ed_val_list $src, 'Description'],
576        Parameter => {do {
577          my @r;
578          for (@{$src->child_nodes}) {
579            if ($_->local_name eq 'Parameter') {
580              push @r, $_->get_attribute_value ('Name')
581                       => {Type => $_->get_attribute_value ('Type'),
582                           Default => $_->get_attribute_value ('Default'),
583                           Description => [barecode m13ed_val_list $_, 'Description']};
584            }
585          }
586          @r;
587        }},
588        %code,
589      };
590      $main .= line $Info, reset => 1;
591    
592    
593    my  $amain = <<EOH;
594  {  {
595    Formatting => sub {$main},    main => sub {$main},
596    @{[line ($Info, reset => 1)]}
597    Description => [@{[m13ed_val_list $src, 'Description']}],    Description => [@{[m13ed_val_list $src, 'Description']}],
598    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;  
599    }]}},    }]}},
600  }  }
601  EOH  EOH
602    my $r;    my $r = change_package $Info, $Info->{module_name};
603      local $Info->{-message_error_used} = 0;  
604    if (@$type == 1) {    if (@$type == 1) {
605      $type->[0] =~ tr/-/_/;      $type->[0] =~ tr/-/_/;
606      $r = qq{\$SuikaWiki::Plugin::Rule{$type->[0]}->{$name} = $main;\n};      $r .= qq{\$SuikaWiki::Plugin::Rule{$type->[0]}->{$name} = $main;\n};
607      push @{$Info->{provide}->{rule}->{$type->[0]}}, $name;      push @{$Info->{provide}->{rule}->{$type->[0]}}, $name;
608    } else {    } else {
609      $r = qq({my \$def = $main;\n);      $r .= qq({my \$def = $main;\n);
610      for my $type (@$type) {      for my $type (@$type) {
611        $type =~ tr/-/_/;        $type =~ tr/-/_/;
612        $r .= qq{\$SuikaWiki::Plugin::Rule{$type}->{$name} = \$def;\n};        $r .= qq{\$SuikaWiki::Plugin::Rule{$type}->{$name} = \$def;\n};
# Line 355  EOH Line 617  EOH
617    $r;    $r;
618  }  }
619    
620    =item FormattingRuleAlias
621    
622    Generating an alias name for a formatting rule that is already loaded.
623    Example:
624    
625      FormattingRuleAlias:
626        @Category[list]:
627          category-1
628          category-2
629          ...
630        @Name: new-rule-name
631        @Reference:
632          @@Category: one-of-category
633          @@Name: one-of-name
634    
635    associates C<(I<category-1>, I<new-rule-name>)>,
636    C<(I<category-2>, I<new-rule-name>)>, ...
637    with C<(I<one-of-category>, I<one-of-name>)>.
638    
639    =cut
640    
641    sub make_rule_alias ($$) {
642      my ($src, $Info) = @_;
643      my $type = $src->get_attribute ('Category', make_new_node => 1)->value || [];
644      my $name = $src->get_attribute ('Name', make_new_node => 1)->value;
645      
646      my $ref = $src->get_attribute ('Reference', make_new_node => 1);
647      my $c = $ref->get_attribute_value ('Category');
648      my $n = $ref->get_attribute_value ('Name');
649      
650      s/(?<=.)-/_/g for $n, $name;
651      tr/-/_/ for $c, @$type;
652      
653      my $def = qq{\$SuikaWiki::Plugin::Rule{@{[literal $c]}}->{@{[literal $n]}} or warn qq{Formatting rule "$c/$n" not defined}};
654      
655      my $r = change_package $Info, $Info->{module_name};
656      for my $type (@$type) {
657        $r .= qq{\$SuikaWiki::Plugin::Rule{@{[literal $type]}}->{@{[literal $name]}} = $def;\n};
658        push @{$Info->{provide}->{rule}->{$type}}, $name;
659      }
660      $r;
661    }
662    
663    
664  sub random_module_name ($;$) {  sub random_module_name ($;$) {
665    my ($Info, $subname) = @_;    my ($Info, $subname) = @_;
# Line 365  sub random_module_name ($;$) { Line 670  sub random_module_name ($;$) {
670      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]),
671      join ('', @rand[rand@rand,rand@rand,rand@rand,rand@rand]);      join ('', @rand[rand@rand,rand@rand,rand@rand,rand@rand]);
672  }  }
673    
674    =head1 NAME
675    
676    mkplugin2.pl - SuikaWiki: WikiPlugin Generator
677    
678    =head1 SYNOPSIS
679    
680      mkplugin2.pl pluginsrc.wp2 > plugin.pm
681    
682    =head1 DESCRIPTION
683    
684    C<mkplugin2.pl> generates WikiPlugin module as a Perl module file
685    from WikiPlugin source description.  WikiPlugin source description
686    is described in SuikaWikiConfig/2.0 format and it contains
687    definitions of wiki constructions (such as formatting rules and
688    WikiView definitions) as both machine understandable code and
689    human readable documentation.  For more information, see
690    <http://suika.fam.cx/~wakaba/-temp/wiki/wiki?WikiPlugin>.
691    
692    This script is part of SuikaWiki.
693    
694    =head1 HISTORY AND COMPATIBILITY
695    
696    C<mkplugin2.pl> introduced as part of SuikaWiki 3.
697    It converts SuikaWiki 3 WikiPlugin source descriptions
698    (in SuikaWikiConfig/2.0) into Perl modules with SuikaWiki 3 interface.
699    
700    SuikaWiki 2 has C<mkplugin.pl>.  It also converts WikiPlugin
701    source descriptions into Perl modules.  But it support
702    SuikaWiki 2 format of WikiPlugin source description that differs from
703    SuikaWiki 3 format.  Wiki programming interface (not limited to
704    WikiPlugin related one) of SuikaWiki 3 also incompatible with that
705    of SuikaWiki 2 so that it is impossible to use SuikaWiki 2 WikiPlugin
706    module with SuikaWiki 3 and vice versa.
707    
708    =head1 SEE ALSO
709    
710    C<SuikaWiki::Plugin>, SuikaWiki:WikiPlugin
711    <http://suika.fam.cx/~wakaba/-temp/wiki/wiki?WikiPlugin>.
712    
713    =head1 LICENSE
714    
715    Copyright 2003-2004 Wakaba <w@suika.fam.cx>.  All rights reserved.
716    
717    This program is free software; you can redistribute it and/or
718    modify it under the same terms as Perl itself.
719    
720    =cut
721    
722    1; # $Date$
Legend:
Removed from v.1.2  
changed lines
  Added in v.1.15
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24