script/lib/suikawiki.pl

# -*- perl -*-
use strict;

package main;
our $VERSION = '2.'.do{my @r=(q$Revision: 1.7 $=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};
binmode STDOUT; binmode STDIN;
use Fcntl;
require SuikaWiki::Plugin;
our %fmt;       ## formatter objects
our %embed_command = (
        form    => qr/\[\[\#form(?:\(([A-Za-z0-9-]+)\))?:'((?:[^'\\]|\\.)*)':'((?:[^'\\]|\\.)*)'(?::'((?:[^'\\]|\\.)*)')?\]\]/,
);
our ($modifier_dbtype,$url_cgi,%uri,%PathTo);
our (%PageName,$kanjicode,$lang);

our %form;
our %database;
our $database = bless {}, 'wiki::dummy';
our %interwiki;
my %command_do = (
    default => \&do_view,
    adminchangepassword => \&do_adminchangepassword,
    write => \&do_write,
    searchform => \&do_searchform,
    comment => \&do_comment,
    RandomJump  => \&do_random_jump,
    wikiform    => \&do_wikiform,
);
our $UA = '';  ## User agent name
$| = 1;
SuikaWiki::Plugin->feature ('SuikaWiki::View');
SuikaWiki::Plugin->feature ('SuikaWiki::Name::Space');
SuikaWiki::Plugin->feature ('SuikaWiki::Markup::XML');
SuikaWiki::Plugin->feature ('Yuki::YukiWikiCache');
my $NS_XHTML1 = 'http://www.w3.org/1999/xhtml';

sub main {
    $UA = $main::ENV{HTTP_USER_AGENT};
    &open_db;
    &init_form;
    for (@{$SuikaWiki::Plugin::On{WikiDatabaseLoaded}||[]}) {
      &{$_};
    }
    if ($command_do{$form{mycmd}}) {
        &{$command_do{$form{mycmd}}};
    } else {
        &{$command_do{default}};
    }
    &close_db;
}

sub do_view {
  my $content = $main::database{$main::form{mypage}};
  my $lm = SuikaWiki::Plugin->_database->mtime ($main::form{mypage});
    my $view = $form{mycmd};
    $view = 'default' if $view =~ /[^0-9A-Za-z_]/;
    if ($view eq 'default' || !$view) {
      ## BUG: this code is not strict
      if ($main::ENV{HTTP_COOKIE} =~ /SelectedMode=([0-9A-Za-z]+)/) {
        $view = $1;
      } else {
        $view = 'read';
      }
    }
  my ($magic, $content) = SuikaWiki::Plugin->magic_and_content ($content);
  $magic ||= '#?SuikaWiki/0.9';
  my $o = bless {param => \%main::form, page => $main::form{mypage}, toc => [],
                 magic => $magic, content => $content,
                 formatter => $fmt{view}, &main::_compatible_options ()}, 'SuikaWiki::Plugin';
  my $view_def = SuikaWiki::View->definition ($view);
  if (!$view_def->check ($o)) {
    print "Status: 406 Unsupported Media Type\n";
    $view = '-UnsupportedMediaType';
    $view_def = SuikaWiki::View->definition ($view);
  }
  my $media = $view_def->properties->{media};
  if ($view_def->properties->{xmedia} && $UA =~ /Gecko/) {
    $media = $view_def->properties->{xmedia};
    $o->{media} = $media;
  } elsif ($main::UA =~ m#Mozilla/0\..+Windows#) {
    $main::kanjicode = 'shift_jis';
  }
    if ($magic =~ m!^\#\?SuikaWiki/0.9!) {
      &main::print_header ($main::form{mypage}, -last_modified => ($magic =~ /interactive="yes"/ ? time : $lm),
        -expires => ($magic =~ /interactive="yes"/ ? 1 : undef), o => $o,
        -media => $media, -magic => $magic,  content => $content);
    } else {
      &main::print_header($main::form{mypage}, -media => $media,
                                   -magic => $magic, -last_modified => $lm, o => $o);
    }
  my $fmt = SuikaWiki::Plugin->formatter ('view');
  if ($main::kanjicode ne 'euc') {
    my $s = $fmt->replace ($view_def->as_string => $o, {formatter => $fmt});
    print &main::code_convert (\$s => $main::kanjicode);
  } else {
    print $fmt->replace ($view_def->as_string => $o, {formatter => $fmt});
  }
}

sub _do_view_msg (%) {
  my %option = @_;
  &load_formatter ('view');
  my $o = bless {param => \%form, page => $option{-page}, toc => [], condition => \%option,
                 formatter => $fmt{view}, &_compatible_options ()}, 'SuikaWiki::Plugin';
  my $view_def = SuikaWiki::View->definition ($option{-view});
  unless ($view_def->check ($o)) {
    print "Status: 406 Unsupported Media Type\n";
    $option{-view} = '-UnsupportedMediaType';
    $view_def = SuikaWiki::View->definition ($option{-view});
  }
  my $media = $view_def->properties->{media};
  if ($view_def->properties->{xmedia} && $UA =~ /Gecko/) {
    $media = $view_def->properties->{xmedia};
    $o->{media} = $media;
  }
  &print_header($option{-page}, -media => $media, o => $o, -goto => $option{-goto});
  print $fmt{view}->replace ($view_def->as_string => $o, {formatter => $fmt{view}});
}

sub do_adminchangepassword {
    if ($form{mynewpassword} ne $form{mynewpassword2}) {
        &_do_view_msg (-view => '-error', -page => $form{mypage},
                       error_message => &Resource ('Error:PasswordMismatch'));
        return;
    }
    my ($validpassword_crypt) = $database->meta (AdminPassword => $PageName{AdminSpecialPage});
    if ($validpassword_crypt) {
        if (not &valid_password($form{myoldpassword})) {
            &_do_view_msg (-view => '-error', -page => $form{mypage},
                           error_message => &Resource ('Error:PasswordIsIncorrect'));
            return;
        }
    }
    my ($sec, $min, $hour, $day, $mon, $year, $weekday) = localtime(time);
    my (@token) = ('0'..'9', 'A'..'Z', 'a'..'z');
    my $salt1 = $token[(time | $$) % scalar(@token)];
    my $salt2 = $token[($sec + $min*60 + $hour*60*60) % scalar(@token)];
    my $crypted = crypt($form{mynewpassword}, "$salt1$salt2");
    $database->meta (AdminPassword => $PageName{AdminSpecialPage} => $crypted);
    
    &_do_view_msg (-view => '-wrote', -page => $form{mypage});
}

sub valid_password ($) {
    my ($validpassword_crypt) = $database->meta (AdminPassword => $PageName{AdminSpecialPage});
    return crypt (shift, $validpassword_crypt) eq $validpassword_crypt ? 1 : 0;
}

sub do_write {
    if (&frozen_reject()) {
        return;
    }

    if (not &is_editable($form{mypage})) {
        &_do_view_msg (-view => '-error', -page => $form{mypage},
                       error_message => &Resource ('Error:ThisPageIsUneditable'));
        return;
    }

    ## Check confliction
    if ($form{myLastModified} ne $database->mtime ($form{mypage})) {
      &_do_view_msg (-view => '-conflict', -page => $form{mypage});
      return;
    }

    if ($form{mymsg}) {
        if ($form{mytouch} || !ref $database) {
          $database{$form{mypage}} = $form{mymsg};
        } else {
          $database->STORE ($form{mypage} => $form{mymsg}, -touch => 0);
        }
        $database->meta (IsFrozen => $form{mypage} => 0 + $form{myfrozen});
        my $fragment = '';
        $fragment .= qq(;after_edit_cmd=@{[&encode($form{after_edit_cmd})]}) if $form{after_edit_cmd};
        if ($form{__comment_anchor_index}) {
            $fragment .= qq(#anchor-$form{__comment_anchor_index});
        } elsif ($form{__wikiform_anchor_index}) {
            $fragment .= qq(#wikiform-$form{__wikiform_anchor_index});
        }
        &_do_view_msg (-view => '-wrote', -page => $form{mypage}, -goto => $url_cgi.'?mycmd='.&encode($form{after_edit_cmd}||'default').';mypage='.&encode($form{mypage}).qq(;x-param=@{[time.[0..9]->[rand 10]]}$fragment));
    } else {
        delete $database{$form{mypage}};
        &_do_view_msg (-view => '-deleted', -page => $form{mypage});
    }
}

sub _compatible_options () {
  (use_anchor_name => ($UA =~ m#Mozilla/[12]\.|Microsoft Internet Explorer# ? 1 : 0));
}

sub do_random_jump {
  my @list = keys %main::database;
  print "Location: ".SuikaWiki::Plugin->_uri_wiki_page ($list[rand @list])."\n";
  print "\n";
}

sub print_header ($;%) {
    my ($page, %option) = @_;
    my $UA = SuikaWiki::Plugin->user_agent_names;
    $option{o}->{-header}->{class}->{frozen} = 1 if &main::is_frozen ($page);
    $option{o}->{-header}->{class}->{'wiki-page-obsoleted'} if $option{-magic} =~ /obsoleted="yes"/;
    $option{o}->{-header}->{additional_html_element} ||= SuikaWiki::Markup::XML->new (type => '#fragment');
    if ($option{-goto}) {
      if ($UA =~ m#Opera|MSIE 2\.#) {
        ## WARNING: This code may output unsafe HTML document if $option{-goto} is unclean.
        $option{-goto} =~ tr/;/&/ if $UA =~ m#Opera#;
        print qq{Refresh: 0; url=$option{-goto}\n};
        for ($option{o}->{-header}->{additional_html_element}->append_new_node
                (namespace_uri => $NS_XHTML1, local_name => 'meta')) {
          $_->set_attribute ('http-equiv' => 'refresh');
          $_->set_attribute (content => "0; url=$option{-goto}");
        }
      } else {
        $option{-goto} =~ tr/;/&/ if $UA =~ m#Mozilla/[1-4]\.#;
        print qq{Refresh: 0; url="$option{-goto}"\n};
        for ($option{o}->{-header}->{additional_html_element}->append_new_node
                (namespace_uri => $NS_XHTML1, local_name => 'meta')) {
          $_->set_attribute ('http-equiv' => 'refresh');
          $_->set_attribute (content => qq(0; url="$option{-goto}"));
        }
      }
    }
    print qq{Last-Modified: @{[scalar gmtime $option{-last_modified}]}\n}
      if $option{-last_modified};
    if ($option{-expires} != -1) {
      if (defined $option{-expires}) {  ## TODO: Don't use asctime
        print qq{Expires: @{[scalar gmtime (time + $option{-expires})]}\n};
      } elsif ($option{-media}->{expires} != -1) {
        print qq{Expires: @{[scalar gmtime (time + $option{-media}->{expires})]}\n};
      }
    }
    if ($option{-media}->{charset} && $UA =~ m#Mozilla/[12]\.#) {
    ## UAs don't support official charset names but do non-official names
      my $ct = qq{$option{-media}->{type}; charset=@{[ &main::get_charset_name ($main::kanjicode, compatible => 1) ]}};
      print qq{Content-Type: $ct\n};
      for ($option{o}->{-header}->{additional_html_element}->append_new_node
                (namespace_uri => $NS_XHTML1, local_name => 'meta')) {
        $_->set_attribute ('http-equiv' => 'content-type');
        $_->set_attribute (content => $ct);
      }
    } elsif (!$option{-media}->{charset} || $UA =~ m#Infomosaic|Mozilla/0\.#) {
    ## Media types or UAs don't support charset parameter in HTTP header
      print qq{Content-Type: $option{-media}->{type}\n};
      if ($option{-media}->{charset}) {
        for ($option{o}->{-header}->{additional_html_element}->append_new_node
                  (namespace_uri => $NS_XHTML1, local_name => 'meta')) {
          $_->set_attribute ('http-equiv' => 'content-type');
          $_->set_attribute (content => qq($option{-media}->{type}; charset=).main::get_charset_name ($main::kanjicode, compatible => 1));
        }
      }
    } else {
    ## Modern UAs and Media types with charset parameter
      my $type = $option{-media}->{type};
      $type = 'application/xml' if ($type =~ m!^application/(?:rdf|rss)\+xml$!) && ($UA =~ m#Gecko#);
      print qq{Content-Type: $type; charset=@{[&main::get_charset_name ($main::kanjicode)]}\n};
      ## meta element is not needed
    }
    #if ($main::ENV{HTTP_IF_MODIFIED_SINCE}) {
      ## TODO: IMS support
    #}
    
    ## TODO: more Vary: support
    print <<"EOD";
Vary: Negotiate,User-Agent,Accept-Language,Accept-Type
Content-Style-Type: text/css

EOD
}

sub get_charset_name ($;%) {
    my ($charset, %option) = (lc shift, @_);
    if ($charset =~ 'euc') {
        $charset = $option{compatible} ? 'x-euc-jp' : 'euc-jp';
    } elsif ($charset =~ 'sjis' || $charset =~ 'shift') {
        $charset = $option{compatible} ? 'x-sjis' : 'shift_jis';
    } elsif ($charset =~ 'jis') {
        $charset = 'iso-2022-jp';
    }
    $charset;
}

sub escape {
    my $s = shift;
    $s =~ s|&|&amp;|g;
    $s =~ s|<|&lt;|g;
    $s =~ s|>|&gt;|g;
    $s =~ s|"|&quot;|g;
    $s =~ s/([\x00-\x08\x0B\x0C\x0E-\x1F])/sprintf '&amp;#%d;', ord $1/ge;
        ## XML unsafe control chars
    return $s;
}

sub unescape {
    my $s = shift;
    $s =~ s|&lt;|<|g;
    $s =~ s|&gt;|>|g;
    $s =~ s|&quot;|"|g;
    $s =~ s|&amp;|&|g;
    return $s;
}

sub convert_format ($$$;%) {
  my ($content, $d => $t, %option) = @_;
  my $f = SuikaWiki::Plugin->format_converter ($d => $t);
  if (ref $f) {
    $option{content} = $content;
    $option{from} = $d;
    $option{to} = $t;
    &$f ({}, bless (\%option, 'SuikaWiki::Plugin'));
  } elsif ($option{-error_no_return}) {
    return undef;
  } elsif ($t =~ /HTML|xml/) {
    if (length $content) {
      my $r = SuikaWiki::Markup::XML->new (namespace_uri => $NS_XHTML1, local_name => 'pre');
      return $r->append_text ($content);
    } else {
      return '';
    }
  } else {
    $content;
  }
}


sub init_form {
    ## TODO: Support multipart/form-data
    my $query = '';
    if (uc $main::ENV{REQUEST_METHOD} eq 'POST') {
      if (lc ($main::ENV{CONTENT_TYPE}) eq 'application/x-www-form-urlencoded'
       || lc ($main::ENV{CONTENT_TYPE}) eq 'application/sgml-form-urlencoded') {
        read STDIN, $query, $main::ENV{CONTENT_LENGTH};
      } else {
        $form{mycmd} = '___unsupported_media_type___';
        $form{mypage} = $PageName{FrontPage};
        return;
      }
    }
    $query .= ($query ? ';' : '') . $main::ENV{QUERY_STRING};
    if ($main::ENV{REQUEST_METHOD} ne 'POST' && $main::ENV{QUERY_STRING} && $main::ENV{QUERY_STRING} !~ /[&;=]/) {
      my $query = &decode($main::ENV{QUERY_STRING});
      $query = &code_convert(\$query, $kanjicode);
        $form{mypage} = $query;
        $form{mycmd} = 'default';
    } else {
      for (split /[;&]/, $query) {
        if (my ($n, $v) = split /=/, $_, 2) {
          for ($n, $v) {tr/+/ /; s/%([0-9A-Fa-f][0-9A-Fa-f])/pack 'C', hex $1/ge};
          $form{$n} = $v;
        }
      }
      unless (defined $form{mypage}) {
        $form{mypage} = $form{epage};
        $form{mypage} =~ s/([0-9A-F]{2})/ord hex $1/g;
      }
      $form{mypage} = &code_convert (\$form{mypage}, $kanjicode);
    }
    $form{mypage} ||= $PageName{FrontPage};
    $form{mypage} =~ tr/\x00-\x1F\x7F//d;
    $form{mypage} = SuikaWiki::Name::Space::normalize_name ($form{mypage});
    $form{mycmd} ||= 'default';
    $form{mycmd} =~ tr/-/_/;

    # mypreview_edit        -> do_edit, with preview.
    # mypreview_adminedit   -> do_adminedit, with preview.
    # mypreview_write       -> do_write, without preview.
    foreach (keys %form) {
        if (/^mypreview_(.*)$/) {
            $form{mycmd} = $1;
            $form{mypreview} = 1;
        }
    }

    # 
    # $form{mycmd} is frozen here.
    # 

    for (grep /^(?:wikiform__|pi_)/, keys %form) {
        $form{$_} = &code_convert (\$form{$_}, $kanjicode);
    }
    $form{mymsg} = &code_convert(\$form{mymsg}, $kanjicode);
    $form{myname} = &code_convert(\$form{myname}, $kanjicode);
}


sub open_db {
    if ($modifier_dbtype eq 'dbmopen') {
        dbmopen(%database, $PathTo{WikiDataBase}, 0666) or die "(dbmopen) $PathTo{WikiDataBase}";
    } elsif ($modifier_dbtype eq 'AnyDBM_File') {
        eval q{use AnyDBM_File};
        tie(%database, "AnyDBM_File", $PathTo{WikiDataBase}, O_RDWR|O_CREAT, 0666) or die ("(tie AnyDBM_File) $PathTo{WikiDataBase}");
    } elsif ($modifier_dbtype eq 'Yuki::YukiWikiDB') {
        eval q{use Yuki::YukiWikiDB};
        tie(%database, "Yuki::YukiWikiDB", $PathTo{WikiDataBase}) or die ("(tie Yuki::YukiWikiDB) $PathTo{WikiDataBase}");
    } else {    ## Yuki::YukiWikiDB || Yuki::YukiWikiDBMeta
        eval qq{use $modifier_dbtype};
        $database = tie(%database, $modifier_dbtype => $PathTo{WikiDataBase}, -lock => 2, -backup => $wiki::diff::UseDiff) or die ("(tie $modifier_dbtype) $PathTo{WikiDataBase}");
    }
}

sub close_db {
    if ($modifier_dbtype eq 'dbmopen') {
        dbmclose(%database);
    } else {
        untie(%database);
    }
}

sub editform (@) {
  my %option = @_;
  my $frozen = &is_frozen ($option{page});
  $option{content} = $database{$option{page}} unless defined $option{content};
  $option{content} = $database{NewPageTemplate} unless length $option{content};
  $option{last_modified} = $database->mtime ($option{page}) unless defined $option{last_modified};
  my $magic = '';
  $magic = $1 if $option{content} =~ m/^([^\x0A\x0D]+)/s;
  
  my $selected = 'default';
  if ($form{after_edit_cmd}) {
    $selected = $form{after_edit_cmd};
  } elsif ($magic =~ /Const|Config|CSS/) {
    $selected = 'edit';
  }
  my $afteredit = <<EOH;
<select name="after_edit_cmd">
<option value="default" label="@{[&Resource('Edit:SaveAndDefault',escape=>1)]}"@{[$selected eq 'default' ? ' selected="selected"':'']}>@{[&Resource('Edit:SaveAndDefault',escape=>1)]}</option>
<option value="read" label="@{[&Resource('Edit:SaveAndView',escape=>1)]}"@{[$selected eq 'read' ? ' selected="selected"':'']}>@{[&Resource('Edit:SaveAndView',escape=>1)]}</option>
<option value="edit" label="@{[&Resource('Edit:SaveAndEdit',escape=>1)]}"@{[$selected eq 'edit' ? ' selected="selected"':'']}>@{[&Resource('Edit:SaveAndEdit',escape=>1)]}</option>
</select>
EOH

=pod

  my $f = SuikaWiki::Markup::XML->new (namespace_uri => $NS_XHTML1, local_name => 'form');
    $f->set_attribute (action => SuikaWiki::Plugin->uri ('wiki');
    $f->set_attribute (method => 'post');
    if (!$option{confloct}) {
      for ($f->append_new_node (namespace_uri => $NS_XHTML1, local_name => 'label')) {
        for ($_->append_new_node (namespace_uri => $NS_XHTML1, local_name => 'input')) {
          $f->set_attribute (type => 'submit');
          $f->set_attribute (name => 'mypreview_write');
          $f->set_attribute (value => SuikaWiki::Plugin->resource ('Edit:Save'));
        }
        $_->append_new_node (namespace_uri => $NS_XHTML1, local_name => 'kbd', value => 'S');
      }
    }

=cut

  my $f = <<"EOD";
<form action="$uri{wiki}" method="post">
    @{[ $option{conflict} ? '' : qq(<label><input type="submit" name="mypreview_write" value="@{[&Resource('Edit:Save',escape=>1)]}" /><kbd>S</kbd></label>) ]}
    @{[ $option{admin} ? qq(<label>@{[&Resource('Edit:Password=',escape=>1)]}<input type="password" name="mypassword" value="" size="10" /></label>) : "" ]} [@{[&get_new_anchor_index($option{content})]}]<br />
    <input type="hidden" name="myLastModified" value="$option{last_modified}" />
    <input type="hidden" name="mypage" value="@{[&escape($form{mypage})]}" />
    <textarea cols="@{[&Resource('Edit:Form:Cols')+0||80]}" rows="@{[&Resource('Edit:Form:Rows')+0||20]}" name="mymsg" tabindex="1">@{[&escape($option{content})]}</textarea><br />
@{[
    $option{admin} ?
    qq(
    <label><input type="radio" name="myfrozen" value="1" @{[$frozen ? qq(checked="checked") : ""]} />@{[&Resource('Edit:Freeze',escape=>1)]}</label>
    <label><input type="radio" name="myfrozen" value="0" @{[$frozen ? "" : qq(checked="checked")]} />@{[&Resource('Edit:DontFreeze',escape=>1)]}</label><br />)
    : ""
]}
@{[
    $option{conflict} ? "" :
    qq(
        <label><input type="checkbox" name="mytouch" value="on" checked="checked" />@{[&Resource('Edit:UpdateTimeStamp',escape=>1)]}</label><br />
        <label><input type="submit" name="mypreview_write" value="@{[&Resource('Edit:Save',escape=>1)]}" accesskey="S" /><kbd>S</kbd></label>
       $afteredit
    )
]}
</form>
EOD
    $f;
}

sub is_editable {
    my ($page) = @_;
    return 0 unless SuikaWiki::Name::Space::validate_name ($page);
    return 0 if $page =~ /[\x00-\x20\[\]\x7F]/;
    1;
}

sub decode {
    my ($s) = @_;
    $s =~ tr/+/ /;
    $s =~ s/%([A-Fa-f0-9][A-Fa-f0-9])/pack("C", hex($1))/eg;
    return $s;
}

sub encode {
  my $s = shift;
  $s =~ s/([^0-9A-Za-z_-])/sprintf '%%%02X', ord $1/ge;
  $s;
}

sub get_now {
    my ($sec, $min, $hour, $day, $mon, $year) = localtime(time);
    $year += 1900;
    $mon++;
    $mon = "0$mon" if $mon < 10;
    $day = "0$day" if $day < 10;
    $hour = "0$hour" if $hour < 10;
    $min = "0$min" if $min < 10;
    #$sec = "0$sec" if $sec < 10;
    return "$year-$mon-$day $hour:$min";
}

sub frozen_reject {
    my ($isfrozen) = $database->meta (IsFrozen => $form{mypage});
    my ($willbefrozen) = $form{myfrozen};
    if (not $isfrozen and not $willbefrozen) {
        # You need no check.
        return 0;
    } elsif (valid_password($form{mypassword})) {
        # You are admin.
        return 0;
    } else {
        &_do_view_msg (-view => '-error', -page => $form{mypage},
                       error_message => SuikaWiki::Plugin->resource ('Error:PasswordIsIncorrect'));
        exit;
    }
}

sub is_frozen ($) { SuikaWiki::Plugin->_database->meta (IsFrozen => $_[0]) ? 1 : 0 }

sub do_comment {
    my ($content) = $database{$form{mypage}};
    my $default_name;   ## this code is not strict.
    $default_name = $1 if $content =~ /default-name="([^"]+)"/;
    my $datestr = '[WEAK['.&get_now.']]';
    my $namestr = $form{myname} || $default_name || &Resource('WikiForm:WikiComment:DefaultName');
    ($namestr = '', $datestr = '') if $form{myname} eq 'nodate';
    if ($namestr =~ /^(?:>>)?[0-9]/) {
      $namestr = qq( ''$namestr'': );
    } elsif (length $namestr) {
      $namestr = qq( ''[[$namestr]]'': );
    }
    my $anchor = &get_new_anchor_index ($content);
    my $i = 1;  my $o = 0;
    $content =~ s{(\[\[\#r?comment\]\])}{
      my $embed = $1;
      if ($i == $form{comment_index}) {
        if ($embed ne '[[#rcomment]]') {
          $embed = "- [$anchor] $datestr$namestr$form{mymsg}\n$embed";  $o = 1;
        } else {
          $embed .= "\n- [$anchor] $datestr$namestr$form{mymsg}";  $o = 1;
        }
      }
      $i++; $embed;
    }ge;
    unless ($o) {
      $content = "#?SuikaWiki/0.9\n\n" unless $content;
      $content .= "\n" unless $content =~ /\n$/s;
      $content .= "- [$anchor] $datestr$namestr$form{mymsg}\n";
    }
    $form{__comment_anchor_index} = $anchor;
    if ($form{mymsg} || $form{myname}) {
        $form{mymsg} = $content;
        $form{mytouch} = 'on';
        &do_write;
    } else {    ## Don't write
        $form{mycmd} = 'default';
        &do_view;
    }
}

sub get_new_anchor_index ($) {
    my $content = shift;
    my $anchor = 0;
    $content =~ s/^(?:[-=]+\s*)?\[([0-9]+)\]/$anchor = $1 if $1 > $anchor; $&/mge;
    $anchor + 1;
}

sub load_formatter (@) {
    for my $t (@_) {
        unless ($fmt{$t}) {
            require Message::Util::Formatter;
            $fmt{$t} = Message::Util::Formatter->new;
            for (@{$SuikaWiki::Plugin::List{'wiki'.$t}||[]}) {
                $_->load_formatter ($fmt{$t}, type => 'wiki'.$t);
            }
            $fmt{$t}->option (return_class => 'SuikaWiki::Markup::XML');
        }
    }
}

sub do_wikiform {
    my $content = $database{$form{mypage}};
    my $anchor = &get_new_anchor_index ($content);
    &load_formatter (qw/form_template form_option/);
    my $write = 0;
    my $i = 1;
    $content =~ s{$embed_command{form}}{
        my ($embed, $wfname, $template, $option) = ($&, $1, $3, $4);
        if (($wfname && $wfname eq $form{wikiform_targetform})
            || $i == $form{wikiform_index}) {
            $template =~ s/\\([\\'])/$1/g;
            $option =~ s/\\([\\'])/$1/g;
            my $param = bless {depth=>10}, 'SuikaWiki::Plugin';
            $param->{page} = $form{mypage};
            $param->{form_index} = $i;
            $param->{form_name} = $wfname;
            $param->{anchor_index} = $anchor;
            $param->{argv} = \%form;
            $param->{default_name} = $1 if $content =~ /default-name="([^"]+)"/;
            $param->{default_name} ||= &Resource('WikiForm:WikiComment:DefaultName');
            $fmt{form_option}->replace ($option, $param);
            my $t = 1;
            for (keys %{$param->{require}||{}}) {
                (undef $t, last) unless length $param->{argv}->{'wikiform__'.$_};
            }
            $t = $fmt{form_template}->replace ($template, $param) if $t;
            if (length $t) {
                if ($param->{output}->{reverse}) {
                    $embed .= "\n" . $t;
                } else {
                    $embed = $t . "\n" . $embed;
                }
                $write = 1;
                $form{__comment_anchor_index} = $anchor
                  if $param->{anchor_index_};  ## $anchor is used!
            }
            $form{__wikiform_anchor_index} = $i;
            undef $form{wikiform_targetform};  ## Make sure never to match
            undef $form{wikiform_index};       ## with WikiForm in rest of page!
        }
        $i++; $embed;
    }ge;
    unless ($write) {
      #$content = "#?SuikaWiki/0.9\n\n" unless $content;
      #$content .= "\n" unless $content =~ /\n$/s;
      #
    }
    if ($write) {
        $form{mymsg} = $content;
        $form{mytouch} = 'on';
        &do_write;
    } else {    ## Don't write!
        $form{mycmd} = 'default';
        &do_view;
    }
}

sub code_convert {
  require Jcode;
    my ($contentref, $code) = (shift, shift || $kanjicode);
    if    ($code =~ /euc/) { $code = 'euc' }
    elsif ($code =~ /iso/) { $code = 'jis' }
    elsif ($code =~ /shi/) { $code = 'sjis' }
    elsif ($code =~ /utf/) { $code = 'utf8' }
    $$contentref = Jcode->new ($contentref)->tr ("\xA3\xB0-\xA3\xB9\xA3\xC1-\xA3\xDA\xA3\xE1-\xA3\xFA\xA1\xF5\xA1\xA4\xA1\xA5\xA1\xA7\xA1\xA8\xA1\xA9\xA1\xAA\xA1\xAE\xA1\xB0\xA1\xB2\xA1\xBF\xA1\xC3\xA1\xCA\xA1\xCB\xA1\xCE\xA1\xCF\xA1\xD0\xA1\xD1\xA1\xDC\xA1\xF0\xA1\xF3\xA1\xF4\xA1\xF6\xA1\xF7\xA1\xE1\xA2\xAF\xA2\xB0\xA2\xB2\xA2\xB1\xA1\xE4\xA1\xE3\xA1\xC0\xA1\xA1" => q(0-9A-Za-z&,.:;?!`^_/|()[]{}+$%#*@='"~-><\ ))->$code;
    return $$contentref;
}

sub _rfc3339_date ($) {
  my @time = gmtime (shift);
  sprintf '%04d-%02d-%02dT%02d:%02d:%02d+00:00', $time[5]+1900,$time[4]+1,@time[3,2,1,0];
}


package wiki::dummy;
sub mtime (@) {undef}
sub meta (@) {undef}
sub Yuki::YukiWikiDB2::meta (@) {undef}

package main;
&SuikaWiki::Plugin::import_plugins ();
&main ();

=head1 NAME

lib/suikawiki.pl --- SuikaWiki transitional library

=head1 AUTHOR

Hiroshi Yuki <hyuki@hyuki.com> <http://www.hyuki.com/yukiwiki/> (YukiWiki)

Makio Tsukamoto <http://digit.que.ne.jp/> (WalWiki)

Wakaba <w@suika.fam.cx>

=head1 LICENSE

Copyright AUTHORS 2000-2003

This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.

=cut

1; # $Date: 2003/05/25 10:56:24 $