70 |
# my $modifier_sendmail = '/usr/sbin/sendmail -t -n'; # Your sendmail. |
# my $modifier_sendmail = '/usr/sbin/sendmail -t -n'; # Your sendmail. |
71 |
my $modifier_sendmail = ''; # If you don't need mail notification. |
my $modifier_sendmail = ''; # If you don't need mail notification. |
72 |
my $modifier_dir_data = './wikidata'; # Your data directory. |
my $modifier_dir_data = './wikidata'; # Your data directory. |
73 |
my $modifier_rss_title = "WalWiki $walversion"; |
my $modifier_rss_title = "SuikaWiki $walversion"; |
74 |
my $modifier_rss_link = 'http://suika.fam.cx/~wakaba/-temp/wiki2/wiki'; # Blank is not allowed. |
my $modifier_rss_link = 'http://suika.fam.cx/~wakaba/-temp/wiki2/wiki'; # Blank is not allowed. |
75 |
my $modifier_rss_description = 'This is WalWiki, yet another Wiki clone based on YukiWiki'; |
my $modifier_rss_description = 'This is SuikaWiki'; |
76 |
############################## |
############################## |
77 |
# |
# |
78 |
# You MAY modify following variables. |
# You MAY modify following variables. |
205 |
} |
} |
206 |
|
|
207 |
sub do_read { |
sub do_read { |
|
&print_header($form{mypage}); |
|
208 |
my $content = $database{$form{mypage}}; |
my $content = $database{$form{mypage}}; |
209 |
|
my $lm = &get_info($form{mypage}, $info_LastModified); |
210 |
|
&print_header($form{mypage}, -last_modified => $lm); |
211 |
|
wiki::referer::add ($form{mypage}, $ENV{HTTP_REFERER}); |
212 |
my $cf = 'SuikaWiki/0.9'; |
my $cf = 'SuikaWiki/0.9'; |
213 |
$cf = $1 if $content =~ s#^(?:/\*\s*|\#\?)?([A-Z][A-Za-z0-9-]+/[0-9.]+(?:\s[^\x0D\x0A]+)?)[\x0D\x0A]+##s; |
## Should be support at least: |
214 |
|
## - 'SuikaWiki/0.9' CRLF |
215 |
|
## - 'H2H/' ("0.9" / "1.0" / "1.1") CRLF |
216 |
|
## - "/*" WSP* 'W3C-CSS/' ("1.0" / "2.0") "*/" CRLF |
217 |
|
$cf = $1 if $content =~ s#^(?:/\*\s*|\#\?)?([A-Z][A-Za-z0-9-]+/[0-9.]+(?:[^0-9.][^\x0D\x0A]*)?)[\x0D\x0A]+##s; |
218 |
if ($cf =~ m#^SuikaWiki/0.9(?:$|\s)#) { |
if ($cf =~ m#^SuikaWiki/0.9(?:$|\s)#) { |
219 |
&print_content($content, $cf); |
&print_content($content, content_format => $cf, last_modified => $lm); |
220 |
print &text_to_html (q([[#comment]])); |
print &text_to_html (q([[#comment]])); |
221 |
} else { |
} else { |
222 |
print "<pre>@{[&escape($content)]}</pre>"; |
print "<pre>@{[&escape($content)]}</pre>"; |
226 |
print q{<h2 id="SEE-ALSO">See also</h2>}; |
print q{<h2 id="SEE-ALSO">See also</h2>}; |
227 |
print $r; |
print $r; |
228 |
} |
} |
229 |
&print_footer($form{mypage}); |
my $r = wiki::referer::list_html ($form{mypage}); |
230 |
|
if ($r) { |
231 |
|
print qq(<div id="wikipage-referer"><h2>»²ΎΘΈ΅</h2>\n$r</div>\n); |
232 |
|
} |
233 |
|
&print_footer($form{mypage}, $lm); |
234 |
} |
} |
235 |
|
|
236 |
sub do_output_css { |
sub do_output_css { |
352 |
&update_recent_changes; |
&update_recent_changes; |
353 |
} |
} |
354 |
&set_info($form{mypage}, $info_IsFrozen, 0 + $form{myfrozen}); |
&set_info($form{mypage}, $info_IsFrozen, 0 + $form{myfrozen}); |
355 |
&print_header($CompletedSuccessfully, -goto => $url_cgi.'?'.&encode($form{mypage})); |
&print_header($CompletedSuccessfully, -goto => $url_cgi.'?'.&encode($form{mypage}).($form{comment_index}?"#x-comment-$form{comment_index}":'')); |
356 |
&print_message($resource{saved}); |
&print_message($resource{saved}); |
357 |
&print_content("$resource{continuereading} @{[&armor_name($form{mypage})]}"); |
&print_content("$resource{continuereading} @{[&armor_name($form{mypage})]}"); |
358 |
&print_footer($CompletedSuccessfully); |
&print_footer($CompletedSuccessfully); |
394 |
|| index ($page, $word) > 0 |
|| index ($page, $word) > 0 |
395 |
|| index ($word, $page) > 0 |
|| index ($word, $page) > 0 |
396 |
) { |
) { |
397 |
$r .= qq(<li><a href ="$url_cgi?@{[&encode($page)]}" class="wiki">@{[&escape($page)]}</a>@{[&escape(&get_subjectline($page))]}</li>); |
$r .= qq(<li><a href ="$url_cgi?@{[&encode($page)]}" class="wiki">@{[&escape($page)]}</a> <span class="wikipage-summary">@{[&escape(&get_subjectline($page))]}</span></li>); |
398 |
$counter++; |
$counter++; |
399 |
} |
} |
400 |
} |
} |
435 |
exit(0); |
exit(0); |
436 |
} |
} |
437 |
|
|
438 |
sub print_header { |
sub print_header ($;%) { |
439 |
my ($page,%option) = @_; |
my ($page, %option) = @_; |
440 |
my $bodyclass = "normal"; |
my $bodyclass = "normal"; |
441 |
if (&is_frozen($page) and $form{mycmd} =~ /^(read|write)$/) { |
if (&is_frozen($page) and $form{mycmd} =~ /^(read|write)$/) { |
442 |
$bodyclass = "frozen"; |
$bodyclass = "frozen"; |
443 |
} |
} |
444 |
if ($option{-goto}) { |
print qq{Refresh: 0; url="$option{-goto}"\n} if $option{-goto}; |
445 |
print qq{Refresh: 0; url="$option{-goto}"\n}; |
print qq{Last-Modified: $option{-last_modified}\n} if $option{-last_modified}; |
|
} |
|
446 |
my $cookedpage = &encode($page); |
my $cookedpage = &encode($page); |
447 |
my $escapedpage = &escape($page); |
my $escapedpage = &escape($page); |
448 |
print <<"EOD"; |
print <<"EOD"; |
465 |
EOD |
EOD |
466 |
&print_navigate_links ($page); |
&print_navigate_links ($page); |
467 |
print <<EOD; |
print <<EOD; |
468 |
<h1 class="header"><a |
<h1 class="header">@{[&escape($page)]} |
469 |
title="$resource{searchthispage}" |
<span class="wikipage-summary">@{[&escape(&get_subjectline($page))]}</span></h1> |
|
href="$url_cgi?mycmd=search;mymsg=$cookedpage">@{[&escape($page)]}</a>@{[&escape(&get_subjectline($page))]}</h1> |
|
470 |
EOD |
EOD |
471 |
} |
} |
472 |
|
|
509 |
} |
} |
510 |
|
|
511 |
sub print_footer { |
sub print_footer { |
512 |
my ($page) = @_; |
my ($page, $lm) = @_; |
513 |
$walrus_log = ($walrus_debugging) ? &text_to_html("----\n$walrus_log") : ''; # Walrus add (debug) |
$walrus_log = ($walrus_debugging) ? &text_to_html("----\n$walrus_log") : ''; # Walrus add (debug) |
514 |
# Walrus mod (1) start |
# Walrus mod (1) start |
515 |
my $cvslog = '$Revision$ $Date$'; |
my $cvslog = '$Revision$ $Date$'; |
516 |
print_navigate_links ($page); |
print_navigate_links ($page); |
517 |
print <<"EOD"; |
print <<"EOD"; |
518 |
|
@{[ $lm ? qq(<div id="wikipage-last-modified">Last modified: $lm</div>) : '' ]} |
519 |
<div class="footer"> |
<div class="footer"> |
520 |
<p> |
<p> |
521 |
<a href="http://digit.que.ne.jp/work/">WalWiki</a> $walversion © 2000-2002 by <a href="http://digit.que.ne.jp/">Makio Tsukamoto</a>.<br /> |
<a href="http://digit.que.ne.jp/work/">WalWiki</a> $walversion © 2000-2002 by <a href="http://digit.que.ne.jp/">Makio Tsukamoto</a>.<br /> |
571 |
} |
} |
572 |
|
|
573 |
sub print_content ($;$) { |
sub print_content ($;$) { |
574 |
my ($rawcontent, $format) = @_; |
my ($rawcontent, %option) = @_; |
575 |
print &text_to_html($rawcontent, toc=>1); |
print &text_to_html($rawcontent, toc=>1); |
576 |
} |
} |
577 |
|
|
668 |
} |
} |
669 |
} |
} |
670 |
push(@result, splice(@saved)); |
push(@result, splice(@saved)); |
671 |
|
|
672 |
|
my $toc = ''; |
673 |
if ($option{toc}) { |
if ($option{toc}) { |
674 |
# Convert @toc (table of contents) to HTML. |
# Convert @toc (table of contents) to HTML. |
675 |
# This part is taken from Makio Tsukamoto's WalWiki. |
# This part is taken from Makio Tsukamoto's WalWiki. |
681 |
} |
} |
682 |
} |
} |
683 |
push(@tocresult, splice(@tocsaved)); |
push(@tocresult, splice(@tocsaved)); |
684 |
return join("\n", @tocresult, @result); |
$toc = join("\n", @tocresult); |
685 |
} else { |
$toc = $toc ? qq(<div id="wikipage-toc">$toc</div>) : ''; |
|
return join("\n", @result); |
|
686 |
} |
} |
687 |
|
return $toc . join("\n", @result); |
688 |
} |
} |
689 |
|
|
690 |
sub back_push { |
sub back_push { |
873 |
my $subject = $database{$page}; |
my $subject = $database{$page}; |
874 |
$subject =~ s#^SuikaWiki/0.9[^\x0D\x0A]*[\x0D\x0A]+##s; |
$subject =~ s#^SuikaWiki/0.9[^\x0D\x0A]*[\x0D\x0A]+##s; |
875 |
$subject =~ s/\r?\n.*//s; |
$subject =~ s/\r?\n.*//s; |
876 |
return "$delim$subject"; |
return "$delim$subject".$option{tail}; |
877 |
} |
} |
878 |
} |
} |
879 |
|
|
1236 |
#} else { |
#} else { |
1237 |
# $content =~ s/(\Q$embed_rcomment\E)/$1\n- $datestr$namestr$form{mymsg}/; |
# $content =~ s/(\Q$embed_rcomment\E)/$1\n- $datestr$namestr$form{mymsg}/; |
1238 |
#} |
#} |
1239 |
my $i = 0; my $o = 0; |
my $i = 1; my $o = 0; |
1240 |
$content =~ s{(\Q$embed_comment\E|\Q$embed_rcomment\E)}{ |
$content =~ s{(\Q$embed_comment\E|\Q$embed_rcomment\E)}{ |
1241 |
my $embed = $1; |
my $embed = $1; |
1242 |
if ($i == $form{comment_index}) { |
if ($i == $form{comment_index}) { |
1261 |
} |
} |
1262 |
} |
} |
1263 |
|
|
1264 |
my $_O_COMMENT_INDEX = 0; |
my $CommentIndex = 0; |
1265 |
sub embedded_to_html { |
sub embedded_to_html { |
1266 |
my ($embedded) = @_; |
my ($embedded) = @_; |
1267 |
if ($embedded eq $embed_comment or $embedded eq $embed_rcomment) { |
if ($embedded eq $embed_comment or $embedded eq $embed_rcomment) { |
1268 |
my $lastmodified = &get_info($form{mypage}, $info_LastModified); |
my $lastmodified = &get_info($form{mypage}, $info_LastModified); |
1269 |
return <<"EOD"; |
return <<"EOD"; |
1270 |
<form action="$url_cgi" method="post"> |
<form action="$url_cgi" method="post" id="x-comment-@{[++$CommentIndex]}"> |
1271 |
<input type="hidden" name="mycmd" value="comment"> |
<input type="hidden" name="mycmd" value="comment"> |
1272 |
<input type="hidden" name="mypage" value="$form{mypage}"> |
<input type="hidden" name="mypage" value="$form{mypage}"> |
1273 |
<input type="hidden" name="myLastModified" value="$lastmodified"> |
<input type="hidden" name="myLastModified" value="$lastmodified"> |
1274 |
<input type="hidden" name="mytouch" value="on"> |
<input type="hidden" name="mytouch" value="on"> |
1275 |
<input type="hidden" name="comment_index" value="@{[$_O_COMMENT_INDEX++]}"> |
<input type="hidden" name="comment_index" value="$CommentIndex"> |
1276 |
$embed_comment_Name_Prompt |
$embed_comment_Name_Prompt |
1277 |
<input type="text" name="myname" value="" size="10"> |
<input type="text" name="myname" value="" size="10"> |
1278 |
<input type="text" name="mymsg" value="" size="60"> |
<input type="text" name="mymsg" value="" size="60"> |
1327 |
# Walrus add (5) end |
# Walrus add (5) end |
1328 |
|
|
1329 |
sub code_convert { |
sub code_convert { |
1330 |
my ($contentref, $kanjicode) = @_; |
my ($contentref, $code) = (shift, shift || $kanjicode); |
1331 |
# &Jcode::convert($contentref, $kanjicode); # for Jcode.pm |
# &Jcode::convert($contentref, $code); # for Jcode.pm |
1332 |
&jcode::convert($contentref, $kanjicode); # for jcode.pl |
&jcode::convert($contentref, $code); # for jcode.pl |
1333 |
return $$contentref; |
return $$contentref; |
1334 |
} |
} |
1335 |
|
|
1468 |
} |
} |
1469 |
} |
} |
1470 |
|
|
1471 |
|
sub __get_database ($) { $database{ $_[0] } } |
1472 |
|
|
1473 |
|
package wiki::referer; |
1474 |
|
sub add ($$) { |
1475 |
|
my $page = shift; |
1476 |
|
my $uri = shift; |
1477 |
|
unless (ref $uri) { |
1478 |
|
require URI; |
1479 |
|
$uri = URI->new ($uri); |
1480 |
|
## Some schemes do not have query part. |
1481 |
|
eval q{ $uri->query (undef) if $uri->query =~ /^[0-9]{6,8}$/ }; |
1482 |
|
$uri->fragment (undef); |
1483 |
|
} |
1484 |
|
$uri = $uri->canonical; |
1485 |
|
return unless $uri; |
1486 |
|
for my $regex (&get_dont_record) { |
1487 |
|
return if $uri =~ /$regex/; |
1488 |
|
} |
1489 |
|
my %list = get ($page); |
1490 |
|
$list{ $uri }++; |
1491 |
|
set ($page, \%list); |
1492 |
|
} |
1493 |
|
sub get ($) { |
1494 |
|
my $page = shift; |
1495 |
|
split /"/, main::get_info ($page, 'Referer'); |
1496 |
|
} |
1497 |
|
sub set ($%) { |
1498 |
|
my $page = shift; |
1499 |
|
my $list = shift; |
1500 |
|
main::set_info ($page, Referer => join '"', %$list); |
1501 |
|
} |
1502 |
|
|
1503 |
|
sub get_dont_record () { |
1504 |
|
map {s/\$/\\\$/g; s/\@/\\\@/g; $_} |
1505 |
|
grep !/^#/, |
1506 |
|
split /[\x0D\x0A]+/, &main::__get_database ('RefererDontRecord'); |
1507 |
|
} |
1508 |
|
sub get_site_name () { |
1509 |
|
my @lines = grep /[^#]/, split /[\x0D\x0A]+/, &main::__get_database('RefererSiteName'); |
1510 |
|
my %item; |
1511 |
|
for (@lines) { |
1512 |
|
next if /^#/; |
1513 |
|
my ($uri, $name) = split /\s+/, $_, 2; |
1514 |
|
$uri =~ s/\$/\\\$/g; $uri =~ s/\@/\\\@/g; $uri =~ s/\//\\\//g; |
1515 |
|
$name =~ s![()/\\]!\\$1!g; $name =~ s/\$([0-9]+)/).__decode (\${$1}).q(/g; |
1516 |
|
$item{$uri} = qq(q($name)); |
1517 |
|
} |
1518 |
|
%item; |
1519 |
|
} |
1520 |
|
|
1521 |
|
sub list_html ($) { |
1522 |
|
my $page = shift; |
1523 |
|
my %list = get ($page); |
1524 |
|
my $r = ''; |
1525 |
|
my %name = get_site_name; |
1526 |
|
for my $uri (sort keys %list) { |
1527 |
|
my $title; |
1528 |
|
for my $regex (keys %name) { |
1529 |
|
if ($uri =~ /$regex/) { |
1530 |
|
$title = $uri; |
1531 |
|
eval qq{\$title =~ s/^.*$regex.*\$/$name{$regex}/e} or die $@; |
1532 |
|
last; |
1533 |
|
} |
1534 |
|
} |
1535 |
|
my $euri = main::escape ($uri); |
1536 |
|
if ($title) { |
1537 |
|
$r .= qq(<li>[$list{$uri}] <a href="$euri" title="URI: <$euri>">@{[main::escape ($title)]}</a></li>\n); |
1538 |
|
} else { |
1539 |
|
$r .= qq(<li>[$list{$uri}] <<a href="$euri">$euri</a>></li>\n); |
1540 |
|
} |
1541 |
|
} |
1542 |
|
$r ? qq(<ul>$r</ul>\n) : ''; |
1543 |
|
} |
1544 |
|
|
1545 |
|
sub __decode ($) { |
1546 |
|
my $s = shift; |
1547 |
|
$s =~ tr/+/ /; |
1548 |
|
$s =~ s/%([0-9A-Fa-f][0-9A-Fa-f])/chr hex $1/ge; |
1549 |
|
main::code_convert (\$s); |
1550 |
|
} |
1551 |
|
|
1552 |
1; |
1; |
1553 |
__END__ |
__END__ |
1554 |
=head1 NAME |
=head1 NAME |