--- suikawiki/script/bin/mkplugin2.pl	2003/10/30 07:48:04	1.4
+++ suikawiki/script/bin/mkplugin2.pl	2003/11/25 12:47:19	1.5
@@ -1,7 +1,7 @@
 #!/usr/bin/perl
 use strict;
-our $VERSION = do{my @r=(q$Revision: 1.4 $=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};
-require SuikaWiki::Markup::SuikaWikiConfig20::Parser;
+our $VERSION = do{my @r=(q$Revision: 1.5 $=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};
+require Message::Markup::SuikaWikiConfig20::Parser;
 
 {
 my $src = '';
@@ -61,8 +61,22 @@
   $code =~ s/__FUNCPACK__/$Info->{module_name}/g;
   $code;
 }
+sub change_package ($$) {
+  my ($Info, $pack) = @_;
+  unless ($Info->{current_package} eq $pack) {
+    $Info->{current_package} = $pack;
+    return qq{package $pack;\n\n};
+  } else {
+    return '';
+  }
+}
+sub quoted_string ($) {
+  my $s = shift;
+  $s =~ s/([\\"])/\\$1/g;
+  '"'.$s.'"';
+}
 
-my $parser = SuikaWiki::Markup::SuikaWikiConfig20::Parser->new;
+my $parser = Message::Markup::SuikaWikiConfig20::Parser->new;
 my $plugins = $parser->parse_text ($src);
 my $meta = $plugins->get_attribute ('Plugin')
           or die "$0: Required 'Plugin' section not found";
@@ -81,12 +95,12 @@
 
 print <<EOH;
 use strict;
-package SuikaWiki::Plugin::Registry;
+@{[change_package \%Info, 'SuikaWiki::Plugin::Registry']}
 our \%Info;
 \$Info{$Info{name_literal}}->{Name} = $Info{name_literal};
 EOH
-for (qw/Version InterfaceVersion mkpluginVersion/) {
-  print qq{\$Info{$Info{name_literal}}->{$_} = v$Info{$_};\n};
+for (qw/Version InterfaceVersion mkpluginVersion module_name/) {
+  print qq{\$Info{$Info{name_literal}}->{$_} = @{[literal $Info{$_}]};\n};
 }
 for (qw/LastModified/) {
   $Info{$_} = n11n $meta->get_attribute ($_,make_new_node=>1)->value;
@@ -116,6 +130,12 @@
 } grep { $_->local_name eq 'Author' } @{$meta->child_nodes}
 ). qq{];\n};
 
+my $use = $meta->get_attribute ('Use');
+if (ref $use) {
+  print change_package \%Info, $Info{module_name};
+  print $use->inner_text;
+}
+
 for (@{$plugins->child_nodes}) {
   if ($_->local_name eq 'FormattingRule') {
     print "\n", make_rule ($_, \%Info);
@@ -129,10 +149,12 @@
     print "\n", make_resdef ($_, \%Info);
   } elsif ($_->local_name eq 'PluginConst') {
     register_plugin_const ($_, \%Info);
+  } elsif ($_->local_name eq 'Format') {
+    print "\n", make_format ($_, \%Info);
   }
 }
 
-print qq{\npackage SuikaWiki::Plugin::Registry;\n\n};
+print change_package \%Info, q(SuikaWiki::Plugin::Registry);
 print qq{\$Info{$Info{name_literal}}->{provide} = } . literal $Info{provide};
 print qq{;\n};
 
@@ -140,11 +162,103 @@
 exit;
 }
 
+sub make_format ($$) {
+  my ($src, $Info) = @_;
+  my $module_name = 'SuikaWiki::Format::Definition::'.$src->get_attribute_value ('ModuleName');
+  my $r = change_package $Info, $module_name;
+  $r .= qq{our \@ISA;\n};
+  if (my $isa = $src->get_attribute_value ('Inherit')) {
+    for (@$isa) {
+      $r .= qq{push \@ISA, @{[literal 'SuikaWiki::Format::Definition::'.$_]};\n};
+    }
+  } else {
+    $r .= qq{push \@ISA, 'SuikaWiki::Format::Definition::template';\n};    
+  }
+  if (my $name = $src->get_attribute_value ('Name')) {
+    $r .= qq{\$SuikaWiki::Format::Definition::Class{@{[literal '/'.$name.'/'.$src->get_attribute_value ('Version', default => '').'//']}} = '$module_name';\n};
+  }
+  if (my $type = $src->get_attribute_value ('Type')) {
+    $r .= qq{\$SuikaWiki::Format::Definition::Class{@{[literal $type.'//']}} = '$module_name';\n};
+  }
+  
+  $r .= <<'EOH';
+our $Converter;
+sub convert ($$;%) {
+  my ($self, $source, %opt) = @_;
+  my $converter;
+  my $flag = '//';
+  $flag .= 'f' if $opt{IsFragment};
+  $flag .= 'p' if $opt{IsPlaceholder};
+  if ($Converter->{$opt{Type}.$flag}) {
+    $converter = $Converter->{$opt{Type}.$flag};
+  } elsif ($Converter->{$opt{Name}.'/'.$opt{Version}.$flag}) {
+    $converter = $Converter->{'/'.$opt{Name}.'/'.$opt{Version}.$flag};
+  }
+  return $converter->{Main}->($self, $source, \%opt) if $converter;
+  $self->SUPER::convert ($source, %opt);
+}
+EOH
+  
+  for (@{$src->child_nodes}) {
+    if ($_->local_name eq 'Converter') {
+      $r .= make_format_converter ($_, $Info);
+    } elsif ($_->local_name eq 'Use') {
+      $r .= $_->inner_text;
+    }
+  }
+  
+  $r;
+}
+
+sub make_format_converter ($$) {
+  my ($src, $Info) = @_;
+  my %def;
+  $def{Type} = $src->get_attribute ('Type');
+  if (ref $def{Type}) {
+    $def{Type} = $def{Type}->inner_text
+          . join '', map {
+              ';'. $_->local_name .'='. quoted_string $_->inner_text
+            } sort {
+              $a->local_name cmp $b->local_name
+            } @{$def{Type}->child_nodes};
+  } else {
+    delete $def{Type};
+  }
+  $def{Name} = $src->get_attribute_value ('Name');
+  delete $def{Name} unless defined $def{Name};
+  $def{Version} = $src->get_attribute_value ('Version');
+  delete $def{Version} if not defined $def{Version} or
+                          not defined $def{Name};
+  
+  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');
+  
+  $def{Main} = $src->get_attribute_value ('Main');
+  $def{Main} = 'my $r;'.$def{Main}.'$r' if $def{Main} =~ /\$r\b/;
+  $def{Main} = barecode code $Info,
+               'sub {my ($self, $source, $opt) = @_;'
+             . $def{Main} . '}';
+  
+  my $r = list %def;
+  if ($def{Type}) {
+    $r = qq{\$Converter->{@{[literal $def{Type}.$flag]}} = {$r};\n};
+    $r .= qq{\$Converter->{@{[literal '/'.$def{Name}.'/'.$def{Version}.$flag]}} = \$Converter->{@{[literal $def{Type}.$flag]}};\n}
+      if $def{Name};
+  } elsif ($def{Name}) {
+    $r = qq{\$Converter->{@{[literal '/'.$def{Name}.'/'.$def{Version}.$flag]}} = {$r};\n};
+    $r 
+  }
+  $r;
+}
+
 sub make_function ($$) {
   my ($src, $Info) = @_;
   ## TODO: support of ARGV property
   my $r = <<EOH;
-package $Info->{module_name};
+@{[change_package $Info, $Info->{module_name}]}
 sub @{[$src->get_attribute_value ('Name')]} {
   @{[code $Info, $src->get_attribute_value ('Main')]}
 }
@@ -160,7 +274,8 @@
 
 sub make_resdef ($$) {
   my ($src, $Info) = @_;
-  my $r = qq{package SuikaWiki::Plugin::Resource;\nour \$BaseResource;\n};
+  my $r = change_package $Info, 'SuikaWiki::Plugin::Resource';
+  $r .= qq{our \$BaseResource;\n};
   for (@{$src->child_nodes}) {
     if ($_->node_type eq '#element') {
       my $lang = literal ($_->get_attribute_value ('lang') || 'und');
@@ -219,7 +334,7 @@
   condition => {$ViewProp->{condition_stringified}},
   object_class => q#$ViewProp->{pack_name}#,
 };
-package $ViewProp->{pack_name};
+@{[change_package $Info, $ViewProp->{pack_name}]}
 our \@ISA = q#SuikaWiki::View::template#;
 EOH
   for (@{$src->child_nodes}) {
@@ -302,11 +417,9 @@
   \$self->{view}->{wiki}->init_db;
   \$self->main_pre (\$opt, \$opt2);
   
-  ## TODO: formal SuikaWiki 3 interface
   my \$fmt = SuikaWiki::Plugin->formatter ('view');
   \$opt2->{output}->{entity}->{body} 
-    = \$fmt->replace (\$opt2->{template} => \$opt2->{o},
-                      {formatter => \$fmt});
+    = \$fmt->replace (\$opt2->{template}, param => \$opt2->{o});
   \$opt2->{output}->output (output => 'http-cgi');
   
   \$self->main_post (\$opt, \$opt2);
@@ -314,23 +427,39 @@
 EOH
 }
 
-## TODO: Implements SuikaWiki 3 interface
 sub make_rule ($$) {
   my ($src, $Info) = @_;
   my $type = $src->get_attribute ('Category', make_new_node => 1)->value || [];
   my $name = $src->get_attribute ('Name', make_new_node => 1)->value;
-  $name =~ s/(?=.)-/_/g;
+  $name =~ s/(?<=.)-/_/g;
   my $main = code $Info, $src->get_attribute_value ('Formatting');
-  $main = q{my ($p, $o) = @_;}."\n" . $main 
-    if $main =~ /\$p/ || $main =~ /\$o/;
-  if ($main =~ /\$r/) {
-    $main = q{my $r = '';} . "\n" . $main;
-    $main .= q{$r};
+  
+  my $reg_block;
+  $reg_block = qr/[^{}]*(?>[^{}]+|{(??{$reg_block})})*/;
+  my $reg_attr = qr/__ATTR(TEXT|NODE)?:%(\w+)(?:->{($reg_block)})?__;/;
+  
+  $main = q{my ($f, $rule_name, $p, $o, %opt) = @_;}."\n".$main
+    if $main =~ /\$f\b/
+    or $main =~ /\$rule_name\b/
+    or $main =~ /\$[opr]\b/
+    or $main =~ /[%\$]opt\b/;
+  if ($main =~ /\$r\b/) {
+    warn qq(Rule @{[list $type]}/$name: Use of \$r is deprecated);
+    $main = q{my $r = '';} . "\n" . $main . "\n" 
+          . q{$p->{-parent}->append_node ($r, node_or_text => 1);};
   }
+  $main =~ s{$reg_attr}
+            {($1 eq 'TEXT' ? '$p->{'.literal($2).'} = do { my $r = ' : '')
+             .'$f->parse_attr ($p=>'.literal($2).', $o, '
+                             .($3?'-parent => '.$3.', ':'')
+                             .($1?'-non_parsed_to_node => 1, ':'')
+                             .'%opt)'
+                             .($1 eq 'TEXT' ? '; ref $r?$r->inner_text:$r}' : '')
+                             .';'}ge;
   
   my $main = <<EOH;
 {
-  Formatting => sub {$main},
+  main => sub {$main},
   Description => [@{[m13ed_val_list $src, 'Description']}],
   Parameter => {@{[do{
     my @r;
@@ -346,13 +475,13 @@
   }]}},
 }
 EOH
-  my $r;
+  my $r = change_package $Info, $Info->{module_name};
   if (@$type == 1) {
     $type->[0] =~ tr/-/_/;
-    $r = qq{\$SuikaWiki::Plugin::Rule{$type->[0]}->{$name} = $main;\n};
+    $r .= qq{\$SuikaWiki::Plugin::Rule{$type->[0]}->{$name} = $main;\n};
     push @{$Info->{provide}->{rule}->{$type->[0]}}, $name;
   } else {
-    $r = qq({my \$def = $main;\n);
+    $r .= qq({my \$def = $main;\n);
     for my $type (@$type) {
       $type =~ tr/-/_/;
       $r .= qq{\$SuikaWiki::Plugin::Rule{$type}->{$name} = \$def;\n};