/[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.15 by wakaba, Fri Mar 19 03:46:22 2004 UTC revision 1.16 by wakaba, Sun Apr 25 07:06:50 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/<Q:([^:]+):([^>]+)>/literal $Info->{Namespace}->{$1}.$2/ge;
63      
64    $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/;
65    if (not $Info->{-message_error_used} and    if (not $Info->{-message_error_used} and
66       ($code =~ /\btry\s*\{/ or $code =~ /\bcatch\s*\{/)) {       ($code =~ /\btry\s*\{/ or $code =~ /\bcatch\s*\{/)) {
# Line 163  print qq{\$Info{$Info{name_literal}}->{A Line 165  print qq{\$Info{$Info{name_literal}}->{A
165  } grep { $_->local_name eq 'Author' } @{$meta->child_nodes}  } grep { $_->local_name eq 'Author' } @{$meta->child_nodes}
166  ). qq{];\n};  ). qq{];\n};
167    
168    for (@{$meta->get_attribute ('Namespace', make_new_node => 1)->child_nodes}) {
169      $Info{Namespace}->{$_->local_name} = $_->value;
170    }
171    
172  my $use = $meta->get_attribute ('Use');  my $use = $meta->get_attribute ('Use');
173  if (ref $use) {  if (ref $use) {
174    print change_package \%Info, $Info{module_name};    print change_package \%Info, $Info{module_name};
# Line 215  sub make_format ($$) { Line 221  sub make_format ($$) {
221      $r .= qq{push \@ISA, 'SuikaWiki::Format::Definition::template';\n};          $r .= qq{push \@ISA, 'SuikaWiki::Format::Definition::template';\n};    
222    }    }
223    if (my $name = $src->get_attribute_value ('Name')) {    if (my $name = $src->get_attribute_value ('Name')) {
224      $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};
225    }    }
226    if (my $type = $src->get_attribute_value ('Type')) {    if (my $type = $src->get_attribute_value ('Type')) {
227      $type .= join '', map {      $type .= join '', map {
# Line 223  sub make_format ($$) { Line 229  sub make_format ($$) {
229               } sort {               } sort {
230                 $a->local_name cmp $b->local_name                 $a->local_name cmp $b->local_name
231               } @{$src->get_attribute ('Type')->child_nodes};               } @{$src->get_attribute ('Type')->child_nodes};
232      $r .= qq{\$SuikaWiki::Format::Definition::Class{@{[literal $type.'//']}} = '$module_name';\n};      $r .= qq{\$SuikaWiki::Format::Definition::Class{@{[literal 'IMT:'.$type.'##']}} = '$module_name';\n};
233    }    }
234        
235    my $convert = line $Info, line_no => __LINE__ + 2, realfile => __FILE__;    my $convert = line $Info, line_no => __LINE__ + 2, realfile => __FILE__;
# Line 231  sub make_format ($$) { Line 237  sub make_format ($$) {
237  our $Converter;  our $Converter;
238  sub convert ($$;%) {  sub convert ($$;%) {
239    my ($self, $source, %opt) = @_;    my ($self, $source, %opt) = @_;
240    my $converter;    my $t = SuikaWiki::Format::Definition->serialize_media_type (%opt);
241    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};  
   }  
242    return ($converter->{$opt{return_type} or 'Main'} or    return ($converter->{$opt{return_type} or 'Main'} or
243            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")
244           ->($self, $source, \%opt)           ->($self, $source, \%opt)
245      if $converter;      if $converter;
246    $self->SUPER::convert ($source, %opt);    $self->SUPER::convert ($source, %opt);
# Line 291  EOH Line 286  EOH
286  sub make_format_converter ($$) {  sub make_format_converter ($$) {
287    my ($src, $Info) = @_;    my ($src, $Info) = @_;
288    my %def;    my %def;
289    $def{Type} = $src->get_attribute ('Type');    for (qw/Type Name Version TypeURIReference IsFragment IsPlaceholder/) {
290    if (ref $def{Type}) {      $def{$_} = $src->get_attribute_value ($_);
291      $def{Type} = $def{Type}->inner_text      delete $def{$_} unless defined $def{$_};
292            . join '', map {    }
293                ';'. $_->local_name .'='. quoted_string $_->inner_text    $def{Type_param} = {map {$_->local_name => $_->value}
294              } sort {                                @{$src->get_attribute ('Type', make_new_node => 1)
295                $a->local_name cmp $b->local_name                                    ->child_nodes}};
296              } @{$def{Type}->child_nodes};    my $type = serialize_media_type ($Info,
297    } else {                 Type => $def{Type},
298      delete $def{Type};                 Type_param => $def{Type_param},
299    }                 Name => $def{Name},
300    $def{Name} = $src->get_attribute_value ('Name');                 Version => $def{Version},
301    delete $def{Name} unless defined $def{Name};                 URIReference => $def{TypeURIReference},
302    $def{Version} = $src->get_attribute_value ('Version');                 IsFragment => $def{IsFragment},
303    delete $def{Version} if not defined $def{Version} or                 IsPlaceholder => $def{IsPlaceholder});
304                            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');  
305        
306    for (qw/Main ToString ToOctetStream/) {    for (qw/Main ToString ToOctetStream/) {
307      my $def = $src->get_attribute_value ($_);      my $def = $src->get_attribute_value ($_);
# Line 329  sub make_format_converter ($$) { Line 318  sub make_format_converter ($$) {
318    }    }
319        
320    my $r = list %def;    my $r = list %def;
321    if ($def{Type}) {    if ($type->{Type}) {
322      $r = qq{\$Converter->{@{[literal $def{Type}.$flag]}} = {$r};\n};      $r = qq{\$Converter->{@{[literal $type->{Type}]}} = {$r};\n};
323      $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}
324        if $def{Name};        if $type->{Magic};
325    } elsif ($def{Name}) {      $r .= qq{\$Converter->{@{[literal $type->{URIReference}]}} = \$Converter->{@{[literal $type->{Type}]}};\n}
326      $r = qq{\$Converter->{@{[literal '/'.$def{Name}.'/'.$def{Version}.$flag]}} = {$r};\n};        if $type->{URIReference};
327      } elsif ($type->{Magic}) {
328        $r = qq{\$Converter->{@{[literal $type->{Magic}]}} = {$r};\n};
329        $r .= qq{\$Converter->{@{[literal $type->{URIReference}]}} = \$Converter->{@{[literal $type->{Magic}]}};\n}
330          if $type->{URIReference};
331      } elsif ($type->{URIReference}) {
332        $r = qq{\$Converter->{@{[literal $type->{URIReference}]}} = {$r};\n};
333    } else {    } else {
334      $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" }';
335    }    }
336    $r;    $r;
337  }  }
338    
339    sub serialize_media_type ($%) {
340      my ($Info, %opt) = @_;
341      my %return;
342      if ($opt{Type}) {
343        $return{Type} = 'IMT:'.$opt{Type};
344        if ($opt{Type_param}) {
345          $return{Type} .= join '', map {my $s;
346                             ';'. $_ .'="'
347                           . (($s = $opt{Type_param}->{$_}) =~ s/([\\"])/\\$1/g, $s)
348                           . '"'
349                           } sort {
350                             $a cmp $b
351                           } keys %{$opt{Type_param}};
352        }
353      }
354      if ($opt{Magic}) {
355        $return{Magic} = 'MAGIC:'.$opt{Magic};
356      } elsif ($opt{Name}) {
357        $return{Name} = 'MAGIC:'.$opt{Name}.'/*';
358        $return{Magic} = 'MAGIC:'.$opt{Name}.'/'.$opt{Version} if $opt{Version};
359      }
360      if ($opt{URIReference}) {
361        $return{URIReference} = $opt{URIReference};
362      }
363      my $flag = '##';
364      $flag .= 'f' if $opt{IsFragment};
365      $flag .= 'p' if $opt{IsPlaceholder};
366      for (qw/URIReference Type Magic Name/) {
367        $return{$_} .= $flag if $return{$_};
368      }
369      $return{_} = $return{URIReference} || $return{Type}
370                || $return{Magic} || $return{Name};
371      \%return;
372    }
373    
374    
375  sub make_function ($$) {  sub make_function ($$) {
376    my ($src, $Info) = @_;    my ($src, $Info) = @_;
377    ## TODO: support of ARGV property    ## TODO: support of ARGV property
Legend:
Removed from v.1.15  
changed lines
  Added in v.1.16
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24