/[pub]/suikawiki/script/bin/mkplugin2.pl
Suika

Contents of /suikawiki/script/bin/mkplugin2.pl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.12 - (hide annotations) (download)
Sun Feb 8 08:58:24 2004 UTC (20 years, 8 months ago) by wakaba
Branch: MAIN
Changes since 1.11: +22 -28 lines
File MIME type: text/plain
Some new options supported

1 wakaba 1.1 #!/usr/bin/perl
2     use strict;
3 wakaba 1.12 our $VERSION = do{my @r=(q$Revision: 1.11 $=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};
4 wakaba 1.5 require Message::Markup::SuikaWikiConfig20::Parser;
5 wakaba 1.1
6 wakaba 1.2 {
7 wakaba 1.1 my $src = '';
8     my $srcfile = shift;
9     open SRC, $srcfile or die "$0: $!"; {
10     local $/ = undef;
11     $src = <SRC>;
12     } close SRC;
13    
14     sub literal ($) {
15     my $s = shift;
16 wakaba 1.2 if (ref ($s) eq 'ARRAY') {
17     q<[> . list (@$s) . q<]>;
18     } elsif (ref ($s) eq 'HASH') {
19     q<{> . hash (%$s) . q<}>;
20     } elsif (ref ($s) eq 'bare') {
21     $$s;
22     } else {
23     $s =~ s/([#\\])/\\$1/g;
24     q<q#> . $s . q<#>;
25     }
26     }
27     sub list (@) {
28     join ', ', map {literal $_} @_;
29     }
30     sub hash (%) {
31     my $i = 0;
32     list map {($i++ % 2) ? $_ : do {my $s = $_; $s =~ s/(?<=.)-/_/; $s}} @_;
33 wakaba 1.1 }
34     sub n11n ($) {
35     my $s = shift;
36     $s =~ s/\s+/ /g;
37     $s;
38     }
39 wakaba 1.2 sub m13ed_val_list ($$) {
40     my ($src, $key) = @_;
41     my @r;
42     for (@{$src->child_nodes}) {
43     if ($_->local_name eq $key) {
44     push @r, [scalar $_->inner_text,
45     scalar $_->get_attribute ('lang', make_new_node => 1)
46     ->inner_text,
47     scalar $_->get_attribute ('script', make_new_node => 1)
48     ->inner_text];
49     }
50     }
51     list @r;
52     }
53     sub barecode ($) {
54     bless \$_[0], 'bare';
55     }
56     sub code ($$) {
57     my ($Info, $code) = @_;
58     for (keys %{$Info->{const}}) {
59 wakaba 1.11 $code =~ s/\$$_\b/$Info->{const}->{$_}/ge;
60 wakaba 1.2 }
61     $code =~ s/__FUNCPACK__/$Info->{module_name}/g;
62     $code;
63     }
64 wakaba 1.5 sub change_package ($$) {
65     my ($Info, $pack) = @_;
66     unless ($Info->{current_package} eq $pack) {
67     $Info->{current_package} = $pack;
68     return qq{package $pack;\n\n};
69     } else {
70     return '';
71     }
72     }
73     sub quoted_string ($) {
74     my $s = shift;
75     $s =~ s/([\\"])/\\$1/g;
76     '"'.$s.'"';
77     }
78 wakaba 1.6 sub line ($;%) {
79     my ($Info, %opt) = @_;
80    
81     unless ($opt{file}) {
82     if ($opt{reset}) {
83     $opt{file} = sprintf '(WikiPlugin module %s, chunk %d)',
84     $Info->{Name},
85     ++$Info->{chunk_count};
86     } elsif ($opt{realfile}) {
87     $opt{file} = sprintf '(WikiPlugin module %s, chunk from %s)',
88     $Info->{Name},
89     $opt{realfile};
90     } else {
91 wakaba 1.7 $opt{file} = sprintf '(WikiPlugin module source %s, block %s)',
92     $Info->{source_file},
93 wakaba 1.6 $opt{node_path};
94     }
95     }
96    
97     $opt{file} =~ s/"/''/g;
98     sprintf '%s#line %d "%s"%s', "\n", $opt{line_no} || 1, $opt{file}, "\n";
99     }
100 wakaba 1.9 sub literal_or_code ($$) {
101     my ($Info, $s) = @_;
102     substr ($s, 0, 1) ne '{' ? literal ($s)
103     : code ($Info, substr ($s, 1, length ($s) - 2));
104     }
105 wakaba 1.1
106 wakaba 1.5 my $parser = Message::Markup::SuikaWikiConfig20::Parser->new;
107 wakaba 1.1 my $plugins = $parser->parse_text ($src);
108     my $meta = $plugins->get_attribute ('Plugin')
109     or die "$0: Required 'Plugin' section not found";
110 wakaba 1.2 my %Info = (provide => {},
111     Name => n11n $meta->get_attribute ('Name')->value);
112 wakaba 1.7 $Info{source_file} = $srcfile;
113 wakaba 1.1 $Info{name_literal} = literal $Info{Name};
114     my @date = gmtime;
115     $Info{LastModified} = sprintf '%04d-%02d-%02dT%02d:%02d:%02d+00:00',
116     $date[5] + 1900, $date[4] + 1, @date[3,2,1,0];
117     $Info{Version} = sprintf '%04d.%02d%02d.%02d%02d',
118     $date[5] + 1900, $date[4] + 1, @date[3,2,1];
119 wakaba 1.2 $Info{InterfaceVersion} = '2.9.1';
120     $Info{mkpluginVersion} = '2.'.$VERSION;
121 wakaba 1.1 $Info{module_name} = q#SuikaWiki::Plugin::plugin#;
122     $Info{module_name} = random_module_name (\%Info, $Info{Name});
123    
124     print <<EOH;
125     use strict;
126 wakaba 1.5 @{[change_package \%Info, 'SuikaWiki::Plugin::Registry']}
127 wakaba 1.1 our \%Info;
128     \$Info{$Info{name_literal}}->{Name} = $Info{name_literal};
129     EOH
130 wakaba 1.5 for (qw/Version InterfaceVersion mkpluginVersion module_name/) {
131     print qq{\$Info{$Info{name_literal}}->{$_} = @{[literal $Info{$_}]};\n};
132 wakaba 1.2 }
133     for (qw/LastModified/) {
134 wakaba 1.1 $Info{$_} = n11n $meta->get_attribute ($_,make_new_node=>1)->value;
135     next unless length $Info{$_};
136     print qq{\$Info{$Info{name_literal}}->{$_} = } . literal $Info{$_};
137     print ";\n";
138     }
139 wakaba 1.2 for (qw/RequiredPlugin RequiredModule/) {
140 wakaba 1.1 $Info{$_} = $meta->get_attribute ($_);
141     next unless ref $Info{$_}; $Info{$_} = $Info{$_}->value;
142     print qq{\$Info{$Info{name_literal}}->{$_} = [};
143     print join ', ', map {literal $_} @{$Info{$_}};
144     print "];\n";
145     }
146 wakaba 1.2 for (qw/Description License RelatedWikiPage RelatedURI/) {
147     my $r = m13ed_val_list $meta, $_;
148     next unless $r;
149     print qq{\$Info{$Info{name_literal}}->{$_} = [$r];\n};
150     }
151    
152     print qq{\$Info{$Info{name_literal}}->{Author} = [} .( list map {
153     [
154     [ barecode m13ed_val_list ($_, 'Name') ],
155     [ $_->get_attribute ('Mail', make_new_node => 1)->value ],
156     [ $_->get_attribute ('URI', make_new_node => 1)->value ],
157     ]
158     } grep { $_->local_name eq 'Author' } @{$meta->child_nodes}
159     ). qq{];\n};
160 wakaba 1.1
161 wakaba 1.5 my $use = $meta->get_attribute ('Use');
162     if (ref $use) {
163     print change_package \%Info, $Info{module_name};
164 wakaba 1.6 print line \%Info, node_path => 'Plugin/Use';
165     print $use->inner_text, "\n";
166     print line \%Info, reset => 1;
167 wakaba 1.5 }
168    
169 wakaba 1.1 for (@{$plugins->child_nodes}) {
170 wakaba 1.2 if ($_->local_name eq 'FormattingRule') {
171     print "\n", make_rule ($_, \%Info);
172     } elsif ($_->local_name eq 'ViewDefinition') {
173 wakaba 1.1 print "\n", make_viewdef ($_, \%Info);
174     } elsif ($_->local_name eq 'ViewFragment') {
175     print "\n", make_viewfragment ($_, \%Info);
176 wakaba 1.2 } elsif ($_->local_name eq 'Function') {
177     print "\n", make_function ($_, \%Info);
178     } elsif ($_->local_name eq 'Resource') {
179     print "\n", make_resdef ($_, \%Info);
180     } elsif ($_->local_name eq 'PluginConst') {
181     register_plugin_const ($_, \%Info);
182 wakaba 1.5 } elsif ($_->local_name eq 'Format') {
183     print "\n", make_format ($_, \%Info);
184 wakaba 1.9 # Parameter
185     # PluginCategory
186 wakaba 1.1 }
187     }
188    
189 wakaba 1.5 print change_package \%Info, q(SuikaWiki::Plugin::Registry);
190 wakaba 1.2 print qq{\$Info{$Info{name_literal}}->{provide} = } . literal $Info{provide};
191     print qq{;\n};
192    
193 wakaba 1.1 print "\n1;\n";
194     exit;
195 wakaba 1.2 }
196    
197 wakaba 1.5 sub make_format ($$) {
198     my ($src, $Info) = @_;
199     my $module_name = 'SuikaWiki::Format::Definition::'.$src->get_attribute_value ('ModuleName');
200     my $r = change_package $Info, $module_name;
201     $r .= qq{our \@ISA;\n};
202     if (my $isa = $src->get_attribute_value ('Inherit')) {
203     for (@$isa) {
204     $r .= qq{push \@ISA, @{[literal 'SuikaWiki::Format::Definition::'.$_]};\n};
205     }
206     } else {
207     $r .= qq{push \@ISA, 'SuikaWiki::Format::Definition::template';\n};
208     }
209     if (my $name = $src->get_attribute_value ('Name')) {
210     $r .= qq{\$SuikaWiki::Format::Definition::Class{@{[literal '/'.$name.'/'.$src->get_attribute_value ('Version', default => '').'//']}} = '$module_name';\n};
211     }
212     if (my $type = $src->get_attribute_value ('Type')) {
213 wakaba 1.10 $type .= join '', map {
214     ';'. $_->local_name .'='. quoted_string $_->inner_text
215     } sort {
216     $a->local_name cmp $b->local_name
217     } @{$src->get_attribute ('Type')->child_nodes};
218 wakaba 1.5 $r .= qq{\$SuikaWiki::Format::Definition::Class{@{[literal $type.'//']}} = '$module_name';\n};
219     }
220    
221 wakaba 1.8 my $convert = line $Info, line_no => __LINE__ + 2, realfile => __FILE__;
222     $convert .= <<'EOH';
223 wakaba 1.5 our $Converter;
224     sub convert ($$;%) {
225     my ($self, $source, %opt) = @_;
226     my $converter;
227     my $flag = '//';
228     $flag .= 'f' if $opt{IsFragment};
229     $flag .= 'p' if $opt{IsPlaceholder};
230 wakaba 1.11 my $type = $opt{Type} ?
231     $opt{Type} .
232     SuikaWiki::Format::Definition->__get_param_string
233     ($opt{Type_param}) : undef;
234     if ($Converter->{$type.$flag}) {
235     $converter = $Converter->{$type.$flag};
236 wakaba 1.5 } elsif ($Converter->{$opt{Name}.'/'.$opt{Version}.$flag}) {
237     $converter = $Converter->{'/'.$opt{Name}.'/'.$opt{Version}.$flag};
238     }
239 wakaba 1.12 return ($converter->{$opt{return_type} or 'Main'} or
240     CORE::die "Buggy implementation: $type $opt{Name}/$opt{Version}$flag/@{[$opt{return_type} or 'Main']} not defined")
241     ->($self, $source, \%opt)
242     if $converter;
243 wakaba 1.5 $self->SUPER::convert ($source, %opt);
244     }
245     EOH
246    
247     for (@{$src->child_nodes}) {
248     if ($_->local_name eq 'Converter') {
249 wakaba 1.8 if ($convert) {
250     $r .= $convert;
251     $r .= line $Info, reset => 1;
252     undef $convert;
253     }
254 wakaba 1.5 $r .= make_format_converter ($_, $Info);
255 wakaba 1.10 } elsif ($_->local_name eq 'WikiForm') {
256     $r .= q(sub wikiform {)."\n".q(my ($self, $source, %opt) = @_;);
257     $r .= line $Info, node_path => qq(Format[module-name()=$module_name]/WikiForm);
258     $r .= code $Info, $_->get_attribute_value ('Main');
259     $r .= line $Info, reset => 1;
260     $r .= qq(}\n);
261 wakaba 1.11 } elsif ($_->local_name eq 'HeadSummary') {
262     $r .= q(sub headsummary {)."\n".q(my ($self, $source, %opt) = @_;);
263     $r .= line $Info, node_path => qq(Format[module-name()=$module_name]/HeadSummary);
264     $r .= code $Info, $_->get_attribute_value ('Main');
265     $r .= line $Info, reset => 1;
266     $r .= qq(}\n);
267 wakaba 1.10 } elsif ($_->local_name eq 'NextIndex') {
268     my $name = $_->get_attribute_value ('Name', default => '');
269     $r .= q(sub next_index_for_).$name
270     . q( {)."\n".q(my ($self, $source, %opt) = @_;)
271     . line $Info, node_path => qq(Format[module-name()=$module_name]/NextIndex[Name=$name]);
272     $r .= code $Info, $_->get_attribute_value ('Main');
273     $r .= line $Info, reset => 1;
274     $r .= qq(}\n);
275 wakaba 1.5 } elsif ($_->local_name eq 'Use') {
276 wakaba 1.6 $r .= line $Info, node_path => qq(Format[module-name()=$module_name]/Use);
277 wakaba 1.5 $r .= $_->inner_text;
278     }
279     }
280     $r;
281     }
282    
283     sub make_format_converter ($$) {
284     my ($src, $Info) = @_;
285     my %def;
286     $def{Type} = $src->get_attribute ('Type');
287     if (ref $def{Type}) {
288     $def{Type} = $def{Type}->inner_text
289     . join '', map {
290     ';'. $_->local_name .'='. quoted_string $_->inner_text
291     } sort {
292     $a->local_name cmp $b->local_name
293     } @{$def{Type}->child_nodes};
294     } else {
295     delete $def{Type};
296     }
297     $def{Name} = $src->get_attribute_value ('Name');
298     delete $def{Name} unless defined $def{Name};
299     $def{Version} = $src->get_attribute_value ('Version');
300     delete $def{Version} if not defined $def{Version} or
301     not defined $def{Name};
302    
303     my $flag = '//';
304     $flag .= 'f' and $def{IsFragment} = 1
305     if $src->get_attribute_value ('IsFragment');
306     $flag .= 'p' and $def{IsPlaceholder} = 1
307     if $src->get_attribute_value ('IsPlaceholder');
308    
309 wakaba 1.12 for (qw/Main ToString ToOctetStream/) {
310     my $def = $src->get_attribute_value ($_);
311     next unless $def;
312     $def{$_} = line ($Info, node_path => '//Converter/'.$_)
313     . $def
314     . line ($Info, reset => 1);
315     if ($def{$_} =~ /\$r\b/) {
316     $def{$_} = 'my $r;'."\n".$def{$_}."\n".'$r';
317     }
318     $def{$_} = barecode code $Info,
319     'sub {my ($self, $source, $opt) = @_;'
320     . $def{$_} . '}';
321     }
322 wakaba 1.5
323     my $r = list %def;
324     if ($def{Type}) {
325     $r = qq{\$Converter->{@{[literal $def{Type}.$flag]}} = {$r};\n};
326     $r .= qq{\$Converter->{@{[literal '/'.$def{Name}.'/'.$def{Version}.$flag]}} = \$Converter->{@{[literal $def{Type}.$flag]}};\n}
327     if $def{Name};
328     } elsif ($def{Name}) {
329     $r = qq{\$Converter->{@{[literal '/'.$def{Name}.'/'.$def{Version}.$flag]}} = {$r};\n};
330 wakaba 1.9 } else {
331     $r = 'BEGIN { die "Invalid Syntax of Converter: Type or Name property required" }';
332 wakaba 1.5 }
333     $r;
334     }
335    
336 wakaba 1.2 sub make_function ($$) {
337     my ($src, $Info) = @_;
338     ## TODO: support of ARGV property
339 wakaba 1.6 my $name;
340 wakaba 1.2 my $r = <<EOH;
341 wakaba 1.5 @{[change_package $Info, $Info->{module_name}]}
342 wakaba 1.6 sub @{[$name = $src->get_attribute_value ('Name')]} {
343     @{[line $Info, node_path => "Function[Name='$name']/Main"]}@{[
344     code $Info, $src->get_attribute_value ('Main')
345 wakaba 1.9 ]}
346 wakaba 1.2 }
347 wakaba 1.9 @{[line $Info, reset => 1]}
348 wakaba 1.2 EOH
349     }
350    
351     sub register_plugin_const ($$) {
352     my ($src, $Info) = @_;
353     for (@{$src->child_nodes}) {
354 wakaba 1.11 $Info->{const}->{$_->local_name} = literal_or_code $Info, $_->value;
355 wakaba 1.2 }
356     }
357    
358     sub make_resdef ($$) {
359     my ($src, $Info) = @_;
360 wakaba 1.5 my $r = change_package $Info, 'SuikaWiki::Plugin::Resource';
361     $r .= qq{our \$BaseResource;\n};
362 wakaba 1.2 for (@{$src->child_nodes}) {
363     if ($_->node_type eq '#element') {
364     my $lang = literal ($_->get_attribute_value ('lang') || 'und');
365     my $script = literal $_->get_attribute_value ('script');
366     my $name = literal $_->local_name;
367     my $val = literal n11n $_->value;
368     $r .= qq{\$BaseResource->{$lang}->{$script}->{$name} = $val;\n};
369     }
370     }
371     $r;
372     }
373 wakaba 1.1
374     sub make_viewfragment ($$) {
375     my ($src, $Info) = @_;
376     my $r = '';
377 wakaba 1.4 my $body = <<EOH;
378     {
379 wakaba 1.2 Main => @{[literal $src->get_attribute_value ('Formatting')]},
380     Order => @{[0+$src->get_attribute_value ('Order')]},
381     Description => [@{[m13ed_val_list $src, 'Description']}],
382     };
383     EOH
384 wakaba 1.4 ## Recommended format
385     my $name = $src->get_attribute_value ('Template');
386     if (ref ($name) and @$name > 1) {
387     $r .= qq({my \$def = $body;\n);
388     for (@$name) {
389     my $name = $_; $name =~ tr/-/_/;
390     $r .= qq(push \@{\$SuikaWiki::View::Implementation::TemplateFragment{@{[literal $name]}}}, \$def;\n);
391     push @{$Info->{provide}->{viewfragment}}, {Name => $name};
392     }
393     $r .= qq(}\n);
394     } else { ## Obsoleted format
395     $name = ref $name ? $name->[0] : $src->get_attribute_value ('Name');
396     $name =~ tr/-/_/;
397     $r .= qq(push \@{\$SuikaWiki::View::Implementation::TemplateFragment{@{[literal $name]}}}, $body);
398     push @{$Info->{provide}->{viewfragment}}, {Name => $name};
399     }
400 wakaba 1.1 $r;
401     }
402    
403     sub make_viewdef ($$) {
404     my ($src, $Info) = @_;
405     my $ViewProp = {};
406     my $r = '';
407 wakaba 1.6 $ViewProp->{Name} = n11n $src->get_attribute_value ('Mode');
408 wakaba 1.10 $ViewProp->{Name} =~ s/(?<=.)-/_/g;
409 wakaba 1.1 $ViewProp->{pack_name} = random_module_name ($Info, $ViewProp->{Name});
410    
411 wakaba 1.2 $ViewProp->{condition_stringified} = hash
412 wakaba 1.1 mode => $ViewProp->{Name},
413     map {($_->local_name => $_->value)}
414     @{$src->get_attribute ('Condition',make_new_node=>1)->child_nodes};
415    
416     $r .= <<EOH;
417     push \@SuikaWiki::View::Implementation::CommonViewDefs, {
418     condition => {$ViewProp->{condition_stringified}},
419     object_class => q#$ViewProp->{pack_name}#,
420     };
421 wakaba 1.5 @{[change_package $Info, $ViewProp->{pack_name}]}
422 wakaba 1.1 our \@ISA = q#SuikaWiki::View::template#;
423     EOH
424 wakaba 1.11
425     my $use = $src->get_attribute ('Use');
426     if (ref $use) {
427     $r .= line $Info, node_path => "ViewDefinition[Mode='$ViewProp->{Name}']/Use";
428     $r .= $use->inner_text . "\n\n";
429     }
430    
431 wakaba 1.1 for (@{$src->child_nodes}) {
432 wakaba 1.2 if ($_->local_name eq 'template') {
433 wakaba 1.8 $r .= make_view_template_method ($_, $Info, $ViewProp);
434 wakaba 1.2 } elsif ($_->local_name eq 'method') {
435 wakaba 1.6 my $method_name = $_->get_attribute_value ('Name');
436 wakaba 1.1 $r .= ({
437 wakaba 1.8 main => q(sub main ($$) {)."\n".q(my ($self, $opt, $opt2) = @_;)."\n",
438 wakaba 1.1 main_pre => q(sub main_pre ($$$) {)."\n".q(my ($self, $opt, $opt2) = @_;)."\n",
439     main_post => q(sub main_post ($$$) {)."\n".q(my ($self, $opt, $opt2) = @_;)."\n",
440 wakaba 1.6 }->{$method_name}
441     ||qq(sub @{[$method_name]} {\n))
442     . line ($Info, node_path => "ViewDefinition[Mode='$ViewProp->{Name}']/method[Name='$method_name']")
443 wakaba 1.2 . code ($Info, $_->value)
444 wakaba 1.9 . qq(}\n)
445     . line ($Info, reset => 1);
446 wakaba 1.1 }
447     }
448 wakaba 1.2 my $prop = {Name => $ViewProp->{Name},
449     Description => barecode m13ed_val_list $_, 'Description'};
450     push @{$Info->{provide}->{viewdef}}, $prop;
451     $r;
452     }
453    
454     sub make_view_template_method ($$) {
455 wakaba 1.8 my ($src, $Info, $ViewProp) = @_;
456 wakaba 1.2 my $r = <<EOH;
457    
458     sub main (\$\$\$) {
459     my (\$self, \$opt, \$opt2) = \@_;
460     require SuikaWiki::Output::HTTP;
461     \$opt2->{output} = SuikaWiki::Output::HTTP->new
462     (wiki => \$self->{view}->{wiki},
463     view => \$self->{view}, viewobj => \$self);
464     for (\@{\$self->{view}->{wiki}->{var}->{client}->{used_for_negotiate}},
465     'Accept-Language') {
466     \$opt2->{output}->add_negotiate_header_field (\$_);
467     }
468    
469     \$opt2->{template} = @{[literal $src->get_attribute ('body', make_new_node => 1)->inner_text]};
470     \$opt2->{o} = bless {
471     ## SuikaWiki 3 WikiPlugin interface
472     wiki => \$self->{view}->{wiki},
473     plugin => \$self->{view}->{wiki}->{plugin},
474     var => {},
475     }, 'SuikaWiki::Plugin';
476     @{[do{my $x=$src->get_attribute('http-status-code',make_new_node=>1)->inner_text;
477     $x?q{$opt2->{output}->{status_code} = }.(0 + $x).q{;}:q{}}]}
478     @{[do{my $x=$src->get_attribute('http-status-phrase',make_new_node=>1)->inner_text;
479 wakaba 1.8 $x?q{$opt2->{output}->{status_phrase} = }.literal($x).q{;}:q{}}]}
480 wakaba 1.2 \$opt2->{output}->{entity}->{media_type} = @{[literal
481     $src->get_attribute ('media-type',make_new_node=>1)
482     ->inner_text || 'application/octet-stream']};
483     @{[($src->get_attribute ('use-media-type-charset',make_new_node=>1)
484     ->inner_text || 0) ?
485     q{$opt2->{output}->{entity}->{charset} = $self->{view}->{wiki}->{config}->{charset}->{output};}:
486     q{}]}
487     @{[do{my $x = $src->get_attribute ('expires',make_new_node=>1)->inner_text;
488     if ($x =~ /%%(\w+)%%/) {
489     qq{\$opt2->{output}->set_expires (%{\$self->{view}->{wiki}->{config}->{entity}->{expires}->{@{[literal $1]}}});};
490     } else {
491     qq{\$opt2->{output}->set_expires (delta => @{[0 + $x]});};
492     }
493     }]}
494 wakaba 1.12 \$opt2->{output}->{entity}->{body_is_octet_stream} = @{[
495     $src->get_attribute ('body')->get_attribute_value ('is-octet-stream', default_value => 0)
496     or 0
497     ]};
498 wakaba 1.2
499     \$self->{view}->{wiki}->init_db;
500     \$self->main_pre (\$opt, \$opt2);
501    
502 wakaba 1.8 use Message::Util::Error;
503     try {
504     \$opt2->{output}->{entity}->{body}
505     = SuikaWiki::Plugin->formatter ('view')
506     ->replace (\$opt2->{template}, param => \$opt2->{o});
507     } \$self->{view}->{wiki}->{config}->{catch}->{ @{[
508     $ViewProp->{Name} eq '-error' ? 'formatter_view_error'
509     : 'formatter_view' ]} };
510 wakaba 1.2 \$opt2->{output}->output (output => 'http-cgi');
511    
512     \$self->main_post (\$opt, \$opt2);
513     }
514     EOH
515     }
516    
517     sub make_rule ($$) {
518     my ($src, $Info) = @_;
519     my $type = $src->get_attribute ('Category', make_new_node => 1)->value || [];
520     my $name = $src->get_attribute ('Name', make_new_node => 1)->value;
521 wakaba 1.5 $name =~ s/(?<=.)-/_/g;
522    
523     my $reg_block;
524     $reg_block = qr/[^{}]*(?>[^{}]+|{(??{$reg_block})})*/;
525 wakaba 1.10 my %code;
526     for my $codename ([qw/Formatting main/], [qw/After after/],
527     [qw/Before before/], [qw/Pre pre/], [qw/Post post/],
528     [qw/Attribute attr/]) {
529     my $main = code $Info, $src->get_attribute_value ($codename->[0]);
530     next unless $main;
531     $main = line ($Info, node_path =>
532     "FormattingRule[name()='@{[list $type]}/$name']/".$codename->[0])
533     . $main;
534    
535 wakaba 1.11 if ( $main =~ /\$f\b/
536 wakaba 1.10 or $main =~ /\$rule_name\b/
537     or $main =~ /\$[opr]\b/
538 wakaba 1.11 or $main =~ /[%\$]opt\b/
539     or $main =~ /\$param_(?:name|value)\n/) {
540     if ($codename->[0] ne 'Attribute') {
541     $main = q{my ($f, $rule_name, $p, $o, %opt) = @_;}."\n".$main;
542     } else {
543     $main = q{my ($f, $rule_name, $p, $o, $param_name => $param_value, %opt) = @_;}."\n".$main;
544     }
545     }
546 wakaba 1.10 if ($main =~ /\$r\b/) {
547     warn qq(Rule @{[list $type]}/$name: Use of \$r is deprecated);
548     $main = q{my $r = '';} . "\n" . $main . "\n"
549     . q{$p->{-parent}->append_node ($r, node_or_text => 1);};
550     }
551     $main =~ s{__ATTR(TEXT|NODE)?:%(\w+|{$reg_block})(?:->{($reg_block)})?__;}
552     {($1 eq 'TEXT' ? '$p->{'.literal_or_code($Info, $2)
553     .'} = do { my $r = ' : '')
554     .'$f->parse_attr ($p=>'.literal_or_code($Info, $2).', $o, '
555     .($3?'-parent => '.$3.', ':'')
556     .($1?'-non_parsed_to_node => 1, ':'')
557     .'%opt)'
558     .($1 eq 'TEXT' ? '; ref $r?$r->inner_text:$r}'
559     : '')
560     .';'}ge;
561     $code{$codename->[1]} = barecode "sub {$main}";
562     }
563    
564     my $main = literal {
565     Description => [barecode m13ed_val_list $src, 'Description'],
566     Parameter => {do {
567     my @r;
568     for (@{$src->child_nodes}) {
569     if ($_->local_name eq 'Parameter') {
570     push @r, $_->get_attribute_value ('Name')
571     => {Type => $_->get_attribute_value ('Type'),
572     Default => $_->get_attribute_value ('Default'),
573     Description => [barecode m13ed_val_list $_, 'Description']};
574     }
575     }
576     @r;
577     }},
578     %code,
579     };
580     $main .= line $Info, reset => 1;
581    
582    
583     my $amain = <<EOH;
584 wakaba 1.2 {
585 wakaba 1.5 main => sub {$main},
586 wakaba 1.9 @{[line ($Info, reset => 1)]}
587 wakaba 1.2 Description => [@{[m13ed_val_list $src, 'Description']}],
588     Parameter => {@{[do{
589     }]}},
590     }
591     EOH
592 wakaba 1.5 my $r = change_package $Info, $Info->{module_name};
593 wakaba 1.2 if (@$type == 1) {
594     $type->[0] =~ tr/-/_/;
595 wakaba 1.5 $r .= qq{\$SuikaWiki::Plugin::Rule{$type->[0]}->{$name} = $main;\n};
596 wakaba 1.2 push @{$Info->{provide}->{rule}->{$type->[0]}}, $name;
597     } else {
598 wakaba 1.5 $r .= qq({my \$def = $main;\n);
599 wakaba 1.2 for my $type (@$type) {
600     $type =~ tr/-/_/;
601     $r .= qq{\$SuikaWiki::Plugin::Rule{$type}->{$name} = \$def;\n};
602     push @{$Info->{provide}->{rule}->{$type}}, $name;
603     }
604     $r .= qq(};\n);
605     }
606 wakaba 1.1 $r;
607     }
608    
609    
610     sub random_module_name ($;$) {
611     my ($Info, $subname) = @_;
612     $subname =~ s/[^0-9A-Za-z_:]//g;
613     my @date = gmtime;
614     my @rand = ('A'..'Z','a'..'z',0..9,'_');
615 wakaba 1.2 sprintf '%s::%s%s%s', $Info->{module_name}, $subname,
616 wakaba 1.1 sprintf ('%02d%02d%02d%02d%02d%02d', @date[5,4,3,2,1,0]),
617     join ('', @rand[rand@rand,rand@rand,rand@rand,rand@rand]);
618     }

admin@suikawiki.org
ViewVC Help
Powered by ViewVC 1.1.24