=head1 NAME suikawiki.pl - SuikaWiki Driver for HTTP CGI Script =cut use strict; package main; our $WIKI; package wiki::driver::http; ## -- Version of WikiDriver -- our $VERSION = do{my @r=(q$Revision: 1.23 $=~/\d+/g);sprintf "%d."."%02d" x $#r,@r}; $WIKI->{implementation_version} = 'hcs'.$VERSION; ## -- Dying Message as HTTP Response -- require SuikaWiki::Output::CGICarp; $SuikaWiki::Output::CGICarp::CUSTOM_REASON_TEXT = 'Internal WikiEngine Error'; CGI::Carp::set_message (sub { my $msg = shift; #$msg =~ s/&/&/g; #$msg =~ s/{implementation_name} .'/'. $WIKI->version; my $trace = Carp::longmess (); for ($trace, $wiki_name_version) { s/&/&/g; s/ 500 Internal WikiEngine Error

Internal WikiEngine Error

$msg

$trace

$wiki_name_version
EOH }); ## -- Required Modules -- use SuikaWiki::DB::Util::Error; require SuikaWiki::Plugin; require SuikaWiki::Name::Space; require SuikaWiki::SrcFormat; ## -- Transitional Functions -- # [to be obsolete] ->Message::MIME::Charset sub main::code_convert { require Jcode; my ($contentref, $code, $srccode) = @_; $code ||= $WIKI->{config}->{charset}->{internal}; for ($code, $srccode) { s/[^0-9A-Za-z_.+-]+//g; if ($_ eq 'euc-jp') { $_ = 'euc' } elsif ($_ eq 'iso-2022-jp') { $_ = 'jis' } elsif ($_ eq 'utf-8') { $_ = 'utf8' } elsif ($_ eq 'shift_jis') { $_ = 'sjis' } } if ($code eq 'iso-8859-1') { return $$contentref; ## TODO: } $$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 (1) ->$code; return $$contentref; } # [to be obsolete] ->Message::Field::Date : Map sub main::_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 sub SuikaWiki::Plugin::get_data ($$$$;%) { my ($self, $prop, $key, %opt) = @_; ## TODO: common interface to WikiDB ## TODO: error recovering $main::WIKI->{db}->get ($prop => $key); } ## -- Initializing WikiPlugin -- $WIKI->init_plugin; ## WikiPlugin manager ## -- Initializing WikiView -- $WIKI->init_view; ## WikiView manager $WIKI->{view}->register_common_modes; ## WikiView manager error handler push @{$WIKI->{event}->{view_error}}, sub { my ($wiki, $event) = @_; SuikaWiki::Plugin->module_package ('Error') ->report_error_simple ($wiki, WikiView => $event->{error}->text, -trace => 1) if $event->{error}->{-def}->{level} eq 'fatal' or $wiki->{config}->{debug}->{view}; unless ($event->{error}->{-def}->{level} eq 'fatal' or $event->{error}->{-def}->{level} eq 'stop') { $event->{cancel} = 1; } }; ## "view_in_mode" method definition push @{$WIKI->{event}->{view_in_mode}}, sub { my ($wiki, $opt) = @_; my $arg = {condition => {mode => $opt->{mode} || '-error', output => 'http-cgi', http_method => $opt->{method} || 'GET'}}; my $viewobj = $wiki->{view}->instantiate ($opt->{mode} || '-error', $arg); if (ref $viewobj) { $viewobj->main ($arg); } elsif ($opt->{mode} ne '-error') { report SuikaWiki::View::Implementation::error -type => 'WARN_VIEW_NOT_DEFINED', condition => $arg->{condition}, -object => $wiki->{view}, method => 'view_in_mode'; $wiki->view_in_mode (mode => '-error', method => 'GET'); ## TODO: cache control for non-GET } else { die "Some error occured. Additionally, error reporting mode not defined"; } }; ## WikiView formatting template error handler $WIKI->{config}->{catch}->{formatter_view} = catch Message::Util::Formatter::error with { my $err = shift; my $wiki = $err->{option}->{param}->{wiki}; SuikaWiki::Plugin->module_package ('Error') ->reporting_formatting_template_error ($err, $wiki, trace => 1); $wiki->view_in_mode (mode => '-error', method => 'GET'); throw SuikaWiki::View::Implementation::error -type => 'ERROR_REPORTED'; }; ## WikiView formatting template error handler (occured in "-error" mode) $WIKI->{config}->{catch}->{formatter_view_error} = catch Message::Util::Formatter::error with { my $err = shift; my $wiki = $err->{option}->{param}->{wiki}; SuikaWiki::Plugin->module_package ('Error') ->reporting_formatting_template_error ($err, $wiki, trace => 1); $wiki->view_in_mode (mode => '-error-error', method => 'GET'); throw SuikaWiki::View::Implementation::error -type => 'ERROR_REPORTED'; }; ## -- WikiDatabase Error Reporting -- { my $error_report = sub { my ($wiki, $err) = @_; my $report = ($err->{-def}->{level} eq 'fatal' or $err->{-def}->{level} eq 'stop' or $wiki->{config}->{debug}->{db}) ? 1 : 0; if ($report and $wiki->{config}->{path_to}->{db__content__error_log}) { my $err_msg = caller (1).($err->{method}? '->'.$err->{method}: '').': ' .(defined $err->{file}? $err->{file} . ': ' : '') .(defined $err->{prop}? $err->{prop} . ': ' : '') .(defined $err->{key}? join ('//', @{$err->{key}}).': ':'') . $err->text; open LOG, '>>', $wiki->{config}->{path_to}->{db__content__error_log}; print LOG scalar (gmtime), " @{[$$]} {$err->{-def}->{level}}: ", $err_msg, "\n"; close LOG; } SuikaWiki::Plugin->module_package ('WikiDB') ->reporting_error ($err, $wiki) if $report; if ($err->{-def}->{level} eq 'fatal' or $err->{-def}->{level} eq 'stop') { $wiki->view_in_mode (mode => '-wdb--fatal-error'); throw SuikaWiki::DB::Util::Error -type => 'ERROR_REPORTED'; } }; unshift @{$WIKI->{event}->{database_loaded}}, sub { my $wiki = shift; unshift @{$wiki->{db}->{event}->{error}}, sub { my ($db, $event) = @_; $error_report->($wiki, $event->{error}); if ($event->{error}->{-type} eq 'INFO_DB_PROP_OPENED') { unshift @{$db->{prop}->{$event->{error}->{prop}}->{-db} ->{event}->{error}}, sub { my ($db, $event) = @_; $error_report->($wiki, $event->{error}); }; } }; # database error }; # database_loaded } ## -- Misc. Error Reporting -- if ($WIKI->{config}->{debug}->{general}) { $main::SIG{__WARN__} = sub { push @{$WIKI->{var}->{error}||=[]}, { description => Message::Markup::XML::Node->new (type => '#text', value => $_[0]), }; }; } ## -- Initializing $wiki->{var} (Declaration) -- push @{$WIKI->{event}->{setting_initial_variables}}, sub { my $wiki = shift; $wiki->{var}->{db}->{read_only}->{'#default'} = 1; require SuikaWiki::Input::HTTP; $wiki->{input} = SuikaWiki::Input::HTTP->new (wiki => $wiki); $wiki->{input}->{decoder}->{'#default'} = sub { my ($http, $s, $temp_params) = @_; return main::code_convert (\$s, $wiki->{config}->{charset}->{internal}, lc (@{$temp_params->{_charset_}||[]}[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']; my $dg = SuikaWiki::Plugin->module_package ('Downgrade'); $dg->set_downgrade_flags ($wiki) if $dg; ## 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, $wiki->{config}->{charset}->{internal}, $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; }; ## -- Initializing $wiki->{var} (Actual) -- $WIKI->init_variables; ## Per-session variables ## -- Instantiating WikiView -- try { $WIKI->view_in_mode (mode => $WIKI->{var}->{mode}, method => $WIKI->{input}->meta_variable ('REQUEST_METHOD')); } catch SuikaWiki::DB::Util::Error with { my $err = shift; $err->throw unless $err->{-type} eq 'ERROR_REPORTED'; } catch SuikaWiki::View::Implementation::error with { my $err = shift; $err->throw unless $err->{-type} eq 'ERROR_REPORTED'; } finally { $WIKI->close_input; $WIKI->close_db; }; exit; ## -- Terminating WikiEngine -- END { $WIKI->exit; } =head1 LICENSE Copyright 2000-2004 Wakaba , et. al This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut 1; # $Date: 2004/01/16 08:01:05 $