1 |
#!/usr/bin/perl |
#!/usr/bin/perl |
2 |
# wiki.cgi - This is YukiWiki, yet another Wiki clone. |
## wiki.cgi - This is SuikaWiki, yet another WikiEngine |
|
# |
|
|
# This program is free software; you can redistribute it and/or |
|
|
# modify it under the same terms as Perl itself. |
|
3 |
|
|
4 |
use strict; |
use strict; |
5 |
use lib qw(./lib); |
use lib qw(./lib); |
6 |
use CGI::Carp qw(fatalsToBrowser); |
use CGI::Carp qw(fatalsToBrowser); |
|
our $VERSION = do{my @r=(q$Revision$=~/\d+/g);sprintf "%d."."%02d" x $#r,@r}; |
|
7 |
binmode STDOUT; binmode STDIN; |
binmode STDOUT; binmode STDIN; |
8 |
require 'wikidata/suikawiki-config.ph'; |
our $VERSION = do{my @r=(q$Revision$=~/\d+/g);sprintf "%d."."%02d" x $#r,@r}; |
9 |
|
require 'wikidata/suikawiki-config.ph'; ## site configuration script |
10 |
|
require Yuki::YukiWikiCache; |
11 |
use Fcntl; |
use Fcntl; |
|
############################## |
|
12 |
our %fmt; ## formatter objects |
our %fmt; ## formatter objects |
13 |
our %embed_command = ( |
our %embed_command = ( |
14 |
searched => '^\[\[#searched:([^\]]+)\]\]$', |
searched => '^\[\[#searched:([^\]]+)\]\]$', |
15 |
form => qr/\[\[\#form(?:\(([A-Za-z0-9-]+)\))?:'((?:[^'\\]|\\.)*)':'((?:[^'\\]|\\.)*)'(?::'((?:[^'\\]|\\.)*)')?\]\]/, |
form => qr/\[\[\#form(?:\(([A-Za-z0-9-]+)\))?:'((?:[^'\\]|\\.)*)':'((?:[^'\\]|\\.)*)'(?::'((?:[^'\\]|\\.)*)')?\]\]/, |
16 |
); |
); |
17 |
our ($modifier_dbtype,$url_cgi,%uri,%PathTo,$use_exists); |
our ($modifier_dbtype,$url_cgi,%uri,%PathTo); |
18 |
our (%PageName,$kanjicode,$lang,%ViewDefinition); |
our (%PageName,$kanjicode,$lang,%ViewDefinition); |
19 |
|
|
|
############################## |
|
20 |
my %form; |
my %form; |
21 |
our %database; |
our %database; |
22 |
our $database = bless {}, 'wiki::dummy'; |
our $database = bless {}, 'wiki::dummy'; |
23 |
my %interwiki; |
my %interwiki; |
|
############################## |
|
24 |
my %command_do = ( |
my %command_do = ( |
25 |
read => \&do_view, |
default => \&do_view, |
26 |
adminchangepassword => \&do_adminchangepassword, |
adminchangepassword => \&do_adminchangepassword, |
27 |
write => \&do_write, |
write => \&do_write, |
28 |
searchform => \&do_searchform, |
searchform => \&do_searchform, |
30 |
RandomJump => \&do_random_jump, |
RandomJump => \&do_random_jump, |
31 |
wikiform => \&do_wikiform, |
wikiform => \&do_wikiform, |
32 |
); |
); |
33 |
my $UA = ''; ## User agent name |
our $UA = ''; ## User agent name |
34 |
$| = 1; |
$| = 1; |
|
############################## |
|
35 |
|
|
36 |
sub main { |
sub main { |
37 |
$UA = $main::ENV{HTTP_USER_AGENT}; |
$UA = $main::ENV{HTTP_USER_AGENT}; |
40 |
if ($command_do{$form{mycmd}}) { |
if ($command_do{$form{mycmd}}) { |
41 |
&{$command_do{$form{mycmd}}}; |
&{$command_do{$form{mycmd}}}; |
42 |
} else { |
} else { |
43 |
&{$command_do{read}}; |
&{$command_do{default}}; |
44 |
} |
} |
45 |
&close_db; |
&close_db; |
46 |
} |
} |
55 |
if ($view eq 'edit') { |
if ($view eq 'edit') { |
56 |
$view = 'adminedit' if $form{admin}; |
$view = 'adminedit' if $form{admin}; |
57 |
} elsif ($view =~ /[^0-9A-Za-z]/) { |
} elsif ($view =~ /[^0-9A-Za-z]/) { |
58 |
$view = 'view' |
$view = 'default' |
59 |
|
} |
60 |
|
if ($view eq 'default' || !$view) { |
61 |
|
## BUG: this code is not strict |
62 |
|
if ($main::ENV{HTTP_COOKIE} =~ /SelectedMode=([0-9A-Za-z]+)/) { |
63 |
|
$view = $1; |
64 |
|
} else { |
65 |
|
$view = 'read'; |
66 |
|
} |
67 |
} |
} |
68 |
my ($magic, $content) = &SuikaWiki::Plugin::magic_and_content (undef, $content); |
my ($magic, $content) = &SuikaWiki::Plugin::magic_and_content (undef, $content); |
69 |
$magic ||= '#?SuikaWiki/0.9'; |
$magic ||= '#?SuikaWiki/0.9'; |
78 |
if ($ViewDefinition{$view}->{xmedia} && $UA =~ /Gecko/) { |
if ($ViewDefinition{$view}->{xmedia} && $UA =~ /Gecko/) { |
79 |
$media = $ViewDefinition{$view}->{xmedia}; |
$media = $ViewDefinition{$view}->{xmedia}; |
80 |
$o->{media} = $media; |
$o->{media} = $media; |
81 |
|
} elsif ($UA =~ m#Mozilla/0\..+Windows#) { |
82 |
|
$kanjicode = 'shift_jis'; |
83 |
} |
} |
84 |
if ($magic =~ m!^\#\?SuikaWiki/0.9!) { |
if ($magic =~ m!^\#\?SuikaWiki/0.9!) { |
85 |
&print_header ($form{mypage}, -last_modified => ($magic =~ /interactive="yes"/ ? $lm : time), |
&print_header ($form{mypage}, -last_modified => ($magic =~ /interactive="yes"/ ? time : $lm), |
86 |
-expires => ($magic =~ /interactive="yes"/ ? 1 : undef), o => $o, |
-expires => ($magic =~ /interactive="yes"/ ? 1 : undef), o => $o, |
87 |
-media => $media, -magic => $magic, content => $content); |
-media => $media, -magic => $magic, content => $content); |
88 |
} else { |
} else { |
89 |
&print_header($form{mypage}, -media => $media, |
&print_header($form{mypage}, -media => $media, |
90 |
-magic => $magic, -last_modified => $lm, o => $o); |
-magic => $magic, -last_modified => $lm, o => $o); |
91 |
} |
} |
92 |
|
if ($kanjicode ne 'euc') { |
93 |
|
my $s = $fmt{view}->replace ($ViewDefinition{$view}->{template} => $o); |
94 |
|
print &code_convert (\$s => $kanjicode); |
95 |
|
} else { |
96 |
print $fmt{view}->replace ($ViewDefinition{$view}->{template} => $o); |
print $fmt{view}->replace ($ViewDefinition{$view}->{template} => $o); |
97 |
|
} |
98 |
} |
} |
99 |
|
|
100 |
sub _do_view_msg (%) { |
sub _do_view_msg (%) { |
184 |
} elsif ($form{__wikiform_anchor_index}) { |
} elsif ($form{__wikiform_anchor_index}) { |
185 |
$fragment .= qq(#wikiform-$form{__wikiform_anchor_index}); |
$fragment .= qq(#wikiform-$form{__wikiform_anchor_index}); |
186 |
} |
} |
187 |
&_do_view_msg (-view => '-wrote', -page => $form{mypage}, -goto => $url_cgi.'?mycmd='.&encode($form{after_edit_cmd}||'read').';mypage='.&encode($form{mypage}).qq(;x-param=@{[time.[0..9]->[rand 10]]}$fragment)); |
&_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)); |
188 |
} else { |
} else { |
189 |
delete $database{$form{mypage}}; |
delete $database{$form{mypage}}; |
190 |
&_do_view_msg (-view => '-deleted', -page => $form{mypage}); |
&_do_view_msg (-view => '-deleted', -page => $form{mypage}); |
197 |
|
|
198 |
sub get_search_result ($;%) { |
sub get_search_result ($;%) { |
199 |
my $word = lc shift; |
my $word = lc shift; |
200 |
|
my $SearchResult = SuikaWiki::Plugin->cache ('search'); |
201 |
my %option = @_; |
my %option = @_; |
202 |
my @r; |
my @r; |
203 |
foreach my $page (keys %database) { |
unless (defined $SearchResult->{$word}) { |
204 |
next if !$option{-match_myself} && ($page eq $word); |
for my $page (keys %database) { |
205 |
my $content = lc $database{$page}; |
next if !$option{-match_myself} && ($page eq $word); |
206 |
if (index (lc $page, $word) > -1) { |
my $content = lc $database{$page}; |
207 |
my $c = $content =~ s/\Q$word\E//g; |
$content =~ s/^[^\x0A\x0D]+[\x0D\x0A]+//s; |
208 |
push @r, [$page, $c+20]; |
if (index (lc $page, $word) > -1) { |
209 |
} elsif (index ($word, lc $page) > -1) { |
my $c = $content =~ s/\Q$word\E//g; |
210 |
my $c = $content =~ s/\Q$word\E//g; |
push @r, [$page, $c+20]; |
211 |
push @r, [$page, $c+10]; |
} elsif (index ($word, lc $page) > -1) { |
212 |
} elsif (my $c = $content =~ s/\Q$word\E//g) { |
my $c = $content =~ s/\Q$word\E//g; |
213 |
push @r, [$page, $c]; |
push @r, [$page, $c+10]; |
214 |
|
} elsif (my $c = $content =~ s/\Q$word\E//g) { |
215 |
|
push @r, [$page, $c]; |
216 |
|
} |
217 |
} |
} |
218 |
|
@r = sort {$b->[1] <=> $a->[1] || $a->[0] cmp $b->[0]} @r; |
219 |
|
$SearchResult->{$word} = join "\x1E", map {$_->[0]."\x1F".$_->[1]} @r; |
220 |
|
} else { |
221 |
|
@r = map {[split /\x1F/, $_, 2]} split /\x1E/, $SearchResult->{$word}; |
222 |
} |
} |
223 |
#my $em = sub { my $s = shift; $s =~ s#(\Q$word\E)#<em>$1</em>#gi; $s }; |
#my $em = sub { my $s = shift; $s =~ s#(\Q$word\E)#<em>$1</em>#gi; $s }; |
224 |
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>)} sort {$b->[1] <=> $a->[1] || $a->[0] cmp $b->[0]} @r; |
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; |
225 |
$r = qq|<ul class="search-result">$r</ul>| if $r; |
$r = qq|<ul class="search-result">$r</ul>| if $r; |
226 |
wantarray? ($r, scalar @r): $r; |
wantarray? ($r, scalar @r): $r; |
227 |
} |
} |
262 |
print qq{Expires: @{[scalar gmtime (time + $option{-media}->{expires})]}\n}; |
print qq{Expires: @{[scalar gmtime (time + $option{-media}->{expires})]}\n}; |
263 |
} |
} |
264 |
} |
} |
265 |
if ($option{-media}->{charset} && $UA =~ m#Mozilla/2#) { |
if ($option{-media}->{charset} && $UA =~ m#Mozilla/[12]\.#) { |
266 |
my $ct = qq{$option{-media}->{type}; charset=@{[&get_charset_name($kanjicode,compatible=>1)]}}; |
my $ct = qq{$option{-media}->{type}; charset=@{[&get_charset_name($kanjicode,compatible=>1)]}}; |
267 |
print qq{Content-Type: $ct\n}; |
print qq{Content-Type: $ct\n}; |
268 |
$option{o}->{-header}->{meta_ct} = qq{<meta http-equiv="content-type" content="$ct">\n}; |
$option{o}->{-header}->{meta_ct} = qq{<meta http-equiv="content-type" content="$ct">\n}; |
269 |
} elsif (!$option{-media}->{charset} || $UA =~ m#Infomosaic#) { |
} elsif (!$option{-media}->{charset} || $UA =~ m#Infomosaic|Mozilla/0\.#) { |
270 |
print qq{Content-Type: $option{-media}->{type}\n}; |
print qq{Content-Type: $option{-media}->{type}\n}; |
271 |
|
$option{o}->{-header}->{meta_ct} = qq{<meta http-equiv="content-type" content="$option{-media}->{type}; charset=@{[&get_charset_name($kanjicode,compatible=>1)]}">\n}; |
272 |
} else { |
} else { |
273 |
my $type = $option{-media}->{type}; |
my $type = $option{-media}->{type}; |
274 |
$type = 'application/xml' if $type eq 'application/rss+xml'; |
$type = 'application/xml' if $type eq 'application/rss+xml'; |
337 |
|
|
338 |
## Load constants |
## Load constants |
339 |
my %const; |
my %const; |
340 |
if ($option{content_format} =~ /import="([^"]+)"/) { |
if ($option{magic} =~ /import="([^"]+)"/) { |
341 |
for (split /\s*,\s*/, $1) { |
for (split /\s*,\s*/, $1) { |
342 |
my $wp = $database{$_}; |
my $wp = $database{$_}; |
343 |
if ($wp =~ m!^\#\?SuikaWikiConst/1.0!) { |
if ($wp =~ m!^\#\?SuikaWikiConst/(?:0.9|1.0)!) { |
344 |
wiki::suikawikiconst::to_hash ($wp => \%const); |
wiki::suikawikiconst::to_hash ($wp => \%const); |
345 |
} |
} |
346 |
} |
} |
355 |
chomp; |
chomp; |
356 |
if (/^\*\*\*\*\*([^\x0D\x0A]*)/) { |
if (/^\*\*\*\*\*([^\x0D\x0A]*)/) { |
357 |
push @$toc, [5, "i$tocnum" => ($1 || $tocnum)]; |
push @$toc, [5, "i$tocnum" => ($1 || $tocnum)]; |
358 |
push(@result, splice(@saved), qq(<h6 @{[&id_and_name("i$tocnum")]}>) . &inline($1, const => \%const) . '</h6>'); |
push(@result, splice(@saved), qq(<h6 @{[&id_and_name("i$tocnum")]}>) . &inline($1, %option, const => \%const) . '</h6>'); |
359 |
$tocnum++; |
$tocnum++; |
360 |
} elsif (/^\*\*\*\*([^\x0D\x0A]*)/) { |
} elsif (/^\*\*\*\*([^\x0D\x0A]*)/) { |
361 |
push @$toc, [4, "i$tocnum" => ($1 || $tocnum)]; |
push @$toc, [4, "i$tocnum" => ($1 || $tocnum)]; |
362 |
push(@result, splice(@saved), qq(<h5 @{[&id_and_name("i$tocnum")]}>) . &inline($1, const => \%const) . '</h5>'); |
push(@result, splice(@saved), qq(<h5 @{[&id_and_name("i$tocnum")]}>) . &inline($1, %option, const => \%const) . '</h5>'); |
363 |
$tocnum++; |
$tocnum++; |
364 |
} elsif (/^\*\*\*([^\x0D\x0A]*)/) { |
} elsif (/^\*\*\*([^\x0D\x0A]*)/) { |
365 |
push @$toc, [3, "i$tocnum" => ($1 || $tocnum)]; |
push @$toc, [3, "i$tocnum" => ($1 || $tocnum)]; |
366 |
push(@result, splice(@saved), qq(<h4 @{[&id_and_name("i$tocnum")]}>) . &inline($1, const => \%const) . '</h4>'); |
push(@result, splice(@saved), qq(<h4 @{[&id_and_name("i$tocnum")]}>) . &inline($1, %option, const => \%const) . '</h4>'); |
367 |
$tocnum++; |
$tocnum++; |
368 |
} elsif (/^\*\*([^\x0D\x0A]*)/) { |
} elsif (/^\*\*([^\x0D\x0A]*)/) { |
369 |
# if (/^\*\*(.*)/) { |
# if (/^\*\*(.*)/) { |
370 |
# Walrus mod (6) end |
# Walrus mod (6) end |
371 |
push @$toc, [2, "i$tocnum" => ($1 || $tocnum)]; |
push @$toc, [2, "i$tocnum" => ($1 || $tocnum)]; |
372 |
push(@result, splice(@saved), qq(<h3 @{[&id_and_name("i$tocnum")]}>) . &inline($1, const => \%const) . '</h3>'); |
push(@result, splice(@saved), qq(<h3 @{[&id_and_name("i$tocnum")]}>) . &inline($1, %option, const => \%const) . '</h3>'); |
373 |
$tocnum++; |
$tocnum++; |
374 |
} elsif (/^\*([^\x0D\x0A]*)/) { |
} elsif (/^\*([^\x0D\x0A]*)/) { |
375 |
push @$toc, [1, "i$tocnum" => ($1 || $tocnum)]; |
push @$toc, [1, "i$tocnum" => ($1 || $tocnum)]; |
376 |
push(@result, splice(@saved), qq(<h2 @{[&id_and_name("i$tocnum")]}>) . &inline($1, const => \%const) . '</h2>'); |
push(@result, splice(@saved), qq(<h2 @{[&id_and_name("i$tocnum")]}>) . &inline($1, %option, const => \%const) . '</h2>'); |
377 |
$tocnum++; |
$tocnum++; |
378 |
} elsif (/^(={1,6})(.*)/) { |
} elsif (/^(={1,6})(.*)/) { |
379 |
&back_push('ol', length($1), \@saved, \@result); |
&back_push('ol', length($1), \@saved, \@result); |
380 |
push(@result, '<li>' . &inline($2, const => \%const) . '</li>'); |
push(@result, '<li>' . &inline($2, %option, const => \%const) . '</li>'); |
381 |
} elsif (/^(-{1,6})(.*)/) { |
} elsif (/^(-{1,6})(.*)/) { |
382 |
&back_push('ul', length($1), \@saved, \@result); |
&back_push('ul', length($1), \@saved, \@result); |
383 |
my ($pf, $l) = ('', $2); |
my ($pf, $l) = ('', $2); |
385 |
my $num = 0+$1; |
my $num = 0+$1; |
386 |
$pf = qq(<a name="anchor-$num" id="anchor-$num" class="anchor">[$num]</a>); |
$pf = qq(<a name="anchor-$num" id="anchor-$num" class="anchor">[$num]</a>); |
387 |
} |
} |
388 |
push(@result, '<li>' . $pf . &inline ($l, const => \%const) . '</li>'); |
push(@result, '<li>' . $pf . &inline ($l, %option, const => \%const) . '</li>'); |
389 |
} elsif (/^:([^:]+):(.*)/) { |
} elsif (/^:([^:]+):(.*)/) { |
390 |
&back_push('dl', 1, \@saved, \@result); |
&back_push('dl', 1, \@saved, \@result); |
391 |
push(@result, '<dt>' . &inline($1, const => \%const) . '</dt>', '<dd>' . &inline($2, const => \%const) . '</dd>'); |
push(@result, '<dt>' . &inline($1, %option, const => \%const) . '</dt>', '<dd>' . &inline($2, %option, const => \%const) . '</dd>'); |
392 |
} elsif (/^(?!>>\d)(>{1,5})(.*)/) { |
} elsif (/^(?!>>\d)(>{1,5})(.*)/) { |
393 |
&back_push('blockquote', length($1), \@saved, \@result); |
&back_push('blockquote', length($1), \@saved, \@result); |
394 |
push @result, "<p>"; |
push @result, "<p>"; |
395 |
push(@result, &inline($2, const => \%const)); |
push(@result, &inline($2, %option, const => \%const)); |
396 |
unshift @saved, "</p>"; |
unshift @saved, "</p>"; |
397 |
} elsif (/^\s*$/) { |
} elsif (/^\s*$/) { |
398 |
push(@result, splice(@saved)); |
push(@result, splice(@saved)); |
400 |
unshift(@saved, "</p>"); |
unshift(@saved, "</p>"); |
401 |
} elsif (/^(\s+.*)$/) { |
} elsif (/^(\s+.*)$/) { |
402 |
&back_push('pre', 1, \@saved, \@result); |
&back_push('pre', 1, \@saved, \@result); |
403 |
push(@result, &inline($1, const => \%const)); |
push(@result, &inline($1, %option, const => \%const)); |
404 |
} elsif (/^\,(.*?)[\x0D\x0A]*$/) { |
} elsif (/^\,(.*?)[\x0D\x0A]*$/) { |
405 |
&back_push('table', 1, \@saved, \@result); |
&back_push('table', 1, \@saved, \@result); |
406 |
####### |
####### |
416 |
$colspan[$i]++; |
$colspan[$i]++; |
417 |
} |
} |
418 |
$colspan[$i] = ($colspan[$i] > 1) ? sprintf(' colspan="%d"', $colspan[$i]) : ''; |
$colspan[$i] = ($colspan[$i] > 1) ? sprintf(' colspan="%d"', $colspan[$i]) : ''; |
419 |
$value[$i] = sprintf('<td%s%s>%s</td>', $align[$i], $colspan[$i], &inline($value[$i], const => \%const)); |
$value[$i] = sprintf('<td%s%s>%s</td>', $align[$i], $colspan[$i], &inline($value[$i], %option, const => \%const)); |
420 |
} else { |
} else { |
421 |
$value[$i] = ''; |
$value[$i] = ''; |
422 |
} |
} |
433 |
} elsif (/^\[([0-9]+)\](.*)$/ && !$main::_EMBEDED) { |
} elsif (/^\[([0-9]+)\](.*)$/ && !$main::_EMBEDED) { |
434 |
my $num = 0+$1; |
my $num = 0+$1; |
435 |
push @result, qq(<a name="anchor-$num" id="anchor-$num" class="anchor">[$num]</a>); |
push @result, qq(<a name="anchor-$num" id="anchor-$num" class="anchor">[$num]</a>); |
436 |
push @result, &inline ($2, const => \%const); |
push @result, &inline ($2, %option, const => \%const); |
437 |
} else { |
} else { |
438 |
push(@result, &inline($_, const => \%const)); |
push(@result, &inline($_, %option, const => \%const)); |
439 |
} |
} |
440 |
} |
} |
441 |
push(@result, splice(@saved)); |
push(@result, splice(@saved)); |
464 |
sub inline ($;%) { |
sub inline ($;%) { |
465 |
my ($line, %option) = @_; |
my ($line, %option) = @_; |
466 |
$line = &escape($line); |
$line = &escape($line); |
467 |
$line =~ s{$embed_command{form}}{&make_custom_form ($1, $2, $3, $4)}ge; |
$line =~ s{$embed_command{form}}{&make_custom_form ($1, $2, $3, $4, \%option)}ge; |
468 |
$line =~ s{\[(INS|DEL|SUP|SUB|VAR|CODE|KBD|SAMP|DFN)(?:\(([A-Za-z0-9\x20-]+)\))?\[(.+?)\]\]}{<@{[lc $1]}@{[$2 ? qq( class="$2") : '']}>$3</@{[lc $1]}>}g; |
$line =~ s{\[(INS|DEL|SUP|SUB|VAR|CODE|KBD|SAMP|DFN)(?:\(([A-Za-z0-9\x20-]+)\))?\[(.+?)\]\]}{<@{[lc $1]}@{[$2 ? qq( class="$2") : '']}>$3</@{[lc $1]}>}g; |
469 |
$line =~ s:\[(WEAK)\[(.+?)\]\]:<span class="@{[lc $1]}">$2</span>:g; |
$line =~ s:\[(WEAK)\[(.+?)\]\]:<span class="@{[lc $1]}">$2</span>:g; |
470 |
$line =~ s:\[ABBR\[([^]]+)\] \[([^]]+)\]\]:<acronym title="$2">$1</acronym>:g; |
$line =~ s:\[ABBR\[([^]]+)\] \[([^]]+)\]\]:<acronym title="$2">$1</acronym>:g; |
496 |
sub make_wikilink ($%) { |
sub make_wikilink ($%) { |
497 |
my ($ename, %option) = @_; |
my ($ename, %option) = @_; |
498 |
my $name = &unescape ($ename); |
my $name = &unescape ($ename); |
499 |
$option{latest} = $option{latest} ? qq(mycmd=read;x-param=@{[time.[0..9]->[rand 10]]};mypage=) : ''; |
$option{latest} = $option{latest} ? qq(mycmd=default;x-param=@{[time.[0..9]->[rand 10]]};mypage=) : ''; |
500 |
if ($database{$name}) { |
if ($database{$name}) { |
501 |
my $subject = &escape (&get_subjectline ($name, delimiter => '')); |
my $subject = &escape (&get_subjectline ($name, delimiter => '')); |
502 |
if ($option{anchor}) { |
if ($option{anchor}) { |
548 |
} |
} |
549 |
} |
} |
550 |
|
|
551 |
{my $FormIndex = 0; |
{my %FormIndex; |
552 |
sub make_custom_form ($$$$) { |
sub make_custom_form ($$$$%) { |
553 |
my ($wfname, $definition, $template, $option) = @_; |
my ($wfname, $definition, $template, $foption, $option) = @_; |
554 |
## $template and $option is currently not used in this procedure. |
## $template is currently not used in this procedure. |
555 |
unless ($main::_EMBEDED) { |
#unless ($main::_EMBEDED) { |
556 |
$FormIndex++; |
$FormIndex{$option->{page}}++; |
557 |
if (length $definition) { |
if (length $definition) { |
558 |
my $param = bless {}, 'SuikaWiki::Plugin'; |
my $param = bless {depth=>10}, 'SuikaWiki::Plugin'; |
559 |
my $lastmodified = $database->mtime ($form{mypage}); |
my $lastmodified = $database->mtime ($option->{page}); |
560 |
&load_formatter (qw/form_input form_option/); |
&load_formatter (qw/form_input form_option/); |
561 |
$definition = &unescape ($definition); |
$definition = &unescape ($definition); |
562 |
$definition =~ s/\\(.)/$1/g; |
$definition =~ s/\\(.)/$1/g; |
563 |
$option = &unescape ($option); |
$foption = &unescape ($foption); |
564 |
$option =~ s/\\(.)/$1/g; |
$foption =~ s/\\(.)/$1/g; |
565 |
$fmt{form_option}->replace ($option, $param); |
$fmt{form_option}->replace ($foption, $param); |
566 |
$param->{output}->{form} = 1 unless defined $param->{output}->{form}; |
$param->{output}->{form} = 1 unless defined $param->{output}->{form}; |
567 |
|
$param->{output}->{form} = 0 if $main::_EMBEDED; |
568 |
$definition .= ' %submit;' if $definition !~ /%submit/ && !$param->{output}->{nosubmit} && $param->{output}->{form}; |
$definition .= ' %submit;' if $definition !~ /%submit/ && !$param->{output}->{nosubmit} && $param->{output}->{form}; |
569 |
$param->{output}->{page} ||= $form{mypage}; |
$param->{output}->{page} ||= $option->{page}; |
570 |
$param->{form_disabled} = 1 if $database->meta (IsFrozen => $form{mypage}); |
$param->{form_disabled} = 1 if $database->meta (IsFrozen => $option->{page}); |
571 |
my $target_form = $param->{output}->{id}; |
my $target_form = $param->{output}->{id}; |
572 |
my $r = ''; |
my $r = ''; |
573 |
$r = <<EOH if $param->{output}->{form}; |
$r = <<EOH if $param->{output}->{form}; |
574 |
<form method="post" action="$url_cgi" id="wikiform-$FormIndex" class="wikiform"> |
<form method="post" action="$url_cgi" id="wikiform-$FormIndex{$option->{page}}" class="wikiform"> |
575 |
<input type="hidden" name="mycmd" value="@{[$param->{form_disabled}?'read':'wikiform']}" /> |
<input type="hidden" name="mycmd" value="@{[$param->{form_disabled}?'default':'wikiform']}" /> |
576 |
<input type="hidden" name="mypage" value="@{[&escape($param->{output}->{page})]}" /> |
<input type="hidden" name="mypage" value="@{[&escape($param->{output}->{page})]}" /> |
577 |
<input type="hidden" name="myLastModified" value="$lastmodified" /> |
<input type="hidden" name="myLastModified" value="$lastmodified" /> |
578 |
<input type="hidden" name="mytouch" value="on" /> |
<input type="hidden" name="mytouch" value="on" /> |
579 |
<input type="hidden" name="@{[$target_form? qq(wikiform_targetform" value="@{[&escape($target_form)]}) : qq(wikiform_index" value="$FormIndex)]}" /> |
<input type="hidden" name="@{[$target_form? qq(wikiform_targetform" value="@{[&escape($target_form)]}) : qq(wikiform_index" value="$FormIndex{$option->{page}})]}" /> |
580 |
EOH |
EOH |
581 |
$r .= qq(<a name="wikiform-$FormIndex"></a>) if $UA =~ m#Mozilla/[12]\.#; |
$r .= qq(<a name="wikiform-$FormIndex{$option->{page}}"></a>) if $UA =~ m#Mozilla/[12]\.#; |
582 |
$r .= $fmt{form_input}->replace ($definition, $param); |
$r .= $fmt{form_input}->replace ($definition, $param); |
583 |
$r .= "</form>\n" if $param->{output}->{form}; |
$r .= "</form>\n" if $param->{output}->{form}; |
584 |
$r; |
$r; |
585 |
} else { ## No input-interface WikiForm |
} else { ## No input-interface WikiForm |
586 |
qq(<a id="wikiform-$FormIndex" name="wikiform-$FormIndex"><!-- #form --></a>); |
qq(<a id="wikiform-$FormIndex{$option->{page}}" name="wikiform-$FormIndex{$option->{page}}"><!-- #form --></a>); |
587 |
} |
} |
588 |
} else { |
#} else { |
589 |
qq(<ins class="wiki-error">@{[&Resource('Error:WikiForm:EmbedIsNotSupported',escape=>1)]}</ins>); |
# qq(<ins class="wiki-error">@{[&Resource('Error:WikiForm:EmbedIsNotSupported',escape=>1)]}</ins>); |
590 |
} |
#} |
591 |
}} |
}} |
592 |
|
|
593 |
sub init_form { |
sub init_form { |
601 |
my $query = &decode($main::ENV{QUERY_STRING}); |
my $query = &decode($main::ENV{QUERY_STRING}); |
602 |
$query = &code_convert(\$query, $kanjicode); |
$query = &code_convert(\$query, $kanjicode); |
603 |
$form{mypage} = $query; |
$form{mypage} = $query; |
604 |
$form{mycmd} = $database{$form{mypage}} ? 'read' : 'edit'; |
$form{mycmd} = 'default'; |
605 |
} else { |
} else { |
606 |
for (split /[;&]/, $query) { |
for (split /[;&]/, $query) { |
607 |
if (my ($n, $v) = split /=/, $_, 2) { |
if (my ($n, $v) = split /=/, $_, 2) { |
616 |
} |
} |
617 |
$form{mypage} ||= $PageName{FrontPage}; |
$form{mypage} ||= $PageName{FrontPage}; |
618 |
$form{mypage} =~ tr/\x00-\x1F\x7F//d; |
$form{mypage} =~ tr/\x00-\x1F\x7F//d; |
619 |
$form{mycmd} ||= 'read'; |
$form{mycmd} ||= 'default'; |
620 |
|
|
621 |
# mypreview_edit -> do_edit, with preview. |
# mypreview_edit -> do_edit, with preview. |
622 |
# mypreview_adminedit -> do_adminedit, with preview. |
# mypreview_adminedit -> do_adminedit, with preview. |
639 |
$form{myname} = &code_convert(\$form{myname}, $kanjicode); |
$form{myname} = &code_convert(\$form{myname}, $kanjicode); |
640 |
} |
} |
641 |
|
|
|
{my %SubjectLine; |
|
642 |
sub get_subjectline { |
sub get_subjectline { |
643 |
my ($page, %option) = @_; |
my ($page, %option) = @_; |
644 |
unless (defined $SubjectLine{$page}) { |
my $SubjectLine = SuikaWiki::Plugin->cache ('headline'); |
645 |
|
unless (defined $SubjectLine->{$page}) { |
646 |
if (not &is_editable($page)) { |
if (not &is_editable($page)) { |
647 |
$SubjectLine{$page} = ""; |
$SubjectLine->{$page} = ""; |
648 |
} else { |
} else { |
649 |
$SubjectLine{$page} = $database{$page}; |
$SubjectLine->{$page} = do { |
650 |
$SubjectLine{$page} =~ s!^\#\?[^\x0A\x0D]+[\x0A\x0D]*!!s; |
my $s=$database{$page}; |
651 |
$SubjectLine{$page} =~ s/\x0D?\x0A.*//s; |
$s =~ s!^\#\?[^\x0A\x0D]+[\x0A\x0D]*!!s; |
652 |
|
$s =~ s/\x0D?\x0A.*//s; |
653 |
|
$s}; |
654 |
} |
} |
655 |
} |
} |
656 |
if (length $SubjectLine{$page}) { |
if (length $SubjectLine->{$page}) { |
657 |
$option{delimiter} = defined $option{delimiter} ? $option{delimiter} : &Resource('Title-Summary Delimiter'); |
$option{delimiter} = defined $option{delimiter} ? $option{delimiter} : &Resource('Title-Summary Delimiter'); |
658 |
$option{delimiter}.$SubjectLine{$page}.$option{tail}; |
$option{delimiter}.$SubjectLine->{$page}.$option{tail}; |
659 |
} else { |
} else { |
660 |
''; |
''; |
661 |
} |
} |
662 |
}} |
} |
663 |
|
|
664 |
sub open_db { |
sub open_db { |
665 |
if ($modifier_dbtype eq 'dbmopen') { |
if ($modifier_dbtype eq 'dbmopen') { |
694 |
my $magic = ''; |
my $magic = ''; |
695 |
$magic = $1 if $option{content} =~ m/^([^\x0A\x0D]+)/s; |
$magic = $1 if $option{content} =~ m/^([^\x0A\x0D]+)/s; |
696 |
|
|
697 |
my $selected = 'read'; |
my $selected = 'default'; |
698 |
if ($form{after_edit_cmd}) { |
if ($form{after_edit_cmd}) { |
699 |
$selected = $form{after_edit_cmd}; |
$selected = $form{after_edit_cmd}; |
700 |
} elsif ($magic =~ /Const|Config|CSS/) { |
} elsif ($magic =~ /Const|Config|CSS/) { |
702 |
} |
} |
703 |
my $afteredit = <<EOH; |
my $afteredit = <<EOH; |
704 |
<select name="after_edit_cmd"> |
<select name="after_edit_cmd"> |
705 |
|
<option value="default" label="@{[&Resource('Edit:SaveAndDefault',escape=>1)]}"@{[$selected eq 'default' ? ' selected="selected"':'']}>@{[&Resource('Edit:SaveAndDefault',escape=>1)]}</option> |
706 |
<option value="read" label="@{[&Resource('Edit:SaveAndView',escape=>1)]}"@{[$selected eq 'read' ? ' selected="selected"':'']}>@{[&Resource('Edit:SaveAndView',escape=>1)]}</option> |
<option value="read" label="@{[&Resource('Edit:SaveAndView',escape=>1)]}"@{[$selected eq 'read' ? ' selected="selected"':'']}>@{[&Resource('Edit:SaveAndView',escape=>1)]}</option> |
707 |
<option value="edit" label="@{[&Resource('Edit:SaveAndEdit',escape=>1)]}"@{[$selected eq 'edit' ? ' selected="selected"':'']}>@{[&Resource('Edit:SaveAndEdit',escape=>1)]}</option> |
<option value="edit" label="@{[&Resource('Edit:SaveAndEdit',escape=>1)]}"@{[$selected eq 'edit' ? ' selected="selected"':'']}>@{[&Resource('Edit:SaveAndEdit',escape=>1)]}</option> |
708 |
</select> |
</select> |
827 |
$form{mymsg} = $content; |
$form{mymsg} = $content; |
828 |
$form{mytouch} = 'on'; |
$form{mytouch} = 'on'; |
829 |
&do_write; |
&do_write; |
830 |
} else { |
} else { ## Don't write |
831 |
$form{mycmd} = 'read'; |
$form{mycmd} = 'default'; |
832 |
&do_read; |
&do_view; |
833 |
} |
} |
834 |
} |
} |
835 |
|
|
862 |
} else { |
} else { |
863 |
return <<"EOD"; |
return <<"EOD"; |
864 |
<del><form action="$url_cgi" method="get"> |
<del><form action="$url_cgi" method="get"> |
865 |
<input type="hidden" name="mycmd" value="read" /> |
<input type="hidden" name="mycmd" value="default" /> |
866 |
<input type="hidden" name="mypage" value="$form{mypage}" /> |
<input type="hidden" name="mypage" value="$form{mypage}" /> |
867 |
@{[&Resource('WikiForm:WikiComment:Name=',escape=>1)]} |
@{[&Resource('WikiForm:WikiComment:Name=',escape=>1)]} |
868 |
<input type="text" name="myname" value="" size="10" disabled="disabled" /> |
<input type="text" name="myname" value="" size="10" disabled="disabled" /> |
875 |
} elsif ($embedded =~ /^\[\[\#embed:(.+)\]\]$/) { |
} elsif ($embedded =~ /^\[\[\#embed:(.+)\]\]$/) { |
876 |
my ($name, $r) = ($1, ''); |
my ($name, $r) = ($1, ''); |
877 |
if ($main::_EMBEDED != 1) { |
if ($main::_EMBEDED != 1) { |
878 |
my ($content, $cf) = ($database{$name}, 'SuikaWiki/0.9'); |
my ($cf, $content) = SuikaWiki::Plugin->magic_and_conten ($database{$name}); |
879 |
$cf = $1 if $content =~ s!^(?:[\#<]\?|/\*\s*)?([A-Z][A-Za-z0-9-]+/[0-9.]+(?:[^0-9.][^\x0D\x0A]*)?)[\x0D\x0A]+!!s; |
$cf ||= '#?SuikaWiki/0.9'; |
880 |
if ($cf =~ m!^(?:\#\?)?SuikaWiki/0.9(?:$|\s)!) { |
if ($cf =~ m!^#\?SuikaWiki/0.9(?:$|\s)!) { |
881 |
$main::_EMBEDED = 1; |
$main::_EMBEDED = 1; |
882 |
$r = &text_to_html ($content, content_format => $cf); |
$r = &text_to_html ($content, magic => $cf, page => $name); |
883 |
$main::_EMBEDED = 0; |
$main::_EMBEDED = 0; |
884 |
} elsif (length $content) { |
} elsif (length $content) { |
885 |
$r = "<pre>@{[&escape ($content)]}</pre>"; |
$r = "<pre>@{[&escape ($content)]}</pre>"; |
886 |
} else { |
} else { |
887 |
$r = &text_to_html ("[INS[\n[[$name]]: @{[&Resource('Embed:PageNotFound')]}\n]INS]\n", content_format => 'SuikaWiki/0.9'); |
$r = &text_to_html ("[INS[\n[[$name]]: @{[&Resource('Embed:PageNotFound')]}\n]INS]\n", magic => '#?SuikaWiki/0.9'); |
888 |
} |
} |
889 |
} else { ## nested #EMBED |
} else { ## nested #EMBED |
890 |
$r = &text_to_html ("[INS[\n[[$name]]: @{[&Resource('Embed:Nested',escape=>1)]}\n]INS]\n", content_format => 'SuikaWiki/0.9'); |
$r = &text_to_html ("[INS[\n[[$name]]: @{[&Resource('Embed:Nested',escape=>1)]}\n]INS]\n", magic => '#?SuikaWiki/0.9'); |
891 |
} |
} |
892 |
return qq(<blockquote title="@{[&escape($name)]}" class="wiki-embed">$r<div class="cite-note">¡Ø<cite><a href="$url_cgi?@{[&encode($name)]}" class="wiki">@{[&escape($name)]}</a></cite>¡Ù</div></blockquote>); |
return qq(<blockquote title="@{[&escape($name)]}" class="wiki-embed">$r<div class="cite-note">¡Ø<cite><a href="$url_cgi?@{[&encode($name)]}" class="wiki">@{[&escape($name)]}</a></cite>¡Ù</div></blockquote>); |
893 |
} elsif ($embedded =~ /^\[\[\#randomlink:(.+)\]\]$/) { |
} elsif ($embedded =~ /^\[\[\#randomlink:(.+)\]\]$/) { |
921 |
|| $i == $form{wikiform_index}) { |
|| $i == $form{wikiform_index}) { |
922 |
$template =~ s/\\(.)/$1/g; |
$template =~ s/\\(.)/$1/g; |
923 |
$option =~ s/\\(.)/$1/g; |
$option =~ s/\\(.)/$1/g; |
924 |
my $param = bless {}, 'SuikaWiki::Plugin'; |
my $param = bless {depth=>10}, 'SuikaWiki::Plugin'; |
925 |
$param->{page} = $form{mypage}; |
$param->{page} = $form{mypage}; |
926 |
$param->{form_index} = $i; |
$param->{form_index} = $i; |
927 |
$param->{form_name} = $wfname; |
$param->{form_name} = $wfname; |
931 |
$param->{default_name} ||= &Resource('WikiForm:WikiComment:DefaultName'); |
$param->{default_name} ||= &Resource('WikiForm:WikiComment:DefaultName'); |
932 |
$fmt{form_option}->replace ($option, $param); |
$fmt{form_option}->replace ($option, $param); |
933 |
my $t = 1; |
my $t = 1; |
934 |
for (@{$param->{require}||[]}) { |
for (keys %{$param->{require}||{}}) { |
935 |
(undef $t, last) unless length $param->{argv}->{'wikiform__'.$_}; |
(undef $t, last) unless length $param->{argv}->{'wikiform__'.$_}; |
936 |
} |
} |
937 |
$t = $fmt{form_template}->replace ($template, $param) if $t; |
$t = $fmt{form_template}->replace ($template, $param) if $t; |
946 |
if $param->{anchor_index_}; ## $anchor is used! |
if $param->{anchor_index_}; ## $anchor is used! |
947 |
} |
} |
948 |
$form{__wikiform_anchor_index} = $i; |
$form{__wikiform_anchor_index} = $i; |
949 |
undef $form{wikiform_targetform}; ## make sure never to match |
undef $form{wikiform_targetform}; ## Make sure never to match |
950 |
undef $form{wikiform_index}; ## with WikiForm in rest of page |
undef $form{wikiform_index}; ## with WikiForm in rest of page! |
951 |
} |
} |
952 |
$i++; $embed; |
$i++; $embed; |
953 |
}ge; |
}ge; |
960 |
$form{mymsg} = $content; |
$form{mymsg} = $content; |
961 |
$form{mytouch} = 'on'; |
$form{mytouch} = 'on'; |
962 |
&do_write; |
&do_write; |
963 |
} else { |
} else { ## Don't write! |
964 |
$form{mycmd} = 'read'; |
$form{mycmd} = 'default'; |
965 |
&do_read; |
&do_view; |
966 |
} |
} |
967 |
} |
} |
968 |
|
|
982 |
sprintf '%04d-%02d-%02dT%02d:%02d:%02d+00:00', $time[5]+1900,$time[4]+1,@time[3,2,1,0]; |
sprintf '%04d-%02d-%02dT%02d:%02d:%02d+00:00', $time[5]+1900,$time[4]+1,@time[3,2,1,0]; |
983 |
} |
} |
984 |
|
|
|
sub is_exist_page { $use_exists ? exists ($database{$_[0]}) : $database{$_[0]} } |
|
|
sub __get_database ($) { $database{ $_[0] } } |
|
|
|
|
985 |
my %_Resource; |
my %_Resource; |
986 |
sub Resource ($;%) { |
sub Resource ($;%) { |
987 |
my ($s, %o) = @_; |
my ($s, %o) = @_; |
1077 |
return unless $UseLog; |
return unless $UseLog; |
1078 |
$s =~ s/([\x00-\x08\x0A-\x1F\x25\x7F-\xFF])/sprintf '%%%02X', unpack 'C', $1/ge; |
$s =~ s/([\x00-\x08\x0A-\x1F\x25\x7F-\xFF])/sprintf '%%%02X', unpack 'C', $1/ge; |
1079 |
my %ua; |
my %ua; |
1080 |
for (split /\n/, &main::__get_database($main::PageName{UserAgentList})) { |
for (split /\n/, $main::database{$main::PageName{UserAgentList}}) { |
1081 |
if (/^-\[(\d+)\] (.+)$/) { |
if (/^-\[(\d+)\] (.+)$/) { |
1082 |
my ($t, $n) = ($1, $2); |
my ($t, $n) = ($1, $2); |
1083 |
$n =~ tr/\x0A\x0D//d; |
$n =~ tr/\x0A\x0D//d; |
1099 |
my $h = shift || {}; |
my $h = shift || {}; |
1100 |
my $val; |
my $val; |
1101 |
for my $line (split /\n/, $page) { |
for my $line (split /\n/, $page) { |
1102 |
|
next if $line =~ /^#/; |
1103 |
$line =~ tr/\x0A\x0D//d; |
$line =~ tr/\x0A\x0D//d; |
1104 |
if ($val && $line =~ s/^\s+//) { |
if ($val && $line =~ s/^\s+//) { |
1105 |
$h->{$val} .= length $h->{$val} ? "\n" . $line : $line; |
$h->{$val} .= length $h->{$val} ? "\n" . $line : $line; |
1116 |
sub Yuki::YukiWikiDB2::meta (@) {undef} |
sub Yuki::YukiWikiDB2::meta (@) {undef} |
1117 |
|
|
1118 |
package SuikaWiki::Plugin; |
package SuikaWiki::Plugin; |
1119 |
our $plugin_directory; |
our ($plugin_directory, %List, %Index, %Cache); |
|
our %List; |
|
|
our %Index; |
|
1120 |
push @main::INC, $plugin_directory.'/../..'; |
push @main::INC, $plugin_directory.'/../..'; |
1121 |
|
|
1122 |
sub escape ($$) { main::escape ($_[1]) } |
sub escape ($$) { main::escape ($_[1]) } |
1142 |
$main::fmt{format}->{($_[1]=~/([A-Za-z0-9]\S+)/?$1:'SuikaWiki/0.9').'_to_'.$_[2]} |
$main::fmt{format}->{($_[1]=~/([A-Za-z0-9]\S+)/?$1:'SuikaWiki/0.9').'_to_'.$_[2]} |
1143 |
|| $main::fmt{format}->{($_[1]=~/([A-Za-z0-9](?:(?!\/)\S)+)/?$1:'SuikaWiki').'_to_'.$_[2]}; |
|| $main::fmt{format}->{($_[1]=~/([A-Za-z0-9](?:(?!\/)\S)+)/?$1:'SuikaWiki').'_to_'.$_[2]}; |
1144 |
} |
} |
1145 |
|
sub cache ($$) { |
1146 |
|
my $name = $_[1]; |
1147 |
|
unless (ref $Cache{$name}) { |
1148 |
|
my %cache; |
1149 |
|
tie (%cache, 'Yuki::YukiWikiCache', -file => $main::PathTo{CachePrefix}.$name); |
1150 |
|
$Cache{$name} = \%cache; |
1151 |
|
} |
1152 |
|
$Cache{$name}; |
1153 |
|
} |
1154 |
|
|
1155 |
sub regist ($@) { |
sub regist ($@) { |
1156 |
my $pack = shift; |
my $pack = shift; |
1177 |
sub get_accept_lang (;$) { |
sub get_accept_lang (;$) { |
1178 |
my $alang = shift || $main::ENV{HTTP_ACCEPT_LANGUAGE}; |
my $alang = shift || $main::ENV{HTTP_ACCEPT_LANGUAGE}; |
1179 |
my %alang = (ja => 0.0002, en => 0.0001); |
my %alang = (ja => 0.0002, en => 0.0001); |
1180 |
|
if ($UA =~ m#Mozilla/0\.#) { |
1181 |
|
$alang{ja} = 0.00001; |
1182 |
|
} |
1183 |
my $i = 0.1; |
my $i = 0.1; |
1184 |
for (split /\s*,\s*/, $alang) { |
for (split /\s*,\s*/, $alang) { |
1185 |
tr/\x09\x0A\x0D\x20//d; |
tr/\x09\x0A\x0D\x20//d; |
1222 |
__END__ |
__END__ |
1223 |
=head1 NAME |
=head1 NAME |
1224 |
|
|
1225 |
wiki.cgi --- SuikaWiki: Yet yet another Wiki engine |
wiki.cgi --- SuikaWiki: Yet yet another WikiEngine |
1226 |
|
|
1227 |
=head1 SEE ALSO |
=head1 SEE ALSO |
1228 |
|
|