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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.21 - (show annotations) (download)
Fri Dec 26 06:51:47 2003 UTC (21 years, 6 months ago) by wakaba
Branch: MAIN
Changes since 1.20: +68 -39 lines
File MIME type: text/plain
Refined to use new interface of Message::Util::Error, Call ->init_variable after ->init_plugin and ->init_view, Database error reporting (to HTTP client) and logging is now unified

1 use strict;
2 package main;
3 binmode STDOUT; binmode STDIN;
4 our $WIKI;
5 require SuikaWiki::Plugin;
6 our %embed_command = ( # Map, main
7 form => qr/\[\[\#form(?:\(([A-Za-z0-9-]+)\))?:'((?:[^'\\]|\\.)*)':'((?:[^'\\]|\\.)*)'(?::'((?:[^'\\]|\\.)*)')?\]\]/,
8 );
9 our $database = bless {}, 'wiki::dummy';
10 require SuikaWiki::Name::Space;
11 require SuikaWiki::SrcFormat;
12
13 # [to be obsolete]
14 sub do_comment {
15 my ($content) = $main::database{$main::form{mypage}};
16 my $default_name; ## this code is not strict.
17 $default_name = $1 if $content =~ /default-name="([^"]+)"/;
18 my @time = gmtime (time);
19 my $datestr = sprintf '[WEAK[%04d-%02d-%02d %02d:%02d:%02d +00:00]]', $time[5]+1900,$time[4]+1,@time[3,2,1,0];
20 my $namestr = $main::form{myname} || $default_name || &Resource('WikiForm:WikiComment:DefaultName');
21 ($namestr = '', $datestr = '') if $main::form{myname} eq 'nodate';
22 if ($namestr =~ /^(?:>>)?[0-9]/) {
23 $namestr = qq( ''$namestr'': );
24 } elsif (length $namestr) {
25 $namestr = qq( ''[[$namestr]]'': );
26 }
27 my $anchor = &get_new_anchor_index ($content);
28 my $i = 1; my $o = 0;
29 $content =~ s{(\[\[\#r?comment\]\])}{
30 my $embed = $1;
31 if ($i == $main::form{comment_index}) {
32 if ($embed ne '[[#rcomment]]') {
33 $embed = "- [$anchor] $datestr$namestr$main::form{mymsg}\n$embed"; $o = 1;
34 } else {
35 $embed .= "\n- [$anchor] $datestr$namestr$main::form{mymsg}"; $o = 1;
36 }
37 }
38 $i++; $embed;
39 }ge;
40 unless ($o) {
41 $content = "#?SuikaWiki/0.9\n\n" unless $content;
42 $content .= "\n" unless $content =~ /\n$/s;
43 $content .= "- [$anchor] $datestr$namestr$main::form{mymsg}\n";
44 }
45 $main::form{__comment_anchor_index} = $anchor;
46 if ($main::form{mymsg} || $main::form{myname}) {
47 $main::form{mymsg} = $content;
48 $main::form{mytouch} = 'on';
49 &do_write;
50 } else { ## Don't write
51 #$main::form{mycmd} = 'default';
52 #&do_view;
53 die "No comment specified";
54 }
55 }
56
57 # [move to SuikaWiki::Plugin::WikiForm]
58 sub get_new_anchor_index ($) {
59 my $content = shift;
60 my $anchor = 0;
61 $content =~ s/^(?:[-=]+\s*)?\[([0-9]+)\]/$anchor = $1 if $1 > $anchor; $&/mge;
62 $anchor + 1;
63 }
64
65 # [move to SuikaWiki::Plugin::WikiForm]
66 sub do_wikiform {
67 my $content = $main::database{$main::form{mypage}};
68 my $anchor = &get_new_anchor_index ($content);
69 my $write = 0;
70 my $i = 1;
71 $content =~ s{$embed_command{form}}{
72 my ($embed, $wfname, $template, $option) = ($&, $1, $3, $4);
73 if (($wfname && $wfname eq $main::form{wikiform_targetform})
74 || $i == $main::form{wikiform_index}) {
75 $template =~ s/\\([\\'])/$1/g;
76 $option =~ s/\\([\\'])/$1/g;
77 my $param = bless {depth=>10}, 'SuikaWiki::Plugin';
78 $param->{page} = $main::form{mypage};
79 $param->{form_index} = $i;
80 $param->{form_name} = $wfname;
81 $param->{anchor_index} = $anchor;
82 $param->{argv} = \%main::form;
83 $param->{default_name} = $1 if $content =~ /default-name="([^"]+)"/;
84 $param->{default_name} ||= &Resource('WikiForm:WikiComment:DefaultName');
85 SuikaWiki::Plugin->formatter ('form_option')->replace ($option, $param);
86 my $t = 1;
87 for (keys %{$param->{require}||{}}) {
88 (undef $t, last) unless length $param->{argv}->{'wikiform__'.$_};
89 }
90 $t = SuikaWiki::Plugin->formatter ('form_template')->replace ($template, $param) if $t;
91 if (length $t) {
92 if ($param->{output}->{reverse}) {
93 $embed .= "\n" . $t;
94 } else {
95 $embed = $t . "\n" . $embed;
96 }
97 $write = 1;
98 $main::form{__comment_anchor_index} = $anchor
99 if $param->{anchor_index_}; ## $anchor is used!
100 }
101 $main::form{__wikiform_anchor_index} = $i;
102 undef $main::form{wikiform_targetform}; ## Make sure never to match
103 undef $main::form{wikiform_index}; ## with WikiForm in rest of page!
104 }
105 $i++; $embed;
106 }ge;
107 unless ($write) {
108 #$content = "#?SuikaWiki/0.9\n\n" unless $content;
109 #$content .= "\n" unless $content =~ /\n$/s;
110 #
111 }
112 if ($write) {
113 $main::form{mymsg} = $content;
114 $main::form{mytouch} = 'on';
115 &do_write;
116 } else { ## Don't write!
117 #$main::form{mycmd} = 'default';
118 #&do_view;
119 die "No content specified";
120 }
121 }
122
123 # [to be obsolete] ->Message::MIME::Charset
124 sub code_convert {
125 require Jcode;
126 my ($contentref, $code, $srccode) = @_;
127 $code ||= $WIKI->{config}->{charset}->{internal};
128 for ($code, $srccode) {
129 if ($_ eq 'euc-jp') { $_ = 'euc' }
130 elsif ($_ eq 'iso-2022-jp') { $_ = 'jis' }
131 elsif ($_ eq 'utf-8') { $_ = 'utf8' }
132 elsif ($_ eq 'shift_jis') { $_ = 'sjis' }
133 }
134 if ($code eq 'iso-8859-1') {
135 return $$contentref; ## TODO:
136 }
137 $$contentref = Jcode->new ($contentref, $srccode)
138 ## Normalize FULLWIDTH characters and IDEOGRAPHIC SPACE
139 ->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&,.:;?!`^_/|()[]{}+$%#*@=>< '"~-))
140 ->tr (qq(\x8E\xDE\x8E\xDF) => qq(\xA1\xAB\xA1\xAC))
141 ->h2z
142 ->$code;
143 return $$contentref;
144 }
145
146 # [to be obsolete] ->Message::Field::Date : Map
147 sub _rfc3339_date ($) {
148 my @time = gmtime (shift);
149 sprintf '%04d-%02d-%02dT%02d:%02d:%02d+00:00', $time[5]+1900,$time[4]+1,@time[3,2,1,0];
150 }
151
152 # [obsolete] ->SuikaWiki::SrcFormat : SuikaWiki09 plugin
153 sub convert_format ($$$;%) {
154 my ($content, $d => $t, %option) = @_;
155 my $f = SuikaWiki::Plugin->format_converter ($d => $t);
156 if (ref $f) {
157 $option{content} = $content;
158 $option{from} = $d;
159 $option{to} = $t;
160 &$f ({}, bless (\%option, 'SuikaWiki::Plugin'));
161 } elsif ($option{-error_no_return}) {
162 return undef;
163 } elsif ($t =~ /HTML|xml/) {
164 if (length $content) {
165 my $NS_XHTML1 = 'http://www.w3.org/1999/xhtml';
166 my $r = Message::Markup::XML::Node->new
167 (type => '#element', namespace_uri => $NS_XHTML1, local_name => 'pre');
168 $r->append_text ($content);
169 return $r;
170 } else {
171 return '';
172 }
173 } else {
174 $content;
175 }
176 }
177
178 package SuikaWiki::Plugin;
179 ## Obsolete
180 sub magic_and_content ($$) {
181 my ($magic, $page) = ('', $_[1]);
182 $magic = $1 if $page =~ s!^((?:\#\?|/\*|<\?)[^\x02\x0A\x0D]+)[\x02\x0A\x0D]+!!s;
183 ($magic, $page);
184 }
185
186 ## Obsolete
187 sub get_data ($$$$;%) {
188 my ($self, $prop, $key, %opt) = @_;
189 ## TODO: common interface to WikiDB
190 ## TODO: error recovering
191 $main::WIKI->{db}->get ($prop => $key);
192 }
193
194 package wiki::transitional::uri_param;
195 require Tie::Hash;
196 our @ISA = 'Tie::Hash';
197
198 sub TIEHASH ($@) {
199 bless {http => $_[1]}, $_[0];
200 }
201
202 sub FETCH ($$) {
203 my ($self, $key) = @_;
204 exists $self->{val}->{$key} ?
205 $self->{val}->{$key}:
206 $self->{http}->parameter ($key);
207 }
208
209 sub STORE ($$$) {
210 my ($self, $key, $val) = @_;
211 $self->{val}->{$key} = $val;
212 }
213
214 sub DELETE ($$) {
215 my ($self, $key) = @_;
216 $self->{val}->{$key} = undef;
217 }
218
219 sub EXISTS ($$) {
220 my ($self, $key) = @_;
221 exists $self->{val}->{$key} ?
222 1:
223 defined $self->{http}->parameter ($key);
224 }
225
226 package main;
227 our $VERSION = do{my @r=(q$Revision: 1.20 $=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};
228
229 $WIKI->{implementation_version} = 'hcs'.$VERSION;
230
231 ## Error output
232 require SuikaWiki::Output::CGICarp;
233 $SuikaWiki::Output::CGICarp::CUSTOM_REASON_TEXT
234 = 'Internal WikiEngine Error';
235 CGI::Carp::set_message (sub {
236 my $msg = shift;
237 #$msg =~ s/&/&amp;/g;
238 #$msg =~ s/</&lt;/g;
239 my $wiki_name_version = $WIKI->{implementation_name} .'/'. $WIKI->version;
240 for ($wiki_name_version) { s/&/&amp;/g; s/</&lt;/g;
241 s/([^\x20-\x7E])/sprintf '&#x%02X;',
242 ord $1/g; };
243 print STDOUT <<EOH;
244 <!DOCTYPE html SYSTEM>
245 <title>500 Internal WikiEngine Error</title>
246 <h1>Internal WikiEngine Error</h1>
247 <p>$msg</p>
248 <address>$wiki_name_version</address>
249 EOH
250 });
251
252 push @{$WIKI->{event}->{setting_initial_variables}}, sub {
253 my $wiki = shift;
254 $wiki->{var}->{db}->{read_only}->{'#default'} = 1;
255
256 require SuikaWiki::Input::HTTP;
257 $wiki->{input} = SuikaWiki::Input::HTTP->new (wiki => $wiki);
258 $wiki->{input}->{decoder}->{'#default'} = sub {
259 my ($http, $s, $temp_params) = @_;
260 return main::code_convert (\$s, $wiki->{config}->{charset}->{internal},
261 lc (@{$temp_params->{_charset_}||[]}[0])
262 || $wiki->{config}->{charset}->{uri_param});
263 };
264 $wiki->{var}->{client}->{user_agent_name}
265 = $wiki->{input}->meta_variable ('HTTP_USER_AGENT');
266 $wiki->{var}->{client}->{used_for_negotiate} = ['User-Agent'];
267 my $dg = SuikaWiki::Plugin->module_package ('Downgrade');
268 $dg->set_downgrade_flags ($wiki) if $dg;
269
270 ## TODO: PATH_INFO support
271 my $page = $wiki->{input}->meta_variable ('QUERY_STRING');
272 if ($page && !(index ($page, '=') > -1)) {
273 $page =~ tr/+/ /;
274 $page =~ s/%([0-9A-Fa-f][0-9A-Fa-f])/pack 'C', hex $1/ge;
275 $page = main::code_convert
276 (\$page, $wiki->{config}->{charset}->{internal},
277 $wiki->{config}->{charset}->{uri_query});
278 } else {
279 $page = $wiki->{input}->parameter ('mypage');
280 }
281
282
283 ## TODO: SuikaWiki 3 WikiName
284 $page =~ tr/\x00-\x20\x7F//d;
285 $page = SuikaWiki::Name::Space::normalize_name ($page);
286 if ($page) {
287 $wiki->{var}->{page} = [split '//', $page];
288 } else {
289 $wiki->{var}->{page} = $wiki->{config}->{page}->{Default};
290 }
291
292 ## Mode
293 my $mode = $wiki->{input}->parameter ('mode')
294 || $wiki->{input}->parameter ('mycmd') ## for compatibility with
295 || 'default'; ## YukiWiki and SuikaWiki 2
296 $mode =~ tr/-/_/;
297 if ($mode eq 'default' || $mode =~ /[^0-9A-Za-z_]/) {
298 ## BUG: this code is not strict
299 my $cookie = $wiki->{input}->meta_variable ('HTTP_COOKIE');
300 if ($cookie =~ /SelectedMode=([0-9A-Za-z_-]+)/) {
301 $mode = $1; $mode =~ tr/-/_/;
302 } else {
303 $mode = 'read';
304 }
305 push @{$wiki->{var}->{client}->{used_for_negotiate}}, 'Cookie';
306 }
307 $wiki->{var}->{mode} = $mode;
308 };
309
310 {
311 my $error_report = sub {
312 my ($wiki, $err) = @_;
313 my $report = ($err->{-def}->{level} eq 'fatal' or
314 $err->{-def}->{level} eq 'stop' or
315 $wiki->{config}->{debug}->{db}) ? 1 : 0;
316 if ($report and $wiki->{config}->{path_to}->{db__content__error_log}) {
317 my $err_msg = caller (1).($err->{-method}? '->'.$err->{-method}: '').': '
318 .(defined $err->{-file}? $err->{-file} . ': ' : '')
319 .(defined $err->{-prop}? $err->{-prop} . ': ' : '')
320 .(defined $err->{-key}? join ('//', @{$err->{-key}}).': ':'')
321 . $err->text;
322 open LOG, '>>', $wiki->{config}->{path_to}->{db__content__error_log};
323 print LOG scalar (gmtime), " @{[$$]} {$err->{-def}->{level}}: ",
324 $err_msg, "\n";
325 close LOG;
326 }
327 SuikaWiki::Plugin->module_package ('WikiDB')
328 ->reporting_error ($err, $wiki) if $report;
329 if ($err->{-def}->{level} eq 'fatal' or $err->{-def}->{level} eq 'stop') {
330 $wiki->view_in_mode (mode => '-wdb--fatal-error');
331 throw SuikaWiki::DB::Util::Error -type => 'ERROR_REPORTED';
332 }
333 };
334 unshift @{$WIKI->{event}->{database_loaded}}, sub {
335 my $wiki = shift;
336 unshift @{$wiki->{db}->{event}->{error}}, sub {
337 my ($db, $event) = @_;
338 $error_report->($wiki, $event->{error});
339 if ($event->{error}->{-type} eq 'INFO_DB_PROP_OPENED') {
340 unshift @{$db->{prop}->{$event->{error}->{prop}}->{-db}
341 ->{event}->{error}}, sub {
342 my ($db, $event) = @_;
343 $error_report->($wiki, $event->{error});
344 };
345 }
346 }; # database error
347 }; # database_loaded
348 }
349
350 if ($WIKI->{config}->{debug}->{general}) {
351 $main::SIG{__WARN__} = sub {
352 push @{$WIKI->{var}->{error}||=[]}, {
353 description => Message::Markup::XML::Node->new
354 (type => '#text',
355 value => $_[0]),
356 };
357 };
358 }
359
360 push @{$WIKI->{event}->{view_in_mode}}, sub {
361 my ($wiki, $opt) = @_;
362 my $arg = {condition => {mode => $opt->{mode} || '-error',
363 output => 'http-cgi',
364 http_method => $opt->{method} || 'GET'}};
365 my $viewobj = $wiki->{view}->instantiate ($opt->{mode} || '-error', $arg);
366 if (ref $viewobj) {
367 $viewobj->main ($arg);
368 } elsif ($opt->{mode} ne '-error') {
369 $wiki->view_in_mode (mode => '-error', method => 'GET');
370 ## TODO: cache control for non-GET
371 } else {
372 die "Some error happens. Additionally, error reporting mode not defined";
373 }
374 };
375
376 $WIKI->init_plugin; ## WikiPlugin manager
377 $WIKI->init_view; ## WikiView manager
378 $WIKI->{view}->register_common_modes;
379
380 ## Error handlers
381 use SuikaWiki::DB::Util::Error;
382 my $catcher = catch SuikaWiki::DB::Util::Error with {
383 my $err = shift;
384 exit if $err->{-type} eq 'ERROR_REPORTED';
385 $err->throw;
386 } catch SuikaWiki::View::Implementation::error with {
387 my $err = shift;
388 exit if $err->{-type} eq 'ERROR_REPORTED';
389 $err->throw;
390 };
391
392 $WIKI->{config}->{catch}->{formatter_view}
393 = catch Message::Util::Formatter::error with {
394 my $err = shift;
395 my $wiki = $err->{-option}->{param}->{wiki};
396 SuikaWiki::Plugin->module_package ('Error')
397 ->reporting_formatting_template_error ($err, $wiki);
398 $wiki->view_in_mode (mode => '-error', method => 'GET');
399 throw SuikaWiki::View::Implementation::error
400 -type => 'ERROR_REPORTED';
401 };
402
403 $WIKI->{config}->{catch}->{formatter_view_error}
404 = catch Message::Util::Formatter::error with {
405 my $err = shift;
406 my $wiki = $err->{-option}->{param}->{wiki};
407 SuikaWiki::Plugin->module_package ('Error')
408 ->reporting_formatting_template_error ($err, $wiki);
409 $wiki->view_in_mode (mode => '-error-error', method => 'GET');
410 throw SuikaWiki::View::Implementation::error
411 -type => 'ERROR_REPORTED';
412 };
413
414 ## Main
415 $WIKI->init_variables; ## Per-session variables
416 try {
417 $WIKI->view_in_mode
418 (mode => $WIKI->{var}->{mode},
419 method => $WIKI->{input}->meta_variable ('REQUEST_METHOD'));
420 } $catcher;
421 exit;
422 END {
423 try {
424 $WIKI->exit;
425 } $catcher;
426 };
427
428 =head1 NAME
429
430 lib/suikawiki.pl --- SuikaWiki : WikiEngine driver for HTTP CGI
431
432 =head1 LICENSE
433
434 Copyright 2000-2003 Wakaba <w@suika.fam.cx>, et. al
435
436 This program is free software; you can redistribute it and/or
437 modify it under the same terms as Perl itself.
438
439 =cut
440
441 1; # $Date: 2003/12/06 02:22:10 $

admin@suikawiki.org
ViewVC Help
Powered by ViewVC 1.1.24