/[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.1 by wakaba, Sun Oct 5 11:11:13 2003 UTC revision 1.4 by wakaba, Thu Oct 30 07:48:04 2003 UTC
# Line 1  Line 1 
1  #!/usr/bin/perl  #!/usr/bin/perl
2  use strict;  use strict;
3    our $VERSION = do{my @r=(q$Revision$=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};
4  require SuikaWiki::Markup::SuikaWikiConfig20::Parser;  require SuikaWiki::Markup::SuikaWikiConfig20::Parser;
5    
6    {
7  my $src = '';  my $src = '';
8  my $srcfile = shift;  my $srcfile = shift;
9  open SRC, $srcfile or die "$0: $!"; {  open SRC, $srcfile or die "$0: $!"; {
# Line 11  open SRC, $srcfile or die "$0: $!"; { Line 13  open SRC, $srcfile or die "$0: $!"; {
13    
14  sub literal ($) {  sub literal ($) {
15    my $s = shift;    my $s = shift;
16    $s =~ s/([#\\])/\\$1/g;    if (ref ($s) eq 'ARRAY') {
17    q<q#> . $s . q<#>;      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  }  }
34  sub n11n ($) {  sub n11n ($) {
35    my $s = shift;    my $s = shift;
36    $s =~ s/\s+/ /g;    $s =~ s/\s+/ /g;
37    $s;    $s;
38  }  }
39    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        $code =~ s/\$$_\b/literal $Info->{const}->{$_}/ge;
60      }
61      $code =~ s/__FUNCPACK__/$Info->{module_name}/g;
62      $code;
63    }
64    
65  my $parser = SuikaWiki::Markup::SuikaWikiConfig20::Parser->new;  my $parser = SuikaWiki::Markup::SuikaWikiConfig20::Parser->new;
66  my $plugins = $parser->parse_text ($src);  my $plugins = $parser->parse_text ($src);
67  my $meta = $plugins->get_attribute ('Plugin')  my $meta = $plugins->get_attribute ('Plugin')
68            or die "$0: Required 'Plugin' section not found";            or die "$0: Required 'Plugin' section not found";
69  my %Info = (Name => n11n $meta->get_attribute ('Name')->value);  my %Info = (provide => {},
70                Name => n11n $meta->get_attribute ('Name')->value);
71  $Info{name_literal} = literal $Info{Name};  $Info{name_literal} = literal $Info{Name};
72  my @date = gmtime;  my @date = gmtime;
73  $Info{LastModified} = sprintf '%04d-%02d-%02dT%02d:%02d:%02d+00:00',  $Info{LastModified} = sprintf '%04d-%02d-%02dT%02d:%02d:%02d+00:00',
74                                $date[5] + 1900, $date[4] + 1, @date[3,2,1,0];                                $date[5] + 1900, $date[4] + 1, @date[3,2,1,0];
75  $Info{Version} = sprintf '%04d.%02d%02d.%02d%02d',  $Info{Version} = sprintf '%04d.%02d%02d.%02d%02d',
76                           $date[5] + 1900, $date[4] + 1, @date[3,2,1];                           $date[5] + 1900, $date[4] + 1, @date[3,2,1];
77    $Info{InterfaceVersion} = '2.9.1';
78    $Info{mkpluginVersion} = '2.'.$VERSION;
79  $Info{module_name} = q#SuikaWiki::Plugin::plugin#;  $Info{module_name} = q#SuikaWiki::Plugin::plugin#;
80  $Info{module_name} = random_module_name (\%Info, $Info{Name});  $Info{module_name} = random_module_name (\%Info, $Info{Name});
81    
# Line 39  use strict; Line 84  use strict;
84  package SuikaWiki::Plugin::Registry;  package SuikaWiki::Plugin::Registry;
85  our \%Info;  our \%Info;
86  \$Info{$Info{name_literal}}->{Name} = $Info{name_literal};  \$Info{$Info{name_literal}}->{Name} = $Info{name_literal};
 \$Info{$Info{name_literal}}->{Version} = q#$Info{Version}#;  
87  EOH  EOH
88  for (qw/Description LastModified License/) {  for (qw/Version InterfaceVersion mkpluginVersion/) {
89      print qq{\$Info{$Info{name_literal}}->{$_} = v$Info{$_};\n};
90    }
91    for (qw/LastModified/) {
92    $Info{$_} = n11n $meta->get_attribute ($_,make_new_node=>1)->value;    $Info{$_} = n11n $meta->get_attribute ($_,make_new_node=>1)->value;
93    next unless length $Info{$_};    next unless length $Info{$_};
94    print qq{\$Info{$Info{name_literal}}->{$_} = } . literal $Info{$_};    print qq{\$Info{$Info{name_literal}}->{$_} = } . literal $Info{$_};
95    print ";\n";    print ";\n";
96  }  }
97  for (qw/Author RelatedURI RelatedWikiPage RequiredPlugin RequiredModule/) {  for (qw/RequiredPlugin RequiredModule/) {
98    $Info{$_} = $meta->get_attribute ($_);    $Info{$_} = $meta->get_attribute ($_);
99    next unless ref $Info{$_}; $Info{$_} = $Info{$_}->value;    next unless ref $Info{$_}; $Info{$_} = $Info{$_}->value;
100    print qq{\$Info{$Info{name_literal}}->{$_} = [};    print qq{\$Info{$Info{name_literal}}->{$_} = [};
101    print join ', ', map {literal $_} @{$Info{$_}};    print join ', ', map {literal $_} @{$Info{$_}};
102    print "];\n";    print "];\n";
103  }  }
104    for (qw/Description License RelatedWikiPage RelatedURI/) {
105      my $r = m13ed_val_list $meta, $_;
106      next unless $r;
107      print qq{\$Info{$Info{name_literal}}->{$_} = [$r];\n};
108    }
109    
110    print qq{\$Info{$Info{name_literal}}->{Author} = [} .( list map {
111            [
112              [ barecode m13ed_val_list ($_, 'Name') ],
113              [ $_->get_attribute ('Mail', make_new_node => 1)->value ],
114              [ $_->get_attribute ('URI', make_new_node => 1)->value ],
115            ]
116    } grep { $_->local_name eq 'Author' } @{$meta->child_nodes}
117    ). qq{];\n};
118    
119  for (@{$plugins->child_nodes}) {  for (@{$plugins->child_nodes}) {
120    if ($_->local_name eq 'ViewDefinition') {    if ($_->local_name eq 'FormattingRule') {
121        print "\n", make_rule ($_, \%Info);
122      } elsif ($_->local_name eq 'ViewDefinition') {
123      print "\n", make_viewdef ($_, \%Info);      print "\n", make_viewdef ($_, \%Info);
124    } elsif ($_->local_name eq 'ViewFragment') {    } elsif ($_->local_name eq 'ViewFragment') {
125      print "\n", make_viewfragment ($_, \%Info);      print "\n", make_viewfragment ($_, \%Info);
126      } elsif ($_->local_name eq 'Function') {
127        print "\n", make_function ($_, \%Info);
128      } elsif ($_->local_name eq 'Resource') {
129        print "\n", make_resdef ($_, \%Info);
130      } elsif ($_->local_name eq 'PluginConst') {
131        register_plugin_const ($_, \%Info);
132    }    }
133  }  }
134    
135    print qq{\npackage SuikaWiki::Plugin::Registry;\n\n};
136    print qq{\$Info{$Info{name_literal}}->{provide} = } . literal $Info{provide};
137    print qq{;\n};
138    
139  print "\n1;\n";  print "\n1;\n";
140  exit;  exit;
141    }
142    
143    sub make_function ($$) {
144      my ($src, $Info) = @_;
145      ## TODO: support of ARGV property
146      my $r = <<EOH;
147    package $Info->{module_name};
148    sub @{[$src->get_attribute_value ('Name')]} {
149      @{[code $Info, $src->get_attribute_value ('Main')]}
150    }
151    EOH
152    }
153    
154    sub register_plugin_const ($$) {
155      my ($src, $Info) = @_;
156      for (@{$src->child_nodes}) {
157        $Info->{const}->{$_->local_name} = $_->value;
158      }
159    }
160    
161    sub make_resdef ($$) {
162      my ($src, $Info) = @_;
163      my $r = qq{package SuikaWiki::Plugin::Resource;\nour \$BaseResource;\n};
164      for (@{$src->child_nodes}) {
165        if ($_->node_type eq '#element') {
166          my $lang = literal ($_->get_attribute_value ('lang') || 'und');
167          my $script = literal $_->get_attribute_value ('script');
168          my $name = literal $_->local_name;
169          my $val = literal n11n $_->value;
170          $r .= qq{\$BaseResource->{$lang}->{$script}->{$name} = $val;\n};
171        }
172      }
173      $r;
174    }
175    
176  sub make_viewfragment ($$) {  sub make_viewfragment ($$) {
177    my ($src, $Info) = @_;    my ($src, $Info) = @_;
178    my $r = '';    my $r = '';
179    for (@{$src->child_nodes}) {    my $body = <<EOH;
180      ## TODO: use SuikaWiki2 interface    {
181      $r .= qq(SuikaWiki::View->template (@{[literal $_->local_name]})->add_line (@{[literal $_->value]});\n);      Main => @{[literal $src->get_attribute_value ('Formatting')]},
182        Order => @{[0+$src->get_attribute_value ('Order')]},
183        Description => [@{[m13ed_val_list $src, 'Description']}],
184      };
185    EOH
186      ## Recommended format
187      my $name = $src->get_attribute_value ('Template');
188      if (ref ($name) and @$name > 1) {
189        $r .= qq({my \$def = $body;\n);
190        for (@$name) {
191          my $name = $_; $name =~ tr/-/_/;
192          $r .= qq(push \@{\$SuikaWiki::View::Implementation::TemplateFragment{@{[literal $name]}}}, \$def;\n);
193          push @{$Info->{provide}->{viewfragment}}, {Name => $name};
194        }
195        $r .= qq(}\n);
196      } else {                           ## Obsoleted format
197        $name = ref $name ? $name->[0] : $src->get_attribute_value ('Name');
198        $name =~ tr/-/_/;
199        $r .= qq(push \@{\$SuikaWiki::View::Implementation::TemplateFragment{@{[literal $name]}}}, $body);
200        push @{$Info->{provide}->{viewfragment}}, {Name => $name};
201    }    }
202    $r;    $r;
203  }  }
# Line 83  sub make_viewdef ($$) { Line 209  sub make_viewdef ($$) {
209    $ViewProp->{Name} = n11n $src->get_attribute ('Mode')->value;    $ViewProp->{Name} = n11n $src->get_attribute ('Mode')->value;
210    $ViewProp->{pack_name} = random_module_name ($Info, $ViewProp->{Name});    $ViewProp->{pack_name} = random_module_name ($Info, $ViewProp->{Name});
211        
212    $ViewProp->{condition_stringified} = join ', ', map {literal $_}    $ViewProp->{condition_stringified} = hash
213      mode => $ViewProp->{Name},      mode => $ViewProp->{Name},
214      map {($_->local_name => $_->value)}      map {($_->local_name => $_->value)}
215        @{$src->get_attribute ('Condition',make_new_node=>1)->child_nodes};        @{$src->get_attribute ('Condition',make_new_node=>1)->child_nodes};
# Line 97  package $ViewProp->{pack_name}; Line 223  package $ViewProp->{pack_name};
223  our \@ISA = q#SuikaWiki::View::template#;  our \@ISA = q#SuikaWiki::View::template#;
224  EOH  EOH
225    for (@{$src->child_nodes}) {    for (@{$src->child_nodes}) {
226      if ($_->local_name eq 'method') {      if ($_->local_name eq 'template') {
227          $r .= make_view_template_method ($_, $Info);
228        } elsif ($_->local_name eq 'method') {
229        $r .= ({        $r .= ({
230                main => q(sub main ($$) {)."\n".q(my ($self, $opt) = @_;)."\n",                main => q(sub main ($$) {)."\n".q(my ($self, $opt) = @_;)."\n",
231                main_pre => q(sub main_pre ($$$) {)."\n".q(my ($self, $opt, $opt2) = @_;)."\n",                main_pre => q(sub main_pre ($$$) {)."\n".q(my ($self, $opt, $opt2) = @_;)."\n",
232                main_post => q(sub main_post ($$$) {)."\n".q(my ($self, $opt, $opt2) = @_;)."\n",                                    main_post => q(sub main_post ($$$) {)."\n".q(my ($self, $opt, $opt2) = @_;)."\n",                    
233               }->{$_->get_attribute ('Name')->value}               }->{$_->get_attribute ('Name')->value}
234               ||qq(sub @{[$_->get_attribute ('Name')->value]} {\n))               ||qq(sub @{[$_->get_attribute ('Name')->value]} {\n))
235           . $_->inner_text           . code ($Info, $_->value)
236           . qq(\n}\n);           . qq(\n}\n);
237      }      }
238    }    }
239      my $prop = {Name => $ViewProp->{Name},
240                  Description => barecode m13ed_val_list $_, 'Description'};
241      push @{$Info->{provide}->{viewdef}}, $prop;
242      $r;
243    }
244    
245    sub make_view_template_method ($$) {
246      my ($src, $info) = @_;
247      my $r = <<EOH;
248    
249    sub main (\$\$\$) {
250      my (\$self, \$opt, \$opt2) = \@_;
251      require SuikaWiki::Output::HTTP;
252      \$opt2->{output} = SuikaWiki::Output::HTTP->new
253        (wiki => \$self->{view}->{wiki},
254         view => \$self->{view}, viewobj => \$self);
255      for (\@{\$self->{view}->{wiki}->{var}->{client}->{used_for_negotiate}},
256           'Accept-Language') {
257        \$opt2->{output}->add_negotiate_header_field (\$_);
258      }
259      
260      \$opt2->{template} = @{[literal $src->get_attribute ('body', make_new_node => 1)->inner_text]};
261      \$opt2->{o} = bless {
262                         ## Compatible options for SuikaWiki 2 WikiPlugin interface
263                           param => \\\%main::form,
264                           page => \$main::form{mypage},
265                           toc => [],
266                           #magic
267                           #content
268                           #use_anchor_name
269                           media => {@{[hash
270        type => ($src->get_attribute ('media-type',make_new_node=>1)->inner_text
271                 || 'application/octet-stream'),
272        charset => ($src->get_attribute ('use-media-type-charset',make_new_node=>1)
273                        ->inner_text || 0),
274        ## In fact, this value is not referred from any SuikaWiki 2 WikiPlugin rule.
275        #expires => ($src->get_attribute ('expires',make_new_node=>1)->inner_text
276        #                             || 0)
277        ]}},
278                          ## SuikaWiki 3 WikiPlugin interface
279                            wiki => \$self->{view}->{wiki},
280                            plugin => \$self->{view}->{wiki}->{plugin},
281                            var => {},
282                          }, 'SuikaWiki::Plugin';  
283      @{[do{my $x=$src->get_attribute('http-status-code',make_new_node=>1)->inner_text;
284         $x?q{$opt2->{output}->{status_code} = }.(0 + $x).q{;}:q{}}]}
285      @{[do{my $x=$src->get_attribute('http-status-phrase',make_new_node=>1)->inner_text;
286         $x?q{$opt2->{output}->{reason_phrase} = }.literal($x).q{;}:q{}}]}
287      \$opt2->{output}->{entity}->{media_type} = @{[literal
288                               $src->get_attribute ('media-type',make_new_node=>1)
289                                   ->inner_text || 'application/octet-stream']};
290      @{[($src->get_attribute ('use-media-type-charset',make_new_node=>1)
291                ->inner_text || 0) ?
292         q{$opt2->{output}->{entity}->{charset} = $self->{view}->{wiki}->{config}->{charset}->{output};}:
293         q{}]}
294      @{[do{my $x = $src->get_attribute ('expires',make_new_node=>1)->inner_text;
295              if ($x =~ /%%(\w+)%%/) {
296                qq{\$opt2->{output}->set_expires (%{\$self->{view}->{wiki}->{config}->{entity}->{expires}->{@{[literal $1]}}});};
297              } else {
298                qq{\$opt2->{output}->set_expires (delta => @{[0 + $x]});};
299              }
300          }]}
301      
302      \$self->{view}->{wiki}->init_db;
303      \$self->main_pre (\$opt, \$opt2);
304      
305      ## TODO: formal SuikaWiki 3 interface
306      my \$fmt = SuikaWiki::Plugin->formatter ('view');
307      \$opt2->{output}->{entity}->{body}
308        = \$fmt->replace (\$opt2->{template} => \$opt2->{o},
309                          {formatter => \$fmt});
310      \$opt2->{output}->output (output => 'http-cgi');
311      
312      \$self->main_post (\$opt, \$opt2);
313    }
314    EOH
315    }
316    
317    ## TODO: Implements SuikaWiki 3 interface
318    sub make_rule ($$) {
319      my ($src, $Info) = @_;
320      my $type = $src->get_attribute ('Category', make_new_node => 1)->value || [];
321      my $name = $src->get_attribute ('Name', make_new_node => 1)->value;
322      $name =~ s/(?=.)-/_/g;
323      my $main = code $Info, $src->get_attribute_value ('Formatting');
324      $main = q{my ($p, $o) = @_;}."\n" . $main
325        if $main =~ /\$p/ || $main =~ /\$o/;
326      if ($main =~ /\$r/) {
327        $main = q{my $r = '';} . "\n" . $main;
328        $main .= q{$r};
329      }
330      
331      my $main = <<EOH;
332    {
333      Formatting => sub {$main},
334      Description => [@{[m13ed_val_list $src, 'Description']}],
335      Parameter => {@{[do{
336        my @r;
337        for (@{$src->child_nodes}) {
338          if ($_->local_name eq 'Parameter') {
339            push @r, $_->get_attribute_value ('Name')
340                     => {Type => $_->get_attribute_value ('Type'),
341                         Default => $_->get_attribute_value ('Default'),
342                         Description => [barecode m13ed_val_list $_, 'Description']};
343          }
344        }
345        list @r;
346      }]}},
347    }
348    EOH
349      my $r;
350      if (@$type == 1) {
351        $type->[0] =~ tr/-/_/;
352        $r = qq{\$SuikaWiki::Plugin::Rule{$type->[0]}->{$name} = $main;\n};
353        push @{$Info->{provide}->{rule}->{$type->[0]}}, $name;
354      } else {
355        $r = qq({my \$def = $main;\n);
356        for my $type (@$type) {
357          $type =~ tr/-/_/;
358          $r .= qq{\$SuikaWiki::Plugin::Rule{$type}->{$name} = \$def;\n};
359          push @{$Info->{provide}->{rule}->{$type}}, $name;
360        }
361        $r .= qq(};\n);
362      }
363    $r;    $r;
364  }  }
365    
# Line 117  sub random_module_name ($;$) { Line 369  sub random_module_name ($;$) {
369    $subname =~ s/[^0-9A-Za-z_:]//g;    $subname =~ s/[^0-9A-Za-z_:]//g;
370    my @date = gmtime;    my @date = gmtime;
371    my @rand = ('A'..'Z','a'..'z',0..9,'_');    my @rand = ('A'..'Z','a'..'z',0..9,'_');
372    sprintf '%s::%s%s%s', $Info{module_name}, $subname,    sprintf '%s::%s%s%s', $Info->{module_name}, $subname,
373      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]),
374      join ('', @rand[rand@rand,rand@rand,rand@rand,rand@rand]);      join ('', @rand[rand@rand,rand@rand,rand@rand,rand@rand]);
375  }  }
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.4
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24