/[pub]/suikawiki/script/lib/suikawiki.pl
Suika

Contents of /suikawiki/script/lib/suikawiki.pl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.26 - (hide annotations) (download)
Wed Feb 18 07:21:24 2004 UTC (20 years, 9 months ago) by wakaba
Branch: MAIN
Changes since 1.25: +14 -9 lines
File MIME type: text/plain
Fix for modified event interface

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.26 our $VERSION = do{my @r=(q$Revision: 1.25 $=~/\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/&/&amp;/g; s/</&lt;/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     require 'wikidata/suikawiki-config.ph';
63     config ($WIKI);
64    
65     ## -- Loading Modules --
66 wakaba 1.1
67 wakaba 1.24 use SuikaWiki::DB::Util::Error;
68     require SuikaWiki::Name::Space;
69 wakaba 1.23
70 wakaba 1.22 ## -- Transitional Functions --
71 wakaba 1.1
72 w 1.9 # [to be obsolete] ->Message::MIME::Charset
73 wakaba 1.22 sub main::code_convert {
74 wakaba 1.24 my ($contentref, $code, $srccode) = @_;
75     return $$contentref if $$contentref !~ /[^\x21-\x7E]/;
76 wakaba 1.1 require Jcode;
77 wakaba 1.15 $code ||= $WIKI->{config}->{charset}->{internal};
78     for ($code, $srccode) {
79 wakaba 1.23 s/[^0-9A-Za-z_.+-]+//g;
80 wakaba 1.15 if ($_ eq 'euc-jp') { $_ = 'euc' }
81     elsif ($_ eq 'iso-2022-jp') { $_ = 'jis' }
82     elsif ($_ eq 'utf-8') { $_ = 'utf8' }
83     elsif ($_ eq 'shift_jis') { $_ = 'sjis' }
84     }
85 wakaba 1.19 if ($code eq 'iso-8859-1') {
86     return $$contentref; ## TODO:
87     }
88 wakaba 1.15 $$contentref = Jcode->new ($contentref, $srccode)
89     ## Normalize FULLWIDTH characters and IDEOGRAPHIC SPACE
90 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&,.:;?!`^_/|()[]{}+$%#*@=>< '"~-))
91 wakaba 1.23 # ->tr (qq(\x8E\xDE\x8E\xDF) => qq(\xA1\xAB\xA1\xAC))
92     ->h2z (1)
93 wakaba 1.15 ->$code;
94     return $$contentref;
95 wakaba 1.1 }
96    
97 wakaba 1.22 ## -- Initializing WikiPlugin --
98 wakaba 1.15
99 wakaba 1.22 $WIKI->init_plugin; ## WikiPlugin manager
100 wakaba 1.15
101 wakaba 1.22 ## -- Initializing WikiView --
102 wakaba 1.15
103 wakaba 1.22 $WIKI->init_view; ## WikiView manager
104     $WIKI->{view}->register_common_modes;
105    
106     ## WikiView manager error handler
107     push @{$WIKI->{event}->{view_error}}, sub {
108     my ($wiki, $event) = @_;
109     SuikaWiki::Plugin->module_package ('Error')
110     ->report_error_simple
111     ($wiki, WikiView => $event->{error}->text,
112     -trace => 1)
113     if $event->{error}->{-def}->{level} eq 'fatal'
114     or $wiki->{config}->{debug}->{view};
115     unless ($event->{error}->{-def}->{level} eq 'fatal'
116     or $event->{error}->{-def}->{level} eq 'stop') {
117     $event->{cancel} = 1;
118     }
119     };
120    
121     ## "view_in_mode" method definition
122     push @{$WIKI->{event}->{view_in_mode}}, sub {
123 wakaba 1.26 my ($wiki, $event) = @_;
124     my $opt = $event->{view_in_mode};
125 wakaba 1.22 my $arg = {condition => {mode => $opt->{mode} || '-error',
126     output => 'http-cgi',
127     http_method => $opt->{method} || 'GET'}};
128     my $viewobj = $wiki->{view}->instantiate ($opt->{mode} || '-error', $arg);
129     if (ref $viewobj) {
130     $viewobj->main ($arg);
131     } elsif ($opt->{mode} ne '-error') {
132     report SuikaWiki::View::Implementation::error
133     -type => 'WARN_VIEW_NOT_DEFINED', condition => $arg->{condition},
134     -object => $wiki->{view}, method => 'view_in_mode';
135 wakaba 1.25 $wiki->view_in_mode (mode => '-wv--no-view-definition', method => 'GET');
136 wakaba 1.22 ## TODO: cache control for non-GET
137     } else {
138     die "Some error occured. Additionally, error reporting mode not defined";
139     }
140     };
141    
142     ## WikiView formatting template error handler
143     $WIKI->{config}->{catch}->{formatter_view}
144     = catch Message::Util::Formatter::error with {
145     my $err = shift;
146 wakaba 1.23 my $wiki = $err->{option}->{param}->{wiki};
147 wakaba 1.22 SuikaWiki::Plugin->module_package ('Error')
148 wakaba 1.23 ->reporting_formatting_template_error ($err, $wiki,
149     trace => 1);
150 wakaba 1.22 $wiki->view_in_mode (mode => '-error', method => 'GET');
151     throw SuikaWiki::View::Implementation::error
152     -type => 'ERROR_REPORTED';
153     };
154    
155     ## WikiView formatting template error handler (occured in "-error" mode)
156     $WIKI->{config}->{catch}->{formatter_view_error}
157     = catch Message::Util::Formatter::error with {
158     my $err = shift;
159 wakaba 1.23 my $wiki = $err->{option}->{param}->{wiki};
160 wakaba 1.22 SuikaWiki::Plugin->module_package ('Error')
161 wakaba 1.23 ->reporting_formatting_template_error ($err, $wiki,
162     trace => 1);
163 wakaba 1.22 $wiki->view_in_mode (mode => '-error-error', method => 'GET');
164     throw SuikaWiki::View::Implementation::error
165     -type => 'ERROR_REPORTED';
166     };
167 wakaba 1.15
168 wakaba 1.24 ## -- Preparing for WikiDatabase Error Reports --
169 wakaba 1.22 {
170     my $error_report = sub {
171     my ($wiki, $err) = @_;
172 wakaba 1.26 if ($err->{-def}->{level} eq 'fatal') {
173     $wiki->close_db if $wiki->{db};
174     }
175 wakaba 1.22 my $report = ($err->{-def}->{level} eq 'fatal' or
176     $err->{-def}->{level} eq 'stop' or
177     $wiki->{config}->{debug}->{db}) ? 1 : 0;
178     if ($report and $wiki->{config}->{path_to}->{db__content__error_log}) {
179 wakaba 1.23 my $err_msg = caller (1).($err->{method}? '->'.$err->{method}: '').': '
180     .(defined $err->{file}? $err->{file} . ': ' : '')
181     .(defined $err->{prop}? $err->{prop} . ': ' : '')
182     .(defined $err->{key}? join ('//', @{$err->{key}}).': ':'')
183 wakaba 1.26 . $err->text
184     . ($wiki->{config}->{debug}->{db} > 1 ? Carp::longmess () : '');
185 wakaba 1.22 open LOG, '>>', $wiki->{config}->{path_to}->{db__content__error_log};
186     print LOG scalar (gmtime), " @{[$$]} {$err->{-def}->{level}}: ",
187     $err_msg, "\n";
188     close LOG;
189     }
190     SuikaWiki::Plugin->module_package ('WikiDB')
191     ->reporting_error ($err, $wiki) if $report;
192 wakaba 1.26 if ($err->{-def}->{level} eq 'fatal'
193 wakaba 1.24 # or $err->{-def}->{level} eq 'stop' ## for debug
194 wakaba 1.26 ) {
195     $wiki->view_in_mode (mode => '-wdb--fatal-error');
196     throw SuikaWiki::DB::Util::Error -type => 'ERROR_REPORTED';
197     }
198 wakaba 1.22 };
199     unshift @{$WIKI->{event}->{database_loaded}}, sub {
200     my $wiki = shift;
201     unshift @{$wiki->{db}->{event}->{error}}, sub {
202     my ($db, $event) = @_;
203     $error_report->($wiki, $event->{error});
204     if ($event->{error}->{-type} eq 'INFO_DB_PROP_OPENED') {
205     unshift @{$db->{prop}->{$event->{error}->{prop}}->{-db}
206     ->{event}->{error}}, sub {
207     my ($db, $event) = @_;
208     $error_report->($wiki, $event->{error});
209     };
210     }
211     }; # database error
212     }; # database_loaded
213 wakaba 1.15 }
214 wakaba 1.22
215 wakaba 1.24 ## -- Preparing for Misc. Error Reports --
216 wakaba 1.15
217 wakaba 1.22 if ($WIKI->{config}->{debug}->{general}) {
218     $main::SIG{__WARN__} = sub {
219     push @{$WIKI->{var}->{error}||=[]}, {
220     description => Message::Markup::XML::Node->new
221     (type => '#text',
222     value => $_[0]),
223     };
224     };
225     }
226 w 1.9
227 wakaba 1.24 ## -- (Declaring for) Initializing $wiki->{var} --
228 wakaba 1.21
229     push @{$WIKI->{event}->{setting_initial_variables}}, sub {
230     my $wiki = shift;
231 wakaba 1.24 ## Database access mode
232 wakaba 1.15 $wiki->{var}->{db}->{read_only}->{'#default'} = 1;
233    
234 wakaba 1.24 ## Input parameter
235 wakaba 1.15 require SuikaWiki::Input::HTTP;
236 wakaba 1.21 $wiki->{input} = SuikaWiki::Input::HTTP->new (wiki => $wiki);
237 wakaba 1.15 $wiki->{input}->{decoder}->{'#default'} = sub {
238     my ($http, $s, $temp_params) = @_;
239 wakaba 1.18 return main::code_convert (\$s, $wiki->{config}->{charset}->{internal},
240     lc (@{$temp_params->{_charset_}||[]}[0])
241 wakaba 1.15 || $wiki->{config}->{charset}->{uri_param});
242     };
243 wakaba 1.24
244     ## User agent negotiation
245 wakaba 1.15 $wiki->{var}->{client}->{user_agent_name}
246     = $wiki->{input}->meta_variable ('HTTP_USER_AGENT');
247     $wiki->{var}->{client}->{used_for_negotiate} = ['User-Agent'];
248 wakaba 1.21 my $dg = SuikaWiki::Plugin->module_package ('Downgrade');
249     $dg->set_downgrade_flags ($wiki) if $dg;
250 wakaba 1.15
251     ## TODO: PATH_INFO support
252 wakaba 1.24
253     ## URI query parameter
254 wakaba 1.15 my $page = $wiki->{input}->meta_variable ('QUERY_STRING');
255 wakaba 1.24 if ($page and not (index ($page, '=') > -1)) {
256 wakaba 1.15 $page =~ tr/+/ /;
257     $page =~ s/%([0-9A-Fa-f][0-9A-Fa-f])/pack 'C', hex $1/ge;
258     $page = main::code_convert
259 wakaba 1.18 (\$page, $wiki->{config}->{charset}->{internal},
260 wakaba 1.15 $wiki->{config}->{charset}->{uri_query});
261     } else {
262     $page = $wiki->{input}->parameter ('mypage');
263     }
264 wakaba 1.25
265     ## ISSUE: WikiName normalization needed
266     $page =~ s/\s+/\x20/g;
267     $page =~ s/^\x20//; $page =~ s/\x20+$//;
268     $page =~ tr/\x00-\x1F\x7F//d;
269 wakaba 1.15 if ($page) {
270 wakaba 1.25 $wiki->{var}->{page} = $wiki->name ($page);
271 wakaba 1.15 } else {
272     $wiki->{var}->{page} = $wiki->{config}->{page}->{Default};
273     }
274    
275     ## Mode
276     my $mode = $wiki->{input}->parameter ('mode')
277     || $wiki->{input}->parameter ('mycmd') ## for compatibility with
278     || 'default'; ## YukiWiki and SuikaWiki 2
279     $mode =~ tr/-/_/;
280 wakaba 1.24 if ($mode eq 'default' or $mode =~ /[^0-9A-Za-z_]/) {
281     my $cookie = $wiki->{input}->meta_variable ('HTTP_COOKIE');
282 wakaba 1.15 ## BUG: this code is not strict
283     if ($cookie =~ /SelectedMode=([0-9A-Za-z_-]+)/) {
284     $mode = $1; $mode =~ tr/-/_/;
285     } else {
286     $mode = 'read';
287     }
288     push @{$wiki->{var}->{client}->{used_for_negotiate}}, 'Cookie';
289     }
290     $wiki->{var}->{mode} = $mode;
291     };
292 wakaba 1.21
293 wakaba 1.24
294     #### ---- Per-Session ----
295    
296 wakaba 1.22 ## -- Initializing $wiki->{var} (Actual) --
297    
298     $WIKI->init_variables; ## Per-session variables
299 wakaba 1.15
300 wakaba 1.22 ## -- Instantiating WikiView --
301    
302     try {
303     $WIKI->view_in_mode
304     (mode => $WIKI->{var}->{mode},
305     method => $WIKI->{input}->meta_variable ('REQUEST_METHOD'));
306     } catch SuikaWiki::DB::Util::Error with {
307     my $err = shift;
308 wakaba 1.24 unless ($err->{-type} eq 'ERROR_REPORTED') {
309     $WIKI->view_in_mode (mode => '-wdb--fatal-error');
310     }
311 wakaba 1.22 } catch SuikaWiki::View::Implementation::error with {
312     my $err = shift;
313     $err->throw unless $err->{-type} eq 'ERROR_REPORTED';
314 wakaba 1.25 } catch SuikaWiki::Format::Definition::error with {
315     $WIKI->view_in_mode (mode => '-wf--converter-not-found');
316 wakaba 1.22 } finally {
317     $WIKI->close_input;
318     $WIKI->close_db;
319 wakaba 1.18 };
320 wakaba 1.22 exit;
321 wakaba 1.18
322 wakaba 1.24
323    
324 wakaba 1.22 ## -- Terminating WikiEngine --
325 wakaba 1.24
326 wakaba 1.14 END {
327 wakaba 1.22 $WIKI->exit;
328     }
329 wakaba 1.1
330 wakaba 1.24 =head1 SYNOPSIS
331    
332     In your C<suikawiki.cgi>, write as:
333    
334     #!/usr/bin/perl
335     BEGIN { $0 = ''.$0 }
336     use strict;
337     use lib qw(lib);
338     use CGI::Carp qw(fatalsToBrowser);
339     require 'suikawiki.pl';
340    
341     =head1 SEE ALSO
342    
343     <http://suika.fam.cx/~wakaba/-temp/wiki/wiki?SuikaWiki>,
344     <http://suika.fam.cx/~wakaba/-temp/wiki/wiki?SWHCS>,
345     C<wiki.cgi>, C<wikidata/suikawiki-config.ph>,
346     C<SuikaWiki::Implementation>
347    
348 wakaba 1.1 =head1 LICENSE
349    
350 wakaba 1.24 Copyright 2000-2004 Wakaba <w@suika.fam.cx>, et. al. All rights reserved.
351 wakaba 1.1
352     This program is free software; you can redistribute it and/or
353     modify it under the same terms as Perl itself.
354    
355     =cut
356    
357 wakaba 1.26 1; # $Date: 2004/02/08 08:53:57 $

admin@suikawiki.org
ViewVC Help
Powered by ViewVC 1.1.24