script/lib/suikawiki.pl

=head1 NAME

suikawiki.pl - SuikaWiki Driver as HTTP CGI Script (SWHCS)

=head1 DESCRIPTION

This script is a WikiDriver for SuikaWiki, working as HTTP CGI script.
With this script, SuikaWiki WikiEngine can be controled via remote WWW 
user agents.

This file is part of SuikaWiki.

=cut

package wiki::driver::http;
use strict;
our $VERSION = do{my @r=(q$Revision: 1.30 $=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};

  ## These lines should be removed after utf8 support
  BEGIN {
    $Message::Util::Formatter::Base::Token = qr/[\w._+\x80-\xFF-]+/;
    require Message::Util::Formatter::Base;
  }

## -- Constructing a new instance of the WikiEngine --

  require SuikaWiki::Implementation;
  our $WIKI = SuikaWiki::Implementation->new;

## -- Registering Version of the WikiDriver --

  $WIKI->{driver_name} = 'SWHCS';
  $WIKI->{driver_version} = $VERSION;
  $WIKI->{driver_uri_reference}
       = q<http://suika.fam.cx/~wakaba/-temp/wiki/wiki?SWHCS>;
    
## -- Preparing 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; ## Already escaped
    my $wiki_name_version = sprintf '%s/%s %s/%s',
                            $WIKI->{driver_name}, $WIKI->{driver_version},
                            $WIKI->{engine_name}, $WIKI->{engine_version};
    my $trace = Carp::longmess ();
    for ($trace, $wiki_name_version) {
      s/&/&amp;/g; s/</&lt;/g; s/([^\x20-\x7E])/sprintf '&#x%02X;', ord $1/ge;
    };
    print <<"    EOH";
      <!DOCTYPE html SYSTEM>
      <title lang="en">500 Internal WikiEngine Error</title>
      <h1 lang="en">Internal WikiEngine Error</h1>
      <p>$msg</p>
      <p>$trace</p>
      <address>$wiki_name_version</address>
    EOH
  });

## -- Loading Configuration File --

  $_->($WIKI) for our @Config;

## -- Setting Upper Bound for Too Many Accesses at the Same Time --

{
  require SuikaWiki::DB::Util::Lock;
  my $lock = SuikaWiki::DB::Util::Lock
               ->new (-directory => $WIKI->{config}->{path_to}->{db__lock__dir},
                      -name => 'main',
                      -share => 1,
                      -limit => 15);
  $lock->lock or do {
    require SuikaWiki::Output::HTTP;
    my $out = SuikaWiki::Output::HTTP->new;
    $out->{status_code} = 503;
    $out->{status_phrase} = q<WikiEngine Busy>;
    $out->add_header_field ('Retry-After' => 120);
    $out->{entity}->{media_type} = q<text/html>;
    $out->{entity}->{charset} = q<iso-8859-1>;
    $out->{entity}->{language} = [q<en>];
    $out->{entity}->{body_is_octet_stream} = 1;
    my $wiki_name_version = sprintf '%s/%s %s/%s',
                            $WIKI->{driver_name}, $WIKI->{driver_version},
                            $WIKI->{engine_name}, $WIKI->{engine_version};
    for ($wiki_name_version) {
      s/&/&amp;/g; s/</&lt;/g; s/([^\x20-\x7E])/sprintf '&#x%02X;', ord $1/ge;
    };
    $out->{entity}->{body} = qq<
      <!DOCTYPE html SYSTEM>
      <title>503 WikiEngine Busy</title>
      <h1>WikiEngine Busy</h1>
      <p>WikiEngine is now busy and is unable to complete your request.
      Please retry again after a moment.</p>
      <address>$wiki_name_version</address>
    >;
    $out->output (output => 'http-cgi');
    exit;
  };
  END { $lock->unlock }
}

## -- Loading Modules --

  use SuikaWiki::DB::Util::Error;

## -- Transitional Functions --

# [to be obsolete] ->Message::MIME::Charset
sub main::code_convert {
  my ($contentref, $code, $srccode) = @_;
  return $$contentref if $$contentref !~ /[^\x21-\x7E]/;
  require Jcode;
  $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" => q(0-9A-Za-z&,.:;?!`^_/|()[]{}+$%#*@=>< '"~-))
#                      ->tr (qq(\x8E\xDE\x8E\xDF) => qq(\xA1\xAB\xA1\xAC))
                      ->h2z (1)
                      ->$code;
  return $$contentref;
}

## -- 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, $event) = @_;
    my $opt = $event->{view_in_mode};
    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 => '-wv--no-view-definition', 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';
  };

## -- Preparing for WikiDatabase Error Reports --
{
  my $error_report = sub {
    my ($wiki, $err) = @_;
    if ($err->{-def}->{level} eq 'fatal') {
      $wiki->close_db if $wiki->{db};
    }
      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
                . ($wiki->{config}->{debug}->{db} > 1 ? Carp::longmess () : '');
        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' ## for debug
       ) {
      $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});
          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
}

## -- Preparing for Misc. Error Reports --

  if ($WIKI->{config}->{debug}->{general}) {
    $main::SIG{__WARN__} = sub {
      push @{$WIKI->{var}->{error}||=[]}, {
        description => Message::Markup::XML::Node->new
                                         (type => '#text',
                                          value => $_[0]),
      };
    };
  }

## -- (Declaring for) Initializing $wiki->{var} --

  push @{$WIKI->{event}->{setting_initial_variables}}, sub {
    my $wiki = shift;
    ## Database access mode
    $wiki->{var}->{db}->{read_only}->{'#default'} = 1;
    $wiki->{var}->{db}->{lock_module}->{'#default'}
      = q<SuikaWiki::DB::Util::Lock>;
    $wiki->{var}->{db}->{read_lock_module}->{'#default'}
      = q<SuikaWiki::DB::Lock::NoLock>;
    
    ## Input parameter
    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});
    };
    
    ## User agent negotiation
    $wiki->{var}->{client}->{user_agent_name}
      = $wiki->{input}->meta_variable ('HTTP_USER_AGENT');
    $wiki->{var}->{client}->{used_for_negotiate} = ['User-Agent'];
    try {
      my $dg = SuikaWiki::Plugin->module_package ('Downgrade');
      $dg->set_downgrade_flags ($wiki) if $dg;
    } catch SuikaWiki::Plugin::error with {
      my $err = shift;
      $err->raise unless $err->{-type} eq 'PLUGIN_NOT_FOUND';
    };
    
    ## TODO: PATH_INFO support
    
    ## URI query parameter
    my $page = $wiki->{input}->meta_variable ('QUERY_STRING');
    if ($page and not (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');
    }
    
    ## ISSUE: WikiName normalization needed
    $page =~ s/\s+/\x20/g;
    $page =~ s/^\x20//; $page =~ s/\x20+$//;
    $page =~ tr/\x00-\x1F\x7F//d;
    if ($page) {
      $wiki->{var}->{page} = $wiki->name ($page);
    } else {
#      $wiki->{var}->{page} = $wiki->{config}->{page}->{Default};
      $wiki->{var}->{page} = $wiki->name ([]);
    }
 
    ## Mode
    my $mode = $wiki->{input}->parameter ('mode') || 'default';
    $mode =~ tr/-/_/;
    if ($mode eq 'default' or $mode =~ /[^0-9A-Za-z_]/) {
      my $cookie = $wiki->{input}->meta_variable ('HTTP_COOKIE');
      ## BUG: this code is not strict
      if ($cookie =~ /SelectedMode=([0-9A-Za-z_-]+)/) {
        $mode = $1; $mode =~ tr/-/_/;
      } else {
        $mode = $wiki->{config}->{mode}->{default} || 'read';
      }
      push @{$wiki->{var}->{client}->{used_for_negotiate}}, 'Cookie';
    }
    $wiki->{var}->{mode} = $mode;
  };

#### ---- Per-Session ----

## -- 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;
    unless ($err->{-type} eq 'ERROR_REPORTED') {
      $WIKI->view_in_mode (mode => '-wdb--fatal-error');
    }
  } catch SuikaWiki::View::Implementation::error with {
    my $err = shift;
    $err->throw unless $err->{-type} eq 'ERROR_REPORTED';
  } catch SuikaWiki::Format::Definition::error with {
    $WIKI->view_in_mode (mode => '-wf--converter-not-found');
  } finally {
    $WIKI->close_input;
    $WIKI->close_db;
  };
  exit;


## -- Terminating WikiEngine --

END {
  $WIKI->exit;
}

=head1 SYNOPSIS

In your C<suikawiki.cgi>, write as:

  #!/usr/bin/perl
  BEGIN { $0 = ''.$0 }
  use strict;
  use lib qw(lib);
  use CGI::Carp qw(fatalsToBrowser);
  require 'suikawiki.pl';

=head1 SEE ALSO

<http://suika.fam.cx/~wakaba/-temp/wiki/wiki?SuikaWiki>,
<http://suika.fam.cx/~wakaba/-temp/wiki/wiki?SWHCS>,
C<wiki.cgi>, C<wikidata/suikawiki-config.ph>,
C<SuikaWiki::Implementation>

=head1 LICENSE

Copyright 2000-2004 Wakaba <w@suika.fam.cx>, et. al.  All rights reserved.

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

=cut

1; # $Date: 2004/04/01 04:46:36 $
1	wakaba	1.22	=head1 NAME
2
3	wakaba	1.24	suikawiki.pl - SuikaWiki Driver as HTTP CGI Script (SWHCS)
4
5			=head1 DESCRIPTION
6
7			This script is a WikiDriver for SuikaWiki, working as HTTP CGI script.
8			With this script, SuikaWiki WikiEngine can be controled via remote WWW
9			user agents.
10
11			This file is part of SuikaWiki.
12	wakaba	1.22
13			=cut
14
15	wakaba	1.24	package wiki::driver::http;
16	wakaba	1.1	use strict;
17	wakaba	1.30.2.1	our $VERSION = do{my @r=(q$Revision: 1.30 $=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};
18	wakaba	1.24
19			## These lines should be removed after utf8 support
20			BEGIN {
21			$Message::Util::Formatter::Base::Token = qr/[\w._+\x80-\xFF-]+/;
22			require Message::Util::Formatter::Base;
23			}
24
25			## -- Constructing a new instance of the WikiEngine --
26
27			require SuikaWiki::Implementation;
28			our $WIKI = SuikaWiki::Implementation->new;
29
30			## -- Registering Version of the WikiDriver --
31
32			$WIKI->{driver_name} = 'SWHCS';
33			$WIKI->{driver_version} = $VERSION;
34			$WIKI->{driver_uri_reference}
35			= q<http://suika.fam.cx/~wakaba/-temp/wiki/wiki?SWHCS>;
36	wakaba	1.22
37	wakaba	1.24	## -- Preparing Dying Message as HTTP Response --
38
39	wakaba	1.22	require SuikaWiki::Output::CGICarp;
40	wakaba	1.24	$SuikaWiki::Output::CGICarp::CUSTOM_REASON_TEXT = 'Internal WikiEngine Error';
41	wakaba	1.22	CGI::Carp::set_message (sub {
42	wakaba	1.24	my $msg = shift; ## Already escaped
43			my $wiki_name_version = sprintf '%s/%s %s/%s',
44			$WIKI->{driver_name}, $WIKI->{driver_version},
45			$WIKI->{engine_name}, $WIKI->{engine_version};
46			my $trace = Carp::longmess ();
47			for ($trace, $wiki_name_version) {
48			s/&/&/g; s/</</g; s/([^\x20-\x7E])/sprintf '&#x%02X;', ord $1/ge;
49			};
50			print <<" EOH";
51			<!DOCTYPE html SYSTEM>
52			<title lang="en">500 Internal WikiEngine Error</title>
53			<h1 lang="en">Internal WikiEngine Error</h1>
54			<p>$msg</p>
55			<p>$trace</p>
56			<address>$wiki_name_version</address>
57			EOH
58	wakaba	1.22	});
59
60	wakaba	1.24	## -- Loading Configuration File --
61
62	wakaba	1.28	$_->($WIKI) for our @Config;
63	wakaba	1.24
64	wakaba	1.29	## -- Setting Upper Bound for Too Many Accesses at the Same Time --
65
66			{
67			require SuikaWiki::DB::Util::Lock;
68			my $lock = SuikaWiki::DB::Util::Lock
69			->new (-directory => $WIKI->{config}->{path_to}->{db__lock__dir},
70			-name => 'main',
71			-share => 1,
72			-limit => 15);
73			$lock->lock or do {
74			require SuikaWiki::Output::HTTP;
75			my $out = SuikaWiki::Output::HTTP->new;
76			$out->{status_code} = 503;
77			$out->{status_phrase} = q<WikiEngine Busy>;
78			$out->add_header_field ('Retry-After' => 120);
79			$out->{entity}->{media_type} = q<text/html>;
80			$out->{entity}->{charset} = q<iso-8859-1>;
81			$out->{entity}->{language} = [q<en>];
82			$out->{entity}->{body_is_octet_stream} = 1;
83			my $wiki_name_version = sprintf '%s/%s %s/%s',
84			$WIKI->{driver_name}, $WIKI->{driver_version},
85			$WIKI->{engine_name}, $WIKI->{engine_version};
86			for ($wiki_name_version) {
87			s/&/&/g; s/</</g; s/([^\x20-\x7E])/sprintf '&#x%02X;', ord $1/ge;
88			};
89			$out->{entity}->{body} = qq<
90			<!DOCTYPE html SYSTEM>
91			<title>503 WikiEngine Busy</title>
92			<h1>WikiEngine Busy</h1>
93			<p>WikiEngine is now busy and is unable to complete your request.
94			Please retry again after a moment.</p>
95			<address>$wiki_name_version</address>
96			>;
97			$out->output (output => 'http-cgi');
98			exit;
99			};
100			END { $lock->unlock }
101			}
102
103	wakaba	1.24	## -- Loading Modules --
104	wakaba	1.1
105	wakaba	1.24	use SuikaWiki::DB::Util::Error;
106	wakaba	1.23
107	wakaba	1.22	## -- Transitional Functions --
108	wakaba	1.1
109	w	1.9	# [to be obsolete] ->Message::MIME::Charset
110	wakaba	1.22	sub main::code_convert {
111	wakaba	1.24	my ($contentref, $code, $srccode) = @_;
112			return $$contentref if $$contentref !~ /[^\x21-\x7E]/;
113	wakaba	1.1	require Jcode;
114	wakaba	1.15	$code \|\|= $WIKI->{config}->{charset}->{internal};
115			for ($code, $srccode) {
116	wakaba	1.23	s/[^0-9A-Za-z_.+-]+//g;
117	wakaba	1.15	if ($_ eq 'euc-jp') { $_ = 'euc' }
118			elsif ($_ eq 'iso-2022-jp') { $_ = 'jis' }
119			elsif ($_ eq 'utf-8') { $_ = 'utf8' }
120			elsif ($_ eq 'shift_jis') { $_ = 'sjis' }
121			}
122	wakaba	1.19	if ($code eq 'iso-8859-1') {
123			return $$contentref; ## TODO:
124			}
125	wakaba	1.15	$$contentref = Jcode->new ($contentref, $srccode)
126			## Normalize FULLWIDTH characters and IDEOGRAPHIC SPACE
127	wakaba	1.25	->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" => q(0-9A-Za-z&,.:;?!`^_/\|()[]{}+$%#*@=>< '"~-))
128	wakaba	1.23	# ->tr (qq(\x8E\xDE\x8E\xDF) => qq(\xA1\xAB\xA1\xAC))
129			->h2z (1)
130	wakaba	1.15	->$code;
131			return $$contentref;
132	wakaba	1.1	}
133
134	wakaba	1.22	## -- Initializing WikiPlugin --
135	wakaba	1.15
136	wakaba	1.22	$WIKI->init_plugin; ## WikiPlugin manager
137	wakaba	1.15
138	wakaba	1.22	## -- Initializing WikiView --
139	wakaba	1.15
140	wakaba	1.22	$WIKI->init_view; ## WikiView manager
141			$WIKI->{view}->register_common_modes;
142
143			## WikiView manager error handler
144			push @{$WIKI->{event}->{view_error}}, sub {
145			my ($wiki, $event) = @_;
146			SuikaWiki::Plugin->module_package ('Error')
147			->report_error_simple
148			($wiki, WikiView => $event->{error}->text,
149			-trace => 1)
150			if $event->{error}->{-def}->{level} eq 'fatal'
151			or $wiki->{config}->{debug}->{view};
152			unless ($event->{error}->{-def}->{level} eq 'fatal'
153			or $event->{error}->{-def}->{level} eq 'stop') {
154			$event->{cancel} = 1;
155			}
156			};
157
158			## "view_in_mode" method definition
159			push @{$WIKI->{event}->{view_in_mode}}, sub {
160	wakaba	1.26	my ($wiki, $event) = @_;
161			my $opt = $event->{view_in_mode};
162	wakaba	1.22	my $arg = {condition => {mode => $opt->{mode} \|\| '-error',
163			output => 'http-cgi',
164			http_method => $opt->{method} \|\| 'GET'}};
165			my $viewobj = $wiki->{view}->instantiate ($opt->{mode} \|\| '-error', $arg);
166			if (ref $viewobj) {
167			$viewobj->main ($arg);
168			} elsif ($opt->{mode} ne '-error') {
169			report SuikaWiki::View::Implementation::error
170			-type => 'WARN_VIEW_NOT_DEFINED', condition => $arg->{condition},
171			-object => $wiki->{view}, method => 'view_in_mode';
172	wakaba	1.25	$wiki->view_in_mode (mode => '-wv--no-view-definition', method => 'GET');
173	wakaba	1.22	## TODO: cache control for non-GET
174			} else {
175			die "Some error occured. Additionally, error reporting mode not defined";
176			}
177			};
178
179			## WikiView formatting template error handler
180			$WIKI->{config}->{catch}->{formatter_view}
181			= catch Message::Util::Formatter::error with {
182			my $err = shift;
183	wakaba	1.23	my $wiki = $err->{option}->{param}->{wiki};
184	wakaba	1.22	SuikaWiki::Plugin->module_package ('Error')
185	wakaba	1.23	->reporting_formatting_template_error ($err, $wiki,
186			trace => 1);
187	wakaba	1.22	$wiki->view_in_mode (mode => '-error', method => 'GET');
188			throw SuikaWiki::View::Implementation::error
189			-type => 'ERROR_REPORTED';
190			};
191
192			## WikiView formatting template error handler (occured in "-error" mode)
193			$WIKI->{config}->{catch}->{formatter_view_error}
194			= catch Message::Util::Formatter::error with {
195			my $err = shift;
196	wakaba	1.23	my $wiki = $err->{option}->{param}->{wiki};
197	wakaba	1.22	SuikaWiki::Plugin->module_package ('Error')
198	wakaba	1.23	->reporting_formatting_template_error ($err, $wiki,
199			trace => 1);
200	wakaba	1.22	$wiki->view_in_mode (mode => '-error-error', method => 'GET');
201			throw SuikaWiki::View::Implementation::error
202			-type => 'ERROR_REPORTED';
203			};
204	wakaba	1.15
205	wakaba	1.24	## -- Preparing for WikiDatabase Error Reports --
206	wakaba	1.22	{
207			my $error_report = sub {
208			my ($wiki, $err) = @_;
209	wakaba	1.26	if ($err->{-def}->{level} eq 'fatal') {
210			$wiki->close_db if $wiki->{db};
211			}
212	wakaba	1.22	my $report = ($err->{-def}->{level} eq 'fatal' or
213			$err->{-def}->{level} eq 'stop' or
214			$wiki->{config}->{debug}->{db}) ? 1 : 0;
215			if ($report and $wiki->{config}->{path_to}->{db__content__error_log}) {
216	wakaba	1.23	my $err_msg = caller (1).($err->{method}? '->'.$err->{method}: '').': '
217			.(defined $err->{file}? $err->{file} . ': ' : '')
218			.(defined $err->{prop}? $err->{prop} . ': ' : '')
219			.(defined $err->{key}? join ('//', @{$err->{key}}).': ':'')
220	wakaba	1.26	. $err->text
221			. ($wiki->{config}->{debug}->{db} > 1 ? Carp::longmess () : '');
222	wakaba	1.22	open LOG, '>>', $wiki->{config}->{path_to}->{db__content__error_log};
223			print LOG scalar (gmtime), " @{[$$]} {$err->{-def}->{level}}: ",
224			$err_msg, "\n";
225			close LOG;
226			}
227			SuikaWiki::Plugin->module_package ('WikiDB')
228			->reporting_error ($err, $wiki) if $report;
229	wakaba	1.26	if ($err->{-def}->{level} eq 'fatal'
230	wakaba	1.24	# or $err->{-def}->{level} eq 'stop' ## for debug
231	wakaba	1.26	) {
232			$wiki->view_in_mode (mode => '-wdb--fatal-error');
233			throw SuikaWiki::DB::Util::Error -type => 'ERROR_REPORTED';
234			}
235	wakaba	1.22	};
236			unshift @{$WIKI->{event}->{database_loaded}}, sub {
237			my $wiki = shift;
238			unshift @{$wiki->{db}->{event}->{error}}, sub {
239			my ($db, $event) = @_;
240			$error_report->($wiki, $event->{error});
241			if ($event->{error}->{-type} eq 'INFO_DB_PROP_OPENED') {
242			unshift @{$db->{prop}->{$event->{error}->{prop}}->{-db}
243			->{event}->{error}}, sub {
244			my ($db, $event) = @_;
245			$error_report->($wiki, $event->{error});
246	wakaba	1.30.2.1	if ($event->{error}->{-type} eq 'INFO_DB_PROP_OPENED') {
247			unshift @{$db->{prop}->{$event->{error}->{prop}}->{-db}
248			->{event}->{error}}, sub {
249			my ($db, $event) = @_;
250			$error_report->($wiki, $event->{error});
251			};
252			}
253	wakaba	1.22	};
254			}
255			}; # database error
256			}; # database_loaded
257	wakaba	1.15	}
258	wakaba	1.30
259	wakaba	1.24	## -- Preparing for Misc. Error Reports --
260	wakaba	1.15
261	wakaba	1.22	if ($WIKI->{config}->{debug}->{general}) {
262			$main::SIG{__WARN__} = sub {
263			push @{$WIKI->{var}->{error}\|\|=[]}, {
264			description => Message::Markup::XML::Node->new
265			(type => '#text',
266			value => $_[0]),
267			};
268			};
269			}
270	w	1.9
271	wakaba	1.24	## -- (Declaring for) Initializing $wiki->{var} --
272	wakaba	1.21
273			push @{$WIKI->{event}->{setting_initial_variables}}, sub {
274			my $wiki = shift;
275	wakaba	1.24	## Database access mode
276	wakaba	1.15	$wiki->{var}->{db}->{read_only}->{'#default'} = 1;
277	wakaba	1.29	$wiki->{var}->{db}->{lock_module}->{'#default'}
278			= q<SuikaWiki::DB::Util::Lock>;
279			$wiki->{var}->{db}->{read_lock_module}->{'#default'}
280			= q<SuikaWiki::DB::Lock::NoLock>;
281	wakaba	1.15
282	wakaba	1.24	## Input parameter
283	wakaba	1.15	require SuikaWiki::Input::HTTP;
284	wakaba	1.21	$wiki->{input} = SuikaWiki::Input::HTTP->new (wiki => $wiki);
285	wakaba	1.15	$wiki->{input}->{decoder}->{'#default'} = sub {
286			my ($http, $s, $temp_params) = @_;
287	wakaba	1.18	return main::code_convert (\$s, $wiki->{config}->{charset}->{internal},
288			lc (@{$temp_params->{_charset_}\|\|[]}[0])
289	wakaba	1.15	\|\| $wiki->{config}->{charset}->{uri_param});
290			};
291	wakaba	1.24
292			## User agent negotiation
293	wakaba	1.15	$wiki->{var}->{client}->{user_agent_name}
294			= $wiki->{input}->meta_variable ('HTTP_USER_AGENT');
295			$wiki->{var}->{client}->{used_for_negotiate} = ['User-Agent'];
296	wakaba	1.27	try {
297			my $dg = SuikaWiki::Plugin->module_package ('Downgrade');
298			$dg->set_downgrade_flags ($wiki) if $dg;
299			} catch SuikaWiki::Plugin::error with {
300			my $err = shift;
301			$err->raise unless $err->{-type} eq 'PLUGIN_NOT_FOUND';
302			};
303	wakaba	1.15
304			## TODO: PATH_INFO support
305	wakaba	1.24
306			## URI query parameter
307	wakaba	1.15	my $page = $wiki->{input}->meta_variable ('QUERY_STRING');
308	wakaba	1.24	if ($page and not (index ($page, '=') > -1)) {
309	wakaba	1.15	$page =~ tr/+/ /;
310			$page =~ s/%([0-9A-Fa-f][0-9A-Fa-f])/pack 'C', hex $1/ge;
311			$page = main::code_convert
312	wakaba	1.18	(\$page, $wiki->{config}->{charset}->{internal},
313	wakaba	1.15	$wiki->{config}->{charset}->{uri_query});
314			} else {
315			$page = $wiki->{input}->parameter ('mypage');
316			}
317	wakaba	1.25
318			## ISSUE: WikiName normalization needed
319			$page =~ s/\s+/\x20/g;
320			$page =~ s/^\x20//; $page =~ s/\x20+$//;
321			$page =~ tr/\x00-\x1F\x7F//d;
322	wakaba	1.15	if ($page) {
323	wakaba	1.25	$wiki->{var}->{page} = $wiki->name ($page);
324	wakaba	1.15	} else {
325	wakaba	1.30	# $wiki->{var}->{page} = $wiki->{config}->{page}->{Default};
326			$wiki->{var}->{page} = $wiki->name ([]);
327	wakaba	1.15	}
328
329			## Mode
330	wakaba	1.30.2.1	my $mode = $wiki->{input}->parameter ('mode') \|\| 'default';
331	wakaba	1.15	$mode =~ tr/-/_/;
332	wakaba	1.24	if ($mode eq 'default' or $mode =~ /[^0-9A-Za-z_]/) {
333			my $cookie = $wiki->{input}->meta_variable ('HTTP_COOKIE');
334	wakaba	1.15	## BUG: this code is not strict
335			if ($cookie =~ /SelectedMode=([0-9A-Za-z_-]+)/) {
336			$mode = $1; $mode =~ tr/-/_/;
337			} else {
338	wakaba	1.30.2.1	$mode = $wiki->{config}->{mode}->{default} \|\| 'read';
339	wakaba	1.15	}
340			push @{$wiki->{var}->{client}->{used_for_negotiate}}, 'Cookie';
341			}
342			$wiki->{var}->{mode} = $mode;
343			};
344	wakaba	1.21
345	wakaba	1.24	#### ---- Per-Session ----
346
347	wakaba	1.22	## -- Initializing $wiki->{var} (Actual) --
348
349			$WIKI->init_variables; ## Per-session variables
350	wakaba	1.15
351	wakaba	1.22	## -- Instantiating WikiView --
352
353			try {
354			$WIKI->view_in_mode
355			(mode => $WIKI->{var}->{mode},
356			method => $WIKI->{input}->meta_variable ('REQUEST_METHOD'));
357			} catch SuikaWiki::DB::Util::Error with {
358			my $err = shift;
359	wakaba	1.24	unless ($err->{-type} eq 'ERROR_REPORTED') {
360			$WIKI->view_in_mode (mode => '-wdb--fatal-error');
361			}
362	wakaba	1.22	} catch SuikaWiki::View::Implementation::error with {
363			my $err = shift;
364			$err->throw unless $err->{-type} eq 'ERROR_REPORTED';
365	wakaba	1.25	} catch SuikaWiki::Format::Definition::error with {
366			$WIKI->view_in_mode (mode => '-wf--converter-not-found');
367	wakaba	1.22	} finally {
368			$WIKI->close_input;
369			$WIKI->close_db;
370	wakaba	1.18	};
371	wakaba	1.22	exit;
372	wakaba	1.18
373	wakaba	1.24
374
375	wakaba	1.22	## -- Terminating WikiEngine --
376	wakaba	1.24
377	wakaba	1.14	END {
378	wakaba	1.22	$WIKI->exit;
379			}
380	wakaba	1.1
381	wakaba	1.24	=head1 SYNOPSIS
382
383			In your C<suikawiki.cgi>, write as:
384
385			#!/usr/bin/perl
386			BEGIN { $0 = ''.$0 }
387			use strict;
388			use lib qw(lib);
389			use CGI::Carp qw(fatalsToBrowser);
390			require 'suikawiki.pl';
391
392			=head1 SEE ALSO
393
394			<http://suika.fam.cx/~wakaba/-temp/wiki/wiki?SuikaWiki>,
395			<http://suika.fam.cx/~wakaba/-temp/wiki/wiki?SWHCS>,
396			C<wiki.cgi>, C<wikidata/suikawiki-config.ph>,
397			C<SuikaWiki::Implementation>
398
399	wakaba	1.1	=head1 LICENSE
400
401	wakaba	1.24	Copyright 2000-2004 Wakaba <w@suika.fam.cx>, et. al. All rights reserved.
402	wakaba	1.1
403			This program is free software; you can redistribute it and/or
404			modify it under the same terms as Perl itself.
405
406			=cut
407
408	wakaba	1.30.2.1	1; # $Date: 2004/04/01 04:46:36 $