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 |
|
$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 ($$) { |
sub change_package ($$) { |
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 module_name/) { |
for (qw/Version InterfaceVersion mkpluginVersion module_name/) { |
136 |
print qq{\$Info{$Info{name_literal}}->{$_} = @{[literal $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/) { |
167 |
if (ref $use) { |
if (ref $use) { |
168 |
print change_package \%Info, $Info{module_name}; |
print change_package \%Info, $Info{module_name}; |
169 |
print line \%Info, node_path => 'Plugin/Use'; |
print line \%Info, node_path => 'Plugin/Use'; |
170 |
print $use->inner_text, "\n"; |
print code \%Info, $use->inner_text; |
171 |
print line \%Info, reset => 1; |
print line \%Info, reset => 1; |
172 |
} |
} |
173 |
|
|
203 |
my ($src, $Info) = @_; |
my ($src, $Info) = @_; |
204 |
my $module_name = 'SuikaWiki::Format::Definition::'.$src->get_attribute_value ('ModuleName'); |
my $module_name = 'SuikaWiki::Format::Definition::'.$src->get_attribute_value ('ModuleName'); |
205 |
my $r = change_package $Info, $module_name; |
my $r = change_package $Info, $module_name; |
206 |
|
local $Info->{-message_error_used} = 0; |
207 |
$r .= qq{our \@ISA;\n}; |
$r .= qq{our \@ISA;\n}; |
208 |
if (my $isa = $src->get_attribute_value ('Inherit')) { |
if (my $isa = $src->get_attribute_value ('Inherit')) { |
209 |
for (@$isa) { |
for (@$isa) { |
242 |
} elsif ($Converter->{$opt{Name}.'/'.$opt{Version}.$flag}) { |
} elsif ($Converter->{$opt{Name}.'/'.$opt{Version}.$flag}) { |
243 |
$converter = $Converter->{'/'.$opt{Name}.'/'.$opt{Version}.$flag}; |
$converter = $Converter->{'/'.$opt{Name}.'/'.$opt{Version}.$flag}; |
244 |
} |
} |
245 |
return $converter->{Main}->($self, $source, \%opt) if $converter; |
return ($converter->{$opt{return_type} or 'Main'} or |
246 |
|
CORE::die "Buggy implementation: $type $opt{Name}/$opt{Version}$flag/@{[$opt{return_type} or 'Main']} not defined") |
247 |
|
->($self, $source, \%opt) |
248 |
|
if $converter; |
249 |
$self->SUPER::convert ($source, %opt); |
$self->SUPER::convert ($source, %opt); |
250 |
} |
} |
251 |
EOH |
EOH |
280 |
$r .= qq(}\n); |
$r .= qq(}\n); |
281 |
} elsif ($_->local_name eq 'Use') { |
} elsif ($_->local_name eq 'Use') { |
282 |
$r .= line $Info, node_path => qq(Format[module-name()=$module_name]/Use); |
$r .= line $Info, node_path => qq(Format[module-name()=$module_name]/Use); |
283 |
$r .= $_->inner_text; |
$r .= code $Info, $_->inner_text; |
284 |
} |
} |
285 |
} |
} |
286 |
$r; |
$r; |
312 |
$flag .= 'p' and $def{IsPlaceholder} = 1 |
$flag .= 'p' and $def{IsPlaceholder} = 1 |
313 |
if $src->get_attribute_value ('IsPlaceholder'); |
if $src->get_attribute_value ('IsPlaceholder'); |
314 |
|
|
315 |
$def{Main} = $src->get_attribute_value ('Main'); |
for (qw/Main ToString ToOctetStream/) { |
316 |
$def{Main} = line ($Info, node_path => '//Converter/Main') |
my $def = $src->get_attribute_value ($_); |
317 |
. $def{Main} |
next unless $def; |
318 |
. line ($Info, reset => 1); |
$def{$_} = line ($Info, node_path => '//Converter/'.$_) |
319 |
if ($def{Main} =~ /\$r\b/) { |
. $def |
320 |
$def{Main} = 'my $r;'."\n".$def{Main}."\n".'$r'; |
. line ($Info, reset => 1); |
321 |
} |
if ($def{$_} =~ /\$r\b/) { |
322 |
$def{Main} = barecode code $Info, |
$def{$_} = 'my $r;'."\n".$def{$_}."\n".'$r'; |
323 |
'sub {my ($self, $source, $opt) = @_;' |
} |
324 |
. $def{Main} . '}'; |
$def{$_} = barecode code $Info, |
325 |
|
'sub {my ($self, $source, $opt) = @_;' |
326 |
|
. $def{$_} . '}'; |
327 |
|
} |
328 |
|
|
329 |
my $r = list %def; |
my $r = list %def; |
330 |
if ($def{Type}) { |
if ($def{Type}) { |
364 |
sub make_resdef ($$) { |
sub make_resdef ($$) { |
365 |
my ($src, $Info) = @_; |
my ($src, $Info) = @_; |
366 |
my $r = change_package $Info, 'SuikaWiki::Plugin::Resource'; |
my $r = change_package $Info, 'SuikaWiki::Plugin::Resource'; |
367 |
|
local $Info->{-message_error_used} = 0; |
368 |
$r .= qq{our \$BaseResource;\n}; |
$r .= qq{our \$BaseResource;\n}; |
369 |
for (@{$src->child_nodes}) { |
for (@{$src->child_nodes}) { |
370 |
if ($_->node_type eq '#element') { |
if ($_->node_type eq '#element') { |
428 |
@{[change_package $Info, $ViewProp->{pack_name}]} |
@{[change_package $Info, $ViewProp->{pack_name}]} |
429 |
our \@ISA = q#SuikaWiki::View::template#; |
our \@ISA = q#SuikaWiki::View::template#; |
430 |
EOH |
EOH |
431 |
|
local $Info->{-message_error_used} = 0; |
432 |
my $use = $src->get_attribute ('Use'); |
my $use = $src->get_attribute ('Use'); |
433 |
if (ref $use) { |
if (ref $use) { |
434 |
$r .= line $Info, node_path => "ViewDefinition[Mode='$ViewProp->{Name}']/Use"; |
$r .= line $Info, node_path => "ViewDefinition[Mode='$ViewProp->{Name}']/Use"; |
435 |
$r .= $use->inner_text . "\n\n"; |
$r .= code $Info, $use->inner_text; |
436 |
|
$r .= "\n\n"; |
437 |
} |
} |
438 |
|
|
439 |
for (@{$src->child_nodes}) { |
for (@{$src->child_nodes}) { |
476 |
|
|
477 |
\$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]}; |
478 |
\$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) |
|
|
]}}, |
|
479 |
## SuikaWiki 3 WikiPlugin interface |
## SuikaWiki 3 WikiPlugin interface |
480 |
wiki => \$self->{view}->{wiki}, |
wiki => \$self->{view}->{wiki}, |
481 |
plugin => \$self->{view}->{wiki}->{plugin}, |
plugin => \$self->{view}->{wiki}->{plugin}, |
499 |
qq{\$opt2->{output}->set_expires (delta => @{[0 + $x]});}; |
qq{\$opt2->{output}->set_expires (delta => @{[0 + $x]});}; |
500 |
} |
} |
501 |
}]} |
}]} |
502 |
|
\$opt2->{output}->{entity}->{body_is_octet_stream} = @{[ |
503 |
|
$src->get_attribute ('body')->get_attribute_value ('is-octet-stream', default_value => 0) |
504 |
|
or 0 |
505 |
|
]}; |
506 |
|
|
507 |
\$self->{view}->{wiki}->init_db; |
\$self->{view}->{wiki}->init_db; |
508 |
\$self->main_pre (\$opt, \$opt2); |
\$self->main_pre (\$opt, \$opt2); |
598 |
} |
} |
599 |
EOH |
EOH |
600 |
my $r = change_package $Info, $Info->{module_name}; |
my $r = change_package $Info, $Info->{module_name}; |
601 |
|
local $Info->{-message_error_used} = 0; |
602 |
if (@$type == 1) { |
if (@$type == 1) { |
603 |
$type->[0] =~ tr/-/_/; |
$type->[0] =~ tr/-/_/; |
604 |
$r .= qq{\$SuikaWiki::Plugin::Rule{$type->[0]}->{$name} = $main;\n}; |
$r .= qq{\$SuikaWiki::Plugin::Rule{$type->[0]}->{$name} = $main;\n}; |
625 |
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]), |
626 |
join ('', @rand[rand@rand,rand@rand,rand@rand,rand@rand]); |
join ('', @rand[rand@rand,rand@rand,rand@rand,rand@rand]); |
627 |
} |
} |
628 |
|
|
629 |
|
=head1 NAME |
630 |
|
|
631 |
|
mkplugin2.pl - SuikaWiki: WikiPlugin Generator |
632 |
|
|
633 |
|
=head1 SYNOPSIS |
634 |
|
|
635 |
|
mkplugin2.pl pluginsrc.wp2 > plugin.pm |
636 |
|
|
637 |
|
=head1 DESCRIPTION |
638 |
|
|
639 |
|
C<mkplugin2.pl> generates WikiPlugin module as a Perl module file |
640 |
|
from WikiPlugin source description. WikiPlugin source description |
641 |
|
is described in SuikaWikiConfig/2.0 format and it contains |
642 |
|
definitions of wiki constructions (such as formatting rules and |
643 |
|
WikiView definitions) as both machine understandable code and |
644 |
|
human readable documentation. For more information, see |
645 |
|
<http://suika.fam.cx/~wakaba/-temp/wiki/wiki?WikiPlugin>. |
646 |
|
|
647 |
|
This script is part of SuikaWiki. |
648 |
|
|
649 |
|
=head1 HISTORY AND COMPATIBILITY |
650 |
|
|
651 |
|
C<mkplugin2.pl> introduced as part of SuikaWiki 3. |
652 |
|
It converts SuikaWiki 3 WikiPlugin source descriptions |
653 |
|
(in SuikaWikiConfig/2.0) into Perl modules with SuikaWiki 3 interface. |
654 |
|
|
655 |
|
SuikaWiki 2 has C<mkplugin.pl>. It also converts WikiPlugin |
656 |
|
source descriptions into Perl modules. But it support |
657 |
|
SuikaWiki 2 format of WikiPlugin source description that differs from |
658 |
|
SuikaWiki 3 format. Wiki programming interface (not limited to |
659 |
|
WikiPlugin related one) of SuikaWiki 3 also incompatible with that |
660 |
|
of SuikaWiki 2 so that it is impossible to use SuikaWiki 2 WikiPlugin |
661 |
|
module with SuikaWiki 3 and vice versa. |
662 |
|
|
663 |
|
=head1 SEE ALSO |
664 |
|
|
665 |
|
C<SuikaWiki::Plugin>, SuikaWiki:WikiPlugin |
666 |
|
<http://suika.fam.cx/~wakaba/-temp/wiki/wiki?WikiPlugin>. |
667 |
|
|
668 |
|
=head1 LICENSE |
669 |
|
|
670 |
|
Copyright 2003-2004 Wakaba <w@suika.fam.cx>. All rights reserved. |
671 |
|
|
672 |
|
This program is free software; you can redistribute it and/or |
673 |
|
modify it under the same terms as Perl itself. |
674 |
|
|
675 |
|
=cut |
676 |
|
|
677 |
|
1; # $Date$ |