script/lib/suikawiki.pl

# -*- perl -*-
use strict;

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

our %form;
our %database;
our $database = bless {}, 'wiki::dummy';
my %command_do = (
    default => \&do_view,
    adminchangepassword => \&do_adminchangepassword,
    write => \&do_write,
    comment => \&do_comment,
    RandomJump  => sub {
      my @list = keys %main::database;
      &main::_http_see_other (page => $list[rand @list]);
    },
    wikiform    => \&do_wikiform,
);
our $UA = '';  ## User agent name
$| = 1;
require SuikaWiki::Name::Space;
my $NS_XHTML1 = 'http://www.w3.org/1999/xhtml';

sub _wiki_exit () {
    &close_db;
    exit;
}

BEGIN {
  require SuikaWiki::Output::CGICarp;
  $SuikaWiki::Output::CGICarp::CUSTOM_REASON_TEXT = 'Internal WikiEngine Error';
  CGI::Carp::set_message (sub {
    my $msg = shift;
    #$msg =~ s/&/&amp;/g;
    #$msg =~ s/</&lt;/g;
    print STDOUT <<EOH
<!DOCTYPE html SYSTEM>
<title>500 Internal WikiEngine Error</title>
<h1>Internal WikiEngine Error</h1>
<p>$msg</p>
EOH
  });
}

sub do_view {
  require SuikaWiki::View;
  my $content = $main::database{$main::form{mypage}};
  my $lm = SuikaWiki::Plugin->_database->mtime ($main::form{mypage});
  ## Determine mode
    my $view = $form{mycmd};
    if (!$view || $view eq 'default' || $view =~ /[^0-9A-Za-z_]/) {
      ## BUG: this code is not strict
      if ($main::ENV{HTTP_COOKIE} =~ /SelectedMode=([0-9A-Za-z_-]+)/) {
        $view = $1; $view =~ tr/-/_/;
      } else {
        $view = 'read';
      }
    }
  ## Get content and its meta info
  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,
                 &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 $prop = $view_def->properties;
  my $media = $prop->{media};
  if ($prop->{xmedia} && $main::UA =~ /Gecko/) {        ## TODO: conneg
    $media = $prop->{xmedia};
    $o->{media} = $media;
  } elsif ($main::UA =~ m#Mozilla/0\..+Windows#) {
    $main::kanjicode = 'shift_jis';
  }
  
  if ($prop->{preprocess}) {
    _wiki_exit () unless &{$prop->{preprocess}} (o => $o);
  }
  
  ## Output CGI/HTTP headers
    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, -view => $view_def, -magic => $magic,  content => $content);
    } else {
      &main::print_header($main::form{mypage}, -media => $media, -view => $view_def,
                                   -magic => $magic, -last_modified => $lm, o => $o);
    }
  ## Output HTTP message body
  my $fmt = SuikaWiki::Plugin->formatter ('view');
  my $s = $fmt->replace ($view_def->as_string => $o, {formatter => $fmt});
  if ($main::kanjicode eq 'euc') {
    #require Compress::Zlib;
    #print scalar Compress::Zlib::memGzip (''.$s);
    print $s;
  } else {
    $s .= '';
    print &main::code_convert (\$s => $main::kanjicode);
  }
}

sub _do_view_msg (%) {
  require SuikaWiki::View;
  my %option = @_;
  my $o = $option{-o} || bless {param => \%form, page => $option{-page},
                                &_compatible_options ()}, 'SuikaWiki::Plugin';
  $o->{toc} = [];
  $o->{condition} = \%option;   ## This parameter really used??
  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 $prop = $view_def->properties;
  my $media = $prop->{media};
  if ($prop->{xmedia} && $UA =~ /Gecko/) {
    $media = $prop->{xmedia};
    $o->{media} = $media;
  }
  &print_header($option{-page}, -media => $media, -view => $view_def, o => $o, -goto => $option{-goto});
  ## Output HTTP message body
  my $fmt = SuikaWiki::Plugin->formatter ('view');
  my $s = $fmt->replace ($view_def->as_string => $o, {formatter => $fmt});
  if ($main::kanjicode eq 'euc') {
    print $s;
  } else {
    print &main::code_convert (\$s => $main::kanjicode);
  }
}

# [move to SuikaWiki::Plugin::WikiAdmin]
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})) {
          print "Status: 403 Unauthorized\n";
          &_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});
}

# [move to SuikaWiki::WikiDB]
sub valid_password ($) {
    my ($validpassword_crypt) = $database->meta (AdminPassword => $PageName{AdminSpecialPage});
    return crypt (shift, $validpassword_crypt) eq $validpassword_crypt ? 1 : 0;
}

# [move to SuikaWiki::Plugin::WikiEdit]
sub do_write {
    if (&frozen_reject()) {
        return;
    }

    if (not &is_editable($form{mypage})) {
      print "Status: 403 WikiPage Uneditable\n";
      &_do_view_msg (-view => '-error', -page => $form{mypage},
                     error_message => &Resource ('Error:ThisPageIsUneditable'));
      return;
    }

    ## Check confliction
    if ($form{myLastModified} ne $database->mtime ($form{mypage})) {
      print "Status: 409 Conflict\n";
      &_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 $uri = SuikaWiki::Plugin->_uri_wiki_page ($form{mypage}, mode => ($form{after_edit_cmd}||'default'), with_lm => 1, absolute => 1);
        $uri .= qq(;after_edit_cmd=@{[SuikaWiki::Plugin->encode($form{after_edit_cmd})]}) if $form{after_edit_cmd};
        if ($form{__comment_anchor_index}) {
            $uri .= qq(#anchor-$form{__comment_anchor_index});
        } elsif ($form{__wikiform_anchor_index}) {
            $uri .= qq(#wikiform-$form{__wikiform_anchor_index});
        }
        &_http_see_other (uri => $uri, page => $form{mypage}, alternate_view => '-wrote');
    } else {
        delete $database{$form{mypage}};
        &_do_view_msg (-view => '-deleted', -page => $form{mypage});
    }
}

sub _http_see_other (%) {
  my %o = @_;
  $o{uri} ||= SuikaWiki::Plugin->_uri_wiki_page ($o{page}, absolute => 1);
  if ($o{alternate_view} && ($main::ENV{SERVER_PROTOCOL} eq 'HTTP/0.9'
                          || $main::ENV{SERVER_PROTOCOL} eq 'HTTP/1.0')
   && !($main::UA =~ m#Microsoft Internet Explorer|Mozilla#)) {
    &_do_view_msg (-view => $o{alternate_view}, -page => $o{page}, -goto => $o{uri}, -o => $o{o});
  } else {
      my $status = q(303 See Other);
      if ($main::UA =~ m!Mozilla/[0-4]\.|Microsoft Internet Explorer!) {
          $status = q(302 See Other);
      }
    my $euri = SuikaWiki::Plugin->escape ($o{uri});
    print qq(Status: $status
Location: $o{uri}
Content-Type: text/html
Content-Language: en

<!DOCTYPE p SYSTEM>
<p>See &lt;<a href="$euri">$euri</a>&gt;.</p>);
  }
  _wiki_exit ();
}

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


sub print_header ($;%) {
    my ($page, %option) = @_;
    if ($main::ENV{HTTP_IF_MODIFIED_SINCE} && $option{-last_modified}) {
      ## TODO: use Message::Field::Date
      if ($option{-view}->properties->{if}->{modified_since}
       && $main::ENV{HTTP_IF_MODIFIED_SINCE} =~ /([0-9]{1,2})\s*([A-Za-z]{3})\s*([0-9]{2,4})\s*([0-9]{2}):([0-9]{2}):([0-9]{2})\s*[Gg][Mm][Tt]/) {
          require Time::Local;
          my ($d, $M, $y, $h, $m, $s) = ($1, $2, $3, $4, $5, $6);
          $M = {jan=>0,feb=>1,mar=>2,apr=>3,may=>4,jun=>5,jul=>6,aug=>7,sep=>8,oct=>9,nov=>10,dec=>11}->{lc $M};
          #$y += 1900 if $y < 100;      ## BUG: don't conform HTTP spec
          my $t = Time::Local::timegm_nocheck ($s, $m, $h, $d, $M, $y);
          if ($option{-last_modified} <= $t) {
            print "Status: 304 Not Modified\n\n";
            _wiki_exit ();
          }
      }
    }
    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'} = 1 if $option{-magic} =~ /obsoleted="yes"/;
    $option{o}->{-header}->{additional_html_element} ||= SuikaWiki::Markup::XML->new (type => '#fragment');
    print "Vary: Negotiate,User-Agent,Accept-Language,Accept\n";
    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}");
          $_->option (use_EmptyElemTag => 1);
        }
      } 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}"));
          $_->option (use_EmptyElemTag => 1);
        }
      }
    }
    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/r(?:df|ss)\+xml$!) && ($UA =~ m#Gecko#);
      print qq{Content-Type: $type; charset=@{[&main::get_charset_name ($main::kanjicode)]}\n};
      ## meta element is not needed
    }
    
    print <<"EOD";
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;
}

=pod

sub _decode_argv () {
  my $QS = $main::ENV{QUERY_STRING};
  if ($main::ENV{PATH_INFO}) {
  die;
  # new format: not implemented yet
  } else {
    my %argv;
    if ($QS =~ /[&;=]/) {       ## ?FOO=foo;BAR=bar;BAZ=baz
      for (split /[;&]/, $QS) {
        if (my ($n, $v) = split /=/, $_, 2) {
          for ($n, $v) {tr/+/ /; s/%([0-9A-Fa-f][0-9A-Fa-f])/pack 'HH', $1/ge};
          $argv{$n} = $v;
        }
      }
    } else {    ## ?FOO-BAR
      $argv{page} = $QS;
      $argv{page} =~ tr/+/ /;
      $argv{page} =~ s/%([0-9A-Fa-f][0-9A-Fa-f])/pack 'HH', $1/ge;
    }
    my $ie = $argv{ie}; ## Input coding system
    for ([qw/mypage page/], [qw/mycmd mode/]) {
      $argv{$_->[1]} ||= $argv{$_->[0]};
      delete $argv{$_->[0]};
    }
    for (keys %argv) {
      $argv{$_} = main::code_convert ($argv{$_}, $main::kanjicode, $ie);
    }
    for ([qw/mypage page/], [qw/mycmd mode/]) {
      $argv{$_->[0]} = $argv{$_->[1]};
    }
  }
}

=cut

sub init_form {
    ## TODO: Support multipart/form-data
    my $query = '';
    if (uc $main::ENV{REQUEST_METHOD} eq 'POST') {
      if ($main::ENV{CONTENT_TYPE}=~ m!^application/(?:x-www|sgml)-form-urlencoded(?:$|\s*;)!) {
        read STDIN, $query, $main::ENV{CONTENT_LENGTH};
      } else {
        $main::form{mycmd} = '___unsupported_media_type___';
        $main::form{mypage} = $main::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 = SuikaWiki::Plugin->decode ($main::ENV{QUERY_STRING});
      $query = &main::code_convert (\$query, $main::kanjicode);
        $main::form{mypage} = $query;
        $main::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};
          $main::form{$n} = $v;
        }
      }
      unless (defined $form{mypage}) {
        $form{mypage} = $form{epage};
        $form{mypage} =~ s/([0-9A-F]{2})/ord hex $1/g;
      }
      $form{mypage} = &main::code_convert (\$form{mypage}, $kanjicode);
    }
    $form{mypage} =~ tr/\x00-\x20\x7F//d;
    $form{mypage} = SuikaWiki::Name::Space::normalize_name ($form{mypage}) || $PageName{FrontPage};
    $form{mycmd} ||= $form{mode} || 'default';
    $form{mycmd} =~ tr/-/_/;

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

# [move to SuikaWiki::WikiDB]
sub open_db {
    if ($main::modifier_dbtype eq 'dbmopen') {
        dbmopen(%main::database, $PathTo{WikiDataBase}, 0666) or die "(dbmopen) $main::PathTo{WikiDataBase}";
    } elsif ($main::modifier_dbtype eq 'AnyDBM_File') {
        eval q{use AnyDBM_File};
        tie(%main::database, "AnyDBM_File", $main::PathTo{WikiDataBase}, O_RDWR|O_CREAT, 0666) or die ("(tie AnyDBM_File) $main::PathTo{WikiDataBase}");
    } elsif ($main::modifier_dbtype eq 'Yuki::YukiWikiDB') {
        eval q{use Yuki::YukiWikiDB};
        tie(%main::database, "Yuki::YukiWikiDB", $main::PathTo{WikiDataBase}) or die ("(tie Yuki::YukiWikiDB) $main::PathTo{WikiDataBase}");
    } else {    ## Yuki::YukiWikiDB || Yuki::YukiWikiDBMeta
        eval qq{use $modifier_dbtype};
        $database = tie (%database, $modifier_dbtype => $PathTo{WikiDataBase},
                         -lock => 0, -backup => $wiki::diff::UseDiff,   ## TODO: new diff i/f
                         -logfile => $main::PathTo{WikiDatabaseErrorLog})
                    or die ("(tie $modifier_dbtype) $PathTo{WikiDataBase}");
    }
}

# [move to SuikaWiki::WikiDB]
sub close_db {
    if ($modifier_dbtype eq 'dbmopen') {
        dbmclose(%database);
    } else {
        untie(%database);
    }
}

# [move to SuikaWiki::Plugin::WikiEdit]
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{conflict}) {
      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 (value => SuikaWiki::Plugin->resource ('Edit:Save'));
        }
        #<input type=hidden name=mycmd value=write/>
        $_->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" value="@{[SuikaWiki::Plugin->resource('Edit:Save',escape=>1)]}" /><kbd>S</kbd></label>) ]}
    @{[ $option{admin} ? qq(<label>@{[SuikaWiki::Plugin->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="mycmd" value="write" />
    <input type="hidden" name="mypage" value="@{[SuikaWiki::Plugin->escape($form{mypage})]}" />
    <textarea cols="@{[SuikaWiki::Plugin->resource('Edit:Form:Cols')+0||35]}" rows="@{[SuikaWiki::Plugin->resource('Edit:Form:Rows')+0||15]}" name="mymsg" tabindex="1"@{[$main::UA =~ m{Mozilla/[0-4]\.} ? ' wrap="virtual"':'']}>@{[SuikaWiki::Plugin->escape($option{content})]}</textarea><br />
@{[
    $option{admin} ?
    qq(
    <label><input type="radio" name="myfrozen" value="1" @{[$frozen ? qq(checked="checked") : ""]} />@{[SuikaWiki::Plugin->resource('Edit:Freeze',escape=>1)]}</label>
    <label><input type="radio" name="myfrozen" value="0" @{[$frozen ? "" : qq(checked="checked")]} />@{[SuikaWiki::Plugin->resource('Edit:DontFreeze',escape=>1)]}</label><br />)
    : ""
]}
@{[
    $option{conflict} ? "" :
    qq(
        <label><input type="checkbox" name="mytouch" value="on" checked="checked" />@{[SuikaWiki::Plugin->resource('Edit:UpdateTimeStamp',escape=>1)]}</label><br />
        <label><input type="submit" value="@{[SuikaWiki::Plugin->resource('Edit:Save',escape=>1)]}" accesskey="S" /><kbd>S</kbd></label>
       $afteredit
    )
]}
</form>
EOD
    $f;
}

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

# [move to SuikaWiki::WikiDB]
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 {
      print "Status: 403 Unauthorized\n";
      &_do_view_msg (-view => '-error', -page => $form{mypage},
                     error_message => SuikaWiki::Plugin->resource ('Error:PasswordIsIncorrect'));
        exit;
    }
}

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

# [to be obsolete]
sub do_comment {
    my ($content) = $database{$form{mypage}};
    my $default_name;   ## this code is not strict.
    $default_name = $1 if $content =~ /default-name="([^"]+)"/;
    my @time = gmtime (time);
    my $datestr = sprintf '[WEAK[%04d-%02d-%02d %02d:%02d:%02d +00:00]]', $time[5]+1900,$time[4]+1,@time[3,2,1,0];
    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;
    }
}

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

# [move to SuikaWiki::Plugin::WikiForm]
sub do_wikiform {
    my $content = $database{$form{mypage}};
    my $anchor = &get_new_anchor_index ($content);
    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');
            SuikaWiki::Plugin->formatter ('form_option')->replace ($option, $param);
            my $t = 1;
            for (keys %{$param->{require}||{}}) {
                (undef $t, last) unless length $param->{argv}->{'wikiform__'.$_};
            }
            $t = SuikaWiki::Plugin->formatter ('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;
    }
}

# [to be obsolete] ->Message::MIME::Charset
sub code_convert {
  require Jcode;
    my ($contentref, $code, $srccode) = (shift, shift || $kanjicode, shift || undef);
    if    ($code =~ /euc/) { $code = 'euc' }
    elsif ($code =~ /iso/) { $code = 'jis' }
    elsif ($code =~ /shi/) { $code = 'sjis' }
    elsif ($code =~ /utf/) { $code = 'utf8' }
    $$contentref = Jcode->new ($contentref, $srccode)->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;
}

# [to be obsolete] ->Message::Field::Date
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];
}

# [obsolete] ->SuikaWiki::SrcFormat
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');
      $r->append_text ($content);
      return $r;
    } else {
      return '';
    }
  } else {
    $content;
  }
}


# [obsolete] SuikaWiki::WikiDB
package wiki::dummy;
sub mtime (@) {undef}
sub meta (@) {undef}
sub Yuki::YukiWikiDB2::meta (@) {undef}

package main;
SuikaWiki::Plugin->import_plugins ();
  $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}}};       # [to be obsolete]
  } else {
    &{$command_do{default}};
  }
_wiki_exit ();

=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/10/05 10:26:17 $