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*\{/)) { |
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 |
|
$Info->{Namespace}->{$prefix} . $lname; |
124 |
|
} |
125 |
|
|
126 |
my $parser = Message::Markup::SuikaWikiConfig20::Parser->new; |
my $parser = Message::Markup::SuikaWikiConfig20::Parser->new; |
127 |
my $plugins = $parser->parse_text ($src); |
my $plugins = $parser->parse_text ($src); |
178 |
} grep { $_->local_name eq 'Author' } @{$meta->child_nodes} |
} grep { $_->local_name eq 'Author' } @{$meta->child_nodes} |
179 |
). qq{];\n}; |
). qq{];\n}; |
180 |
|
|
181 |
|
for (@{$meta->get_attribute ('Namespace', make_new_node => 1)->child_nodes}) { |
182 |
|
$Info{Namespace}->{$_->local_name} = $_->value; |
183 |
|
} |
184 |
|
|
185 |
my $use = $meta->get_attribute ('Use'); |
my $use = $meta->get_attribute ('Use'); |
186 |
if (ref $use) { |
if (ref $use) { |
187 |
print change_package \%Info, $Info{module_name}; |
print change_package \%Info, $Info{module_name}; |
234 |
$r .= qq{push \@ISA, 'SuikaWiki::Format::Definition::template';\n}; |
$r .= qq{push \@ISA, 'SuikaWiki::Format::Definition::template';\n}; |
235 |
} |
} |
236 |
if (my $name = $src->get_attribute_value ('Name')) { |
if (my $name = $src->get_attribute_value ('Name')) { |
237 |
$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}; |
238 |
} |
} |
239 |
if (my $type = $src->get_attribute_value ('Type')) { |
if (my $type = $src->get_attribute_value ('Type')) { |
240 |
$type .= join '', map { |
$type .= join '', map { |
242 |
} sort { |
} sort { |
243 |
$a->local_name cmp $b->local_name |
$a->local_name cmp $b->local_name |
244 |
} @{$src->get_attribute ('Type')->child_nodes}; |
} @{$src->get_attribute ('Type')->child_nodes}; |
245 |
$r .= qq{\$SuikaWiki::Format::Definition::Class{@{[literal $type.'//']}} = '$module_name';\n}; |
$r .= qq{\$SuikaWiki::Format::Definition::Class{@{[literal 'IMT:'.$type.'##']}} = '$module_name';\n}; |
246 |
} |
} |
247 |
|
|
248 |
my $convert = line $Info, line_no => __LINE__ + 2, realfile => __FILE__; |
my $convert = line $Info, line_no => __LINE__ + 2, realfile => __FILE__; |
250 |
our $Converter; |
our $Converter; |
251 |
sub convert ($$;%) { |
sub convert ($$;%) { |
252 |
my ($self, $source, %opt) = @_; |
my ($self, $source, %opt) = @_; |
253 |
my $converter; |
my $t = SuikaWiki::Format::Definition->serialize_media_type (%opt); |
254 |
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}; |
|
|
} |
|
255 |
return ($converter->{$opt{return_type} or 'Main'} or |
return ($converter->{$opt{return_type} or 'Main'} or |
256 |
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") |
257 |
->($self, $source, \%opt) |
->($self, $source, \%opt) |
258 |
if $converter; |
if $converter; |
259 |
$self->SUPER::convert ($source, %opt); |
$self->SUPER::convert ($source, %opt); |
288 |
$r .= code $Info, $_->get_attribute_value ('Main'); |
$r .= code $Info, $_->get_attribute_value ('Main'); |
289 |
$r .= line $Info, reset => 1; |
$r .= line $Info, reset => 1; |
290 |
$r .= qq(}\n); |
$r .= qq(}\n); |
291 |
|
} elsif ({qw/content_written 1 content_removed 1 content_type_changed_from 1 |
292 |
|
content_prop_modified 1/} |
293 |
|
->{my $node_name = $_->local_name}) { |
294 |
|
$r .= q(sub ).$node_name |
295 |
|
. q( {)."\n".q(my ($self, %opt) = @_;) |
296 |
|
. line $Info, node_path => qq(Format[module-name()=$module_name]/$node_name]); |
297 |
|
$r .= code $Info, $_->get_attribute_value ('Main'); |
298 |
|
$r .= line $Info, reset => 1; |
299 |
|
$r .= qq(}\n); |
300 |
} elsif ($_->local_name eq 'Use') { |
} elsif ($_->local_name eq 'Use') { |
301 |
$r .= line $Info, node_path => qq(Format[module-name()=$module_name]/Use); |
$r .= line $Info, node_path => qq(Format[module-name()=$module_name]/Use); |
302 |
$r .= code $Info, $_->inner_text; |
$r .= code $Info, $_->inner_text; |
303 |
|
} elsif ($_->local_name eq 'Prop') { |
304 |
|
$r .= q<sub prop ($$;%) { my ($self, $name, %opt) = @_;>; |
305 |
|
my $f = 0; |
306 |
|
for my $prop (@{$_->child_nodes}) { |
307 |
|
if ($prop->local_name =~ /^([^:]+):([^:]+)$/) { |
308 |
|
$r .= qq{if (\$name eq @{[literal expanded_uri $Info, $1, $2]}) { return @{[literal $prop->value]} } els}; |
309 |
|
$f = 1; |
310 |
|
} |
311 |
|
} |
312 |
|
$r .= q<e {> if $f; |
313 |
|
$r .= q{$self->SUPER::prop ($name, %opt);}; |
314 |
|
$r .= q<}> if $f; |
315 |
|
$r .= qq<\n}\n>; |
316 |
} |
} |
317 |
} |
} |
318 |
$r; |
$r; |
321 |
sub make_format_converter ($$) { |
sub make_format_converter ($$) { |
322 |
my ($src, $Info) = @_; |
my ($src, $Info) = @_; |
323 |
my %def; |
my %def; |
324 |
$def{Type} = $src->get_attribute ('Type'); |
for (qw/Type Name Version TypeURIReference IsFragment IsPlaceholder/) { |
325 |
if (ref $def{Type}) { |
$def{$_} = $src->get_attribute_value ($_); |
326 |
$def{Type} = $def{Type}->inner_text |
delete $def{$_} unless defined $def{$_}; |
327 |
. join '', map { |
} |
328 |
';'. $_->local_name .'='. quoted_string $_->inner_text |
$def{Type_param} = {map {$_->local_name => $_->value} |
329 |
} sort { |
@{$src->get_attribute ('Type', make_new_node => 1) |
330 |
$a->local_name cmp $b->local_name |
->child_nodes}}; |
331 |
} @{$def{Type}->child_nodes}; |
my $type = serialize_media_type ($Info, |
332 |
} else { |
Type => $def{Type}, |
333 |
delete $def{Type}; |
Type_param => $def{Type_param}, |
334 |
} |
Name => $def{Name}, |
335 |
$def{Name} = $src->get_attribute_value ('Name'); |
Version => $def{Version}, |
336 |
delete $def{Name} unless defined $def{Name}; |
URIReference => $def{TypeURIReference}, |
337 |
$def{Version} = $src->get_attribute_value ('Version'); |
IsFragment => $def{IsFragment}, |
338 |
delete $def{Version} if not defined $def{Version} or |
IsPlaceholder => $def{IsPlaceholder}); |
339 |
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'); |
|
340 |
|
|
341 |
for (qw/Main ToString ToOctetStream/) { |
for (qw/Main ToString ToOctetStream/) { |
342 |
my $def = $src->get_attribute_value ($_); |
my $def = $src->get_attribute_value ($_); |
353 |
} |
} |
354 |
|
|
355 |
my $r = list %def; |
my $r = list %def; |
356 |
if ($def{Type}) { |
if ($type->{Type}) { |
357 |
$r = qq{\$Converter->{@{[literal $def{Type}.$flag]}} = {$r};\n}; |
$r = qq{\$Converter->{@{[literal $type->{Type}]}} = {$r};\n}; |
358 |
$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} |
359 |
if $def{Name}; |
if $type->{Magic}; |
360 |
} elsif ($def{Name}) { |
$r .= qq{\$Converter->{@{[literal $type->{URIReference}]}} = \$Converter->{@{[literal $type->{Type}]}};\n} |
361 |
$r = qq{\$Converter->{@{[literal '/'.$def{Name}.'/'.$def{Version}.$flag]}} = {$r};\n}; |
if $type->{URIReference}; |
362 |
|
} elsif ($type->{Magic}) { |
363 |
|
$r = qq{\$Converter->{@{[literal $type->{Magic}]}} = {$r};\n}; |
364 |
|
$r .= qq{\$Converter->{@{[literal $type->{URIReference}]}} = \$Converter->{@{[literal $type->{Magic}]}};\n} |
365 |
|
if $type->{URIReference}; |
366 |
|
} elsif ($type->{URIReference}) { |
367 |
|
$r = qq{\$Converter->{@{[literal $type->{URIReference}]}} = {$r};\n}; |
368 |
} else { |
} else { |
369 |
$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" }'; |
370 |
} |
} |
371 |
$r; |
$r; |
372 |
} |
} |
373 |
|
|
374 |
|
sub serialize_media_type ($%) { |
375 |
|
my ($Info, %opt) = @_; |
376 |
|
my %return; |
377 |
|
if ($opt{Type}) { |
378 |
|
$return{Type} = 'IMT:'.$opt{Type}; |
379 |
|
if ($opt{Type_param}) { |
380 |
|
$return{Type} .= join '', map {my $s; |
381 |
|
';'. $_ .'="' |
382 |
|
. (($s = $opt{Type_param}->{$_}) =~ s/([\\"])/\\$1/g, $s) |
383 |
|
. '"' |
384 |
|
} sort { |
385 |
|
$a cmp $b |
386 |
|
} keys %{$opt{Type_param}}; |
387 |
|
} |
388 |
|
} |
389 |
|
if ($opt{Magic}) { |
390 |
|
$return{Magic} = 'MAGIC:'.$opt{Magic}; |
391 |
|
} elsif ($opt{Name}) { |
392 |
|
$return{Name} = 'MAGIC:'.$opt{Name}.'/*'; |
393 |
|
$return{Magic} = 'MAGIC:'.$opt{Name}.'/'.$opt{Version} if $opt{Version}; |
394 |
|
} |
395 |
|
if ($opt{URIReference}) { |
396 |
|
$return{URIReference} = $opt{URIReference}; |
397 |
|
} |
398 |
|
my $flag = '##'; |
399 |
|
$flag .= 'f' if $opt{IsFragment}; |
400 |
|
$flag .= 'p' if $opt{IsPlaceholder}; |
401 |
|
for (qw/URIReference Type Magic Name/) { |
402 |
|
$return{$_} .= $flag if $return{$_}; |
403 |
|
} |
404 |
|
$return{_} = $return{URIReference} || $return{Type} |
405 |
|
|| $return{Magic} || $return{Name}; |
406 |
|
\%return; |
407 |
|
} |
408 |
|
|
409 |
|
|
410 |
sub make_function ($$) { |
sub make_function ($$) { |
411 |
my ($src, $Info) = @_; |
my ($src, $Info) = @_; |
412 |
## TODO: support of ARGV property |
## TODO: support of ARGV property |
529 |
|
|
530 |
sub make_view_template_method ($$) { |
sub make_view_template_method ($$) { |
531 |
my ($src, $Info, $ViewProp) = @_; |
my ($src, $Info, $ViewProp) = @_; |
532 |
|
my $media_type = $src->get_attribute_value |
533 |
|
('media-type', |
534 |
|
default => q<application/octet-stream>); |
535 |
my $r = <<EOH; |
my $r = <<EOH; |
536 |
|
|
537 |
sub main (\$\$\$) { |
sub main (\$\$\$) { |
556 |
$x?q{$opt2->{output}->{status_code} = }.(0 + $x).q{;}:q{}}]} |
$x?q{$opt2->{output}->{status_code} = }.(0 + $x).q{;}:q{}}]} |
557 |
@{[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; |
558 |
$x?q{$opt2->{output}->{status_phrase} = }.literal($x).q{;}:q{}}]} |
$x?q{$opt2->{output}->{status_phrase} = }.literal($x).q{;}:q{}}]} |
559 |
\$opt2->{output}->{entity}->{media_type} = @{[literal |
\$opt2->{output}->{entity}->{media_type} = @{[literal $media_type]}; |
560 |
$src->get_attribute ('media-type',make_new_node=>1) |
|
|
->inner_text || 'application/octet-stream']}; |
|
561 |
@{[($src->get_attribute ('use-media-type-charset',make_new_node=>1) |
@{[($src->get_attribute ('use-media-type-charset',make_new_node=>1) |
562 |
->inner_text || 0) ? |
->inner_text || 0) ? |
563 |
q{$opt2->{output}->{entity}->{charset} = $self->{view}->{wiki}->{config}->{charset}->{output};}: |
q{$opt2->{output}->{entity}->{charset} = $self->{view}->{wiki}->{config}->{charset}->{output};}: |
577 |
\$self->{view}->{wiki}->init_db; |
\$self->{view}->{wiki}->init_db; |
578 |
\$self->main_pre (\$opt, \$opt2); |
\$self->main_pre (\$opt, \$opt2); |
579 |
|
|
580 |
|
@{[$media_type eq 'text/html' ? q{require Message::Markup::XML::Serialize::HTML;} : '']} |
581 |
use Message::Util::Error; |
use Message::Util::Error; |
582 |
try { |
try { |
583 |
\$opt2->{output}->{entity}->{body} |
\$opt2->{output}->{entity}->{body} |
584 |
= SuikaWiki::Plugin->formatter ('view') |
= @{[$media_type eq 'text/html' ? q{Message::Markup::XML::Serialize::HTML::html_simple} : '']} |
585 |
->replace (\$opt2->{template}, param => \$opt2->{o}); |
(SuikaWiki::Plugin->formatter ('view') |
586 |
|
->replace (\$opt2->{template}, param => \$opt2->{o})); |
587 |
} \$self->{view}->{wiki}->{config}->{catch}->{ @{[ |
} \$self->{view}->{wiki}->{config}->{catch}->{ @{[ |
588 |
$ViewProp->{Name} eq '-error' ? 'formatter_view_error' |
$ViewProp->{Name} eq '-error' ? 'formatter_view_error' |
589 |
: 'formatter_view' ]} }; |
: 'formatter_view' ]} }; |