Name:
	SuikaWiki09XML
FullName:
	SuikaWiki/0.9 documentation format support with XML syntax
URI:
	IW:SuikaWiki:SuikaWiki

Initialize:
	my $NS_XHTML1 = 'http://www.w3.org/1999/xhtml';
	my $NS_SW09 = 'urn:x-suika-fam-cx:markup:suikawiki:0:9:';

{
Name:
	wikiformat/SuikaWiki/0.9-to-SuikaWiki/0.9/XML
FullName:
	SuikaWiki/0.9 wiki syntax -> XML syntax
URI:
	IW:SuikaWiki:SuikaWiki
Format:
	$r = wiki2xml ($o->{content}, %$o);
}

MODULE:
	sub wiki2xml {
	    my ($txt, %option) = @_;
	 ## TODO: const and paramters
	    ## Load constants
	    my %const;
	    #if ($option{magic} =~ /import="([^"]+)"/) {
	    #  for (split /\s*,\s*/, $1) {
	    #    my $wp = $main::database{$_};
	    #    if ($wp =~ m!^\#\?SuikaWikiConst/(?:0.9|1.0)!) {
	    #      wiki::suikawikiconst::to_hash ($wp => \%const);
	    #    }
	    #  }
	    #}
	    
	    #$txt =~ s{__&&([^&]+)&&__}{defined $const{$1}?$const{$1}:qq(__&&$1&&__)}ge;
	    my (@txt) = split(/\n/, $txt);
	    my (@saved, @result);
	    my $p = SuikaWiki::Markup::XML->new (type => '#fragment');
	    my $current = $p;
	    my %depth;
	    my $exit_p = sub {
	          my $current = shift;
	          if ($current->local_name eq 'p') {
	            $current = $current->parent_node;
	          }
	          $current;
	    };
	    my $cut_anchor = sub {
	      my ($current, $content) = @_;
	          if ($content =~ s/^\s*\[([0-9]+)\]\s+//) {
	            $current->append_new_node (type => '#element',
	                      namespace_uri => $NS_SW09,
	                      local_name => 'anchor-end')
	                    ->append_text (0+$1);
	          }
	      $content;
	    };
	    my $back_to_section = sub {
	      my $current = shift;
	      while ($current->node_type ne '#fragment') {
	        if ({ins=>1,del=>1,blockquote=>1}->{$current->local_name}) {
	          return $current;
	        }
	        $current = $current->parent_node;
	      }
	      return $current;
	    };
	    
	    foreach (@txt) {
	        chomp;
	        if ($depth{block_name}->{$depth{block}} ne 'PRE'
	                 && /^(\*{1,5})([^\x0D\x0A]*)/) {
	            $current = &$back_to_section ($current);
	            for my $H ($current->append_new_node (namespace_uri => $NS_XHTML1, local_name => 'h'.length ($1))) {
	              $H->append_node (_inline_xml ($2, %option,
	                                            const => \%const));
	            }
	        } elsif ($depth{block_name}->{$depth{block}} ne 'PRE' && /^([-=]{1,6})(.*)/) {
	          my ($depth, $content, $type) = (length ($1), $2, (substr ($1, -1) eq '-' ? 'ul' : 'ol'));
	          $current = &$exit_p ($current);
	          if ($current->local_name eq 'li') {
	            if ($depth{list} == $depth && $depth{list_type} eq $type) {
	              $current = $current->parent_node;
	            } elsif ($depth <= $depth{list}) {
	              for (1..($depth{list} - $depth)*2) {
	                ($depth{list} = 1, last) unless ref $current->parent_node;
	                ($depth{list} = 1, last) unless {li=>1,ul=>1,ol=>1}->{$current->local_name};
	                $current = $current->parent_node;
	                $depth{list} -= 0.5;
	              }
	              $current = $current->parent_node;
	              if ($type ne $current->local_name) {
	                $current = $current->parent_node->append_new_node (namespace_uri => $NS_XHTML1, local_name => $type);
	                $current->parent_node->append_text ("\n");
	              }
	            } else {	# $depth{list} < $depth
	              $current = $current->append_new_node (namespace_uri => $NS_XHTML1, local_name => $type);
	              $current->parent_node->append_text ("\n");
	              $depth{list}++;
	            }
	          } else {
	            $current = $current->append_new_node (namespace_uri => $NS_XHTML1, local_name => $type);
	            $current->parent_node->append_text ("\n\n");
	            $depth{list} = 1;
	          }
	          $depth{list_type} = $type;
	          $current = $current->append_new_node (namespace_uri => $NS_XHTML1, local_name => 'li');
	          $current->parent_node->append_text ("\n");
	          $content = &$cut_anchor ($current, $content);
	          $current->append_node (_inline_xml ($content, %option, const => \%const));
	        } elsif ($depth{block_name}->{$depth{block}} ne 'PRE' && /^:([^:]+):(.*)/) {
	          $current = &$exit_p ($current);
	          if ($current->local_name eq 'dd') {
	            $current = $current->parent_node->parent_node;
	          } else {
	            $current = $current->append_new_node (type => '#element',
	                                 namespace_uri => $NS_XHTML1,
	                                 local_name => 'dl');
	          }
	          $current = $current->append_new_node (type => '#element',
	                               namespace_uri => $NS_SW09,
	                               local_name => 'dr');
	          $current->append_new_node (namespace_uri => $NS_XHTML1, local_name => 'dt')
	                  ->append_node (_inline_xml ($1, %option, const => \%const));
	          $current = $current->append_new_node (namespace_uri => $NS_XHTML1, local_name => 'dd');
	          $current->append_node (_inline_xml ($2, %option, const => \%const));
	        } elsif ($depth{block_name}->{$depth{block}} ne 'PRE' && /^(?!>>[0-9])(>{1,5})(.*)/) {
	          my ($depth, $content) = (length $1, $2);
	          $current = &$exit_p ($current);
	          if ($depth == $depth{bq}) {
	            #
	          } elsif ($depth{bq} < $depth) {
	            $current = $current->append_new_node (namespace_uri => $NS_XHTML1, local_name => 'blockquote');
	            $depth{bq}++;
	          } else {	# $depth < $depth{bq}
	            for (1..($depth{bq}-$depth)) {
	              last if $current->node_type eq '#fragment';
	              $current = &$back_to_section ($current->parent_node);
	            }
	            $current = $current->append_new_node (namespace_uri => $NS_XHTML1, local_name => 'blockquote')
	              unless $current->local_name eq 'blockquote';
	            $depth{bq} = $depth;
	          }
	          if (length $content) {
	            $current = $current->append_new_node (namespace_uri => $NS_XHTML1, local_name => 'p');
	            $current->append_node (_inline_xml ($content, %option, const => \%const));
	          }
	        } elsif ($depth{block_name}->{$depth{block}} ne 'PRE' && /^\s*$/) {
	          $current = &$back_to_section ($current);
	          while ($current->local_name eq 'blockquote') {
	            $depth{bq}--;
	            $current = &$back_to_section ($current->parent_node);
	          }
	        } elsif ($depth{block_name}->{$depth{block}} ne 'PRE' && /^(\s+.*)$/) {
	          if ($current->local_name ne 'pre') {
	            $current = &$exit_p ($current)->append_new_node (namespace_uri => $NS_XHTML1, local_name => 'pre');
	            #$depth{block_name}->{++$depth{block}} = 'pre';
	          }
	          $current->append_node (_inline_xml ($1, %option, const => \%const));
	        } elsif ($depth{block_name}->{$depth{block}} ne 'PRE' && /^\,(.*?)[\x0D\x0A]*$/) {
	          $current = &$exit_p ($current);
	          if ($current->local_name eq 'td') {
	            $current = $current
	                       ->parent_node	# tr
	                       ->parent_node	# tbody
	                       ->append_new_node (namespace_uri => $NS_XHTML1, local_name => 'tr');
	          } else {
	            $current = $current
	                       ->append_new_node (namespace_uri => $NS_XHTML1, local_name => 'table')
	                       ->append_new_node (namespace_uri => $NS_XHTML1, local_name => 'tbody')
	                       ->append_new_node (namespace_uri => $NS_XHTML1, local_name => 'tr');
	          }
	          $current->parent_node->append_text ("\n");	# </tr>\n
	          my $tmp = "$1,";
	          my @value = map {/^"(.*)"$/ ? scalar($_ = $1, s/""/"/g, $_) : $_} ($tmp =~ /("[^"]*(?:""[^"]*)*"|[^,]*),/g);
	          my @colspan = map {($_ eq '==') ? 0 : 1} @value;
	          my ($tr, $td) = ($current, $current);
	          for (my $i = 0; $i < @value; $i++) {
	            if ($colspan[$i]) {
	              while ($i + $colspan[$i] < @value and $value[$i + $colspan[$i]] eq '==') {
	                $colspan[$i]++;
	              }
	              $td = $tr->append_new_node (namespace_uri => $NS_XHTML1, local_name => 'td');
	              $td->set_attribute (colspan => $colspan[$i]) if $colspan[$i] > 1;
	              $td->append_node (_inline_xml ($value[$i], %option, const => \%const));
	            }
	          }
	          if ($td->local_name eq 'tr') {	# No <td/> in the <tr/> (error!)
	            $td = $tr->append_new_node (namespace_uri => $NS_XHTML1, local_name => 'td');
	          }
	          $current = $td;
	        } elsif (/^\[(INS|DEL|PRE)\[\s*$/) {
	          if ($depth{block_name}->{$depth{block}} ne 'PRE') {
	            $current = &$exit_p ($current)->append_new_node (namespace_uri => $NS_XHTML1, local_name => lc $1);
	            $depth{block}++;
	            $depth{block_name}->{$depth{block}} = $1;
	          } else {
	            $current->append_text ($_);
	          }
	        } elsif ($depth{block} && /^\]($depth{block_name}->{$depth{block}})\]\s*$/) {
	          while ($current->node_type ne '#fragment') {
	            if ($current->local_name eq lc $depth{block_name}->{$depth{block}}) {
	              $current = $current->parent_node;
	              $depth{block}--;
	              last;
	            }
	            $current = $current->parent_node;
	          }
	        } else {
	          if ($current->node_type eq '#fragment' || {ins=>1,del=>1}->{$current->local_name}) {
	            $current = $current->append_new_node (namespace_uri => $NS_XHTML1, local_name => 'p');
	            $current->parent_node->append_text ("\n\n");	# <P> is two <BR>s:-)
	          }
	          $current->append_node (_inline_xml (&$cut_anchor ($current, $_), %option, const => \%const));
	        }
	    }
	  my $root = SuikaWiki::Markup::XML->new (type => '#document')
	                 ->append_new_node (type => '#element',
	                                    namespace_uri => $NS_SW09,
	                                    local_name => 'body');
	  $root->append_node ($p);
	  $root->define_new_namespace ('' => $NS_XHTML1);
	  $root->define_new_namespace (sw => $NS_SW09);
	  $root->parent_node;
	}
	
	sub _inline_xml ($;%) {
	  my ($line, %option) = @_;
	  my $l = SuikaWiki::Markup::XML->new (type => '#fragment');
	  my $current = $l;
	  $line =~ s{(?:\[([A-Z]+)(?:\(([^)]*)\))?\[|(\[\[#form(?:\([A-Za-z0-9-]+\))?(?::'(?:[^'\\]|\\.)*')+\]\]|\[\[[^]]+\](?:>>[0-9]+)?\])|(\]\])|(\] \[)|(>>[0-9]+|<[A-Za-z0-9%]+:[^>]+>|'''?)|([\[\]'<>]|[^\[\]'<>]+))}{
	  ## BUG: <IW:foo:"<foo>">
	    my ($el_name, $attr, $lnk, $etag, $nxt, $misc, $s) = ($1, $2, $3, $4, $5, $6, $7);
	    if ($el_name) {
	      my $edef = {
	      	ABBR	=> {html_el => 'abbr', use_class_attr => 1},
	      	CODE	=> {html_el => 'code', use_class_attr => 1},
	      	DEL	=> {html_el => 'del', use_class_attr => 1},
	      	DFN	=> {html_el => 'dfn', use_class_attr => 1},
	      	INS	=> {html_el => 'ins', use_class_attr => 1},
	      	KBD	=> {html_el => 'kbd', use_class_attr => 1},
	      	RUBY	=> {html_el => 'ruby'},
	      	RUBYB	=> {html_el => 'rubyb', ns_uri => $NS_SW09},
	      	SAMP	=> {html_el => 'samp', use_class_attr => 1},
	      	SUB	=> {html_el => 'sub'},
	      	SUP	=> {html_el => 'sup'},
	      	VAR	=> {html_el => 'var', use_class_attr => 1},
	      	WEAK	=> {html_el => 'weak', ns_uri => $NS_SW09},
	      }->{ $el_name };
	      if ($edef) {
	        $current = $current->append_new_node (namespace_uri => ($edef->{ns_uri} || $NS_XHTML1), local_name => $edef->{html_el});
	        $current->set_attribute (class => $edef->{html_class}) if $edef->{html_class};
	        $current->get_attribute ('class', make_new_node => 1)
	                ->append_text ($attr) if $attr && $edef->{use_class_attr};
	        if ($edef->{html_el} eq 'ruby' || $edef->{html_el} eq 'abbr') {
	          $current = $current->append_new_node (namespace_uri => $NS_XHTML1, local_name => 'rb');
	        }
	      } else {
	        $current->append_text ($&);
	      }
	    } elsif ($etag) {
	      if (ref $current->parent_node) {
	        if ($current->node_type eq '#attribute') {
	          $current = $current->parent_node;
	        }
	        $current = $current->parent_node;
	        if ($current->local_name eq 'ruby') {
	          $current = $current->parent_node;
	        }
	      } else {
	        $current->append_text (']]');
	      }
	    } elsif ($nxt) {
	      my $c_l_n = $current->local_name;
	      if ($c_l_n eq 'rb') {
	        for ($current->parent_node) {
	          $current = $_->append_new_node (namespace_uri => $NS_XHTML1, local_name => 'rt');
	        }
	      } elsif ($c_l_n eq 'rt') {
	        for ($current->parent_node) {
	          $_->append_text (' ');
	          $current = $_->append_new_node (namespace_uri => $NS_XHTML1, local_name => 'rt');
	        }
	      } elsif ($c_l_n eq 'abbr') {
	        $current = $current->append_new_node (namespace_uri => $NS_XHTML1, local_name => 'rt');
	      } else {
	        $current->append_text ('] [');
	      }
	    } elsif ($lnk) {
	      if ($lnk =~ /\[\[\#form(?:\(([A-Za-z0-9-]+)\))?:'((?:[^'\\]|\\.)*)':'((?:[^'\\]|\\.)*)'(?::'((?:[^'\\]|\\.)*)')?\]\]/) {
	        my $form = $current->append_new_node (type => '#element',
	                               namespace_uri => $NS_SW09,
	                               local_name => 'form');
	        $form->set_attribute (id => $1) if $1;
	        $form->append_new_node (type => '#element',
	                                namespace_uri => $NS_SW09,
	                                local_name => 'input')
	        #     ->append_new_node (type => '#section',
	        #                        namespace_uri => $NS_SGML.'cdata')
	             ->append_text ($2);
	        $form->append_new_node (type => '#element',
	                                namespace_uri => $NS_SW09,
	                                local_name => 'output')
	             ->append_text ($3);
	        $form->append_new_node (type => '#element',
	                                namespace_uri => $NS_SW09,
	                                local_name => 'option')
	             ->append_text ($4); 
	      } elsif ($lnk =~ /\[\[([^]]+)\](?:>>([0-9]+))?\]/) {
	        my ($page, $anchor_no) = ($1, $2);
	        if ($page eq '#comment') {
	          $current->append_new_node (type => '#element',
	                                     namespace_uri => $NS_SW09,
	                                     local_name => 'comment')
	                  ->option (use_EmptyElemTag => 1);
	        } elsif ($page eq '#rcomment') {
	          $current->append_new_node (type => '#element',
	                                     namespace_uri => $NS_SW09,
	                                     local_name => 'rcomment')
	                  ->option (use_EmptyElemTag => 1);
	        } elsif ($page =~ /^\#embed:(IMG:)?(.+)$/) {
	          my $e = $current->append_new_node (type => '#element',
	                            namespace_uri => $NS_SW09,
	                            local_name => 'embed')
	                          ->option (use_EmptyElemTag => 1);
	          $e->set_attribute (type => 'IMG') if $1;
	          $e->set_attribute (page => $2);
	        } else {
	          my $anchor = $current->append_new_node (type => '#element',
	                                     namespace_uri => $NS_SW09,
	                                     local_name => 'anchor');
	          $anchor->append_new_node (type => '#element',
	                                    namespace_uri => $NS_SW09,
	                                    local_name => 'page')
	                 ->append_text ($page);
	          $anchor->append_new_node (type => '#element',
	                                    namespace_uri => $NS_SW09,
	                                    local_name => 'fragment')
	                 ->append_text (0+$anchor_no) if defined $anchor_no;
	        }
	      }
	    } elsif ($misc) {
	      if ($misc =~ />>([0-9]+)/) {
	        $current->append_new_node (type => '#element',
	                  namespace_uri => $NS_SW09, local_name => 'anchor')
	                ->append_new_node (type => '#element',
	                  namespace_uri => $NS_SW09, local_name => 'fragment')
	                ->append_text (0+$1);
	      } elsif ($misc =~ /<([A-Z]+):((?:[^>"]|"(?:[^"\\]|\\.)*")+)>/) {
	        $current->append_new_node (type => '#element',
	                  namespace_uri => $NS_SW09, local_name => 'anchor')
	                ->append_new_node (type => '#element',
	                  namespace_uri => $NS_SW09, local_name => $1)
	                ->append_text ($2);
	      } elsif ($misc =~ /<([A-Za-z0-9%]+:[^>]+)>/) {
	        $current->append_new_node (type => '#element',
	                  namespace_uri => $NS_SW09, local_name => 'anchor')
	                ->append_new_node (type => '#element',
	                  namespace_uri => $NS_SW09, local_name => 'uri')
	                ->append_text ($1);
	      } elsif ($misc eq q('')) {
	        if ($current->local_name eq 'em') {
	          $current = $current->parent_node;
	        } else {
	          $current = $current->append_new_node (namespace_uri => $NS_XHTML1, local_name => 'em');
	        }
	      } else {	# '''
	        if ($current->local_name eq 'strong') {
	          $current = $current->parent_node;
	        } else {
	          $current = $current->append_new_node (namespace_uri => $NS_XHTML1, local_name => 'strong');
	        }
	      }
	    } else {
	      $current->append_text ($s);
	    }
	    '';
	  }ge;
	  return $l;
	}
	
	SuikaWiki::View->definition (sw09x__xml => {
		media => {type => 'text/plain', expires => 240*3600,
	                  charset => 1},
		check => sub { ($_->[0]->{magic}||'SuikaWiki/0.9') =~ m!SuikaWiki/0\.9! ? 1 : 0 },
		template => '%read(to=>SuikaWiki/0.9/XML);'});
	

POD:LICENSE:
	Copyright 2002-2003 Wakaba <w@suika.fam.cx>
	
	%%GNUGPL2%%