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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.5 - (show annotations) (download)
Wed May 7 08:57:34 2003 UTC (22 years ago) by wakaba
Branch: MAIN
Changes since 1.4: +20 -214 lines
File MIME type: text/plain
Move some functions to plugin module

1 # -*- perl -*-
2 use strict;
3
4 package main;
5 our $VERSION = '2.'.do{my @r=(q$Revision: 1.4 $=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};
6 binmode STDOUT; binmode STDIN;
7 use Fcntl;
8 require Yuki::YukiWikiCache;
9 require SuikaWiki::Name::Space;
10 require SuikaWiki::View;
11 require SuikaWiki::Plugin;
12 our %fmt; ## formatter objects
13 our %embed_command = (
14 form => qr/\[\[\#form(?:\(([A-Za-z0-9-]+)\))?:'((?:[^'\\]|\\.)*)':'((?:[^'\\]|\\.)*)'(?::'((?:[^'\\]|\\.)*)')?\]\]/,
15 );
16 our ($modifier_dbtype,$url_cgi,%uri,%PathTo);
17 our (%PageName,$kanjicode,$lang);
18
19 my %form;
20 our %database;
21 our $database = bless {}, 'wiki::dummy';
22 our %interwiki;
23 my %command_do = (
24 default => \&do_view,
25 adminchangepassword => \&do_adminchangepassword,
26 write => \&do_write,
27 searchform => \&do_searchform,
28 comment => \&do_comment,
29 RandomJump => \&do_random_jump,
30 wikiform => \&do_wikiform,
31 );
32 our $UA = ''; ## User agent name
33 $| = 1;
34 my $HAS_XML = SuikaWiki::Plugin->feature ('SuikaWiki::Markup::XML');
35 my $NS_XHTML1 = 'http://www.w3.org/1999/xhtml';
36
37 sub main {
38 $UA = $main::ENV{HTTP_USER_AGENT};
39 &open_db;
40 &init_form;
41 if ($command_do{$form{mycmd}}) {
42 &{$command_do{$form{mycmd}}};
43 } else {
44 &{$command_do{default}};
45 }
46 &close_db;
47 }
48
49 sub do_view {
50 my $content = $database{$form{mypage}};
51 my $lm = $database->mtime ($form{mypage});
52 wiki::referer::add ($form{mypage}, $ENV{HTTP_REFERER});
53 wiki::useragent::add ($ENV{HTTP_USER_AGENT});
54 &load_formatter ('view');
55 my $view = $form{mycmd};
56 if ($view eq 'edit') {
57 $view = 'adminedit' if $form{admin};
58 } elsif ($view =~ /[^0-9A-Za-z_]/) {
59 $view = 'default'
60 }
61 if ($view eq 'default' || !$view) {
62 ## BUG: this code is not strict
63 if ($main::ENV{HTTP_COOKIE} =~ /SelectedMode=([0-9A-Za-z]+)/) {
64 $view = $1;
65 } else {
66 $view = 'read';
67 }
68 }
69 my ($magic, $content) = &SuikaWiki::Plugin::magic_and_content (undef, $content);
70 $magic ||= '#?SuikaWiki/0.9';
71 my $o = bless {param => \%form, page => $form{mypage}, toc => [],
72 magic => $magic, content => $content,
73 formatter => $fmt{view}, &_compatible_options ()}, 'SuikaWiki::Plugin';
74 my $view_def = SuikaWiki::View->definition ($view);
75 if (!$view_def->check ($o)) {
76 print "Status: 406 Unsupported Media Type\n";
77 $view = '-UnsupportedMediaType';
78 $view_def = SuikaWiki::View->definition ($view);
79 }
80 my $media = $view_def->properties->{media};
81 if ($view_def->properties->{xmedia} && $UA =~ /Gecko/) {
82 $media = $view_def->properties->{xmedia};
83 $o->{media} = $media;
84 } elsif ($UA =~ m#Mozilla/0\..+Windows#) {
85 $kanjicode = 'shift_jis';
86 }
87 if ($magic =~ m!^\#\?SuikaWiki/0.9!) {
88 &print_header ($form{mypage}, -last_modified => ($magic =~ /interactive="yes"/ ? time : $lm),
89 -expires => ($magic =~ /interactive="yes"/ ? 1 : undef), o => $o,
90 -media => $media, -magic => $magic, content => $content);
91 } else {
92 &print_header($form{mypage}, -media => $media,
93 -magic => $magic, -last_modified => $lm, o => $o);
94 }
95 if ($kanjicode ne 'euc') {
96 my $s = $fmt{view}->replace ($view_def->as_string => $o, {formatter => $fmt{view}});
97 print &code_convert (\$s => $kanjicode);
98 } else {
99 print $fmt{view}->replace ($view_def->as_string => $o, {formatter => $fmt{view}});
100 }
101 }
102
103 sub _do_view_msg (%) {
104 my %option = @_;
105 &load_formatter ('view');
106 my $o = bless {param => \%form, page => $option{-page}, toc => [], condition => \%option,
107 formatter => $fmt{view}, &_compatible_options ()}, 'SuikaWiki::Plugin';
108 my $view_def = SuikaWiki::View->definition ($option{-view});
109 unless ($view_def->check ($o)) {
110 print "Status: 406 Unsupported Media Type\n";
111 $option{-view} = '-UnsupportedMediaType';
112 $view_def = SuikaWiki::View->definition ($option{-view});
113 }
114 my $media = $view_def->properties->{media};
115 if ($view_def->properties->{xmedia} && $UA =~ /Gecko/) {
116 $media = $view_def->properties->{xmedia};
117 $o->{media} = $media;
118 }
119 &print_header($option{-page}, -media => $media, o => $o, -goto => $option{-goto});
120 print $fmt{view}->replace ($view_def->as_string => $o, {formatter => $fmt{view}});
121 }
122
123 sub do_adminchangepassword {
124 if ($form{mynewpassword} ne $form{mynewpassword2}) {
125 &_do_view_msg (-view => '-error', -page => $form{mypage},
126 error_message => &Resource ('Error:PasswordMismatch'));
127 return;
128 }
129 my ($validpassword_crypt) = $database->meta (AdminPassword => $PageName{AdminSpecialPage});
130 if ($validpassword_crypt) {
131 if (not &valid_password($form{myoldpassword})) {
132 &_do_view_msg (-view => '-error', -page => $form{mypage},
133 error_message => &Resource ('Error:PasswordIsIncorrect'));
134 return;
135 }
136 }
137 my ($sec, $min, $hour, $day, $mon, $year, $weekday) = localtime(time);
138 my (@token) = ('0'..'9', 'A'..'Z', 'a'..'z');
139 my $salt1 = $token[(time | $$) % scalar(@token)];
140 my $salt2 = $token[($sec + $min*60 + $hour*60*60) % scalar(@token)];
141 my $crypted = crypt($form{mynewpassword}, "$salt1$salt2");
142 $database->meta (AdminPassword => $PageName{AdminSpecialPage} => $crypted);
143
144 &_do_view_msg (-view => '-wrote', -page => $form{mypage});
145 }
146
147 sub valid_password ($) {
148 my ($validpassword_crypt) = $database->meta (AdminPassword => $PageName{AdminSpecialPage});
149 return crypt (shift, $validpassword_crypt) eq $validpassword_crypt ? 1 : 0;
150 }
151
152 sub do_write {
153 if (&frozen_reject()) {
154 return;
155 }
156
157 if (not &is_editable($form{mypage})) {
158 &_do_view_msg (-view => '-error', -page => $form{mypage},
159 error_message => &Resource ('Error:ThisPageIsUneditable'));
160 return;
161 }
162
163 ## Check confliction
164 if ($form{myLastModified} ne $database->mtime ($form{mypage})) {
165 &_do_view_msg (-view => '-conflict', -page => $form{mypage});
166 return;
167 }
168
169 if ($form{mymsg}) {
170 if ($form{mytouch} || !ref $database) {
171 $database{$form{mypage}} = $form{mymsg};
172 } else {
173 $database->STORE ($form{mypage} => $form{mymsg}, -touch => 0);
174 }
175 $database->meta (IsFrozen => $form{mypage} => 0 + $form{myfrozen});
176 my $fragment = '';
177 $fragment .= qq(;after_edit_cmd=@{[&encode($form{after_edit_cmd})]}) if $form{after_edit_cmd};
178 if ($form{__comment_anchor_index}) {
179 $fragment .= qq(#anchor-$form{__comment_anchor_index});
180 } elsif ($form{__wikiform_anchor_index}) {
181 $fragment .= qq(#wikiform-$form{__wikiform_anchor_index});
182 }
183 &_do_view_msg (-view => '-wrote', -page => $form{mypage}, -goto => $url_cgi.'?mycmd='.&encode($form{after_edit_cmd}||'default').';mypage='.&encode($form{mypage}).qq(;x-param=@{[time.[0..9]->[rand 10]]}$fragment));
184 } else {
185 delete $database{$form{mypage}};
186 &_do_view_msg (-view => '-deleted', -page => $form{mypage});
187 }
188 }
189
190 sub _compatible_options () {
191 (use_anchor_name => ($UA =~ m#Mozilla/[12]\.|Microsoft Internet Explorer# ? 1 : 0));
192 }
193
194 sub get_search_result ($;%) {
195 my $word = lc shift;
196 my $SearchResult = SuikaWiki::Plugin->cache ('search');
197 my %option = @_;
198 my @r;
199 unless (defined $SearchResult->{$word}) {
200 for my $page (keys %database) {
201 next if !$option{-match_myself} && ($page eq $word);
202 my $content = lc $database{$page};
203 $content =~ s/^[^\x0A\x0D]+[\x0D\x0A]+//s;
204 if (index (lc $page, $word) > -1) {
205 my $c = $content =~ s/\Q$word\E//g;
206 push @r, [$page, $c+20];
207 } elsif (index ($word, lc $page) > -1) {
208 my $c = $content =~ s/\Q$word\E//g;
209 push @r, [$page, $c+10];
210 } elsif (my $c = $content =~ s/\Q$word\E//g) {
211 push @r, [$page, $c];
212 }
213 }
214 @r = sort {$b->[1] <=> $a->[1] || $a->[0] cmp $b->[0]} @r;
215 $SearchResult->{$word} = join "\x1E", map {$_->[0]."\x1F".$_->[1]} @r;
216 } else {
217 @r = map {[split /\x1F/, $_, 2]} split /\x1E/, $SearchResult->{$word};
218 }
219 #my $em = sub { my $s = shift; $s =~ s#(\Q$word\E)#<em>$1</em>#gi; $s };
220 my $r = join "\n", map {qq(<li>[$_->[1]] <a href ="$url_cgi?@{[&encode($_->[0])]}" class="wiki">@{[&escape($_->[0])]}</a> <span class="wikipage-summary">@{[&escape(&get_subjectline($_->[0]))]}</span></li>)} @r;
221 $r = qq|<ul class="search-result">$r</ul>| if $r;
222 wantarray? ($r, scalar @r): $r;
223 }
224
225 sub do_random_jump {
226 my @list = keys %database;
227 my $name = &encode ($list[rand @list]);
228 print "Location: $uri{wiki}?$name\n";
229 print "\n";
230 }
231
232 sub print_header ($;%) {
233 my ($page, %option) = @_;
234 my @head;
235 $option{o}->{-header}->{class} = &is_frozen($page) ? 'frozen' : '';
236 $option{o}->{-header}->{class} .= " wiki-page-obsoleted" if $option{-magic} =~ /obsoleted="yes"/;
237 if ($option{-goto}) {
238 if ($UA =~ m#Opera|MSIE 2\.#) {
239 ## WARNING: This code may output unsafe HTML document if
240 ## $option{-goto} is not clean.
241 $option{-goto} =~ tr/;/&/ if $UA =~ m#Opera#;
242 print qq{Refresh: 0; url=$option{-goto}\n};
243 push @head, qq(<meta http-equiv="refresh" content="0; url=$option{-goto}">);
244 } elsif ($UA =~ /Gecko/) {
245 print qq{Refresh: 0; url="$option{-goto}"\n};
246 push @head, qq(<meta http-equiv="refresh" content="0; url=&quot;@{[&escape($option{-goto})]}&quot;" />);
247 } else {
248 $option{-goto} =~ tr/;/&/ if $UA =~ m#Mozilla/[1-4]\.#;
249 print qq{Refresh: 0; url="$option{-goto}"\n};
250 push @head, qq(<meta http-equiv="refresh" content="0; url=&quot;@{[&escape($option{-goto})]}&quot;">);
251 }
252 }
253 print qq{Last-Modified: @{[scalar gmtime $option{-last_modified}]}\n} if $option{-last_modified};
254 if ($option{-expires} != -1) {
255 if (defined $option{-expires}) { ## TODO: Don't use asctime
256 print qq{Expires: @{[scalar gmtime (time + $option{-expires})]}\n};
257 } elsif ($option{-media}->{expires} != -1) {
258 print qq{Expires: @{[scalar gmtime (time + $option{-media}->{expires})]}\n};
259 }
260 }
261 if ($option{-media}->{charset} && $UA =~ m#Mozilla/[12]\.#) {
262 my $ct = qq{$option{-media}->{type}; charset=@{[&get_charset_name($kanjicode,compatible=>1)]}};
263 print qq{Content-Type: $ct\n};
264 $option{o}->{-header}->{meta_ct} = qq{<meta http-equiv="content-type" content="$ct">\n};
265 } elsif (!$option{-media}->{charset} || $UA =~ m#Infomosaic|Mozilla/0\.#) {
266 print qq{Content-Type: $option{-media}->{type}\n};
267 $option{o}->{-header}->{meta_ct} = qq{<meta http-equiv="content-type" content="$option{-media}->{type}; charset=@{[&get_charset_name($kanjicode,compatible=>1)]}">\n};
268 } else {
269 my $type = $option{-media}->{type};
270 $type = 'application/xml' if ($type =~ m!^application/(?:rdf|rss)\+xml$!) && ($UA =~ m#Gecko#);
271 print qq{Content-Type: $type; charset=@{[&get_charset_name($kanjicode)]}\n};
272 }
273 #if ($main::ENV{HTTP_IF_MODIFIED_SINCE}) {
274 ## TODO: IMS support
275 #}
276
277 ## TODO: more Vary: support
278 print <<"EOD";
279 Vary: Negotiate,User-Agent,Accept-Language
280 Content-Style-Type: text/css
281
282 EOD
283 $option{o}->{-header}->{links} = join "\n", (@head);
284 }
285
286 sub get_charset_name ($;%) {
287 my ($charset, %option) = (lc shift, @_);
288 if ($charset =~ 'euc') {
289 $charset = $option{compatible} ? 'x-euc-jp' : 'euc-jp';
290 } elsif ($charset =~ 'sjis' || $charset =~ 'shift') {
291 $charset = $option{compatible} ? 'x-sjis' : 'shift_jis';
292 } elsif ($charset =~ 'jis') {
293 $charset = 'iso-2022-jp';
294 }
295 $charset;
296 }
297
298 sub escape {
299 my $s = shift;
300 $s =~ s|&|&amp;|g;
301 $s =~ s|<|&lt;|g;
302 $s =~ s|>|&gt;|g;
303 $s =~ s|"|&quot;|g;
304 return $s;
305 }
306
307 sub unescape {
308 my $s = shift;
309 $s =~ s|&lt;|<|g;
310 $s =~ s|&gt;|>|g;
311 $s =~ s|&quot;|"|g;
312 $s =~ s|&amp;|&|g;
313 return $s;
314 }
315
316 sub convert_format ($$$;%) {
317 my ($content, $d => $t, %option) = @_;
318 my $f = SuikaWiki::Plugin->format_converter ($d => $t);
319 if (ref $f) {
320 $option{content} = $content;
321 $option{from} = $d;
322 $option{to} = $t;
323 &$f ({}, bless (\%option, 'SuikaWiki::Plugin'));
324 } elsif ($option{-error_no_return}) {
325 return undef;
326 } elsif ($t =~ /HTML|xml/) {
327 length $content ? '<pre>'.&escape($content).'</pre>' : '';
328 } else {
329 $content;
330 }
331 }
332
333 {my %FormIndex;
334 sub make_custom_form ($$$$%) {
335 my ($wfname, $definition, $template, $foption, $option) = @_;
336 ## $template is currently not used in this procedure.
337 #unless ($main::_EMBEDED) {
338 $FormIndex{$option->{page}}++;
339 if (length $definition) {
340 my $param = bless {depth=>10}, 'SuikaWiki::Plugin';
341 my $lastmodified = $database->mtime ($option->{page});
342 &load_formatter (qw/form_input form_option/);
343 $definition = &unescape ($definition);
344 $definition =~ s/\\(['\\])/$1/g;
345 $foption = &unescape ($foption);
346 $foption =~ s/\\(['\\])/$1/g;
347 $fmt{form_option}->replace ($foption, $param);
348 $param->{output}->{form} = 1 unless defined $param->{output}->{form};
349 $param->{output}->{form} = 0 if $main::_EMBEDED;
350 $definition .= ' %submit;' if $definition !~ /%submit/ && !$param->{output}->{nosubmit} && $param->{output}->{form};
351 $param->{output}->{page} ||= $option->{page};
352 $param->{form_disabled} = 1 if $database->meta (IsFrozen => $option->{page});
353 my $target_form = $param->{output}->{id};
354 my $r = '';
355 $r = <<EOH if $param->{output}->{form};
356 <form method="post" action="$url_cgi" id="wikiform-$FormIndex{$option->{page}}" class="wikiform">
357 <input type="hidden" name="mycmd" value="@{[$param->{form_disabled}?'default':'wikiform']}" />
358 <input type="hidden" name="mypage" value="@{[&escape($param->{output}->{page})]}" />
359 <input type="hidden" name="myLastModified" value="$lastmodified" />
360 <input type="hidden" name="mytouch" value="on" />
361 <input type="hidden" name="@{[$target_form? qq(wikiform_targetform" value="@{[&escape($target_form)]}) : qq(wikiform_index" value="$FormIndex{$option->{page}})]}" />
362 EOH
363 $r .= qq(<a name="wikiform-$FormIndex{$option->{page}}"></a>) if $UA =~ m#Mozilla/[12]\.#;
364 $r .= $fmt{form_input}->replace ($definition, $param);
365 $r .= "</form>\n" if $param->{output}->{form};
366 $r;
367 } else { ## No input-interface WikiForm
368 qq(<a id="wikiform-$FormIndex{$option->{page}}" name="wikiform-$FormIndex{$option->{page}}"><!-- #form --></a>);
369 }
370 #} else {
371 # qq(<ins class="wiki-error">@{[&Resource('Error:WikiForm:EmbedIsNotSupported',escape=>1)]}</ins>);
372 #}
373 }}
374
375 sub init_form {
376 ## TODO: Support multipart/form-data
377 my $query = '';
378 if (uc $main::ENV{REQUEST_METHOD} eq 'POST') {
379 if (lc ($main::ENV{CONTENT_TYPE}) eq 'application/x-www-form-urlencoded'
380 || lc ($main::ENV{CONTENT_TYPE}) eq 'application/sgml-form-urlencoded') {
381 read STDIN, $query, $main::ENV{CONTENT_LENGTH};
382 } else {
383 $form{mycmd} = '___unsupported_media_type___';
384 $form{mypage} = $PageName{FrontPage};
385 return;
386 }
387 }
388 $query .= ($query ? ';' : '') . $main::ENV{QUERY_STRING};
389 if ($main::ENV{REQUEST_METHOD} ne 'POST' && $main::ENV{QUERY_STRING} && $main::ENV{QUERY_STRING} !~ /[&;=]/) {
390 my $query = &decode($main::ENV{QUERY_STRING});
391 $query = &code_convert(\$query, $kanjicode);
392 $form{mypage} = $query;
393 $form{mycmd} = 'default';
394 } else {
395 for (split /[;&]/, $query) {
396 if (my ($n, $v) = split /=/, $_, 2) {
397 for ($n, $v) {tr/+/ /; s/%([0-9A-Fa-f][0-9A-Fa-f])/pack 'C', hex $1/ge};
398 $form{$n} = $v;
399 }
400 }
401 unless (defined $form{mypage}) {
402 $form{mypage} = $form{epage};
403 $form{mypage} =~ s/([0-9A-F]{2})/ord hex $1/g;
404 }
405 $form{mypage} = &code_convert (\$form{mypage}, $kanjicode);
406 }
407 $form{mypage} ||= $PageName{FrontPage};
408 $form{mypage} =~ tr/\x00-\x1F\x7F//d;
409 $form{mypage} = SuikaWiki::Name::Space::normalize_name ($form{mypage});
410 $form{mycmd} ||= 'default';
411 $form{mycmd} =~ tr/-/_/;
412
413 # mypreview_edit -> do_edit, with preview.
414 # mypreview_adminedit -> do_adminedit, with preview.
415 # mypreview_write -> do_write, without preview.
416 foreach (keys %form) {
417 if (/^mypreview_(.*)$/) {
418 $form{mycmd} = $1;
419 $form{mypreview} = 1;
420 }
421 }
422
423 #
424 # $form{mycmd} is frozen here.
425 #
426
427 for (grep /^(?:wikiform__|pi_)/, keys %form) {
428 $form{$_} = &code_convert (\$form{$_}, $kanjicode);
429 }
430 $form{mymsg} = &code_convert(\$form{mymsg}, $kanjicode);
431 $form{myname} = &code_convert(\$form{myname}, $kanjicode);
432 }
433
434 sub get_subjectline {
435 my ($page, %option) = @_;
436 my $SubjectLine = SuikaWiki::Plugin->cache ('headline');
437 unless (defined $SubjectLine->{$page}) {
438 if (not &is_editable($page)) {
439 $SubjectLine->{$page} = "";
440 } else {
441 $SubjectLine->{$page} = do {
442 my $s=$database{$page};
443 $s =~ s!^\#\?[^\x0A\x0D]+[\x0A\x0D]*!!s;
444 $s =~ s/\x0D?\x0A.*//s;
445 $s =~ s/^[-=]*\s*\[\d+\]\s*//;
446 $s =~ s/'''?//g;
447 $s =~ s/\[[A-Z]+(?:\([^)]+\))?\[([^]]+)\](?:\s\[([^]]+)\])?\]/$1$2/g;
448 $s =~ s/\[\[([^]]+)\]\]/$1/g;
449 $s};
450 }
451 }
452 if (length $SubjectLine->{$page}) {
453 $option{delimiter} = defined $option{delimiter} ? $option{delimiter} : &Resource('Title-Summary Delimiter');
454 $option{delimiter}.$SubjectLine->{$page}.$option{tail};
455 } else {
456 '';
457 }
458 }
459
460 sub open_db {
461 if ($modifier_dbtype eq 'dbmopen') {
462 dbmopen(%database, $PathTo{WikiDataBase}, 0666) or die "(dbmopen) $PathTo{WikiDataBase}";
463 } elsif ($modifier_dbtype eq 'AnyDBM_File') {
464 eval q{use AnyDBM_File};
465 tie(%database, "AnyDBM_File", $PathTo{WikiDataBase}, O_RDWR|O_CREAT, 0666) or die ("(tie AnyDBM_File) $PathTo{WikiDataBase}");
466 } elsif ($modifier_dbtype eq 'Yuki::YukiWikiDB') {
467 eval q{use Yuki::YukiWikiDB};
468 tie(%database, "Yuki::YukiWikiDB", $PathTo{WikiDataBase}) or die ("(tie Yuki::YukiWikiDB) $PathTo{WikiDataBase}");
469 } else { ## Yuki::YukiWikiDB || Yuki::YukiWikiDBMeta
470 eval qq{use $modifier_dbtype};
471 $database = tie(%database, $modifier_dbtype => $PathTo{WikiDataBase}, -lock => 2, -backup => $wiki::diff::UseDiff) or die ("(tie $modifier_dbtype) $PathTo{WikiDataBase}");
472 }
473 }
474
475 sub close_db {
476 if ($modifier_dbtype eq 'dbmopen') {
477 dbmclose(%database);
478 } else {
479 untie(%database);
480 }
481 }
482
483 sub editform (@) {
484 my %option = @_;
485 my $frozen = &is_frozen ($option{page});
486 $option{content} = $database{$option{page}} unless defined $option{content};
487 $option{content} = $database{NewPageTemplate} unless length $option{content};
488 $option{last_modified} = $database->mtime ($option{page}) unless defined $option{last_modified};
489 my $f = '';
490 my $magic = '';
491 $magic = $1 if $option{content} =~ m/^([^\x0A\x0D]+)/s;
492
493 my $selected = 'default';
494 if ($form{after_edit_cmd}) {
495 $selected = $form{after_edit_cmd};
496 } elsif ($magic =~ /Const|Config|CSS/) {
497 $selected = 'edit';
498 }
499 my $afteredit = <<EOH;
500 <select name="after_edit_cmd">
501 <option value="default" label="@{[&Resource('Edit:SaveAndDefault',escape=>1)]}"@{[$selected eq 'default' ? ' selected="selected"':'']}>@{[&Resource('Edit:SaveAndDefault',escape=>1)]}</option>
502 <option value="read" label="@{[&Resource('Edit:SaveAndView',escape=>1)]}"@{[$selected eq 'read' ? ' selected="selected"':'']}>@{[&Resource('Edit:SaveAndView',escape=>1)]}</option>
503 <option value="edit" label="@{[&Resource('Edit:SaveAndEdit',escape=>1)]}"@{[$selected eq 'edit' ? ' selected="selected"':'']}>@{[&Resource('Edit:SaveAndEdit',escape=>1)]}</option>
504 </select>
505 EOH
506 $f .= <<"EOD";
507 <form action="$uri{wiki}" method="post">
508 @{[ $option{conflict} ? '' : qq(<label><input type="submit" name="mypreview_write" value="@{[&Resource('Edit:Save',escape=>1)]}" /><kbd>S</kbd></label>) ]}
509 @{[ $option{admin} ? qq(<label>@{[&Resource('Edit:Password=',escape=>1)]}<input type="password" name="mypassword" value="" size="10" /></label>) : "" ]} [@{[&get_new_anchor_index($option{content})]}]<br />
510 <input type="hidden" name="myLastModified" value="$option{last_modified}" />
511 <input type="hidden" name="mypage" value="@{[&escape($form{mypage})]}" />
512 <textarea cols="@{[&Resource('Edit:Form:Cols')+0||80]}" rows="@{[&Resource('Edit:Form:Rows')+0||20]}" name="mymsg" tabindex="1">@{[&escape($option{content})]}</textarea><br />
513 @{[
514 $option{admin} ?
515 qq(
516 <label><input type="radio" name="myfrozen" value="1" @{[$frozen ? qq(checked="checked") : ""]} />@{[&Resource('Edit:Freeze',escape=>1)]}</label>
517 <label><input type="radio" name="myfrozen" value="0" @{[$frozen ? "" : qq(checked="checked")]} />@{[&Resource('Edit:DontFreeze',escape=>1)]}</label><br />)
518 : ""
519 ]}
520 @{[
521 $option{conflict} ? "" :
522 qq(
523 <label><input type="checkbox" name="mytouch" value="on" checked="checked" />@{[&Resource('Edit:UpdateTimeStamp',escape=>1)]}</label><br />
524 <label><input type="submit" name="mypreview_write" value="@{[&Resource('Edit:Save',escape=>1)]}" accesskey="S" /><kbd>S</kbd></label>
525 $afteredit
526 )
527 ]}
528 </form>
529 EOD
530 $f;
531 }
532
533 sub is_editable {
534 my ($page) = @_;
535 return 0 unless SuikaWiki::Name::Space::validate_name ($page);
536 return 0 if $page =~ /[\x00-\x20\[\]\x7F]/;
537 1;
538 }
539
540 sub decode {
541 my ($s) = @_;
542 $s =~ tr/+/ /;
543 $s =~ s/%([A-Fa-f0-9][A-Fa-f0-9])/pack("C", hex($1))/eg;
544 return $s;
545 }
546
547 sub encode {
548 my $s = shift;
549 $s =~ s/([^0-9A-Za-z_-])/sprintf '%%%02X', ord $1/ge;
550 $s;
551 }
552
553 sub get_now {
554 my ($sec, $min, $hour, $day, $mon, $year) = localtime(time);
555 $year += 1900;
556 $mon++;
557 $mon = "0$mon" if $mon < 10;
558 $day = "0$day" if $day < 10;
559 $hour = "0$hour" if $hour < 10;
560 $min = "0$min" if $min < 10;
561 #$sec = "0$sec" if $sec < 10;
562 return "$year-$mon-$day $hour:$min";
563 }
564
565 sub frozen_reject {
566 my ($isfrozen) = $database->meta (IsFrozen => $form{mypage});
567 my ($willbefrozen) = $form{myfrozen};
568 if (not $isfrozen and not $willbefrozen) {
569 # You need no check.
570 return 0;
571 } elsif (valid_password($form{mypassword})) {
572 # You are admin.
573 return 0;
574 } else {
575 &_do_view_msg (-view => '-error', -page => $form{mypage},
576 error_message => &Resource ('Error:PasswordIsIncorrect'));
577 exit;
578 }
579 }
580
581 sub is_frozen ($) { $database->meta (IsFrozen => $_[0]) ? 1 : 0 }
582
583 sub do_comment {
584 my ($content) = $database{$form{mypage}};
585 my $default_name; ## this code is not strict.
586 $default_name = $1 if $content =~ /default-name="([^"]+)"/;
587 my $datestr = '[WEAK['.&get_now.']]';
588 my $namestr = $form{myname} || $default_name || &Resource('WikiForm:WikiComment:DefaultName');
589 ($namestr = '', $datestr = '') if $form{myname} eq 'nodate';
590 if ($namestr =~ /^(?:>>)?[0-9]/) {
591 $namestr = qq( ''$namestr'': );
592 } elsif (length $namestr) {
593 $namestr = qq( ''[[$namestr]]'': );
594 }
595 my $anchor = &get_new_anchor_index ($content);
596 my $i = 1; my $o = 0;
597 $content =~ s{(\[\[\#r?comment\]\])}{
598 my $embed = $1;
599 if ($i == $form{comment_index}) {
600 if ($embed ne '[[#rcomment]]') {
601 $embed = "- [$anchor] $datestr$namestr$form{mymsg}\n$embed"; $o = 1;
602 } else {
603 $embed .= "\n- [$anchor] $datestr$namestr$form{mymsg}"; $o = 1;
604 }
605 }
606 $i++; $embed;
607 }ge;
608 unless ($o) {
609 $content = "#?SuikaWiki/0.9\n\n" unless $content;
610 $content .= "\n" unless $content =~ /\n$/s;
611 $content .= "- [$anchor] $datestr$namestr$form{mymsg}\n";
612 }
613 $form{__comment_anchor_index} = $anchor;
614 if ($form{mymsg} || $form{myname}) {
615 $form{mymsg} = $content;
616 $form{mytouch} = 'on';
617 &do_write;
618 } else { ## Don't write
619 $form{mycmd} = 'default';
620 &do_view;
621 }
622 }
623
624 sub get_new_anchor_index ($) {
625 my $content = shift;
626 my $anchor = 0;
627 $content =~ s/^(?:[-=]+\s*)?\[([0-9]+)\]/$anchor = $1 if $1 > $anchor; $&/mge;
628 $anchor + 1;
629 }
630
631 sub load_formatter (@) {
632 for my $t (@_) {
633 unless ($fmt{$t}) {
634 require Message::Util::Formatter;
635 $fmt{$t} = Message::Util::Formatter->new;
636 for (@{$SuikaWiki::Plugin::List{'wiki'.$t}||[]}) {
637 $_->load_formatter ($fmt{$t}, type => 'wiki'.$t);
638 }
639 $fmt{$t}->option (return_class => 'SuikaWiki::Markup::XML') if $HAS_XML;
640 }
641 }
642 }
643
644 sub do_wikiform {
645 my $content = $database{$form{mypage}};
646 my $anchor = &get_new_anchor_index ($content);
647 &load_formatter (qw/form_template form_option/);
648 my $write = 0;
649 my $i = 1;
650 $content =~ s{$embed_command{form}}{
651 my ($embed, $wfname, $template, $option) = ($&, $1, $3, $4);
652 if (($wfname && $wfname eq $form{wikiform_targetform})
653 || $i == $form{wikiform_index}) {
654 $template =~ s/\\([\\'])/$1/g;
655 $option =~ s/\\([\\'])/$1/g;
656 my $param = bless {depth=>10}, 'SuikaWiki::Plugin';
657 $param->{page} = $form{mypage};
658 $param->{form_index} = $i;
659 $param->{form_name} = $wfname;
660 $param->{anchor_index} = $anchor;
661 $param->{argv} = \%form;
662 $param->{default_name} = $1 if $content =~ /default-name="([^"]+)"/;
663 $param->{default_name} ||= &Resource('WikiForm:WikiComment:DefaultName');
664 $fmt{form_option}->replace ($option, $param);
665 my $t = 1;
666 for (keys %{$param->{require}||{}}) {
667 (undef $t, last) unless length $param->{argv}->{'wikiform__'.$_};
668 }
669 $t = $fmt{form_template}->replace ($template, $param) if $t;
670 if (length $t) {
671 if ($param->{output}->{reverse}) {
672 $embed .= "\n" . $t;
673 } else {
674 $embed = $t . "\n" . $embed;
675 }
676 $write = 1;
677 $form{__comment_anchor_index} = $anchor
678 if $param->{anchor_index_}; ## $anchor is used!
679 }
680 $form{__wikiform_anchor_index} = $i;
681 undef $form{wikiform_targetform}; ## Make sure never to match
682 undef $form{wikiform_index}; ## with WikiForm in rest of page!
683 }
684 $i++; $embed;
685 }ge;
686 unless ($write) {
687 #$content = "#?SuikaWiki/0.9\n\n" unless $content;
688 #$content .= "\n" unless $content =~ /\n$/s;
689 #
690 }
691 if ($write) {
692 $form{mymsg} = $content;
693 $form{mytouch} = 'on';
694 &do_write;
695 } else { ## Don't write!
696 $form{mycmd} = 'default';
697 &do_view;
698 }
699 }
700
701 sub code_convert {
702 require Jcode;
703 my ($contentref, $code) = (shift, shift || $kanjicode);
704 if ($code =~ /euc/) { $code = 'euc' }
705 elsif ($code =~ /iso/) { $code = 'jis' }
706 elsif ($code =~ /shi/) { $code = 'sjis' }
707 elsif ($code =~ /utf/) { $code = 'utf8' }
708 $$contentref = Jcode->new ($contentref)->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\xA2\xAF\xA2\xB0\xA2\xB2\xA2\xB1\xA1\xE4\xA1\xE3\xA1\xC0\xA1\xA1" => q(0-9A-Za-z&,.:;?!`^_/|()[]{}+$%#*@='"~-><\ ))->$code;
709 return $$contentref;
710 }
711
712 sub _rfc3339_date ($) {
713 my @time = gmtime (shift);
714 sprintf '%04d-%02d-%02dT%02d:%02d:%02d+00:00', $time[5]+1900,$time[4]+1,@time[3,2,1,0];
715 }
716
717 package wiki::referer;
718 sub add ($$) {
719 my $page = shift;
720 my $uri = shift;
721 unless (ref $uri) {
722 require URI;
723 $uri = URI->new ($uri);
724 ## Some schemes do not have query part.
725 eval q{ $uri->query (undef) if $uri->query =~ /^[0-9]{6,8}$/ };
726 $uri->fragment (undef);
727 }
728 $uri = $uri->canonical;
729 return unless $uri;
730 for my $regex (&get_dont_record) {
731 return if $uri =~ /$regex/;
732 }
733 my %list = get ($page);
734 $list{ $uri }++;
735 set ($page, \%list);
736 }
737 sub get ($) { split /"/, $main::database->meta (Referer => $_[0]) }
738 sub set ($%) {
739 my $page = shift;
740 my $list = shift;
741 $main::database->meta (Referer => $page => join '"', %$list);
742 }
743
744 sub get_dont_record () {
745 map {s/\$/\\\$/g; s/\@/\\\@/g; $_}
746 grep !/^#/,
747 split /[\x0D\x0A]+/, $main::database{RefererDontRecord};
748 }
749 sub get_site_name () {
750 my @lines = grep /[^#]/, split /[\x0D\x0A]+/, $main::database{RefererSiteName};
751 my @item;
752 for (@lines) {
753 next if /^#/;
754 my ($uri, $name) = split /\s+/, $_, 2;
755 $uri =~ s/\$/\\\$/g; $uri =~ s/\@/\\\@/g; $uri =~ s/\//\\\//g;
756 $name =~ s!([()/\\])!\\$1!g; $name =~ s/\$([0-9]+)/).__decode (\${$1}).q(/g;
757 push @item, [$uri, qq(q($name))];
758 }
759 @item;
760 }
761
762 sub list_html ($) {
763 my $page = shift;
764 my %list = get ($page);
765 my $r = '';
766 my @name = get_site_name ();
767 for my $uri (sort {$list{$b}<=>$list{$a}||$a cmp $b} keys %list) {
768 my $title;
769 for my $item (@name) {
770 if ($uri =~ /$item->[0]/) {
771 $title = $uri;
772 eval qq{\$title =~ s/^.*$item->[0].*\$/$item->[1]/e}
773 or die $@ ;#. qq{\$title =~ s/^.*$item->[0].*\$/$item->[1]/e};
774 last;
775 }
776 }
777 my $euri = main::escape ($uri);
778 if ($title) {
779 $r .= qq(<li>{$list{$uri}} <a href="$euri" title="URI: &lt;$euri&gt;">@{[main::escape ($title)]}</a></li>\n);
780 } else {
781 $r .= qq(<li>{$list{$uri}} &lt;<a href="$euri">$euri</a>&gt;</li>\n);
782 }
783 }
784 $r ? qq(<ul>$r</ul>\n) : '';
785 }
786
787 sub __decode ($) {
788 my $s = shift;
789 $s =~ tr/+/ /;
790 $s =~ s/%([0-9A-Fa-f][0-9A-Fa-f])/chr hex $1/ge;
791 main::code_convert (\$s);
792 }
793
794 package wiki::useragent;
795 our $UseLog;
796
797 sub add ($) {
798 my $s = shift;
799 return unless length $s;
800 return unless $UseLog;
801 $s =~ s/([^\x20-\x24\x26-\x7E])/sprintf '%%%02X', unpack 'C', $1/ge;
802 my %ua;
803 for (split /\n/, $main::database{$main::PageName{UserAgentList}}) {
804 if (/^-\[(\d+)\] (.+)$/) {
805 my ($t, $n) = ($1, $2);
806 $n =~ tr/\x0A\x0D//d;
807 $ua{$n} = $t;
808 }
809 }
810 $ua{$s}++;
811 my $s = qq(#?SuikaWiki/0.9\n);
812 for (sort {$ua{$a} <=> $ua{$b}} keys %ua) {
813 $s .= sprintf qq(-[%d] %s\n), $ua{$_}, $_;
814 }
815 $main::database->STORE ($main::PageName{UserAgentList} => $s, -touch => 0);
816 }
817
818
819 package wiki::dummy;
820 sub mtime (@) {undef}
821 sub meta (@) {undef}
822 sub Yuki::YukiWikiDB2::meta (@) {undef}
823
824 package main;
825 &SuikaWiki::Plugin::import_plugins ();
826 &main ();
827
828 =head1 NAME
829
830 lib/suikawiki.pl --- SuikaWiki transitional library
831
832 =head1 AUTHOR
833
834 Hiroshi Yuki <hyuki@hyuki.com> <http://www.hyuki.com/yukiwiki/> (YukiWiki)
835
836 Makio Tsukamoto <http://digit.que.ne.jp/> (WalWiki)
837
838 Wakaba <w@suika.fam.cx>
839
840 =head1 LICENSE
841
842 Copyright AUTHORS 2000-2003
843
844 This program is free software; you can redistribute it and/or
845 modify it under the same terms as Perl itself.
846
847 =cut
848
849 1; # $Date: 2003/04/29 10:41:07 $

admin@suikawiki.org
ViewVC Help
Powered by ViewVC 1.1.24