script/lib/suikawiki.pl

use strict;

package wiki;
our $VERSION = do{my @r=(q$Revision: 1.16 $=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};
package main;
binmode STDOUT; binmode STDIN;

require SuikaWiki::Plugin;
our %embed_command = (
        form    => qr/\[\[\#form(?:\(([A-Za-z0-9-]+)\))?:'((?:[^'\\]|\\.)*)':'((?:[^'\\]|\\.)*)'(?::'((?:[^'\\]|\\.)*)')?\]\]/,
);
our $database = bless {}, 'wiki::dummy';
$| = 1;
require SuikaWiki::Name::Space;
my $NS_XHTML1 = 'http://www.w3.org/1999/xhtml';
our $WIKI;
require Message::Markup::XML;

sub _do_view_msg (%) {
  require SuikaWiki::View;
  my %option = @_;
  my $o = $option{-o} || bless {param => \%main::form, page => $option{-page},
                                }, '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} && $main::UA =~ /Gecko/) {
    $media = $prop->{xmedia};
    $o->{media} = $media;
  }
  &print_header($option{-page}, -media => $media, -view => $view_def, o => $o, -goto => $option{-goto});
  print "\n";
  ## Output HTTP message body
  my $fmt = SuikaWiki::Plugin->formatter ('view');
  my $s = $fmt->replace ($view_def->as_string => $o, {formatter => $fmt});
  print $s;
}

# temp
sub valid_password ($) { 0 }
sub is_editable { 1 }

# [move to SuikaWiki::WikiDB]
sub frozen_reject {
    my ($isfrozen) = $main::database->meta (IsFrozen => $main::form{mypage});
    my ($willbefrozen) = $main::form{myfrozen};
    if (not $isfrozen and not $willbefrozen) {
        # You need no check.
        return 0;
    } elsif (valid_password($main::form{mypassword})) {
        # You are admin.
        return 0;
    } else {
        &_do_view_msg (-view => '-error', -page => $main::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) = $main::database{$main::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 = $main::form{myname} || $default_name || &Resource('WikiForm:WikiComment:DefaultName');
    ($namestr = '', $datestr = '') if $main::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 == $main::form{comment_index}) {
        if ($embed ne '[[#rcomment]]') {
          $embed = "- [$anchor] $datestr$namestr$main::form{mymsg}\n$embed";  $o = 1;
        } else {
          $embed .= "\n- [$anchor] $datestr$namestr$main::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$main::form{mymsg}\n";
    }
    $main::form{__comment_anchor_index} = $anchor;
    if ($main::form{mymsg} || $main::form{myname}) {
        $main::form{mymsg} = $content;
        $main::form{mytouch} = 'on';
        &do_write;
    } else {    ## Don't write
        #$main::form{mycmd} = 'default';
        #&do_view;
      die "No comment specified";
    }
}

# [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 = $main::database{$main::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 $main::form{wikiform_targetform})
            || $i == $main::form{wikiform_index}) {
            $template =~ s/\\([\\'])/$1/g;
            $option =~ s/\\([\\'])/$1/g;
            my $param = bless {depth=>10}, 'SuikaWiki::Plugin';
            $param->{page} = $main::form{mypage};
            $param->{form_index} = $i;
            $param->{form_name} = $wfname;
            $param->{anchor_index} = $anchor;
            $param->{argv} = \%main::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;
                $main::form{__comment_anchor_index} = $anchor
                  if $param->{anchor_index_};  ## $anchor is used!
            }
            $main::form{__wikiform_anchor_index} = $i;
            undef $main::form{wikiform_targetform};  ## Make sure never to match
            undef $main::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) {
        $main::form{mymsg} = $content;
        $main::form{mytouch} = 'on';
        &do_write;
    } else {    ## Don't write!
        #$main::form{mycmd} = 'default';
        #&do_view;
      die "No content specified";
    }
}

# [to be obsolete] ->Message::MIME::Charset
sub code_convert {
  require Jcode;
  my ($contentref, $code, $srccode) = @_;
  $code ||= $WIKI->{config}->{charset}->{internal};
  for ($code, $srccode) {
    if    ($_ eq 'euc-jp') { $_ = 'euc' }
    elsif ($_ eq 'iso-2022-jp') { $_ = 'jis' }
    elsif ($_ eq 'utf-8') { $_ = 'utf8' }
    elsif ($_ eq 'shift_jis') { $_ = 'sjis' }
  }
  $$contentref = Jcode->new ($contentref, $srccode)
    ## Normalize FULLWIDTH characters and IDEOGRAPHIC SPACE
                      ->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\xA1\xE4\xA1\xE3\xA1\xA1\xA2\xAF\xA2\xB0\xA2\xB2\xA2\xB1\xA1\xA1\xC0" => q(0-9A-Za-z&,.:;?!`^_/|()[]{}+$%#*@=>< '"~-))
                      ->tr (qq(\x8E\xDE\x8E\xDF) => qq(\xA1\xAB\xA1\xAC))
                      ->h2z
                      ->$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 : SuikaWiki09 plugin
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;
  }
}

package wiki::transitional::uri_param;
require Tie::Hash;
our @ISA = 'Tie::Hash';

sub TIEHASH ($@) {
  bless {http => $_[1]}, $_[0];
}

sub FETCH ($$) {
  my ($self, $key) = @_;
  exists $self->{val}->{$key} ?
    $self->{val}->{$key}:
    $self->{http}->parameter ($key);
}

sub STORE ($$$) {
  my ($self, $key, $val) = @_;
  $self->{val}->{$key} = $val;
}

sub DELETE ($$) {
  my ($self, $key) = @_;
  $self->{val}->{$key} = undef;
}

sub EXISTS ($$) {
  my ($self, $key) = @_;
  exists $self->{val}->{$key} ?
    1:
    defined $self->{http}->parameter ($key);
}

package main;
  push @{$WIKI->{event}->{setting_initial_variables}}, sub {
    my $wiki = shift;
    $wiki->{implementation_version} = 'sw'.$VERSION;
    
    ## Error output
    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;
      my $wiki_name_version = $wiki->{implementation_name} .'/'. $wiki->version;
      for ($wiki_name_version) { s/&/&amp;/g; s/</&lt;/g;
                                 s/([^\x20-\x7E])/sprintf '&#x%02X;',
                                                          ord $1/g; };
      print STDOUT <<EOH
<!DOCTYPE html SYSTEM>
<title>500 Internal WikiEngine Error</title>
<h1>Internal WikiEngine Error</h1>
<p>$msg</p>
<address>$wiki_name_version</address>
EOH
    });
    
    $wiki->{var}->{db}->{read_only}->{'#default'} = 1;
    
    require SuikaWiki::Input::HTTP;
    $wiki->{input} = SuikaWiki::Input::HTTP->new;
    $wiki->{input}->{decoder}->{'#default'} = sub {
      my ($http, $s, $temp_params) = @_;
      return main::code_convert (\$s, undef, # internal code 
                                 @{$temp_params->{ie}||[]}[0]
                                 || $wiki->{config}->{charset}->{uri_param});
    };
    $wiki->{var}->{client}->{user_agent_name}
      = $wiki->{input}->meta_variable ('HTTP_USER_AGENT');
    $wiki->{var}->{client}->{used_for_negotiate} = ['User-Agent'];
    
    ## TODO: PATH_INFO support
    my $page = $wiki->{input}->meta_variable ('QUERY_STRING');
    if ($page && !(index ($page, '=') > -1)) {
      $page =~ tr/+/ /;
      $page =~ s/%([0-9A-Fa-f][0-9A-Fa-f])/pack 'C', hex $1/ge;
      $page = main::code_convert 
        (\$page, undef, # internal code
         $wiki->{config}->{charset}->{uri_query});
    } else {
      $page = $wiki->{input}->parameter ('mypage');
    }
    

    ## TODO: SuikaWiki 3 WikiName
    $page =~ tr/\x00-\x20\x7F//d;
    $page = SuikaWiki::Name::Space::normalize_name ($page);
    if ($page) {
      $wiki->{var}->{page} = [split '//', $page];
    } else {
      $wiki->{var}->{page} = $wiki->{config}->{page}->{Default};
    }
 
    ## Mode
    my $mode = $wiki->{input}->parameter ('mode')
            || $wiki->{input}->parameter ('mycmd') ## for compatibility with
            || 'default';                          ## YukiWiki and SuikaWiki 2
    $mode =~ tr/-/_/;
    if ($mode eq 'default' || $mode =~ /[^0-9A-Za-z_]/) {
      ## BUG: this code is not strict
      my $cookie = $wiki->{input}->meta_variable ('HTTP_COOKIE');
      if ($cookie =~ /SelectedMode=([0-9A-Za-z_-]+)/) {
        $mode = $1; $mode =~ tr/-/_/;
      } else {
        $mode = 'read';
      }
      push @{$wiki->{var}->{client}->{used_for_negotiate}}, 'Cookie';
    }
    $wiki->{var}->{mode} = $mode;
    
    ## Transitional variables
    tie %main::form, 'wiki::transitional::uri_param', $wiki->{input};
    $main::UA = $wiki->{var}->{client}->{user_agent_name};
    $main::form{mypage} = join '//', @{$wiki->{var}->{page}};
    $main::form{mycmd} = $mode;
  };
  
  $WIKI->init_variables;
  
  $WIKI->init_plugin;
  $WIKI->init_view;
  $WIKI->{plugin}->use_type ('view-definition');
  $WIKI->{view}->register_common_modes;
  my $opt = {condition => {mode => $WIKI->{var}->{mode}, output => 'http-cgi',
                           http_method => $main::ENV{REQUEST_METHOD}}};
  my $viewobj = $WIKI->{view}->instantiate ($WIKI->{var}->{mode}, $opt);
  $viewobj->main ($opt); ## TODO: or unsupported mode

exit;
END {
  $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/25 02:22:06 $
1	wakaba	1.1	use strict;
2
3	wakaba	1.12	package wiki;
4	wakaba	1.17	our $VERSION = do{my @r=(q$Revision: 1.16 $=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};
5	wakaba	1.1	package main;
6			binmode STDOUT; binmode STDIN;
7	wakaba	1.14
8	wakaba	1.1	require SuikaWiki::Plugin;
9			our %embed_command = (
10			form => qr/\[\[\#form(?:\(([A-Za-z0-9-]+)\))?:'((?:[^'\\]\|\\.))':'((?:[^'\\]\|\\.))'(?::'((?:[^'\\]\|\\.)*)')?\]\]/,
11			);
12			our $database = bless {}, 'wiki::dummy';
13			$\| = 1;
14	w	1.9	require SuikaWiki::Name::Space;
15	wakaba	1.5	my $NS_XHTML1 = 'http://www.w3.org/1999/xhtml';
16	wakaba	1.14	our $WIKI;
17	wakaba	1.15	require Message::Markup::XML;
18	wakaba	1.1
19			sub _do_view_msg (%) {
20	w	1.9	require SuikaWiki::View;
21	wakaba	1.1	my %option = @_;
22	wakaba	1.15	my $o = $option{-o} \|\| bless {param => \%main::form, page => $option{-page},
23	wakaba	1.17	}, 'SuikaWiki::Plugin';
24	w	1.9	$o->{toc} = [];
25			$o->{condition} = \%option; ## This parameter really used??
26	wakaba	1.3	my $view_def = SuikaWiki::View->definition ($option{-view});
27			unless ($view_def->check ($o)) {
28	wakaba	1.1	print "Status: 406 Unsupported Media Type\n";
29			$option{-view} = '-UnsupportedMediaType';
30	wakaba	1.3	$view_def = SuikaWiki::View->definition ($option{-view});
31	wakaba	1.1	}
32	w	1.9	my $prop = $view_def->properties;
33			my $media = $prop->{media};
34	wakaba	1.15	if ($prop->{xmedia} && $main::UA =~ /Gecko/) {
35	w	1.9	$media = $prop->{xmedia};
36	wakaba	1.1	$o->{media} = $media;
37			}
38	w	1.9	&print_header($option{-page}, -media => $media, -view => $view_def, o => $o, -goto => $option{-goto});
39	wakaba	1.15	print "\n";
40	w	1.9	## Output HTTP message body
41			my $fmt = SuikaWiki::Plugin->formatter ('view');
42			my $s = $fmt->replace ($view_def->as_string => $o, {formatter => $fmt});
43	wakaba	1.15	print $s;
44	wakaba	1.1	}
45
46	wakaba	1.15	# temp
47	wakaba	1.17	sub valid_password ($) { 0 }
48	wakaba	1.15	sub is_editable { 1 }
49
50	w	1.9	# [move to SuikaWiki::WikiDB]
51	wakaba	1.1	sub frozen_reject {
52	wakaba	1.15	my ($isfrozen) = $main::database->meta (IsFrozen => $main::form{mypage});
53			my ($willbefrozen) = $main::form{myfrozen};
54	wakaba	1.1	if (not $isfrozen and not $willbefrozen) {
55			# You need no check.
56			return 0;
57	wakaba	1.15	} elsif (valid_password($main::form{mypassword})) {
58	wakaba	1.1	# You are admin.
59			return 0;
60			} else {
61	wakaba	1.15	&_do_view_msg (-view => '-error', -page => $main::form{mypage},
62	wakaba	1.8	error_message => SuikaWiki::Plugin->resource ('Error:PasswordIsIncorrect'));
63	wakaba	1.1	exit;
64			}
65			}
66
67	w	1.9	# [move to SuikaWiki::WikiDB]
68	wakaba	1.8	sub is_frozen ($) { SuikaWiki::Plugin->_database->meta (IsFrozen => $_[0]) ? 1 : 0 }
69	wakaba	1.1
70	w	1.9	# [to be obsolete]
71	wakaba	1.1	sub do_comment {
72	wakaba	1.15	my ($content) = $main::database{$main::form{mypage}};
73	wakaba	1.1	my $default_name; ## this code is not strict.
74			$default_name = $1 if $content =~ /default-name="([^"]+)"/;
75	w	1.9	my @time = gmtime (time);
76			my $datestr = sprintf '[WEAK[%04d-%02d-%02d %02d:%02d:%02d +00:00]]', $time[5]+1900,$time[4]+1,@time[3,2,1,0];
77	wakaba	1.15	my $namestr = $main::form{myname} \|\| $default_name \|\| &Resource('WikiForm:WikiComment:DefaultName');
78			($namestr = '', $datestr = '') if $main::form{myname} eq 'nodate';
79	wakaba	1.1	if ($namestr =~ /^(?:>>)?[0-9]/) {
80			$namestr = qq( ''$namestr'': );
81			} elsif (length $namestr) {
82			$namestr = qq( ''[[$namestr]]'': );
83			}
84			my $anchor = &get_new_anchor_index ($content);
85			my $i = 1; my $o = 0;
86			$content =~ s{(\[\[\#r?comment\]\])}{
87			my $embed = $1;
88	wakaba	1.15	if ($i == $main::form{comment_index}) {
89	wakaba	1.1	if ($embed ne '[[#rcomment]]') {
90	wakaba	1.15	$embed = "- [$anchor] $datestr$namestr$main::form{mymsg}\n$embed"; $o = 1;
91	wakaba	1.1	} else {
92	wakaba	1.15	$embed .= "\n- [$anchor] $datestr$namestr$main::form{mymsg}"; $o = 1;
93	wakaba	1.1	}
94			}
95			$i++; $embed;
96			}ge;
97			unless ($o) {
98			$content = "#?SuikaWiki/0.9\n\n" unless $content;
99			$content .= "\n" unless $content =~ /\n$/s;
100	wakaba	1.15	$content .= "- [$anchor] $datestr$namestr$main::form{mymsg}\n";
101	wakaba	1.1	}
102	wakaba	1.15	$main::form{__comment_anchor_index} = $anchor;
103			if ($main::form{mymsg} \|\| $main::form{myname}) {
104			$main::form{mymsg} = $content;
105			$main::form{mytouch} = 'on';
106	wakaba	1.1	&do_write;
107			} else { ## Don't write
108	wakaba	1.15	#$main::form{mycmd} = 'default';
109			#&do_view;
110			die "No comment specified";
111	wakaba	1.1	}
112			}
113
114	w	1.9	# [move to SuikaWiki::Plugin::WikiForm]
115	wakaba	1.1	sub get_new_anchor_index ($) {
116			my $content = shift;
117			my $anchor = 0;
118			$content =~ s/^(?:[-=]+\s*)?\[([0-9]+)\]/$anchor = $1 if $1 > $anchor; $&/mge;
119			$anchor + 1;
120			}
121
122	w	1.9	# [move to SuikaWiki::Plugin::WikiForm]
123	wakaba	1.1	sub do_wikiform {
124	wakaba	1.15	my $content = $main::database{$main::form{mypage}};
125	wakaba	1.1	my $anchor = &get_new_anchor_index ($content);
126			my $write = 0;
127			my $i = 1;
128			$content =~ s{$embed_command{form}}{
129			my ($embed, $wfname, $template, $option) = ($&, $1, $3, $4);
130	wakaba	1.15	if (($wfname && $wfname eq $main::form{wikiform_targetform})
131			\|\| $i == $main::form{wikiform_index}) {
132	wakaba	1.1	$template =~ s/\\([\\'])/$1/g;
133			$option =~ s/\\([\\'])/$1/g;
134			my $param = bless {depth=>10}, 'SuikaWiki::Plugin';
135	wakaba	1.15	$param->{page} = $main::form{mypage};
136	wakaba	1.1	$param->{form_index} = $i;
137			$param->{form_name} = $wfname;
138			$param->{anchor_index} = $anchor;
139	wakaba	1.15	$param->{argv} = \%main::form;
140	wakaba	1.1	$param->{default_name} = $1 if $content =~ /default-name="([^"]+)"/;
141			$param->{default_name} \|\|= &Resource('WikiForm:WikiComment:DefaultName');
142	w	1.9	SuikaWiki::Plugin->formatter ('form_option')->replace ($option, $param);
143	wakaba	1.1	my $t = 1;
144			for (keys %{$param->{require}\|\|{}}) {
145			(undef $t, last) unless length $param->{argv}->{'wikiform__'.$_};
146			}
147	w	1.9	$t = SuikaWiki::Plugin->formatter ('form_template')->replace ($template, $param) if $t;
148	wakaba	1.1	if (length $t) {
149			if ($param->{output}->{reverse}) {
150			$embed .= "\n" . $t;
151			} else {
152			$embed = $t . "\n" . $embed;
153			}
154			$write = 1;
155	wakaba	1.15	$main::form{__comment_anchor_index} = $anchor
156	wakaba	1.1	if $param->{anchor_index_}; ## $anchor is used!
157			}
158	wakaba	1.15	$main::form{__wikiform_anchor_index} = $i;
159			undef $main::form{wikiform_targetform}; ## Make sure never to match
160			undef $main::form{wikiform_index}; ## with WikiForm in rest of page!
161	wakaba	1.1	}
162			$i++; $embed;
163			}ge;
164			unless ($write) {
165			#$content = "#?SuikaWiki/0.9\n\n" unless $content;
166			#$content .= "\n" unless $content =~ /\n$/s;
167			#
168			}
169			if ($write) {
170	wakaba	1.15	$main::form{mymsg} = $content;
171			$main::form{mytouch} = 'on';
172	wakaba	1.1	&do_write;
173			} else { ## Don't write!
174	wakaba	1.15	#$main::form{mycmd} = 'default';
175			#&do_view;
176			die "No content specified";
177	wakaba	1.1	}
178			}
179
180	w	1.9	# [to be obsolete] ->Message::MIME::Charset
181	wakaba	1.1	sub code_convert {
182			require Jcode;
183	wakaba	1.15	my ($contentref, $code, $srccode) = @_;
184			$code \|\|= $WIKI->{config}->{charset}->{internal};
185			for ($code, $srccode) {
186			if ($_ eq 'euc-jp') { $_ = 'euc' }
187			elsif ($_ eq 'iso-2022-jp') { $_ = 'jis' }
188			elsif ($_ eq 'utf-8') { $_ = 'utf8' }
189			elsif ($_ eq 'shift_jis') { $_ = 'sjis' }
190			}
191			$$contentref = Jcode->new ($contentref, $srccode)
192			## Normalize FULLWIDTH characters and IDEOGRAPHIC SPACE
193			->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\xA1\xE4\xA1\xE3\xA1\xA1\xA2\xAF\xA2\xB0\xA2\xB2\xA2\xB1\xA1\xA1\xC0" => q(0-9A-Za-z&,.:;?!`^_/\|()[]{}+$%#*@=>< '"~-))
194			->tr (qq(\x8E\xDE\x8E\xDF) => qq(\xA1\xAB\xA1\xAC))
195			->h2z
196			->$code;
197			return $$contentref;
198	wakaba	1.1	}
199
200	w	1.9	# [to be obsolete] ->Message::Field::Date
201	wakaba	1.1	sub _rfc3339_date ($) {
202			my @time = gmtime (shift);
203			sprintf '%04d-%02d-%02dT%02d:%02d:%02d+00:00', $time[5]+1900,$time[4]+1,@time[3,2,1,0];
204			}
205
206	wakaba	1.15	# [obsolete] ->SuikaWiki::SrcFormat : SuikaWiki09 plugin
207	w	1.9	sub convert_format ($$$;%) {
208			my ($content, $d => $t, %option) = @_;
209			my $f = SuikaWiki::Plugin->format_converter ($d => $t);
210			if (ref $f) {
211			$option{content} = $content;
212			$option{from} = $d;
213			$option{to} = $t;
214			&$f ({}, bless (\%option, 'SuikaWiki::Plugin'));
215			} elsif ($option{-error_no_return}) {
216			return undef;
217			} elsif ($t =~ /HTML\|xml/) {
218			if (length $content) {
219			my $r = SuikaWiki::Markup::XML->new (namespace_uri => $NS_XHTML1, local_name => 'pre');
220			$r->append_text ($content);
221			return $r;
222			} else {
223			return '';
224			}
225			} else {
226			$content;
227			}
228			}
229
230	wakaba	1.15	package wiki::transitional::uri_param;
231			require Tie::Hash;
232			our @ISA = 'Tie::Hash';
233
234			sub TIEHASH ($@) {
235			bless {http => $_[1]}, $_[0];
236			}
237
238			sub FETCH ($$) {
239			my ($self, $key) = @_;
240			exists $self->{val}->{$key} ?
241			$self->{val}->{$key}:
242			$self->{http}->parameter ($key);
243			}
244
245			sub STORE ($$$) {
246			my ($self, $key, $val) = @_;
247			$self->{val}->{$key} = $val;
248			}
249
250			sub DELETE ($$) {
251			my ($self, $key) = @_;
252			$self->{val}->{$key} = undef;
253			}
254
255			sub EXISTS ($$) {
256			my ($self, $key) = @_;
257			exists $self->{val}->{$key} ?
258			1:
259			defined $self->{http}->parameter ($key);
260			}
261	w	1.9
262	wakaba	1.1	package main;
263	wakaba	1.15	push @{$WIKI->{event}->{setting_initial_variables}}, sub {
264			my $wiki = shift;
265	wakaba	1.17	$wiki->{implementation_version} = 'sw'.$VERSION;
266	wakaba	1.15
267			## Error output
268			require SuikaWiki::Output::CGICarp;
269			$SuikaWiki::Output::CGICarp::CUSTOM_REASON_TEXT
270			= 'Internal WikiEngine Error';
271			CGI::Carp::set_message (sub {
272			my $msg = shift;
273			#$msg =~ s/&/&/g;
274			#$msg =~ s/</</g;
275			my $wiki_name_version = $wiki->{implementation_name} .'/'. $wiki->version;
276			for ($wiki_name_version) { s/&/&/g; s/</</g;
277			s/([^\x20-\x7E])/sprintf '&#x%02X;',
278			ord $1/g; };
279			print STDOUT <<EOH
280			<!DOCTYPE html SYSTEM>
281			<title>500 Internal WikiEngine Error</title>
282			<h1>Internal WikiEngine Error</h1>
283			<p>$msg</p>
284			<address>$wiki_name_version</address>
285			EOH
286			});
287
288			$wiki->{var}->{db}->{read_only}->{'#default'} = 1;
289
290			require SuikaWiki::Input::HTTP;
291			$wiki->{input} = SuikaWiki::Input::HTTP->new;
292			$wiki->{input}->{decoder}->{'#default'} = sub {
293			my ($http, $s, $temp_params) = @_;
294			return main::code_convert (\$s, undef, # internal code
295			@{$temp_params->{ie}\|\|[]}[0]
296			\|\| $wiki->{config}->{charset}->{uri_param});
297			};
298			$wiki->{var}->{client}->{user_agent_name}
299			= $wiki->{input}->meta_variable ('HTTP_USER_AGENT');
300			$wiki->{var}->{client}->{used_for_negotiate} = ['User-Agent'];
301
302			## TODO: PATH_INFO support
303			my $page = $wiki->{input}->meta_variable ('QUERY_STRING');
304			if ($page && !(index ($page, '=') > -1)) {
305			$page =~ tr/+/ /;
306			$page =~ s/%([0-9A-Fa-f][0-9A-Fa-f])/pack 'C', hex $1/ge;
307			$page = main::code_convert
308			(\$page, undef, # internal code
309			$wiki->{config}->{charset}->{uri_query});
310			} else {
311			$page = $wiki->{input}->parameter ('mypage');
312			}
313
314
315			## TODO: SuikaWiki 3 WikiName
316			$page =~ tr/\x00-\x20\x7F//d;
317			$page = SuikaWiki::Name::Space::normalize_name ($page);
318			if ($page) {
319			$wiki->{var}->{page} = [split '//', $page];
320			} else {
321			$wiki->{var}->{page} = $wiki->{config}->{page}->{Default};
322			}
323
324			## Mode
325			my $mode = $wiki->{input}->parameter ('mode')
326			\|\| $wiki->{input}->parameter ('mycmd') ## for compatibility with
327			\|\| 'default'; ## YukiWiki and SuikaWiki 2
328			$mode =~ tr/-/_/;
329			if ($mode eq 'default' \|\| $mode =~ /[^0-9A-Za-z_]/) {
330			## BUG: this code is not strict
331			my $cookie = $wiki->{input}->meta_variable ('HTTP_COOKIE');
332			if ($cookie =~ /SelectedMode=([0-9A-Za-z_-]+)/) {
333			$mode = $1; $mode =~ tr/-/_/;
334			} else {
335			$mode = 'read';
336			}
337			push @{$wiki->{var}->{client}->{used_for_negotiate}}, 'Cookie';
338			}
339			$wiki->{var}->{mode} = $mode;
340
341			## Transitional variables
342			tie %main::form, 'wiki::transitional::uri_param', $wiki->{input};
343			$main::UA = $wiki->{var}->{client}->{user_agent_name};
344			$main::form{mypage} = join '//', @{$wiki->{var}->{page}};
345			$main::form{mycmd} = $mode;
346			};
347
348			$WIKI->init_variables;
349
350	wakaba	1.14	$WIKI->init_plugin;
351			$WIKI->init_view;
352			$WIKI->{plugin}->use_type ('view-definition');
353			$WIKI->{view}->register_common_modes;
354	wakaba	1.15	my $opt = {condition => {mode => $WIKI->{var}->{mode}, output => 'http-cgi',
355			http_method => $main::ENV{REQUEST_METHOD}}};
356			my $viewobj = $WIKI->{view}->instantiate ($WIKI->{var}->{mode}, $opt);
357	wakaba	1.14	$viewobj->main ($opt); ## TODO: or unsupported mode
358
359			exit;
360			END {
361			$WIKI->exit;
362			}
363	wakaba	1.1
364			=head1 NAME
365
366	wakaba	1.4	lib/suikawiki.pl --- SuikaWiki transitional library
367	wakaba	1.1
368			=head1 AUTHOR
369
370	wakaba	1.4	Hiroshi Yuki <hyuki@hyuki.com> <http://www.hyuki.com/yukiwiki/> (YukiWiki)
371	wakaba	1.1
372	wakaba	1.4	Makio Tsukamoto <http://digit.que.ne.jp/> (WalWiki)
373	wakaba	1.1
374			Wakaba <w@suika.fam.cx>
375
376			=head1 LICENSE
377
378	wakaba	1.4	Copyright AUTHORS 2000-2003
379	wakaba	1.1
380			This program is free software; you can redistribute it and/or
381			modify it under the same terms as Perl itself.
382
383			=cut
384
385	wakaba	1.17	1; # $Date: 2003/10/25 02:22:06 $