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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.22 - (hide annotations) (download)
Fri Dec 26 09:40:28 2003 UTC (20 years, 11 months ago) by wakaba
Branch: MAIN
Changes since 1.21: +178 -319 lines
File MIME type: text/plain
Rearranged

1 wakaba 1.22 =head1 NAME
2    
3     suikawiki.pl - SuikaWiki Driver for HTTP CGI Script
4    
5     =cut
6    
7 wakaba 1.1 use strict;
8     package main;
9 wakaba 1.18 our $WIKI;
10 wakaba 1.22 package wiki::driver::http;
11     ## -- Version of WikiDriver --
12     our $VERSION = do{my @r=(q$Revision: 1.21 $=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};
13     $WIKI->{implementation_version} = 'hcs'.$VERSION;
14    
15     ## -- Dying Message as HTTP Response --
16     require SuikaWiki::Output::CGICarp;
17     $SuikaWiki::Output::CGICarp::CUSTOM_REASON_TEXT
18     = 'Internal WikiEngine Error';
19     CGI::Carp::set_message (sub {
20     my $msg = shift;
21     #$msg =~ s/&/&/g;
22     #$msg =~ s/</&lt;/g;
23     my $wiki_name_version = $WIKI->{implementation_name} .'/'. $WIKI->version;
24     my $trace = Carp::longmess ();
25     for ($trace, $wiki_name_version)
26     { s/&/&amp;/g; s/</&lt;/g;
27     s/([^\x20-\x7E])/sprintf '&#x%02X;', ord $1/ge; };
28     print STDOUT <<EOH;
29     <!DOCTYPE html SYSTEM>
30     <title>500 Internal WikiEngine Error</title>
31     <h1>Internal WikiEngine Error</h1>
32     <p>$msg</p>
33     <p>$trace</p>
34     <address>$wiki_name_version</address>
35     EOH
36     });
37    
38     ## -- Required Modules --
39     use SuikaWiki::DB::Util::Error;
40 wakaba 1.1 require SuikaWiki::Plugin;
41 w 1.9 require SuikaWiki::Name::Space;
42 wakaba 1.18 require SuikaWiki::SrcFormat;
43 wakaba 1.1
44 wakaba 1.22 ## -- Transitional Functions --
45 wakaba 1.1
46 w 1.9 # [to be obsolete] ->Message::MIME::Charset
47 wakaba 1.22 sub main::code_convert {
48 wakaba 1.1 require Jcode;
49 wakaba 1.15 my ($contentref, $code, $srccode) = @_;
50     $code ||= $WIKI->{config}->{charset}->{internal};
51     for ($code, $srccode) {
52     if ($_ eq 'euc-jp') { $_ = 'euc' }
53     elsif ($_ eq 'iso-2022-jp') { $_ = 'jis' }
54     elsif ($_ eq 'utf-8') { $_ = 'utf8' }
55     elsif ($_ eq 'shift_jis') { $_ = 'sjis' }
56     }
57 wakaba 1.19 if ($code eq 'iso-8859-1') {
58     return $$contentref; ## TODO:
59     }
60 wakaba 1.15 $$contentref = Jcode->new ($contentref, $srccode)
61     ## Normalize FULLWIDTH characters and IDEOGRAPHIC SPACE
62     ->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&,.:;?!`^_/|()[]{}+$%#*@=>< '"~-))
63     ->tr (qq(\x8E\xDE\x8E\xDF) => qq(\xA1\xAB\xA1\xAC))
64     ->h2z
65     ->$code;
66     return $$contentref;
67 wakaba 1.1 }
68    
69 wakaba 1.18 # [to be obsolete] ->Message::Field::Date : Map
70 wakaba 1.22 sub main::_rfc3339_date ($) {
71 wakaba 1.1 my @time = gmtime (shift);
72     sprintf '%04d-%02d-%02dT%02d:%02d:%02d+00:00', $time[5]+1900,$time[4]+1,@time[3,2,1,0];
73     }
74    
75 wakaba 1.20 ## Obsolete
76 wakaba 1.22 sub SuikaWiki::Plugin::get_data ($$$$;%) {
77 wakaba 1.20 my ($self, $prop, $key, %opt) = @_;
78     ## TODO: common interface to WikiDB
79     ## TODO: error recovering
80     $main::WIKI->{db}->get ($prop => $key);
81     }
82    
83 wakaba 1.22 ## -- Initializing WikiPlugin --
84 wakaba 1.15
85 wakaba 1.22 $WIKI->init_plugin; ## WikiPlugin manager
86 wakaba 1.15
87 wakaba 1.22 ## -- Initializing WikiView --
88 wakaba 1.15
89 wakaba 1.22 $WIKI->init_view; ## WikiView manager
90     $WIKI->{view}->register_common_modes;
91    
92     ## WikiView manager error handler
93     push @{$WIKI->{event}->{view_error}}, sub {
94     my ($wiki, $event) = @_;
95     SuikaWiki::Plugin->module_package ('Error')
96     ->report_error_simple
97     ($wiki, WikiView => $event->{error}->text,
98     -trace => 1)
99     if $event->{error}->{-def}->{level} eq 'fatal'
100     or $wiki->{config}->{debug}->{view};
101     unless ($event->{error}->{-def}->{level} eq 'fatal'
102     or $event->{error}->{-def}->{level} eq 'stop') {
103     $event->{cancel} = 1;
104     }
105     };
106    
107     ## "view_in_mode" method definition
108     push @{$WIKI->{event}->{view_in_mode}}, sub {
109     my ($wiki, $opt) = @_;
110     my $arg = {condition => {mode => $opt->{mode} || '-error',
111     output => 'http-cgi',
112     http_method => $opt->{method} || 'GET'}};
113     my $viewobj = $wiki->{view}->instantiate ($opt->{mode} || '-error', $arg);
114     if (ref $viewobj) {
115     $viewobj->main ($arg);
116     } elsif ($opt->{mode} ne '-error') {
117     report SuikaWiki::View::Implementation::error
118     -type => 'WARN_VIEW_NOT_DEFINED', condition => $arg->{condition},
119     -object => $wiki->{view}, method => 'view_in_mode';
120     $wiki->view_in_mode (mode => '-error', method => 'GET');
121     ## TODO: cache control for non-GET
122     } else {
123     die "Some error occured. Additionally, error reporting mode not defined";
124     }
125     };
126    
127     ## WikiView formatting template error handler
128     $WIKI->{config}->{catch}->{formatter_view}
129     = catch Message::Util::Formatter::error with {
130     my $err = shift;
131     my $wiki = $err->{-option}->{param}->{wiki};
132     SuikaWiki::Plugin->module_package ('Error')
133     ->reporting_formatting_template_error ($err, $wiki);
134     $wiki->view_in_mode (mode => '-error', method => 'GET');
135     throw SuikaWiki::View::Implementation::error
136     -type => 'ERROR_REPORTED';
137     };
138    
139     ## WikiView formatting template error handler (occured in "-error" mode)
140     $WIKI->{config}->{catch}->{formatter_view_error}
141     = catch Message::Util::Formatter::error with {
142     my $err = shift;
143     my $wiki = $err->{-option}->{param}->{wiki};
144     SuikaWiki::Plugin->module_package ('Error')
145     ->reporting_formatting_template_error ($err, $wiki);
146     $wiki->view_in_mode (mode => '-error-error', method => 'GET');
147     throw SuikaWiki::View::Implementation::error
148     -type => 'ERROR_REPORTED';
149     };
150 wakaba 1.15
151 wakaba 1.22 ## -- WikiDatabase Error Reporting --
152     {
153     my $error_report = sub {
154     my ($wiki, $err) = @_;
155     my $report = ($err->{-def}->{level} eq 'fatal' or
156     $err->{-def}->{level} eq 'stop' or
157     $wiki->{config}->{debug}->{db}) ? 1 : 0;
158     if ($report and $wiki->{config}->{path_to}->{db__content__error_log}) {
159     my $err_msg = caller (1).($err->{-method}? '->'.$err->{-method}: '').': '
160     .(defined $err->{-file}? $err->{-file} . ': ' : '')
161     .(defined $err->{-prop}? $err->{-prop} . ': ' : '')
162     .(defined $err->{-key}? join ('//', @{$err->{-key}}).': ':'')
163     . $err->text;
164     open LOG, '>>', $wiki->{config}->{path_to}->{db__content__error_log};
165     print LOG scalar (gmtime), " @{[$$]} {$err->{-def}->{level}}: ",
166     $err_msg, "\n";
167     close LOG;
168     }
169     SuikaWiki::Plugin->module_package ('WikiDB')
170     ->reporting_error ($err, $wiki) if $report;
171     if ($err->{-def}->{level} eq 'fatal' or $err->{-def}->{level} eq 'stop') {
172     $wiki->view_in_mode (mode => '-wdb--fatal-error');
173     throw SuikaWiki::DB::Util::Error -type => 'ERROR_REPORTED';
174     }
175     };
176     unshift @{$WIKI->{event}->{database_loaded}}, sub {
177     my $wiki = shift;
178     unshift @{$wiki->{db}->{event}->{error}}, sub {
179     my ($db, $event) = @_;
180     $error_report->($wiki, $event->{error});
181     if ($event->{error}->{-type} eq 'INFO_DB_PROP_OPENED') {
182     unshift @{$db->{prop}->{$event->{error}->{prop}}->{-db}
183     ->{event}->{error}}, sub {
184     my ($db, $event) = @_;
185     $error_report->($wiki, $event->{error});
186     };
187     }
188     }; # database error
189     }; # database_loaded
190 wakaba 1.15 }
191 wakaba 1.22
192     ## -- Misc. Error Reporting --
193 wakaba 1.15
194 wakaba 1.22 if ($WIKI->{config}->{debug}->{general}) {
195     $main::SIG{__WARN__} = sub {
196     push @{$WIKI->{var}->{error}||=[]}, {
197     description => Message::Markup::XML::Node->new
198     (type => '#text',
199     value => $_[0]),
200     };
201     };
202     }
203 w 1.9
204 wakaba 1.22 ## -- Initializing $wiki->{var} (Declaration) --
205 wakaba 1.21
206     push @{$WIKI->{event}->{setting_initial_variables}}, sub {
207     my $wiki = shift;
208 wakaba 1.15 $wiki->{var}->{db}->{read_only}->{'#default'} = 1;
209    
210     require SuikaWiki::Input::HTTP;
211 wakaba 1.21 $wiki->{input} = SuikaWiki::Input::HTTP->new (wiki => $wiki);
212 wakaba 1.15 $wiki->{input}->{decoder}->{'#default'} = sub {
213     my ($http, $s, $temp_params) = @_;
214 wakaba 1.18 return main::code_convert (\$s, $wiki->{config}->{charset}->{internal},
215     lc (@{$temp_params->{_charset_}||[]}[0])
216 wakaba 1.15 || $wiki->{config}->{charset}->{uri_param});
217     };
218     $wiki->{var}->{client}->{user_agent_name}
219     = $wiki->{input}->meta_variable ('HTTP_USER_AGENT');
220     $wiki->{var}->{client}->{used_for_negotiate} = ['User-Agent'];
221 wakaba 1.21 my $dg = SuikaWiki::Plugin->module_package ('Downgrade');
222     $dg->set_downgrade_flags ($wiki) if $dg;
223 wakaba 1.15
224     ## TODO: PATH_INFO support
225     my $page = $wiki->{input}->meta_variable ('QUERY_STRING');
226     if ($page && !(index ($page, '=') > -1)) {
227     $page =~ tr/+/ /;
228     $page =~ s/%([0-9A-Fa-f][0-9A-Fa-f])/pack 'C', hex $1/ge;
229     $page = main::code_convert
230 wakaba 1.18 (\$page, $wiki->{config}->{charset}->{internal},
231 wakaba 1.15 $wiki->{config}->{charset}->{uri_query});
232     } else {
233     $page = $wiki->{input}->parameter ('mypage');
234     }
235    
236    
237     ## TODO: SuikaWiki 3 WikiName
238     $page =~ tr/\x00-\x20\x7F//d;
239     $page = SuikaWiki::Name::Space::normalize_name ($page);
240     if ($page) {
241     $wiki->{var}->{page} = [split '//', $page];
242     } else {
243     $wiki->{var}->{page} = $wiki->{config}->{page}->{Default};
244     }
245    
246     ## Mode
247     my $mode = $wiki->{input}->parameter ('mode')
248     || $wiki->{input}->parameter ('mycmd') ## for compatibility with
249     || 'default'; ## YukiWiki and SuikaWiki 2
250     $mode =~ tr/-/_/;
251     if ($mode eq 'default' || $mode =~ /[^0-9A-Za-z_]/) {
252     ## BUG: this code is not strict
253     my $cookie = $wiki->{input}->meta_variable ('HTTP_COOKIE');
254     if ($cookie =~ /SelectedMode=([0-9A-Za-z_-]+)/) {
255     $mode = $1; $mode =~ tr/-/_/;
256     } else {
257     $mode = 'read';
258     }
259     push @{$wiki->{var}->{client}->{used_for_negotiate}}, 'Cookie';
260     }
261     $wiki->{var}->{mode} = $mode;
262     };
263 wakaba 1.21
264 wakaba 1.22 ## -- Initializing $wiki->{var} (Actual) --
265    
266     $WIKI->init_variables; ## Per-session variables
267 wakaba 1.15
268 wakaba 1.22 ## -- Instantiating WikiView --
269    
270     try {
271     $WIKI->view_in_mode
272     (mode => $WIKI->{var}->{mode},
273     method => $WIKI->{input}->meta_variable ('REQUEST_METHOD'));
274     } catch SuikaWiki::DB::Util::Error with {
275     my $err = shift;
276     $err->throw unless $err->{-type} eq 'ERROR_REPORTED';
277     } catch SuikaWiki::View::Implementation::error with {
278     my $err = shift;
279     $err->throw unless $err->{-type} eq 'ERROR_REPORTED';
280     } finally {
281     $WIKI->close_input;
282     $WIKI->close_db;
283 wakaba 1.18 };
284 wakaba 1.22 exit;
285 wakaba 1.18
286 wakaba 1.22 ## -- Terminating WikiEngine --
287 wakaba 1.14 END {
288 wakaba 1.22 $WIKI->exit;
289     }
290 wakaba 1.1
291     =head1 LICENSE
292    
293 wakaba 1.18 Copyright 2000-2003 Wakaba <w@suika.fam.cx>, et. al
294 wakaba 1.1
295     This program is free software; you can redistribute it and/or
296     modify it under the same terms as Perl itself.
297    
298     =cut
299    
300 wakaba 1.22 1; # $Date: 2003/12/26 06:51:47 $

admin@suikawiki.org
ViewVC Help
Powered by ViewVC 1.1.24