/[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.20 by wakaba, Tue Sep 21 03:18:21 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 =~ s/__FUNCPACK{([^{}]+)}__/(\$SuikaWiki::Plugin::Registry::Info{@{[literal $1]}}->{module_name} || SuikaWiki::Plugin->module_package (@{[literal $1]}))/g;
63      $code =~ s{<Q:([^:]+):([^>]+)>}{
64        if ($Info->{Namespace}->{$1}) {
65          literal $Info->{Namespace}->{$1}.$2;
66        } else {
67          warn qq(Namespace prefix "$1" not defined);
68          literal $2;
69        }
70      }ge;
71      
72      $Info->{-message_error_used} = 1 if $code =~ /\buse\s+Message::Util::Error\b/;
73      if (not $Info->{-message_error_used} and
74         ($code =~ /\btry\s*\{/ or $code =~ /\bcatch\s*\{/)) {
75        warn "Message::Util::Error MUST be 'use'd before 'try'...'catch' block used";
76      }
77    $code;    $code;
78  }  }
79    sub change_package ($$) {
80      my ($Info, $pack) = @_;
81      unless ($Info->{current_package} eq $pack) {
82        $Info->{current_package} = $pack;
83        return qq{package $pack;\n\n};
84      } else {
85        return '';
86      }
87    }
88    sub quoted_string ($) {
89      my $s = shift;
90      $s =~ s/([\\"])/\\$1/g;
91      '"'.$s.'"';
92    }
93    sub line ($;%) {
94      my ($Info, %opt) = @_;
95      
96      unless ($opt{file}) {
97        if ($opt{reset}) {
98          $opt{file} = sprintf '(WikiPlugin module %s, chunk %d)',
99                               $Info->{Name},
100                               ++$Info->{chunk_count};
101        } elsif ($opt{realfile}) {
102          $opt{file} = sprintf '(WikiPlugin module %s, chunk from %s)',
103                               $Info->{Name},
104                               $opt{realfile};
105        } else {
106          $opt{file} = sprintf '(WikiPlugin module source %s, block %s)',
107                               $Info->{source_file},
108                               $opt{node_path};
109        }
110      }
111      
112      $opt{file} =~ s/"/''/g;
113      sprintf '%s#line %d "%s"%s', "\n", $opt{line_no} || 1, $opt{file}, "\n";
114    }
115    sub literal_or_code ($$) {
116      my ($Info, $s) = @_;
117      substr ($s, 0, 1) ne '{' ? literal ($s)
118                               : code ($Info, substr ($s, 1, length ($s) - 2));
119    }
120    sub expanded_uri ($$$) {
121      my ($Info, $prefix, $lname) = @_;
122      warn "$0: $prefix: Namespace prefix not declared"
123        unless $Info->{Namespace}->{$prefix};
124      $Info->{Namespace}->{$prefix} . $lname;
125    }
126    
127  my $parser = SuikaWiki::Markup::SuikaWikiConfig20::Parser->new;  my $parser = Message::Markup::SuikaWikiConfig20::Parser->new;
128  my $plugins = $parser->parse_text ($src);  my $plugins = $parser->parse_text ($src);
129  my $meta = $plugins->get_attribute ('Plugin')  my $meta = $plugins->get_attribute ('Plugin')
130            or die "$0: Required 'Plugin' section not found";            or die "$0: Required 'Plugin' section not found";
131  my %Info = (provide => {},  my %Info = (provide => {},
132              Name => n11n $meta->get_attribute ('Name')->value);              Name => n11n $meta->get_attribute ('Name')->value);
133    $Info{source_file} = $srcfile;
134  $Info{name_literal} = literal $Info{Name};  $Info{name_literal} = literal $Info{Name};
135  my @date = gmtime;  my @date = gmtime;
136  $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 144  $Info{module_name} = random_module_name
144    
145  print <<EOH;  print <<EOH;
146  use strict;  use strict;
147  package SuikaWiki::Plugin::Registry;  @{[change_package \%Info, 'SuikaWiki::Plugin::Registry']}
148  our \%Info;  our \%Info;
149  \$Info{$Info{name_literal}}->{Name} = $Info{name_literal};  \$Info{$Info{name_literal}}->{Name} = $Info{name_literal};
150  EOH  EOH
151  for (qw/Version InterfaceVersion mkpluginVersion/) {  for (qw/Version InterfaceVersion mkpluginVersion module_name/) {
152    print qq{\$Info{$Info{name_literal}}->{$_} = v$Info{$_};\n};    print qq{\$Info{$Info{name_literal}}->{@{[literal $_]}} = @{[literal $Info{$_}]};\n};
153  }  }
154  for (qw/LastModified/) {  for (qw/LastModified Date.RCS/) {
155    $Info{$_} = n11n $meta->get_attribute ($_,make_new_node=>1)->value;    $Info{$_} = n11n $meta->get_attribute ($_,make_new_node=>1)->value;
156    next unless length $Info{$_};    next unless length $Info{$_};
157    print qq{\$Info{$Info{name_literal}}->{$_} = } . literal $Info{$_};    print qq{\$Info{$Info{name_literal}}->{@{[literal $_]}} = } . literal $Info{$_};
158    print ";\n";    print ";\n";
159  }  }
160  for (qw/RequiredPlugin RequiredModule/) {  for (qw/RequiredPlugin RequiredModule/) {
# Line 116  print qq{\$Info{$Info{name_literal}}->{A Line 179  print qq{\$Info{$Info{name_literal}}->{A
179  } grep { $_->local_name eq 'Author' } @{$meta->child_nodes}  } grep { $_->local_name eq 'Author' } @{$meta->child_nodes}
180  ). qq{];\n};  ). qq{];\n};
181    
182    for (@{$meta->get_attribute ('Namespace', make_new_node => 1)->child_nodes}) {
183      $Info{Namespace}->{$_->local_name} = $_->value;
184    }
185    
186    my $use = $meta->get_attribute ('Use');
187    if (ref $use) {
188      print change_package \%Info, $Info{module_name};
189      print line \%Info, node_path => 'Plugin/Use';
190      print code \%Info, $use->inner_text;
191      print line \%Info, reset => 1;
192    }
193    
194  for (@{$plugins->child_nodes}) {  for (@{$plugins->child_nodes}) {
195    if ($_->local_name eq 'FormattingRule') {    if ($_->local_name eq 'FormattingRule') {
196      print "\n", make_rule ($_, \%Info);      print "\n", make_rule ($_, \%Info);
# Line 129  for (@{$plugins->child_nodes}) { Line 204  for (@{$plugins->child_nodes}) {
204      print "\n", make_resdef ($_, \%Info);      print "\n", make_resdef ($_, \%Info);
205    } elsif ($_->local_name eq 'PluginConst') {    } elsif ($_->local_name eq 'PluginConst') {
206      register_plugin_const ($_, \%Info);      register_plugin_const ($_, \%Info);
207      } elsif ($_->local_name eq 'Format') {
208        print "\n", make_format ($_, \%Info);
209      } elsif ($_->local_name eq 'FormattingRuleAlias') {
210        print "\n", make_rule_alias ($_, \%Info);
211    # Parameter
212    # PluginCategory
213    }    }
214  }  }
215    
216  print qq{\npackage SuikaWiki::Plugin::Registry;\n\n};  print change_package \%Info, q(SuikaWiki::Plugin::Registry);
217  print qq{\$Info{$Info{name_literal}}->{provide} = } . literal $Info{provide};  print qq{\$Info{$Info{name_literal}}->{provide} = } . literal $Info{provide};
218  print qq{;\n};  print qq{;\n};
219    
# Line 140  print "\n1;\n"; Line 221  print "\n1;\n";
221  exit;  exit;
222  }  }
223    
224    sub make_format ($$) {
225      my ($src, $Info) = @_;
226      my $module_name = 'SuikaWiki::Format::Definition::'.$src->get_attribute_value ('ModuleName');
227      my $r = change_package $Info, $module_name;
228      local $Info->{-message_error_used} = 0;  
229      $r .= qq{our \@ISA;\n};
230      if (my $isa = $src->get_attribute_value ('Inherit')) {
231        for (@$isa) {
232          $r .= qq{push \@ISA, @{[literal 'SuikaWiki::Format::Definition::'.$_]};\n};
233        }
234      } else {
235        $r .= qq{push \@ISA, 'SuikaWiki::Format::Definition::template';\n};    
236      }
237      if (my $name = $src->get_attribute_value ('Name')) {
238        $r .= qq{\$SuikaWiki::Format::Definition::Class{@{[literal 'MAGIC:'.$name.'/'.$src->get_attribute_value ('Version', default => '').'##']}} = '$module_name';\n};
239      }
240      if (my $type = $src->get_attribute_value ('Type')) {
241        $type .= join '', map {
242                   ';'. $_->local_name .'='. quoted_string $_->inner_text
243                 } sort {
244                   $a->local_name cmp $b->local_name
245                 } @{$src->get_attribute ('Type')->child_nodes};
246        $r .= qq{\$SuikaWiki::Format::Definition::Class{@{[literal 'IMT:'.$type.'##']}} = '$module_name';\n};
247      }
248      
249      my $convert = line $Info, line_no => __LINE__ + 2, realfile => __FILE__;
250      $convert .= <<'EOH';
251    our $Converter;
252    sub convert ($$;%) {
253      my ($self, $source, %opt) = @_;
254      my $t = SuikaWiki::Format::Definition->serialize_media_type (%opt);
255      my $converter = $Converter->{$t->{_}};
256      return ($converter->{$opt{return_type} or 'Main'} or
257              CORE::die "Buggy implementation: $t->{_}/@{[$opt{return_type} or 'Main']} not defined")
258             ->($self, $source, \%opt)
259        if $converter;
260      $self->SUPER::convert ($source, %opt);
261    }
262    EOH
263      
264      for (@{$src->child_nodes}) {
265        if ($_->local_name eq 'Converter') {
266          if ($convert) {
267            $r .= $convert;
268            $r .= line $Info, reset => 1;
269            undef $convert;
270          }
271          $r .= make_format_converter ($_, $Info);
272        } elsif ($_->local_name eq 'WikiForm') {
273          $r .= q(sub wikiform {)."\n".q(my ($self, $source, %opt) = @_;);
274          $r .= line $Info, node_path => qq(Format[module-name()=$module_name]/WikiForm);
275          $r .= code $Info, $_->get_attribute_value ('Main');
276          $r .= line $Info, reset => 1;
277          $r .= qq(}\n);
278        } elsif ($_->local_name eq 'HeadSummary') {
279          $r .= q(sub headsummary {)."\n".q(my ($self, $source, %opt) = @_;);
280          $r .= line $Info, node_path => qq(Format[module-name()=$module_name]/HeadSummary);
281          $r .= code $Info, $_->get_attribute_value ('Main');
282          $r .= line $Info, reset => 1;
283          $r .= qq(}\n);
284        } elsif ($_->local_name eq 'NextIndex') {
285          my $name = $_->get_attribute_value ('Name', default => '');
286          $r .= q(sub next_index_for_).$name
287             .  q( {)."\n".q(my ($self, $source, %opt) = @_;)
288             .  line $Info, node_path => qq(Format[module-name()=$module_name]/NextIndex[Name=$name]);
289          $r .= code $Info, $_->get_attribute_value ('Main');
290          $r .= line $Info, reset => 1;
291          $r .= qq(}\n);
292        } elsif ({qw/content_written 1 content_removed 1 content_type_changed_from 1
293                     content_prop_modified 1/}
294                 ->{my $node_name = $_->local_name}) {
295          $r .= q(sub ).$node_name
296             .  q( {)."\n".q(my ($self, %opt) = @_;)
297             .  line $Info, node_path => qq(Format[module-name()=$module_name]/$node_name]);
298          $r .= code $Info, $_->get_attribute_value ('Main');
299          $r .= line $Info, reset => 1;
300          $r .= qq(}\n);
301        } elsif ($_->local_name eq 'Use') {
302          $r .= line $Info, node_path => qq(Format[module-name()=$module_name]/Use);
303          $r .= code $Info, $_->inner_text;
304        } elsif ($_->local_name eq 'Prop') {
305          $r .= q<sub prop ($$;%) { my ($self, $name, %opt) = @_;>;
306          my $f = 0;
307          for my $prop (@{$_->child_nodes}) {
308            if ($prop->local_name =~ /^([^:]+):([^:]+)$/) {
309              $r .= qq{if (\$name eq @{[literal expanded_uri $Info, $1, $2]}) { return @{[literal $prop->value]} } els};
310              $f = 1;
311            }
312          }
313          $r .= q<e {> if $f;
314          $r .= q{$self->SUPER::prop ($name, %opt);};
315          $r .= q<}> if $f;
316          $r .= qq<\n}\n>;
317        }
318      }
319      $r;
320    }
321    
322    sub make_format_converter ($$) {
323      my ($src, $Info) = @_;
324      my %def;
325      for (qw/Type Name Version TypeURIReference IsFragment IsPlaceholder/) {
326        $def{$_} = $src->get_attribute_value ($_);
327        delete $def{$_} unless defined $def{$_};
328      }
329      $def{Type_param} = {map {$_->local_name => $_->value}
330                                  @{$src->get_attribute ('Type', make_new_node => 1)
331                                      ->child_nodes}};
332      my $type = serialize_media_type ($Info,
333                   Type => $def{Type},
334                   Type_param => $def{Type_param},
335                   Name => $def{Name},
336                   Version => $def{Version},
337                   URIReference => $def{TypeURIReference},
338                   IsFragment => $def{IsFragment},
339                   IsPlaceholder => $def{IsPlaceholder});
340      $def{serialized_type} = $type->{_};
341      
342      for (qw/Main ToString ToOctetStream/) {
343        my $def = $src->get_attribute_value ($_);
344        next unless $def;
345        $def{$_} = line ($Info, node_path => '//Converter/'.$_)
346                   . $def
347                   . line ($Info, reset => 1);
348        if ($def{$_} =~ /\$r\b/) {
349          $def{$_} = 'my $r;'."\n".$def{$_}."\n".'$r';
350        }
351        $def{$_} = barecode code $Info,
352                     'sub {my ($self, $source, $opt) = @_;'
353                   . $def{$_} . '}';
354      }
355      
356      my $r = list %def;
357      if ($type->{Type}) {
358        $r = qq{\$Converter->{@{[literal $type->{Type}]}} = {$r};\n};
359        $r .= qq{\$Converter->{@{[literal $type->{Magic}]}} = \$Converter->{@{[literal $type->{Type}]}};\n}
360          if $type->{Magic};
361        $r .= qq{\$Converter->{@{[literal $type->{URIReference}]}} = \$Converter->{@{[literal $type->{Type}]}};\n}
362          if $type->{URIReference};
363      } elsif ($type->{Magic}) {
364        $r = qq{\$Converter->{@{[literal $type->{Magic}]}} = {$r};\n};
365        $r .= qq{\$Converter->{@{[literal $type->{URIReference}]}} = \$Converter->{@{[literal $type->{Magic}]}};\n}
366          if $type->{URIReference};
367      } elsif ($type->{URIReference}) {
368        $r = qq{\$Converter->{@{[literal $type->{URIReference}]}} = {$r};\n};
369      } else {
370        $r = 'BEGIN { die "Invalid Syntax of Converter: Type or Name or TypeURIReference property required" }';
371      }
372      $r;
373    }
374    
375    sub serialize_media_type ($%) {
376      my ($Info, %opt) = @_;
377      my %return;
378      if ($opt{Type}) {
379        $return{Type} = 'IMT:'.$opt{Type};
380        if ($opt{Type_param}) {
381          $return{Type} .= join '', map {my $s;
382                             ';'. $_ .'="'
383                           . (($s = $opt{Type_param}->{$_}) =~ s/([\\"])/\\$1/g, $s)
384                           . '"'
385                           } sort {
386                             $a cmp $b
387                           } keys %{$opt{Type_param}};
388        }
389      }
390      if ($opt{Magic}) {
391        $return{Magic} = 'MAGIC:'.$opt{Magic};
392      } elsif ($opt{Name}) {
393        $return{Name} = 'MAGIC:'.$opt{Name}.'/*';
394        $return{Magic} = 'MAGIC:'.$opt{Name}.'/'.$opt{Version} if $opt{Version};
395      }
396      if ($opt{URIReference}) {
397        $return{URIReference} = $opt{URIReference};
398      }
399      my $flag = '##';
400      $flag .= 'f' if $opt{IsFragment};
401      $flag .= 'p' if $opt{IsPlaceholder};
402      for (qw/URIReference Type Magic Name/) {
403        $return{$_} .= $flag if $return{$_};
404      }
405      $return{_} = $return{URIReference} || $return{Type}
406                || $return{Magic} || $return{Name};
407      \%return;
408    }
409    
410    
411  sub make_function ($$) {  sub make_function ($$) {
412    my ($src, $Info) = @_;    my ($src, $Info) = @_;
413    ## TODO: support of ARGV property    ## TODO: support of ARGV property
414      my $name;
415    my $r = <<EOH;    my $r = <<EOH;
416  package $Info->{module_name};  @{[change_package $Info, $Info->{module_name}]}
417  sub @{[$src->get_attribute_value ('Name')]} {  sub @{[$name = $src->get_attribute_value ('Name')]} {
418    @{[code $Info, $src->get_attribute_value ('Main')]}  @{[line $Info, node_path => "Function[Name='$name']/Main"]}@{[
419      code $Info, $src->get_attribute_value ('Main')
420    ]}
421  }  }
422    @{[line $Info, reset => 1]}
423  EOH  EOH
424  }  }
425    
426  sub register_plugin_const ($$) {  sub register_plugin_const ($$) {
427    my ($src, $Info) = @_;    my ($src, $Info) = @_;
428    for (@{$src->child_nodes}) {    for (@{$src->child_nodes}) {
429      $Info->{const}->{$_->local_name} = $_->value;      $Info->{const}->{$_->local_name} = literal_or_code $Info, $_->value;
430    }    }
431  }  }
432    
433  sub make_resdef ($$) {  sub make_resdef ($$) {
434    my ($src, $Info) = @_;    my ($src, $Info) = @_;
435    my $r = qq{package SuikaWiki::Plugin::Resource;\nour \$BaseResource;\n};    my $r = change_package $Info, 'SuikaWiki::Plugin::Resource';
436      local $Info->{-message_error_used} = 0;  
437      $r .= qq{our \$BaseResource;\n};
438    for (@{$src->child_nodes}) {    for (@{$src->child_nodes}) {
439      if ($_->node_type eq '#element') {      if ($_->node_type eq '#element') {
440        my $lang = literal ($_->get_attribute_value ('lang') || 'und');        my $lang = literal ($_->get_attribute_value ('lang') || 'und');
# Line 176  sub make_resdef ($$) { Line 450  sub make_resdef ($$) {
450  sub make_viewfragment ($$) {  sub make_viewfragment ($$) {
451    my ($src, $Info) = @_;    my ($src, $Info) = @_;
452    my $r = '';    my $r = '';
453    my $name = $src->get_attribute_value ('Name');    my $body = <<EOH;
454    $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]}}}, {  
455      Main => @{[literal $src->get_attribute_value ('Formatting')]},      Main => @{[literal $src->get_attribute_value ('Formatting')]},
456      Order => @{[0+$src->get_attribute_value ('Order')]},      Order => @{[0+$src->get_attribute_value ('Order')]},
457      Description => [@{[m13ed_val_list $src, 'Description']}],      Description => [@{[m13ed_val_list $src, 'Description']}],
458    };    };
459  EOH  EOH
460    push @{$Info->{provide}->{viewfragment}},    ## Recommended format
461         {Name => $src->get_attribute ('Name')->value};    my $name = $src->get_attribute_value ('Template');
462      if (ref ($name) and @$name > 1) {
463        $r .= qq({my \$def = $body;\n);
464        for (@$name) {
465          my $name = $_; $name =~ tr/-/_/;
466          $r .= qq(push \@{\$SuikaWiki::View::Implementation::TemplateFragment{@{[literal $name]}}}, \$def;\n);
467          push @{$Info->{provide}->{viewfragment}}, {Name => $name};
468        }
469        $r .= qq(}\n);
470      } else {                           ## Obsoleted format
471        $name = ref $name ? $name->[0] : $src->get_attribute_value ('Name');
472        $name =~ tr/-/_/;
473        $r .= qq(push \@{\$SuikaWiki::View::Implementation::TemplateFragment{@{[literal $name]}}}, $body);
474        push @{$Info->{provide}->{viewfragment}}, {Name => $name};
475      }
476    $r;    $r;
477  }  }
478    
# Line 198  sub make_viewdef ($$) { Line 480  sub make_viewdef ($$) {
480    my ($src, $Info) = @_;    my ($src, $Info) = @_;
481    my $ViewProp = {};    my $ViewProp = {};
482    my $r = '';    my $r = '';
483    $ViewProp->{Name} = n11n $src->get_attribute ('Mode')->value;    $ViewProp->{Name} = n11n $src->get_attribute_value ('Mode');
484      $ViewProp->{Name} =~ s/(?<=.)-/_/g;
485    $ViewProp->{pack_name} = random_module_name ($Info, $ViewProp->{Name});    $ViewProp->{pack_name} = random_module_name ($Info, $ViewProp->{Name});
486        
487    $ViewProp->{condition_stringified} = hash    $ViewProp->{condition_stringified} = hash
# Line 211  push \@SuikaWiki::View::Implementation:: Line 494  push \@SuikaWiki::View::Implementation::
494    condition => {$ViewProp->{condition_stringified}},    condition => {$ViewProp->{condition_stringified}},
495    object_class => q#$ViewProp->{pack_name}#,    object_class => q#$ViewProp->{pack_name}#,
496  };  };
497  package $ViewProp->{pack_name};  @{[change_package $Info, $ViewProp->{pack_name}]}
498  our \@ISA = q#SuikaWiki::View::template#;  our \@ISA = q#SuikaWiki::View::template#;
499  EOH  EOH
500      local $Info->{-message_error_used} = 0;  
501      my $use = $src->get_attribute ('Use');
502      if (ref $use) {
503        $r .= line $Info, node_path => "ViewDefinition[Mode='$ViewProp->{Name}']/Use";
504        $r .= code $Info, $use->inner_text;
505        $r .= "\n\n";
506      }
507      
508    for (@{$src->child_nodes}) {    for (@{$src->child_nodes}) {
509      if ($_->local_name eq 'template') {      if ($_->local_name eq 'template') {
510        $r .= make_view_template_method ($_, $Info);        $r .= make_view_template_method ($_, $Info, $ViewProp);
511      } elsif ($_->local_name eq 'method') {      } elsif ($_->local_name eq 'method') {
512          my $method_name = $_->get_attribute_value ('Name');
513        $r .= ({        $r .= ({
514                main => q(sub main ($$) {)."\n".q(my ($self, $opt) = @_;)."\n",                main => q(sub main ($$) {)."\n".q(my ($self, $opt, $opt2) = @_;)."\n",
515                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",
516                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",                    
517               }->{$_->get_attribute ('Name')->value}               }->{$method_name}
518               ||qq(sub @{[$_->get_attribute ('Name')->value]} {\n))               ||qq(sub @{[$method_name]} {\n))
519             . line ($Info, node_path => "ViewDefinition[Mode='$ViewProp->{Name}']/method[Name='$method_name']")
520           . code ($Info, $_->value)           . code ($Info, $_->value)
521           . qq(\n}\n);           . qq(}\n)
522             . line ($Info, reset => 1);
523      }      }
524    }    }
525    my $prop = {Name => $ViewProp->{Name},    my $prop = {Name => $ViewProp->{Name},
# Line 235  EOH Line 529  EOH
529  }  }
530    
531  sub make_view_template_method ($$) {  sub make_view_template_method ($$) {
532    my ($src, $info) = @_;    my ($src, $Info, $ViewProp) = @_;
533      my $media_type = $src->get_attribute_value
534                                ('media-type',
535                                 default => q<application/octet-stream>);
536    my $r = <<EOH;    my $r = <<EOH;
537    
538  sub main (\$\$\$) {  sub main (\$\$\$) {
# Line 251  sub main (\$\$\$) { Line 548  sub main (\$\$\$) {
548        
549    \$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]};
550    \$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)  
     ]}},  
551                        ## SuikaWiki 3 WikiPlugin interface                        ## SuikaWiki 3 WikiPlugin interface
552                          wiki => \$self->{view}->{wiki},                          wiki => \$self->{view}->{wiki},
553                          plugin => \$self->{view}->{wiki}->{plugin},                          plugin => \$self->{view}->{wiki}->{plugin},
# Line 275  sub main (\$\$\$) { Line 556  sub main (\$\$\$) {
556    @{[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;
557       $x?q{$opt2->{output}->{status_code} = }.(0 + $x).q{;}:q{}}]}       $x?q{$opt2->{output}->{status_code} = }.(0 + $x).q{;}:q{}}]}
558    @{[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;
559       $x?q{$opt2->{output}->{reason_phrase} = }.literal($x).q{;}:q{}}]}       $x?q{$opt2->{output}->{status_phrase} = }.literal($x).q{;}:q{}}]}
560    \$opt2->{output}->{entity}->{media_type} = @{[literal    \$opt2->{output}->{entity}->{media_type} = @{[literal $media_type]};
561                             $src->get_attribute ('media-type',make_new_node=>1)  
                                ->inner_text || 'application/octet-stream']};  
562    @{[($src->get_attribute ('use-media-type-charset',make_new_node=>1)    @{[($src->get_attribute ('use-media-type-charset',make_new_node=>1)
563              ->inner_text || 0) ?              ->inner_text || 0) ?
564       q{$opt2->{output}->{entity}->{charset} = $self->{view}->{wiki}->{config}->{charset}->{output};}:       q{$opt2->{output}->{entity}->{charset} = $self->{view}->{wiki}->{config}->{charset}->{output};}:
# Line 290  sub main (\$\$\$) { Line 570  sub main (\$\$\$) {
570              qq{\$opt2->{output}->set_expires (delta => @{[0 + $x]});};              qq{\$opt2->{output}->set_expires (delta => @{[0 + $x]});};
571            }            }
572        }]}        }]}
573      \$opt2->{output}->{entity}->{body_is_octet_stream} = @{[
574        $src->get_attribute ('body')->get_attribute_value ('is-octet-stream', default_value => 0)
575        or 0
576      ]};
577        
578    \$self->{view}->{wiki}->init_db;    \$self->{view}->{wiki}->init_db;
579    \$self->main_pre (\$opt, \$opt2);    \$self->main_pre (\$opt, \$opt2);
580        
581    ## TODO: formal SuikaWiki 3 interface    @{[$media_type eq 'text/html' ? q{require Message::Markup::XML::Serialize::HTML;} : '']}
582    my \$fmt = SuikaWiki::Plugin->formatter ('view');    use Message::Util::Error;
583    \$opt2->{output}->{entity}->{body}    try {
584      = \$fmt->replace (\$opt2->{template} => \$opt2->{o},      \$opt2->{output}->{entity}->{body}
585                        {formatter => \$fmt});        = @{[$media_type eq 'text/html' ? q{Message::Markup::XML::Serialize::HTML::html_simple} : '']}
586            (SuikaWiki::Plugin->formatter ('view')
587            ->replace (\$opt2->{template}, param => \$opt2->{o}));
588      } \$self->{view}->{wiki}->{config}->{catch}->{ @{[
589           $ViewProp->{Name} eq '-error' ? 'formatter_view_error'
590                                         : 'formatter_view' ]} };
591    \$opt2->{output}->output (output => 'http-cgi');    \$opt2->{output}->output (output => 'http-cgi');
592        
593    \$self->main_post (\$opt, \$opt2);    \$self->main_post (\$opt, \$opt2);
# Line 306  sub main (\$\$\$) { Line 595  sub main (\$\$\$) {
595  EOH  EOH
596  }  }
597    
 ## TODO: Implements SuikaWiki 3 interface  
598  sub make_rule ($$) {  sub make_rule ($$) {
599    my ($src, $Info) = @_;    my ($src, $Info) = @_;
600    my $type = $src->get_attribute ('Category', make_new_node => 1)->value || [];    my $type = $src->get_attribute ('Category', make_new_node => 1)->value || [];
601    my $name = $src->get_attribute ('Name', make_new_node => 1)->value;    my $name = $src->get_attribute ('Name', make_new_node => 1)->value;
602    $name =~ s/(?=.)-/_/g;    $name =~ s/(?<=.)-/_/g;
603    my $main = code $Info, $src->get_attribute_value ('Formatting');    
604    $main = q{my ($p, $o) = @_;}."\n" . $main    my $reg_block;
605      if $main =~ /\$p/ || $main =~ /\$o/;    $reg_block = qr/[^{}]*(?>[^{}]+|{(??{$reg_block})})*/;
606    if ($main =~ /\$r/) {    my %code;
607      $main = q{my $r = '';} . "\n" . $main;    for my $codename ([qw/Formatting main/], [qw/After after/],
608      $main .= q{$r};                      [qw/Before before/], [qw/Pre pre/], [qw/Post post/],
609                        [qw/Attribute attr/]) {
610        my $main = code $Info, $src->get_attribute_value ($codename->[0]);
611        next unless $main;
612        $main = line ($Info, node_path =>
613                  "FormattingRule[name()='@{[list $type]}/$name']/".$codename->[0])
614              . $main;
615        
616        if ( $main =~ /\$f\b/
617          or $main =~ /\$rule_name\b/
618          or $main =~ /\$[opr]\b/
619          or $main =~ /[%\$]opt\b/
620          or $main =~ /\$param_(?:name|value)\n/) {
621          if ($codename->[0] ne 'Attribute') {
622            $main = q{my ($f, $rule_name, $p, $o, %opt) = @_;}."\n".$main;
623          } else {
624            $main = q{my ($f, $rule_name, $p, $o, $param_name => $param_value, %opt) = @_;}."\n".$main;
625          }
626        }
627        if ($main =~ /\$r\b/) {
628          warn qq(Rule @{[list $type]}/$name: Use of \$r is deprecated);
629          $main = q{my $r = '';} . "\n" . $main . "\n"
630                . q{$p->{-parent}->append_node ($r, node_or_text => 1);};
631        }
632        $main =~ s{__ATTR(TEXT|NODE)?:%(\w+|{$reg_block})(?:->{($reg_block)})?__;}
633                  {($1 eq 'TEXT' ? '$p->{'.literal_or_code($Info, $2)
634                                          .'} = do { my $r = ' : '')
635                   .'$f->parse_attr ($p=>'.literal_or_code($Info, $2).', $o, '
636                                   .($3?'-parent => '.$3.', ':'')
637                                   .($1?'-non_parsed_to_node => 1, ':'')
638                                   .'%opt)'
639                                   .($1 eq 'TEXT' ? '; ref $r?$r->inner_text:$r}'
640                                                  : '')
641                                   .';'}ge;
642        $code{$codename->[1]} = barecode "sub {$main}";
643    }    }
644        
645    my $main = <<EOH;    my $main = literal {
646        Description => [barecode m13ed_val_list $src, 'Description'],
647        Parameter => {do {
648          my @r;
649          for (@{$src->child_nodes}) {
650            if ($_->local_name eq 'Parameter') {
651              push @r, $_->get_attribute_value ('Name')
652                       => {Type => $_->get_attribute_value ('Type'),
653                           Default => $_->get_attribute_value ('Default'),
654                           Description => [barecode m13ed_val_list $_, 'Description']};
655            }
656          }
657          @r;
658        }},
659        %code,
660      };
661      $main .= line $Info, reset => 1;
662    
663    
664    my  $amain = <<EOH;
665  {  {
666    Formatting => sub {$main},    main => sub {$main},
667    @{[line ($Info, reset => 1)]}
668    Description => [@{[m13ed_val_list $src, 'Description']}],    Description => [@{[m13ed_val_list $src, 'Description']}],
669    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;  
670    }]}},    }]}},
671  }  }
672  EOH  EOH
673    my $r;    my $r = change_package $Info, $Info->{module_name};
674      local $Info->{-message_error_used} = 0;  
675    if (@$type == 1) {    if (@$type == 1) {
676      $type->[0] =~ tr/-/_/;      $type->[0] =~ tr/-/_/;
677      $r = qq{\$SuikaWiki::Plugin::Rule{$type->[0]}->{$name} = $main;\n};      $r .= qq{\$SuikaWiki::Plugin::Rule{$type->[0]}->{$name} = $main;\n};
678      push @{$Info->{provide}->{rule}->{$type->[0]}}, $name;      push @{$Info->{provide}->{rule}->{$type->[0]}}, $name;
679    } else {    } else {
680      $r = qq({my \$def = $main;\n);      $r .= qq({my \$def = $main;\n);
681      for my $type (@$type) {      for my $type (@$type) {
682        $type =~ tr/-/_/;        $type =~ tr/-/_/;
683        $r .= qq{\$SuikaWiki::Plugin::Rule{$type}->{$name} = \$def;\n};        $r .= qq{\$SuikaWiki::Plugin::Rule{$type}->{$name} = \$def;\n};
# Line 355  EOH Line 688  EOH
688    $r;    $r;
689  }  }
690    
691    =item FormattingRuleAlias
692    
693    Generating an alias name for a formatting rule that is already loaded.
694    Example:
695    
696      FormattingRuleAlias:
697        @Category[list]:
698          category-1
699          category-2
700          ...
701        @Name: new-rule-name
702        @Reference:
703          @@Category: one-of-category
704          @@Name: one-of-name
705    
706    associates C<(I<category-1>, I<new-rule-name>)>,
707    C<(I<category-2>, I<new-rule-name>)>, ...
708    with C<(I<one-of-category>, I<one-of-name>)>.
709    
710    =cut
711    
712    sub make_rule_alias ($$) {
713      my ($src, $Info) = @_;
714      my $type = $src->get_attribute ('Category', make_new_node => 1)->value || [];
715      my $name = $src->get_attribute ('Name', make_new_node => 1)->value;
716      
717      my $ref = $src->get_attribute ('Reference', make_new_node => 1);
718      my $c = $ref->get_attribute_value ('Category');
719      my $n = $ref->get_attribute_value ('Name');
720      
721      s/(?<=.)-/_/g for $n, $name;
722      tr/-/_/ for $c, @$type;
723      
724      my $def = qq{\$SuikaWiki::Plugin::Rule{@{[literal $c]}}->{@{[literal $n]}} or warn qq{Formatting rule "$c/$n" not defined}};
725      
726      my $r = change_package $Info, $Info->{module_name};
727      for my $type (@$type) {
728        $r .= qq{\$SuikaWiki::Plugin::Rule{@{[literal $type]}}->{@{[literal $name]}} = $def;\n};
729        push @{$Info->{provide}->{rule}->{$type}}, $name;
730      }
731      $r;
732    }
733    
734    
735  sub random_module_name ($;$) {  sub random_module_name ($;$) {
736    my ($Info, $subname) = @_;    my ($Info, $subname) = @_;
# Line 365  sub random_module_name ($;$) { Line 741  sub random_module_name ($;$) {
741      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]),
742      join ('', @rand[rand@rand,rand@rand,rand@rand,rand@rand]);      join ('', @rand[rand@rand,rand@rand,rand@rand,rand@rand]);
743  }  }
744    
745    =head1 NAME
746    
747    mkplugin2.pl - SuikaWiki: WikiPlugin Generator
748    
749    =head1 SYNOPSIS
750    
751      mkplugin2.pl pluginsrc.wp2 > plugin.pm
752    
753    =head1 DESCRIPTION
754    
755    C<mkplugin2.pl> generates WikiPlugin module as a Perl module file
756    from WikiPlugin source description.  WikiPlugin source description
757    is described in SuikaWikiConfig/2.0 format and it contains
758    definitions of wiki constructions (such as formatting rules and
759    WikiView definitions) as both machine understandable code and
760    human readable documentation.  For more information, see
761    <http://suika.fam.cx/~wakaba/-temp/wiki/wiki?WikiPlugin>.
762    
763    This script is part of SuikaWiki.
764    
765    =head1 HISTORY AND COMPATIBILITY
766    
767    C<mkplugin2.pl> introduced as part of SuikaWiki 3.
768    It converts SuikaWiki 3 WikiPlugin source descriptions
769    (in SuikaWikiConfig/2.0) into Perl modules with SuikaWiki 3 interface.
770    
771    SuikaWiki 2 has C<mkplugin.pl>.  It also converts WikiPlugin
772    source descriptions into Perl modules.  But it support
773    SuikaWiki 2 format of WikiPlugin source description that differs from
774    SuikaWiki 3 format.  Wiki programming interface (not limited to
775    WikiPlugin related one) of SuikaWiki 3 also incompatible with that
776    of SuikaWiki 2 so that it is impossible to use SuikaWiki 2 WikiPlugin
777    module with SuikaWiki 3 and vice versa.
778    
779    =head1 SEE ALSO
780    
781    C<SuikaWiki::Plugin>, SuikaWiki:WikiPlugin
782    <http://suika.fam.cx/~wakaba/-temp/wiki/wiki?WikiPlugin>.
783    
784    =head1 LICENSE
785    
786    Copyright 2003-2004 Wakaba <w@suika.fam.cx>.  All rights reserved.
787    
788    This program is free software; you can redistribute it and/or
789    modify it under the same terms as Perl itself.
790    
791    =cut
792    
793    1; # $Date$
Legend:
Removed from v.1.3  
changed lines
  Added in v.1.20
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24