/[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.2 by wakaba, Sat Oct 18 07:08:34 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_viewfragment ($$) {  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) = @_;    my ($src, $Info) = @_;
   my $r = '';  
156    for (@{$src->child_nodes}) {    for (@{$src->child_nodes}) {
157      ## TODO: use SuikaWiki2 interface      $Info->{const}->{$_->local_name} = $_->value;
     $r .= qq(SuikaWiki::View->template (@{[literal $_->local_name]})->add_line (@{[literal $_->value]});\n);  
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 ($$) {
177      my ($src, $Info) = @_;
178      my $r = '';
179      my $name = $src->get_attribute_value ('Name');
180      $name =~ tr/-/_/;
181      ## SuikaWiki 2 Interface
182        $r .= qq(SuikaWiki::View->template (@{[literal $name]})
183                                ->add_line (@{[literal $src->get_attribute_value ('Formatting')]});\n);
184      ## SuikaWiki 3 Interface
185        $r .= <<EOH;
186      push \@{\$SuikaWiki::View::Implementation::TemplateFragment{@{[literal $name]}}}, {
187        Main => @{[literal $src->get_attribute_value ('Formatting')]},
188        Order => @{[0+$src->get_attribute_value ('Order')]},
189        Description => [@{[m13ed_val_list $src, 'Description']}],
190      };
191    EOH
192      push @{$Info->{provide}->{viewfragment}},
193           {Name => $src->get_attribute ('Name')->value};
194    $r;    $r;
195  }  }
196    
# Line 83  sub make_viewdef ($$) { Line 201  sub make_viewdef ($$) {
201    $ViewProp->{Name} = n11n $src->get_attribute ('Mode')->value;    $ViewProp->{Name} = n11n $src->get_attribute ('Mode')->value;
202    $ViewProp->{pack_name} = random_module_name ($Info, $ViewProp->{Name});    $ViewProp->{pack_name} = random_module_name ($Info, $ViewProp->{Name});
203        
204    $ViewProp->{condition_stringified} = join ', ', map {literal $_}    $ViewProp->{condition_stringified} = hash
205      mode => $ViewProp->{Name},      mode => $ViewProp->{Name},
206      map {($_->local_name => $_->value)}      map {($_->local_name => $_->value)}
207        @{$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 215  package $ViewProp->{pack_name};
215  our \@ISA = q#SuikaWiki::View::template#;  our \@ISA = q#SuikaWiki::View::template#;
216  EOH  EOH
217    for (@{$src->child_nodes}) {    for (@{$src->child_nodes}) {
218      if ($_->local_name eq 'method') {      if ($_->local_name eq 'template') {
219          $r .= make_view_template_method ($_, $Info);
220        } elsif ($_->local_name eq 'method') {
221        $r .= ({        $r .= ({
222                main => q(sub main ($$) {)."\n".q(my ($self, $opt) = @_;)."\n",                main => q(sub main ($$) {)."\n".q(my ($self, $opt) = @_;)."\n",
223                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",
224                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",                    
225               }->{$_->get_attribute ('Name')->value}               }->{$_->get_attribute ('Name')->value}
226               ||qq(sub @{[$_->get_attribute ('Name')->value]} {\n))               ||qq(sub @{[$_->get_attribute ('Name')->value]} {\n))
227           . $_->inner_text           . code ($Info, $_->value)
228           . qq(\n}\n);           . qq(\n}\n);
229      }      }
230    }    }
231      my $prop = {Name => $ViewProp->{Name},
232                  Description => barecode m13ed_val_list $_, 'Description'};
233      push @{$Info->{provide}->{viewdef}}, $prop;
234      $r;
235    }
236    
237    sub make_view_template_method ($$) {
238      my ($src, $info) = @_;
239      my $r = <<EOH;
240    
241    sub main (\$\$\$) {
242      my (\$self, \$opt, \$opt2) = \@_;
243      require SuikaWiki::Output::HTTP;
244      \$opt2->{output} = SuikaWiki::Output::HTTP->new
245        (wiki => \$self->{view}->{wiki},
246         view => \$self->{view}, viewobj => \$self);
247      for (\@{\$self->{view}->{wiki}->{var}->{client}->{used_for_negotiate}},
248           'Accept-Language') {
249        \$opt2->{output}->add_negotiate_header_field (\$_);
250      }
251      
252      \$opt2->{template} = @{[literal $src->get_attribute ('body', make_new_node => 1)->inner_text]};
253      \$opt2->{o} = bless {
254                         ## Compatible options for SuikaWiki 2 WikiPlugin interface
255                           param => \\\%main::form,
256                           page => \$main::form{mypage},
257                           toc => [],
258                           #magic
259                           #content
260                           #use_anchor_name
261                           media => {@{[hash
262        type => ($src->get_attribute ('media-type',make_new_node=>1)->inner_text
263                 || 'application/octet-stream'),
264        charset => ($src->get_attribute ('use-media-type-charset',make_new_node=>1)
265                        ->inner_text || 0),
266        ## In fact, this value is not referred from any SuikaWiki 2 WikiPlugin rule.
267        #expires => ($src->get_attribute ('expires',make_new_node=>1)->inner_text
268        #                             || 0)
269        ]}},
270                          ## SuikaWiki 3 WikiPlugin interface
271                            wiki => \$self->{view}->{wiki},
272                            plugin => \$self->{view}->{wiki}->{plugin},
273                            var => {},
274                          }, 'SuikaWiki::Plugin';  
275      @{[do{my $x=$src->get_attribute('http-status-code',make_new_node=>1)->inner_text;
276         $x?q{$opt2->{output}->{status_code} = }.(0 + $x).q{;}:q{}}]}
277      @{[do{my $x=$src->get_attribute('http-status-phrase',make_new_node=>1)->inner_text;
278         $x?q{$opt2->{output}->{reason_phrase} = }.literal($x).q{;}:q{}}]}
279      \$opt2->{output}->{entity}->{media_type} = @{[literal
280                               $src->get_attribute ('media-type',make_new_node=>1)
281                                   ->inner_text || 'application/octet-stream']};
282      @{[($src->get_attribute ('use-media-type-charset',make_new_node=>1)
283                ->inner_text || 0) ?
284         q{$opt2->{output}->{entity}->{charset} = $self->{view}->{wiki}->{config}->{charset}->{output};}:
285         q{}]}
286      @{[do{my $x = $src->get_attribute ('expires',make_new_node=>1)->inner_text;
287              if ($x =~ /%%(\w+)%%/) {
288                qq{\$opt2->{output}->set_expires (%{\$self->{view}->{wiki}->{config}->{entity}->{expires}->{@{[literal $1]}}});};
289              } else {
290                qq{\$opt2->{output}->set_expires (delta => @{[0 + $x]});};
291              }
292          }]}
293      
294      \$self->{view}->{wiki}->init_db;
295      \$self->main_pre (\$opt, \$opt2);
296      
297      ## TODO: formal SuikaWiki 3 interface
298      my \$fmt = SuikaWiki::Plugin->formatter ('view');
299      \$opt2->{output}->{entity}->{body}
300        = \$fmt->replace (\$opt2->{template} => \$opt2->{o},
301                          {formatter => \$fmt});
302      \$opt2->{output}->output (output => 'http-cgi');
303      
304      \$self->main_post (\$opt, \$opt2);
305    }
306    EOH
307    }
308    
309    ## TODO: Implements SuikaWiki 3 interface
310    sub make_rule ($$) {
311      my ($src, $Info) = @_;
312      my $type = $src->get_attribute ('Category', make_new_node => 1)->value || [];
313      my $name = $src->get_attribute ('Name', make_new_node => 1)->value;
314      $name =~ s/(?=.)-/_/g;
315      my $main = code $Info, $src->get_attribute_value ('Formatting');
316      $main = q{my ($p, $o) = @_;}."\n" . $main
317        if $main =~ /\$p/ || $main =~ /\$o/;
318      if ($main =~ /\$r/) {
319        $main = q{my $r = '';} . "\n" . $main;
320        $main .= q{$r};
321      }
322      
323      my $main = <<EOH;
324    {
325      Formatting => sub {$main},
326      Description => [@{[m13ed_val_list $src, 'Description']}],
327      Parameter => {@{[do{
328        my @r;
329        for (@{$src->child_nodes}) {
330          if ($_->local_name eq 'Parameter') {
331            push @r, $_->get_attribute_value ('Name')
332                     => {Type => $_->get_attribute_value ('Type'),
333                         Default => $_->get_attribute_value ('Default'),
334                         Description => [barecode m13ed_val_list $_, 'Description']};
335          }
336        }
337        list @r;
338      }]}},
339    }
340    EOH
341      my $r;
342      if (@$type == 1) {
343        $type->[0] =~ tr/-/_/;
344        $r = qq{\$SuikaWiki::Plugin::Rule{$type->[0]}->{$name} = $main;\n};
345        push @{$Info->{provide}->{rule}->{$type->[0]}}, $name;
346      } else {
347        $r = qq({my \$def = $main;\n);
348        for my $type (@$type) {
349          $type =~ tr/-/_/;
350          $r .= qq{\$SuikaWiki::Plugin::Rule{$type}->{$name} = \$def;\n};
351          push @{$Info->{provide}->{rule}->{$type}}, $name;
352        }
353        $r .= qq(};\n);
354      }
355    $r;    $r;
356  }  }
357    
# Line 117  sub random_module_name ($;$) { Line 361  sub random_module_name ($;$) {
361    $subname =~ s/[^0-9A-Za-z_:]//g;    $subname =~ s/[^0-9A-Za-z_:]//g;
362    my @date = gmtime;    my @date = gmtime;
363    my @rand = ('A'..'Z','a'..'z',0..9,'_');    my @rand = ('A'..'Z','a'..'z',0..9,'_');
364    sprintf '%s::%s%s%s', $Info{module_name}, $subname,    sprintf '%s::%s%s%s', $Info->{module_name}, $subname,
365      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]),
366      join ('', @rand[rand@rand,rand@rand,rand@rand,rand@rand]);      join ('', @rand[rand@rand,rand@rand,rand@rand,rand@rand]);
367  }  }
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24