/[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.14 by wakaba, Thu Mar 11 04:04:06 2004 UTC revision 1.21 by wakaba, Mon Nov 8 09:57:49 2004 UTC
# Line 59  sub code ($$) { Line 59  sub code ($$) {
59      $code =~ s/\$$_\b/$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/;    $Info->{-message_error_used} = 1 if $code =~ /\buse\s+Message::Util::Error\b/;
73    if (not $Info->{-message_error_used} and    if (not $Info->{-message_error_used} and
74       ($code =~ /\btry\s*\{/ or $code =~ /\bcatch\s*\{/)) {       ($code =~ /\btry\s*\{/ or $code =~ /\bcatch\s*\{/)) {
# Line 107  sub literal_or_code ($$) { Line 117  sub literal_or_code ($$) {
117    substr ($s, 0, 1) ne '{' ? literal ($s)    substr ($s, 0, 1) ne '{' ? literal ($s)
118                             : code ($Info, substr ($s, 1, length ($s) - 2));                             : 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 = Message::Markup::SuikaWikiConfig20::Parser->new;  my $parser = Message::Markup::SuikaWikiConfig20::Parser->new;
128  my $plugins = $parser->parse_text ($src);  my $plugins = $parser->parse_text ($src);
# Line 163  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');  my $use = $meta->get_attribute ('Use');
187  if (ref $use) {  if (ref $use) {
188    print change_package \%Info, $Info{module_name};    print change_package \%Info, $Info{module_name};
# Line 186  for (@{$plugins->child_nodes}) { Line 206  for (@{$plugins->child_nodes}) {
206      register_plugin_const ($_, \%Info);      register_plugin_const ($_, \%Info);
207    } elsif ($_->local_name eq 'Format') {    } elsif ($_->local_name eq 'Format') {
208      print "\n", make_format ($_, \%Info);      print "\n", make_format ($_, \%Info);
209      } elsif ($_->local_name eq 'FormattingRuleAlias') {
210        print "\n", make_rule_alias ($_, \%Info);
211  # Parameter  # Parameter
212  # PluginCategory  # PluginCategory
213    }    }
# Line 213  sub make_format ($$) { Line 235  sub make_format ($$) {
235      $r .= qq{push \@ISA, 'SuikaWiki::Format::Definition::template';\n};          $r .= qq{push \@ISA, 'SuikaWiki::Format::Definition::template';\n};    
236    }    }
237    if (my $name = $src->get_attribute_value ('Name')) {    if (my $name = $src->get_attribute_value ('Name')) {
238      $r .= qq{\$SuikaWiki::Format::Definition::Class{@{[literal '/'.$name.'/'.$src->get_attribute_value ('Version', default => '').'//']}} = '$module_name';\n};      $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')) {    if (my $type = $src->get_attribute_value ('Type')) {
241      $type .= join '', map {      $type .= join '', map {
# Line 221  sub make_format ($$) { Line 243  sub make_format ($$) {
243               } sort {               } sort {
244                 $a->local_name cmp $b->local_name                 $a->local_name cmp $b->local_name
245               } @{$src->get_attribute ('Type')->child_nodes};               } @{$src->get_attribute ('Type')->child_nodes};
246      $r .= qq{\$SuikaWiki::Format::Definition::Class{@{[literal $type.'//']}} = '$module_name';\n};      $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__;    my $convert = line $Info, line_no => __LINE__ + 2, realfile => __FILE__;
# Line 229  sub make_format ($$) { Line 251  sub make_format ($$) {
251  our $Converter;  our $Converter;
252  sub convert ($$;%) {  sub convert ($$;%) {
253    my ($self, $source, %opt) = @_;    my ($self, $source, %opt) = @_;
254    my $converter;    my $t = SuikaWiki::Format::Definition->serialize_media_type (%opt);
255    my $flag = '//';    my $converter = $Converter->{$t->{_}};
   $flag .= 'f' if $opt{IsFragment};  
   $flag .= 'p' if $opt{IsPlaceholder};  
   my $type = $opt{Type} ?  
                 $opt{Type} .  
                 SuikaWiki::Format::Definition->__get_param_string  
                   ($opt{Type_param}) : undef;  
   if ($Converter->{$type.$flag}) {  
     $converter = $Converter->{$type.$flag};  
   } elsif ($Converter->{$opt{Name}.'/'.$opt{Version}.$flag}) {  
     $converter = $Converter->{'/'.$opt{Name}.'/'.$opt{Version}.$flag};  
   }  
256    return ($converter->{$opt{return_type} or 'Main'} or    return ($converter->{$opt{return_type} or 'Main'} or
257            CORE::die "Buggy implementation: $type $opt{Name}/$opt{Version}$flag/@{[$opt{return_type} or 'Main']} not defined")            CORE::die "Buggy implementation: $t->{_}/@{[$opt{return_type} or 'Main']} not defined")
258           ->($self, $source, \%opt)           ->($self, $source, \%opt)
259      if $converter;      if $converter;
260      local $Error::Depth = $Error::Depth + 1;
261    $self->SUPER::convert ($source, %opt);    $self->SUPER::convert ($source, %opt);
262  }  }
263  EOH  EOH
# Line 278  EOH Line 290  EOH
290        $r .= code $Info, $_->get_attribute_value ('Main');        $r .= code $Info, $_->get_attribute_value ('Main');
291        $r .= line $Info, reset => 1;        $r .= line $Info, reset => 1;
292        $r .= qq(}\n);        $r .= qq(}\n);
293        } elsif ({qw/content_written 1 content_removed 1 content_type_changed_from 1
294                     content_prop_modified 1/}
295                 ->{my $node_name = $_->local_name}) {
296          $r .= q(sub ).$node_name
297             .  q( {)."\n".q(my ($self, %opt) = @_;)
298             .  line $Info, node_path => qq(Format[module-name()=$module_name]/$node_name]);
299          $r .= code $Info, $_->get_attribute_value ('Main');
300          $r .= line $Info, reset => 1;
301          $r .= qq(}\n);
302      } elsif ($_->local_name eq 'Use') {      } elsif ($_->local_name eq 'Use') {
303        $r .= line $Info, node_path => qq(Format[module-name()=$module_name]/Use);        $r .= line $Info, node_path => qq(Format[module-name()=$module_name]/Use);
304        $r .= code $Info, $_->inner_text;        $r .= code $Info, $_->inner_text;
305        } elsif ($_->local_name eq 'Prop') {
306          $r .= q<sub prop ($$;%) { my ($self, $name, %opt) = @_;>;
307          my $f = 0;
308          for my $prop (@{$_->child_nodes}) {
309            if ($prop->local_name =~ /^([^:]+):([^:]+)$/) {
310              $r .= qq{if (\$name eq @{[literal expanded_uri $Info, $1, $2]}) { return @{[literal $prop->value]} } els};
311              $f = 1;
312            }
313          }
314          $r .= q<e {> if $f;
315          $r .= q{$self->SUPER::prop ($name, %opt);};
316          $r .= q<}> if $f;
317          $r .= qq<\n}\n>;
318      }      }
319    }    }
320    $r;    $r;
# Line 289  EOH Line 323  EOH
323  sub make_format_converter ($$) {  sub make_format_converter ($$) {
324    my ($src, $Info) = @_;    my ($src, $Info) = @_;
325    my %def;    my %def;
326    $def{Type} = $src->get_attribute ('Type');    for (qw/Type Name Version TypeURIReference IsFragment IsPlaceholder/) {
327    if (ref $def{Type}) {      $def{$_} = $src->get_attribute_value ($_);
328      $def{Type} = $def{Type}->inner_text      delete $def{$_} unless defined $def{$_};
329            . join '', map {    }
330                ';'. $_->local_name .'='. quoted_string $_->inner_text    $def{Type_param} = {map {$_->local_name => $_->value}
331              } sort {                                @{$src->get_attribute ('Type', make_new_node => 1)
332                $a->local_name cmp $b->local_name                                    ->child_nodes}};
333              } @{$def{Type}->child_nodes};    my $type = serialize_media_type ($Info,
334    } else {                 Type => $def{Type},
335      delete $def{Type};                 Type_param => $def{Type_param},
336    }                 Name => $def{Name},
337    $def{Name} = $src->get_attribute_value ('Name');                 Version => $def{Version},
338    delete $def{Name} unless defined $def{Name};                 URIReference => $def{TypeURIReference},
339    $def{Version} = $src->get_attribute_value ('Version');                 IsFragment => $def{IsFragment},
340    delete $def{Version} if not defined $def{Version} or                 IsPlaceholder => $def{IsPlaceholder});
341                            not defined $def{Name};    $def{serialized_type} = $type->{_};
     
   my $flag = '//';  
   $flag .= 'f' and $def{IsFragment} = 1  
     if $src->get_attribute_value ('IsFragment');  
   $flag .= 'p' and $def{IsPlaceholder} = 1  
     if $src->get_attribute_value ('IsPlaceholder');  
342        
343    for (qw/Main ToString ToOctetStream/) {    for (qw/Main ToString ToOctetStream/) {
344      my $def = $src->get_attribute_value ($_);      my $def = $src->get_attribute_value ($_);
# Line 327  sub make_format_converter ($$) { Line 355  sub make_format_converter ($$) {
355    }    }
356        
357    my $r = list %def;    my $r = list %def;
358    if ($def{Type}) {    if ($type->{Type}) {
359      $r = qq{\$Converter->{@{[literal $def{Type}.$flag]}} = {$r};\n};      $r = qq{\$Converter->{@{[literal $type->{Type}]}} = {$r};\n};
360      $r .= qq{\$Converter->{@{[literal '/'.$def{Name}.'/'.$def{Version}.$flag]}} = \$Converter->{@{[literal $def{Type}.$flag]}};\n}      $r .= qq{\$Converter->{@{[literal $type->{Magic}]}} = \$Converter->{@{[literal $type->{Type}]}};\n}
361        if $def{Name};        if $type->{Magic};
362    } elsif ($def{Name}) {      $r .= qq{\$Converter->{@{[literal $type->{URIReference}]}} = \$Converter->{@{[literal $type->{Type}]}};\n}
363      $r = qq{\$Converter->{@{[literal '/'.$def{Name}.'/'.$def{Version}.$flag]}} = {$r};\n};        if $type->{URIReference};
364      } elsif ($type->{Magic}) {
365        $r = qq{\$Converter->{@{[literal $type->{Magic}]}} = {$r};\n};
366        $r .= qq{\$Converter->{@{[literal $type->{URIReference}]}} = \$Converter->{@{[literal $type->{Magic}]}};\n}
367          if $type->{URIReference};
368      } elsif ($type->{URIReference}) {
369        $r = qq{\$Converter->{@{[literal $type->{URIReference}]}} = {$r};\n};
370    } else {    } else {
371      $r = 'BEGIN { die "Invalid Syntax of Converter: Type or Name property required" }';      $r = 'BEGIN { die "Invalid Syntax of Converter: Type or Name or TypeURIReference property required" }';
372    }    }
373    $r;    $r;
374  }  }
375    
376    sub serialize_media_type ($%) {
377      my ($Info, %opt) = @_;
378      my %return;
379      if ($opt{Type}) {
380        $return{Type} = 'IMT:'.$opt{Type};
381        if ($opt{Type_param}) {
382          $return{Type} .= join '', map {my $s;
383                             ';'. $_ .'="'
384                           . (($s = $opt{Type_param}->{$_}) =~ s/([\\"])/\\$1/g, $s)
385                           . '"'
386                           } sort {
387                             $a cmp $b
388                           } keys %{$opt{Type_param}};
389        }
390      }
391      if ($opt{Magic}) {
392        $return{Magic} = 'MAGIC:'.$opt{Magic};
393      } elsif ($opt{Name}) {
394        $return{Name} = 'MAGIC:'.$opt{Name}.'/*';
395        $return{Magic} = 'MAGIC:'.$opt{Name}.'/'.$opt{Version} if $opt{Version};
396      }
397      if ($opt{URIReference}) {
398        $return{URIReference} = $opt{URIReference};
399      }
400      my $flag = '##';
401      $flag .= 'f' if $opt{IsFragment};
402      $flag .= 'p' if $opt{IsPlaceholder};
403      for (qw/URIReference Type Magic Name/) {
404        $return{$_} .= $flag if $return{$_};
405      }
406      $return{_} = $return{URIReference} || $return{Type}
407                || $return{Magic} || $return{Name};
408      \%return;
409    }
410    
411    
412  sub make_function ($$) {  sub make_function ($$) {
413    my ($src, $Info) = @_;    my ($src, $Info) = @_;
414    ## TODO: support of ARGV property    ## TODO: support of ARGV property
# Line 461  EOH Line 531  EOH
531    
532  sub make_view_template_method ($$) {  sub make_view_template_method ($$) {
533    my ($src, $Info, $ViewProp) = @_;    my ($src, $Info, $ViewProp) = @_;
534      my $media_type = $src->get_attribute_value
535                                ('media-type',
536                                 default => q<application/octet-stream>);
537    my $r = <<EOH;    my $r = <<EOH;
538    
539  sub main (\$\$\$) {  sub main (\$\$\$) {
# Line 485  sub main (\$\$\$) { Line 558  sub main (\$\$\$) {
558       $x?q{$opt2->{output}->{status_code} = }.(0 + $x).q{;}:q{}}]}       $x?q{$opt2->{output}->{status_code} = }.(0 + $x).q{;}:q{}}]}
559    @{[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;
560       $x?q{$opt2->{output}->{status_phrase} = }.literal($x).q{;}:q{}}]}       $x?q{$opt2->{output}->{status_phrase} = }.literal($x).q{;}:q{}}]}
561    \$opt2->{output}->{entity}->{media_type} = @{[literal    \$opt2->{output}->{entity}->{media_type} = @{[literal $media_type]};
562                             $src->get_attribute ('media-type',make_new_node=>1)  
                                ->inner_text || 'application/octet-stream']};  
563    @{[($src->get_attribute ('use-media-type-charset',make_new_node=>1)    @{[($src->get_attribute ('use-media-type-charset',make_new_node=>1)
564              ->inner_text || 0) ?              ->inner_text || 0) ?
565       q{$opt2->{output}->{entity}->{charset} = $self->{view}->{wiki}->{config}->{charset}->{output};}:       q{$opt2->{output}->{entity}->{charset} = $self->{view}->{wiki}->{config}->{charset}->{output};}:
# Line 507  sub main (\$\$\$) { Line 579  sub main (\$\$\$) {
579    \$self->{view}->{wiki}->init_db;    \$self->{view}->{wiki}->init_db;
580    \$self->main_pre (\$opt, \$opt2);    \$self->main_pre (\$opt, \$opt2);
581        
582      @{[$media_type eq 'text/html' ? q{require Message::Markup::XML::Serialize::HTML;} : '']}
583    use Message::Util::Error;    use Message::Util::Error;
584    try {    try {
585      \$opt2->{output}->{entity}->{body}      \$opt2->{output}->{entity}->{body}
586        = SuikaWiki::Plugin->formatter ('view')        = @{[$media_type eq 'text/html' ? q{Message::Markup::XML::Serialize::HTML::html_simple} : '']}
587          ->replace (\$opt2->{template}, param => \$opt2->{o});          (SuikaWiki::Plugin->formatter ('view')
588            ->replace (\$opt2->{template}, param => \$opt2->{o}));
589    } \$self->{view}->{wiki}->{config}->{catch}->{ @{[    } \$self->{view}->{wiki}->{config}->{catch}->{ @{[
590         $ViewProp->{Name} eq '-error' ? 'formatter_view_error'         $ViewProp->{Name} eq '-error' ? 'formatter_view_error'
591                                       : 'formatter_view' ]} };                                       : 'formatter_view' ]} };
# Line 614  EOH Line 688  EOH
688    }    }
689    $r;    $r;
690  }  }
691    
692    =item FormattingRuleAlias
693    
694    Generating an alias name for a formatting rule that is already loaded.
695    Example:
696    
697      FormattingRuleAlias:
698        @Category[list]:
699          category-1
700          category-2
701          ...
702        @Name: new-rule-name
703        @Reference:
704          @@Category: one-of-category
705          @@Name: one-of-name
706    
707    associates C<(I<category-1>, I<new-rule-name>)>,
708    C<(I<category-2>, I<new-rule-name>)>, ...
709    with C<(I<one-of-category>, I<one-of-name>)>.
710    
711    =cut
712    
713    sub make_rule_alias ($$) {
714      my ($src, $Info) = @_;
715      my $type = $src->get_attribute ('Category', make_new_node => 1)->value || [];
716      my $name = $src->get_attribute ('Name', make_new_node => 1)->value;
717      
718      my $ref = $src->get_attribute ('Reference', make_new_node => 1);
719      my $c = $ref->get_attribute_value ('Category');
720      my $n = $ref->get_attribute_value ('Name');
721      
722      s/(?<=.)-/_/g for $n, $name;
723      tr/-/_/ for $c, @$type;
724      
725      my $def = qq{\$SuikaWiki::Plugin::Rule{@{[literal $c]}}->{@{[literal $n]}} or warn qq{Formatting rule "$c/$n" not defined}};
726      
727      my $r = change_package $Info, $Info->{module_name};
728      for my $type (@$type) {
729        $r .= qq{\$SuikaWiki::Plugin::Rule{@{[literal $type]}}->{@{[literal $name]}} = $def;\n};
730        push @{$Info->{provide}->{rule}->{$type}}, $name;
731      }
732      $r;
733    }
734    
735    
736  sub random_module_name ($;$) {  sub random_module_name ($;$) {
Legend:
Removed from v.1.14  
changed lines
  Added in v.1.21
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24