82 |
my $file_FrontPage = "$modifier_dir_data/frontpage.txt"; |
my $file_FrontPage = "$modifier_dir_data/frontpage.txt"; |
83 |
my $file_conflict = "$modifier_dir_data/conflict.txt"; |
my $file_conflict = "$modifier_dir_data/conflict.txt"; |
84 |
my $file_format = "$modifier_dir_data/format.txt"; |
my $file_format = "$modifier_dir_data/format.txt"; |
85 |
my $url_cgi = 'wiki'; |
my $url_cgi = '/~wakaba/-temp/wiki/wiki'; ## MUST be started from '/' |
86 |
my $url_stylesheet = $url_cgi.'?mycmd=TEXT_CSS;mypage=WikiHTMLStyle'; |
my $url_stylesheet = $url_cgi.'?mycmd=TEXT_CSS;mypage=WikiHTMLStyle'; |
87 |
my $icontag = '<img src="/icons/folder" alt="*" width="40" height="40" />'; |
my $icontag = '<img src="/icons/folder" alt="*" width="40" height="40" />'; |
88 |
my $maxrecent = 50; |
my $maxrecent = 50; |
177 |
createresult => \&do_createresult, |
createresult => \&do_createresult, |
178 |
FrontPage => \&do_FrontPage, |
FrontPage => \&do_FrontPage, |
179 |
comment => \&do_comment, |
comment => \&do_comment, |
180 |
|
RandomJump => \&do_random_jump, |
181 |
rss => \&do_rss, |
rss => \&do_rss, |
182 |
diff => \&do_diff, |
diff => \&do_diff, |
183 |
interwikibox => \&do_interwiki_box, # Walrus add (5) |
interwikibox => \&do_interwiki_box, # Walrus add (5) |
208 |
sub do_read { |
sub do_read { |
209 |
my $content = $database{$form{mypage}}; |
my $content = $database{$form{mypage}}; |
210 |
my $lm = &get_info($form{mypage}, $info_LastModified); |
my $lm = &get_info($form{mypage}, $info_LastModified); |
|
&print_header($form{mypage}, -last_modified => $lm); |
|
211 |
wiki::referer::add ($form{mypage}, $ENV{HTTP_REFERER}); |
wiki::referer::add ($form{mypage}, $ENV{HTTP_REFERER}); |
212 |
|
my ($r, $c) = get_search_result ($form{mypage}); |
213 |
|
my $rl = wiki::referer::list_html ($form{mypage}); |
214 |
|
my @toc; |
215 |
|
push @toc, qq(-<a href="#wikipage-see-also">See Also</a>) if $c; |
216 |
|
push @toc, qq(-<a href="#wikipage-referer">参照元</a>) if $rl; |
217 |
my $cf = 'SuikaWiki/0.9'; |
my $cf = 'SuikaWiki/0.9'; |
218 |
## Should be support at least: |
## Should be support at least: |
219 |
## - 'SuikaWiki/0.9' CRLF |
## - 'SuikaWiki/0.9' CRLF |
220 |
## - 'H2H/' ("0.9" / "1.0" / "1.1") CRLF |
## - 'H2H/' ("0.9" / "1.0" / "1.1") CRLF |
221 |
## - "/*" WSP* 'W3C-CSS/' ("1.0" / "2.0") "*/" CRLF |
## - "/*" WSP* 'W3C-CSS/' ("1.0" / "2.0") "*/" CRLF |
222 |
$cf = $1 if $content =~ s#^(?:/\*\s*|\#\?)?([A-Z][A-Za-z0-9-]+/[0-9.]+(?:[^0-9.][^\x0D\x0A]*)?)[\x0D\x0A]+##s; |
$cf = $1 if $content =~ s#^(?:/\*\s*|[\#<]\?)?([A-Z][A-Za-z0-9-]+/[0-9.]+(?:[^0-9.][^\x0D\x0A]*)?)[\x0D\x0A]+##s; |
223 |
if ($cf =~ m#^SuikaWiki/0.9(?:$|\s)#) { |
if ($cf =~ m!^(?:\#\?)?SuikaWiki/0.9(?:$|\s)!) { |
224 |
&print_content($content, content_format => $cf, last_modified => $lm); |
&print_header ($form{mypage}, -last_modified => $lm, |
225 |
|
-content_format => $cf, -noindex => $cf =~ /obsoleted="yes"/); |
226 |
|
&print_content ($content, content_format => $cf, last_modified => $lm, |
227 |
|
-toc => \@toc); |
228 |
print &text_to_html (q([[#comment]])); |
print &text_to_html (q([[#comment]])); |
229 |
} else { |
} else { |
230 |
|
&print_header($form{mypage}, -last_modified => $lm); |
231 |
print "<pre>@{[&escape($content)]}</pre>"; |
print "<pre>@{[&escape($content)]}</pre>"; |
232 |
} |
} |
|
my ($r, $c) = get_search_result ($form{mypage}); |
|
233 |
if ($c) { |
if ($c) { |
234 |
print q{<h2 id="SEE-ALSO">See also</h2>}; |
print q{<h2 id="wikipage-see-also">See also</h2>}; |
235 |
print $r; |
print $r; |
236 |
} |
} |
237 |
my $r = wiki::referer::list_html ($form{mypage}); |
if ($rl) { |
238 |
if ($r) { |
print qq(<div id="wikipage-referer"><h2>参照元</h2>\n$rl</div>\n); |
|
print qq(<div id="wikipage-referer"><h2>参照元</h2>\n$r</div>\n); |
|
239 |
} |
} |
240 |
&print_footer($form{mypage}, $lm); |
&print_footer($form{mypage}, $lm); |
241 |
} |
} |
243 |
sub do_output_css { |
sub do_output_css { |
244 |
my $content = $database{$form{mypage}}; |
my $content = $database{$form{mypage}}; |
245 |
if ($content =~ m#^\s*/\*\s*W3C-CSS#) { |
if ($content =~ m#^\s*/\*\s*W3C-CSS#) { |
246 |
|
my $lm = &get_info($form{mypage}, $info_LastModified); |
247 |
print "Content-Type: text/css; charset=$charset\n"; |
print "Content-Type: text/css; charset=$charset\n"; |
248 |
|
print "Last-Modified: $lm\n"; |
249 |
print "\n"; |
print "\n"; |
250 |
print $content; |
print $content; |
251 |
} else { |
} else { |
252 |
print "Status: 406 Unsupported Media Type\n"; |
print "Status: 406 Unsupported Media Type\n"; |
253 |
&print_header('WikiPageIsNotCSS'); |
&print_header('WikiPageIsNotCSS', -noindex => 1); |
254 |
&print_content($database{WikiPageIsNotCSS}); |
&print_content($database{WikiPageIsNotCSS}); |
255 |
&print_footer('WikiPageIsNotCSS'); |
&print_footer('WikiPageIsNotCSS'); |
256 |
} |
} |
258 |
|
|
259 |
sub do_edit { |
sub do_edit { |
260 |
my ($page) = &unarmor_name(&armor_name($form{mypage})); |
my ($page) = &unarmor_name(&armor_name($form{mypage})); |
261 |
&print_header($page); |
&print_header($page, -noindex => 1); |
262 |
if (not &is_editable($page)) { |
if (not &is_editable($page)) { |
263 |
&print_message($resource{cantchange}); |
&print_message($resource{cantchange}); |
264 |
} elsif (&is_frozen($page)) { |
} elsif (&is_frozen($page)) { |
271 |
|
|
272 |
sub do_adminedit { |
sub do_adminedit { |
273 |
my ($page) = &unarmor_name(&armor_name($form{mypage})); |
my ($page) = &unarmor_name(&armor_name($form{mypage})); |
274 |
&print_header($page); |
&print_header($page, -noindex => 1); |
275 |
if (not &is_editable($page)) { |
if (not &is_editable($page)) { |
276 |
&print_message($resource{cantchange}); |
&print_message($resource{cantchange}); |
277 |
} else { |
} else { |
282 |
} |
} |
283 |
|
|
284 |
sub do_adminchangepasswordform { |
sub do_adminchangepasswordform { |
285 |
&print_header($AdminChangePassword); |
&print_header($AdminChangePassword, -noindex => 1); |
286 |
&print_passwordform; |
&print_passwordform; |
287 |
&print_footer($AdminChangePassword); |
&print_footer($AdminChangePassword); |
288 |
} |
} |
309 |
my $crypted = crypt($form{mynewpassword}, "$salt1$salt2"); |
my $crypted = crypt($form{mynewpassword}, "$salt1$salt2"); |
310 |
&set_info($AdminSpecialPage, $info_AdminPassword, $crypted); |
&set_info($AdminSpecialPage, $info_AdminPassword, $crypted); |
311 |
|
|
312 |
&print_header($CompletedSuccessfully); |
&print_header($CompletedSuccessfully, -noindex => 1); |
313 |
&print_message($resource{passwordchanged}); |
&print_message($resource{passwordchanged}); |
314 |
&print_footer($CompletedSuccessfully); |
&print_footer($CompletedSuccessfully); |
315 |
} |
} |
334 |
} |
} |
335 |
|
|
336 |
if (not &is_editable($form{mypage})) { |
if (not &is_editable($form{mypage})) { |
337 |
&print_header($form{mypage}); |
&print_header($form{mypage}, -noindex => 1); |
338 |
&print_message($resource{cantchange}); |
&print_message($resource{cantchange}); |
339 |
&print_footer($form{mypage}); |
&print_footer($form{mypage}); |
340 |
return; |
return; |
361 |
&update_recent_changes; |
&update_recent_changes; |
362 |
} |
} |
363 |
&set_info($form{mypage}, $info_IsFrozen, 0 + $form{myfrozen}); |
&set_info($form{mypage}, $info_IsFrozen, 0 + $form{myfrozen}); |
364 |
&print_header($CompletedSuccessfully, -goto => $url_cgi.'?'.&encode($form{mypage}).($form{comment_index}?"#x-comment-$form{comment_index}":'')); |
&print_header($CompletedSuccessfully, -noindex => 1, -goto => $url_cgi.'?'.&encode($form{mypage}).($form{__comment_anchor_index}?"#anchor-$form{__comment_anchor_index}":'')); |
365 |
&print_message($resource{saved}); |
&print_message($resource{saved}); |
366 |
&print_content("$resource{continuereading} @{[&armor_name($form{mypage})]}"); |
&print_content("$resource{continuereading} @{[&armor_name($form{mypage})]}"); |
367 |
&print_footer($CompletedSuccessfully); |
&print_footer($CompletedSuccessfully); |
372 |
if ($form{mytouch}) { |
if ($form{mytouch}) { |
373 |
&update_recent_changes; |
&update_recent_changes; |
374 |
} |
} |
375 |
&print_header($form{mypage}); |
&print_header($form{mypage}, -noindex => 1); |
376 |
&print_message($resource{deleted}); |
&print_message($resource{deleted}); |
377 |
&print_footer($form{mypage}); |
&print_footer($form{mypage}); |
378 |
} |
} |
399 |
my $r = ''; |
my $r = ''; |
400 |
foreach my $page (sort keys %database) { |
foreach my $page (sort keys %database) { |
401 |
next if $page eq $RecentChanges; |
next if $page eq $RecentChanges; |
402 |
if ( index ($database{$page}, $word) > 0 |
my $content = $database{$page}; |
403 |
|
$content =~ s/^\#\?[^\x0A\x0D]+//s; |
404 |
|
if ( index ($content, $word) > 0 |
405 |
|| index ($page, $word) > 0 |
|| index ($page, $word) > 0 |
406 |
|| index ($word, $page) > 0 |
|| index ($word, $page) > 0 |
407 |
) { |
) { |
428 |
&print_footer($CreatePage); |
&print_footer($CreatePage); |
429 |
} |
} |
430 |
|
|
431 |
|
sub do_random_jump { |
432 |
|
my @list = keys %database; |
433 |
|
my $name = &encode ($list[rand @list]); |
434 |
|
my ($scheme) = 'http'; |
435 |
|
$scheme = $1 if $main::ENV{SERVER_PROTOCOL} =~ m#([A-Za-z0-9+.%-]+)#; |
436 |
|
print "Location: $scheme://$main::ENV{SERVER_NAME}:$main::ENV{SERVER_PORT}$url_cgi?$name\n"; |
437 |
|
print "\n"; |
438 |
|
} |
439 |
|
|
440 |
sub do_FrontPage { |
sub do_FrontPage { |
441 |
open(FILE, $file_FrontPage) or &print_error("($file_FrontPage)"); |
open(FILE, $file_FrontPage) or &print_error("($file_FrontPage)"); |
442 |
my $content = join('', <FILE>); |
my $content = join('', <FILE>); |
449 |
|
|
450 |
sub print_error { |
sub print_error { |
451 |
my ($msg) = @_; |
my ($msg) = @_; |
452 |
&print_header($ErrorPage); |
&print_header($ErrorPage, -noindex => 1); |
453 |
print qq(<p><strong class="error">$msg</strong></p>); |
print qq(<p><strong class="error">$msg</strong></p>); |
454 |
&print_footer($ErrorPage); |
&print_footer($ErrorPage); |
455 |
exit(0); |
exit(0); |
461 |
if (&is_frozen($page) and $form{mycmd} =~ /^(read|write)$/) { |
if (&is_frozen($page) and $form{mycmd} =~ /^(read|write)$/) { |
462 |
$bodyclass = "frozen"; |
$bodyclass = "frozen"; |
463 |
} |
} |
464 |
|
$bodyclass .= " wiki-page-obsoleted" if $option{-content_format} =~ /obsoleted="yes"/; |
465 |
print qq{Refresh: 0; url="$option{-goto}"\n} if $option{-goto}; |
print qq{Refresh: 0; url="$option{-goto}"\n} if $option{-goto}; |
466 |
print qq{Last-Modified: $option{-last_modified}\n} if $option{-last_modified}; |
print qq{Last-Modified: $option{-last_modified}\n} if $option{-last_modified}; |
467 |
my $cookedpage = &encode($page); |
my $cookedpage = &encode($page); |
471 |
Content-Language: $lang |
Content-Language: $lang |
472 |
Content-Style-Type: text/css |
Content-Style-Type: text/css |
473 |
|
|
474 |
|
<!-- |
475 |
<!DOCTYPE html |
<!DOCTYPE html |
476 |
PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" |
PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" |
477 |
"http://www.w3.org/TR/html4/loose.dtd"> |
"http://www.w3.org/TR/html4/loose.dtd"> + RUBY --> |
478 |
<html lang="$lang"> |
<html lang="$lang"> |
479 |
<head> |
<head> |
480 |
<title>$escapedpage @{[&escape(&get_subjectline($page))]}</title> |
<title>$escapedpage</title> |
481 |
<link rel="index" href="$url_cgi?$IndexPage"> |
<link rel="index" href="$url_cgi?$IndexPage"> |
482 |
<link rel="copyright" href="$url_cgi?$NAME_OF_WikiPageLicense"> |
<link rel="copyright" href="$url_cgi?$NAME_OF_WikiPageLicense"> |
483 |
<link rev="made" href="mailto:@{[&escape($modifier_mail)]}"> |
<link rev="made" href="mailto:@{[&escape($modifier_mail)]}"> |
484 |
<link rel="stylesheet" type="text/css" href="@{[&escape($url_stylesheet)]}"> |
<link rel="stylesheet" type="text/css" href="@{[&escape($url_stylesheet)]}"> |
485 |
|
@{[$option{-noindex} ? q(<meta name="ROBOTS" content="NOINDEX">) : '']} |
486 |
</head> |
</head> |
487 |
<body class="$bodyclass"> |
<body class="$bodyclass"> |
488 |
EOD |
EOD |
489 |
&print_navigate_links ($page); |
&print_navigate_links ($page); |
490 |
print <<EOD; |
print <<EOD; |
491 |
<h1 class="header">@{[&escape($page)]} |
<h1 class="header">@{[&escape($page)]}</h1> |
|
<span class="wikipage-summary">@{[&escape(&get_subjectline($page))]}</span></h1> |
|
492 |
EOD |
EOD |
493 |
} |
} |
494 |
|
|
498 |
my $admineditable = 0; |
my $admineditable = 0; |
499 |
if (&is_frozen($page) and $form{mycmd} =~ /^(read|write)$/) { |
if (&is_frozen($page) and $form{mycmd} =~ /^(read|write)$/) { |
500 |
$editable = 0; |
$editable = 0; |
501 |
$admineditable = 1; |
#$admineditable = 1; |
502 |
} elsif (&is_editable($page) and $form{mycmd} =~ /^(read|write)$/) { |
} elsif (&is_editable($page) and $form{mycmd} =~ /^(read|write)$/) { |
503 |
$admineditable = 1; |
#$admineditable = 1; |
504 |
$editable = 1; |
$editable = 1; |
505 |
} else { |
} else { |
506 |
$editable = 0; |
$editable = 0; |
513 |
: qq() |
: qq() |
514 |
]} |
]} |
515 |
@{[ $editable |
@{[ $editable |
516 |
? qq(<a title="$resource{editthispage}" href="$url_cgi?mycmd=edit;mypage=$cookedpage" accesskey="E">$resource{editbutton} <kbd>E</kbd></a> | ) |
? #qq(<a title="$resource{editthispage}" href="$url_cgi?mycmd=edit;mypage=$cookedpage" accesskey="E">$resource{editbutton} <kbd>E</kbd></a> | ) |
517 |
|
qq(<a title="$resource{editthispage}" href="$url_cgi?mycmd=edit;mypage=$cookedpage" accesskey="E">編集</a> | ) |
518 |
: qq() |
: qq() |
519 |
]} |
]} |
520 |
@{[ $admineditable |
@{[ $admineditable |
521 |
? qq(<a href="$url_cgi?mycmd=diff;mypage=$cookedpage">$resource{diffbutton}</a> | ) |
? qq(<a href="$url_cgi?mycmd=diff;mypage=$cookedpage">$resource{diffbutton}</a> | ) |
522 |
: qq() |
: qq() |
523 |
]} |
]} |
524 |
<a href="$url_cgi?$CreatePage">$resource{createbutton}</a> | |
<a href="$url_cgi?$CreatePage" class="wiki">新規</a> | |
525 |
<a href="$url_cgi?$IndexPage">$resource{indexbutton}</a> | |
<a href="$url_cgi?$IndexPage" class="wiki">$resource{indexbutton}</a> | |
526 |
<a href="$url_cgi?$RssPage">$resource{rssbutton}</a> | |
<a href="$url_cgi?$FrontPage" class="wiki">首頁</a> | |
527 |
<a href="$url_cgi?$FrontPage">$FrontPage</a> | |
<a href="$url_cgi?$SearchPage" class="wiki">$resource{searchbutton}</a> | |
528 |
<a href="$url_cgi?$SearchPage">$resource{searchbutton}</a> | |
<a href="$url_cgi?mycmd=RandomJump;x-param=@{[time.[0..9]->[rand 10]]}" class="wiki randomlink">どこか</a> | |
529 |
<a href="$url_cgi?$RecentChanges">$resource{recentchangesbutton}</a> |
<a href="$url_cgi?$RecentChanges" class="wiki">最新</a> |
530 |
|
</div> |
531 |
|
EOH |
532 |
|
<<EOH; ## temp |
533 |
|
<a href="$url_cgi?$CreatePage" class="wiki">$resource{createbutton}</a> | |
534 |
|
<a href="$url_cgi?$IndexPage" class="wiki">$resource{indexbutton}</a> | |
535 |
|
<!-- <a href="$url_cgi?$RssPage" class="wiki">$resource{rssbutton}</a> | --> |
536 |
|
<a href="$url_cgi?$FrontPage" class="wiki">$FrontPage</a> | |
537 |
|
<a href="$url_cgi?$SearchPage" class="wiki">$resource{searchbutton}</a> | |
538 |
|
<a href="$url_cgi?mycmd=RandomJump;x-param=@{[time.[0..9]->[rand 10]]}" class="wiki randomlink">どこか</a> | |
539 |
|
<a href="$url_cgi?$RecentChanges" class="wiki">$resource{recentchangesbutton}</a> |
540 |
</div> |
</div> |
541 |
EOH |
EOH |
542 |
} |
} |
545 |
my ($page, $lm) = @_; |
my ($page, $lm) = @_; |
546 |
$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) |
547 |
# Walrus mod (1) start |
# Walrus mod (1) start |
548 |
my $cvslog = '$Revision$ $Date$'; |
my $cvslog1 = q$Revision$; |
549 |
|
my $cvslog2 = q$Date$; |
550 |
print_navigate_links ($page); |
print_navigate_links ($page); |
551 |
print <<"EOD"; |
print <<"EOD"; |
552 |
@{[ $lm ? qq(<div id="wikipage-last-modified">Last modified: $lm</div>) : '' ]} |
@{[ $lm ? qq(<div id="wikipage-last-modified">Last modified: $lm</div>) : '' ]} |
553 |
<div class="footer"> |
<div class="footer"> |
554 |
<p> |
<a href="http://www.hyuki.com/yukiwiki/" title="$version © 2000-2002 by Hiroshi Yuki">YukiWiki</a> <a href="http://digit.que.ne.jp/work/" title="$walversion © 2000-2002 by Makio Tsukamoto">WalWiki</a> |
555 |
<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="/gate/cvs/wakaba/wiki/" title="CVS Repository of this script ($cvslog2)">SuikaWiki $cvslog1</a> |
|
based on <a href="http://www.hyuki.com/yukiwiki/">YukiWiki</a> $version © 2000-2002 by <a href="http://www.hyuki.com/">Hiroshi Yuki</a>.<br /> |
|
|
<a href="/gate/cvs/wakaba/wiki/" title="CVS Repository"> |
|
|
$cvslog |
|
|
</a> |
|
|
</p> |
|
556 |
<div class="navigation"> |
<div class="navigation"> |
557 |
[<a href="/" title="このサーバーの首頁">/</a> |
[<a href="/" title="このサーバーの首頁">/</a> |
558 |
<a href="/map" title="このサーバーの案内">地図</a> |
<a href="/map" title="このサーバーの案内">地図</a> |
601 |
|
|
602 |
sub print_content ($;$) { |
sub print_content ($;$) { |
603 |
my ($rawcontent, %option) = @_; |
my ($rawcontent, %option) = @_; |
604 |
print &text_to_html($rawcontent, toc=>1); |
print &text_to_html($rawcontent, toc=>1, %option); |
605 |
} |
} |
606 |
|
|
607 |
sub text_to_html { |
sub text_to_html { |
608 |
my ($txt, %option) = @_; |
my ($txt, %option) = @_; |
609 |
my (@txt) = split(/\n/, $txt); |
my (@txt) = split(/\n/, $txt); |
610 |
my (@toc); |
my @toc; |
611 |
|
my @toc2 = @{$option{-toc}||[]}; |
612 |
my $tocnum = 0; |
my $tocnum = 0; |
613 |
my (@saved, @result); |
my (@saved, @result); |
614 |
unshift(@saved, "</p>"); |
unshift(@saved, "</p>"); |
641 |
&back_push('ol', length($1), \@saved, \@result); |
&back_push('ol', length($1), \@saved, \@result); |
642 |
push(@result, '<li>' . &inline($2) . '</li>'); |
push(@result, '<li>' . &inline($2) . '</li>'); |
643 |
} elsif (/^(-{1,6})(.*)/) { |
} elsif (/^(-{1,6})(.*)/) { |
644 |
&back_push('ul', length($1), \@saved, \@result); |
&back_push('ul', length($1), \@saved, \@result); |
645 |
push(@result, '<li>' . &inline($2) . '</li>'); |
my ($pf, $l) = ('', $2); |
646 |
|
if (!$main::_EMBEDED && $l =~ s/^\s*\[([0-9]+)\]//) { |
647 |
|
my $num = 0+$1; |
648 |
|
$pf = qq(<a name="anchor-$num" id="anchor-$num" class="anchor">[$num]</a>); |
649 |
|
} |
650 |
|
push(@result, '<li>' . $pf . &inline ($l) . '</li>'); |
651 |
} elsif (/^:([^:]+):(.*)/) { |
} elsif (/^:([^:]+):(.*)/) { |
652 |
&back_push('dl', 1, \@saved, \@result); |
&back_push('dl', 1, \@saved, \@result); |
653 |
push(@result, '<dt>' . &inline($1) . '</dt>', '<dd>' . &inline($2) . '</dd>'); |
push(@result, '<dt>' . &inline($1) . '</dt>', '<dd>' . &inline($2) . '</dd>'); |
686 |
push(@result, join('', '<tr>', @value, '</tr>')); |
push(@result, join('', '<tr>', @value, '</tr>')); |
687 |
# XXXXX |
# XXXXX |
688 |
####### |
####### |
689 |
} elsif (/^\[INS\[/) { |
} elsif (/^\[(INS|DEL|PRE)\[\s*$/) { |
690 |
push(@result, "<ins>"); |
push @result, splice (@saved), '<'.lc($1).'>'; |
691 |
} elsif (/^\]INS\]/) { |
unshift @saved, "</p>"; |
692 |
push(@result, "</ins>"); |
push @result, "<p>"; |
693 |
} elsif (/^\[DEL\[/) { |
} elsif (/^\](INS|DEL|PRE)\]\s*$/) { |
694 |
push(@result, "<del>"); |
push @result, splice (@saved), '</'.lc($1).'>'; |
695 |
} elsif (/^\]DEL\]/) { |
} elsif (/^\[([0-9]+)\](.*)$/ && !$main::_EMBEDED) { |
696 |
push(@result, "</del>"); |
my $num = 0+$1; |
697 |
} elsif (/^\[PRE\[/) { |
push @result, qq(<a name="anchor-$num" id="anchor-$num" class="anchor">[$num]</a>); |
698 |
push(@result, "<pre>"); |
push @result, &inline ($2); |
|
} elsif (/^\]PRE\]/) { |
|
|
push(@result, "</pre>"); |
|
699 |
} else { |
} else { |
700 |
push(@result, &inline($_)); |
push(@result, &inline($_)); |
701 |
} |
} |
707 |
# Convert @toc (table of contents) to HTML. |
# Convert @toc (table of contents) to HTML. |
708 |
# This part is taken from Makio Tsukamoto's WalWiki. |
# This part is taken from Makio Tsukamoto's WalWiki. |
709 |
my (@tocsaved, @tocresult); |
my (@tocsaved, @tocresult); |
710 |
foreach (@toc) { |
foreach (@toc,@toc2) { |
711 |
if (/^(-{1,6})(.*)$/) { |
if (/^(-{1,6})(.*)$/) { |
712 |
&back_push('ul', length($1), \@tocsaved, \@tocresult); |
&back_push('ul', length($1), \@tocsaved, \@tocresult); |
713 |
push(@tocresult, '<li>' . $2 . '</li>'); |
push(@tocresult, '<li>' . $2 . '</li>'); |
737 |
sub inline { |
sub inline { |
738 |
my ($line) = @_; |
my ($line) = @_; |
739 |
$line = &escape($line); |
$line = &escape($line); |
740 |
|
$line =~ s:\[(INS|DEL|SUP|SUB)\[(.+?)\]\]:<@{[lc $1]}>$2</@{[lc $1]}>:g; |
741 |
|
$line =~ s:\[ABBR\[(.+?)\] \[(.+?)\]\]:<acronym title="$2">$1</acronym>:g; |
742 |
|
$line =~ s:\[RUBY\[(.+?)\] \[(.+?)\]\]:<ruby><rb>$1</rb><rp>(</rp><rt>$2</rt><rp>)</rp></ruby>:g; |
743 |
|
$line =~ s%\[Q\[(.+?)\](?: \[<([\x21-\x5A\x5E-\x7E]+)>\])?\]%「<q@{[$2?qq( cite="$2"):'']}>$1</q>」%g; |
744 |
$line =~ s|'''([^']+?)'''|<strong>$1</strong>|g; |
$line =~ s|'''([^']+?)'''|<strong>$1</strong>|g; |
745 |
$line =~ s|''([^']+?)''|<em>$1</em>|g; |
$line =~ s|''([^']+?)''|<em>$1</em>|g; |
746 |
$line =~ s|(\d\d\d\d-\d\d-\d\d \(\w\w\w\) \d\d:\d\d:\d\d)|<span class="date">$1</span>|g; # Date |
$line =~ s|(\d\d\d\d-\d\d-\d\d \(\w\w\w\) \d\d:\d\d:\d\d)|<span class="date">$1</span>|g; # Date |
748 |
( |
( |
749 |
(?:<(?:mailto|http|https|ftp|urn|news):[\x21-\x7E]*)> |
(?:<(?:mailto|http|https|ftp|urn|news):[\x21-\x7E]*)> |
750 |
| |
| |
751 |
($bracket_name) # [[likethis]], [[#comment]], [[Friend:remotelink]] |
(?:$bracket_name)) # [[likethis]], [[#comment]], [[Friend:remotelink]] |
752 |
| |
|\[\[([^[]+?)]>>([0-9]+)] |
753 |
($interwiki_definition) # [[Friend http://somewhere/?q=sjis($1)]] |
|>>([0-9]+) |
754 |
#| |
! |
755 |
# ($wiki_name) |
my ($l, $page,$anchor, $anum) = ($1, $3,$4, 0+$5); |
756 |
) |
if ($l) { |
757 |
! |
&make_link($l) |
758 |
&make_link($1) |
} elsif (defined $page) { |
759 |
!gex; |
&make_wikilink ($page, anchor => 0+$anchor); |
760 |
|
} elsif ($anum) { |
761 |
|
qq(<a href="#anchor-$anum" class="wiki-anchor">>>$anum</a>); |
762 |
|
} |
763 |
|
!gex; |
764 |
return $line; |
return $line; |
765 |
} |
} |
766 |
|
|
767 |
|
sub make_wikilink ($%) { |
768 |
|
my ($ename, %option) = @_; |
769 |
|
my $name = &unescape ($ename); |
770 |
|
if ($database{$name}) { |
771 |
|
my $subject = &escape (&get_subjectline ($name, delimiter => '')); |
772 |
|
if ($option{anchor}) { |
773 |
|
return qq(<a title="$subject" href="$url_cgi?@{[&encode($name)]}#anchor-$option{anchor}" class="wiki">$ename>>$option{anchor}</a>); |
774 |
|
} else { |
775 |
|
return qq(<a title="$subject" href="$url_cgi?@{[&encode($name)]}" class="wiki">$ename</a>); |
776 |
|
} |
777 |
|
} else { |
778 |
|
return qq(<a title="$resource{editthispage}" href="$url_cgi?mycmd=edit;mypage=@{[&escape($name)]}" class="wiki not-exist">$ename<span class="mark">$editchar</span></a>); |
779 |
|
} |
780 |
|
} |
781 |
|
|
782 |
sub make_link { |
sub make_link { |
783 |
my $chunk = shift; |
my $chunk = shift; |
784 |
# Walrus add (3) start |
# Walrus add (3) start |
892 |
} |
} |
893 |
|
|
894 |
sub update_recent_changes { |
sub update_recent_changes { |
895 |
my $update = "- @{[&get_now]} @{[&armor_name($form{mypage})]} @{[&get_subjectline($form{mypage})]}"; |
my $update = "- @{[&get_now]} [[@{[&escape($form{mypage})]}]] @{[&get_subjectline($form{mypage})]}"; |
896 |
my @oldupdates = split(/\r?\n/, $database{$RecentChanges}); |
my @oldupdates = split(/\r?\n/, $database{$RecentChanges}); |
897 |
my @updates; |
my @updates; |
898 |
foreach (@oldupdates) { |
foreach (@oldupdates) { |
899 |
/^\- \d\d\d\d\-\d\d\-\d\d \(...\) \d\d:\d\d:\d\d (\S+)/; # date format. |
/^\- \d\d\d\d\-\d\d\-\d\d \([^)]+\) \d\d:\d\d \[\[(\S+?)\]\]/; |
900 |
my $name = &unarmor_name($1); |
my $name = $1; |
901 |
if (&is_exist_page($name) and ($name ne $form{mypage})) { |
if ($name ne $form{mypage}) { |
902 |
push(@updates, $_); |
push @updates, $_; |
903 |
} |
} |
904 |
} |
} |
905 |
if (&is_exist_page($form{mypage})) { |
if (&is_exist_page($form{mypage})) { |
906 |
unshift(@updates, $update); |
unshift @updates, $update; |
907 |
} |
} |
908 |
splice(@updates, $maxrecent + 1); |
splice(@updates, $maxrecent + 1); |
909 |
$database{$RecentChanges} = join("\n", @updates); |
$database{$RecentChanges} = join("\n", @updates); |
927 |
|
|
928 |
# Get the subject of the page. |
# Get the subject of the page. |
929 |
my $subject = $database{$page}; |
my $subject = $database{$page}; |
930 |
$subject =~ s#^SuikaWiki/0.9[^\x0D\x0A]*[\x0D\x0A]+##s; |
$subject =~ s#^(?:\#\?)?SuikaWiki/0.9[^\x0D\x0A]*[\x0D\x0A]+##s; |
931 |
$subject =~ s/\r?\n.*//s; |
$subject =~ s/\r?\n.*//s; |
932 |
return "$delim$subject".$option{tail}; |
return "$delim$subject".$option{tail}; |
933 |
} |
} |
1177 |
my $content = join('', <FILE>); |
my $content = join('', <FILE>); |
1178 |
&code_convert(\$content, $kanjicode); |
&code_convert(\$content, $kanjicode); |
1179 |
close(FILE); |
close(FILE); |
1180 |
&print_header($page); |
&print_header($page, -noindex => 1); |
1181 |
&print_content($content); |
&print_content($content); |
1182 |
&print_editform($rawmsg, $form{myLastModified}, frozen=>0, conflict=>1); |
&print_editform($rawmsg, $form{myLastModified}, frozen=>0, conflict=>1); |
1183 |
&print_footer($page); |
&print_footer($page); |
1186 |
|
|
1187 |
sub get_now { |
sub get_now { |
1188 |
my (@week) = qw(Sun Mon Tue Wed Thu Fri Sat); |
my (@week) = qw(Sun Mon Tue Wed Thu Fri Sat); |
1189 |
|
my (@week) = qw(日 月 火 水 木 金 土); |
1190 |
my ($sec, $min, $hour, $day, $mon, $year, $weekday) = localtime(time); |
my ($sec, $min, $hour, $day, $mon, $year, $weekday) = localtime(time); |
1191 |
$year += 1900; |
$year += 1900; |
1192 |
$mon++; |
$mon++; |
1194 |
$day = "0$day" if $day < 10; |
$day = "0$day" if $day < 10; |
1195 |
$hour = "0$hour" if $hour < 10; |
$hour = "0$hour" if $hour < 10; |
1196 |
$min = "0$min" if $min < 10; |
$min = "0$min" if $min < 10; |
1197 |
$sec = "0$sec" if $sec < 10; |
#$sec = "0$sec" if $sec < 10; |
1198 |
$weekday = $week[$weekday]; |
$weekday = $week[$weekday]; |
1199 |
return "$year-$mon-$day ($weekday) $hour:$min:$sec"; |
return "$year-$mon-$day ($weekday) $hour:$min"; |
1200 |
} |
} |
1201 |
|
|
1202 |
# [[YukiWiki http://www.hyuki.com/yukiwiki/wiki.cgi?euc($1)]] |
# [[YukiWiki http://www.hyuki.com/yukiwiki/wiki.cgi?euc($1)]] |
1287 |
sub do_comment { |
sub do_comment { |
1288 |
my ($content) = $database{$form{mypage}}; |
my ($content) = $database{$form{mypage}}; |
1289 |
my $datestr = &get_now; |
my $datestr = &get_now; |
1290 |
my $namestr = " ''[[@{[$form{myname}||$DEFAULT_embed_comment_name]}]]'' : "; |
my $namestr = $form{myname} || $DEFAULT_embed_comment_name; |
1291 |
#if ($content =~ s/(\Q$embed_comment\E)/- $datestr$namestr$form{mymsg}\n$1/) { |
if ($namestr =~ /^(?:>>)?[0-9]/) { |
1292 |
# ; |
$namestr = qq( ''$namestr'': ); |
1293 |
#} else { |
} else { |
1294 |
# $content =~ s/(\Q$embed_rcomment\E)/$1\n- $datestr$namestr$form{mymsg}/; |
$namestr = qq( ''[[$namestr]]'': ); |
1295 |
#} |
} |
1296 |
|
my $anchor = 0; |
1297 |
|
$content =~ s/(?:-+\s)?\[([0-9]+)\]/$anchor = $1 if $1 > $anchor; $&/mge; |
1298 |
|
$anchor++; |
1299 |
my $i = 1; my $o = 0; |
my $i = 1; my $o = 0; |
1300 |
$content =~ s{(\Q$embed_comment\E|\Q$embed_rcomment\E)}{ |
$content =~ s{(\Q$embed_comment\E|\Q$embed_rcomment\E)}{ |
1301 |
my $embed = $1; |
my $embed = $1; |
1302 |
if ($i == $form{comment_index}) { |
if ($i == $form{comment_index}) { |
1303 |
if ($embed eq $embed_comment) { |
if ($embed eq $embed_comment) { |
1304 |
$embed = "- $datestr$namestr$form{mymsg}\n$embed"; $o = 1; |
$embed = "- [$anchor] $datestr$namestr$form{mymsg}\n$embed"; $o = 1; |
1305 |
} else { |
} else { |
1306 |
$embed .= "\n- $datestr$namestr$form{mymsg}"; $o = 1; |
$embed .= "\n- [$anchor] $datestr$namestr$form{mymsg}"; $o = 1; |
1307 |
} |
} |
1308 |
} |
} |
1309 |
$i++; $embed; |
$i++; $embed; |
1310 |
}ge; |
}ge; |
1311 |
unless ($o) { |
unless ($o) { |
1312 |
$content .= "- $datestr$namestr$form{mymsg}\n"; |
$content .= "- [$anchor] $datestr$namestr$form{mymsg}\n"; |
1313 |
} |
} |
1314 |
|
$form{__comment_anchor_index} = $anchor; |
1315 |
if ($form{mymsg}) { |
if ($form{mymsg}) { |
1316 |
$form{mymsg} = $content; |
$form{mymsg} = $content; |
1317 |
$form{mytouch} = 'on'; |
$form{mytouch} = 'on'; |
1326 |
sub embedded_to_html { |
sub embedded_to_html { |
1327 |
my ($embedded) = @_; |
my ($embedded) = @_; |
1328 |
if ($embedded eq $embed_comment or $embedded eq $embed_rcomment) { |
if ($embedded eq $embed_comment or $embedded eq $embed_rcomment) { |
1329 |
|
unless ($main::_EMBEDED) { |
1330 |
my $lastmodified = &get_info($form{mypage}, $info_LastModified); |
my $lastmodified = &get_info($form{mypage}, $info_LastModified); |
1331 |
return <<"EOD"; |
return <<"EOD"; |
1332 |
<form action="$url_cgi" method="post" id="x-comment-@{[++$CommentIndex]}"> |
<form action="$url_cgi" method="post" id="x-comment-@{[++$CommentIndex]}"> |
1341 |
<input type="submit" value="$resource{commentbutton}"> |
<input type="submit" value="$resource{commentbutton}"> |
1342 |
</form> |
</form> |
1343 |
EOD |
EOD |
1344 |
|
} else { |
1345 |
|
return <<"EOD"; |
1346 |
|
<del><form action="$url_cgi" method="get"> |
1347 |
|
<input type="hidden" name="mycmd" value="read"> |
1348 |
|
<input type="hidden" name="mypage" value="$form{mypage}"> |
1349 |
|
$embed_comment_Name_Prompt |
1350 |
|
<input type="text" name="myname" value="" size="10" disabled="disabled"> |
1351 |
|
<input type="text" name="mymsg" value="" size="60" disabled="disabled"> |
1352 |
|
<input type="submit" value="$resource{commentbutton}" disabled="disabled"> |
1353 |
|
</form></del> |
1354 |
|
EOD |
1355 |
|
} |
1356 |
} elsif ($embedded =~ /$embed_command{searched}/) { |
} elsif ($embedded =~ /$embed_command{searched}/) { |
1357 |
return get_search_result ($1); |
return get_search_result ($1); |
1358 |
# Walrus add (5) start |
# Walrus add (5) start |
1360 |
$_ = &make_interwiki_box($1, $2); |
$_ = &make_interwiki_box($1, $2); |
1361 |
return ($_) ? $_ : $embedded; |
return ($_) ? $_ : $embedded; |
1362 |
# Walrus add (5) end |
# Walrus add (5) end |
1363 |
} else { |
} elsif ($embedded =~ /^\[\[\#embed:(.+)\]\]$/) { |
1364 |
return $embedded; |
my ($name, $r) = ($1, ''); |
1365 |
|
if ($main::_EMBEDED != 1) { |
1366 |
|
my ($content, $cf) = ($database{$name}, 'SuikaWiki/0.9'); |
1367 |
|
$cf = $1 if $content =~ s!^(?:[\#<]\?|/\*\s*)?([A-Z][A-Za-z0-9-]+/[0-9.]+(?:[^0-9.][^\x0D\x0A]*)?)[\x0D\x0A]+!!s; |
1368 |
|
if ($cf =~ m!^(?:\#\?)?SuikaWiki/0.9(?:$|\s)!) { |
1369 |
|
$main::_EMBEDED = 1; |
1370 |
|
$r = &text_to_html ($content, content_format => $cf); |
1371 |
|
$main::_EMBEDED = 0; |
1372 |
|
} elsif (length $content) { |
1373 |
|
$r = "<pre>@{[&escape ($content)]}</pre>"; |
1374 |
|
} else { |
1375 |
|
$r = &text_to_html ("[[$name]]", content_format => 'SuikaWiki/0.9'); |
1376 |
|
} |
1377 |
|
} else { ## nested #EMBED |
1378 |
|
$r = &text_to_html ("[INS[\n[[$name]] の埋め込みは (入り組んでいるので) 解決されませんでした。\n]INS]\n", content_format => 'SuikaWiki/0.9'); |
1379 |
} |
} |
1380 |
|
return qq(<blockquote title="@{[&escape($name)]}">$r</blockquote>); |
1381 |
|
} elsif ($embedded =~ /^\[\[\#randomlink:(.+)\]\]$/) { |
1382 |
|
return qq(<a href="$url_cgi?mycmd=RandomJump;x-param=@{[time.[0..9]->[rand 10]]}" class="wiki randomlink">$1</a>); |
1383 |
|
} else { |
1384 |
|
return $embedded; |
1385 |
|
} |
1386 |
} |
} |
1387 |
|
|
1388 |
# Walrus add (5) start |
# Walrus add (5) start |
1497 |
} |
} |
1498 |
&open_diff; |
&open_diff; |
1499 |
my $title = $form{mypage}; |
my $title = $form{mypage}; |
1500 |
&print_header($title); |
&print_header($title, -noindex => 1); |
1501 |
$_ = &escape($diffbase{$form{mypage}}); |
$_ = &escape($diffbase{$form{mypage}}); |
1502 |
&close_diff; |
&close_diff; |
1503 |
print qq(<h3>$resource{difftitle}</h3>); |
print qq(<h3>$resource{difftitle}</h3>); |
1533 |
my $count = 0; |
my $count = 0; |
1534 |
foreach (split(/\n/, $recentchanges)) { |
foreach (split(/\n/, $recentchanges)) { |
1535 |
last if ($count >= 15); |
last if ($count >= 15); |
1536 |
/^\- \d\d\d\d\-\d\d\-\d\d \(...\) \d\d:\d\d:\d\d (\S+)/; # date format. |
/^\- \d\d\d\d\-\d\d\-\d\d \([^)]+\) \d\d:\d\d:\d\d (\S+)/; # date format. |
1537 |
my $title = &unarmor_name($1); |
my $title = &unarmor_name($1); |
1538 |
my $escaped_title = &escape($title); |
my $escaped_title = &escape($title); |
1539 |
my $link = $modifier_rss_link . '?' . &encode($title); |
my $link = $modifier_rss_link . '?' . &encode($title); |
1601 |
} |
} |
1602 |
sub get_site_name () { |
sub get_site_name () { |
1603 |
my @lines = grep /[^#]/, split /[\x0D\x0A]+/, &main::__get_database('RefererSiteName'); |
my @lines = grep /[^#]/, split /[\x0D\x0A]+/, &main::__get_database('RefererSiteName'); |
1604 |
my %item; |
my @item; |
1605 |
for (@lines) { |
for (@lines) { |
1606 |
next if /^#/; |
next if /^#/; |
1607 |
my ($uri, $name) = split /\s+/, $_, 2; |
my ($uri, $name) = split /\s+/, $_, 2; |
1608 |
$uri =~ s/\$/\\\$/g; $uri =~ s/\@/\\\@/g; $uri =~ s/\//\\\//g; |
$uri =~ s/\$/\\\$/g; $uri =~ s/\@/\\\@/g; $uri =~ s/\//\\\//g; |
1609 |
$name =~ s![()/\\]!\\$1!g; $name =~ s/\$([0-9]+)/).__decode (\${$1}).q(/g; |
$name =~ s!([()/\\])!\\$1!g; $name =~ s/\$([0-9]+)/).__decode (\${$1}).q(/g; |
1610 |
$item{$uri} = qq(q($name)); |
push @item, [$uri, qq(q($name))]; |
1611 |
} |
} |
1612 |
%item; |
@item; |
1613 |
} |
} |
1614 |
|
|
1615 |
sub list_html ($) { |
sub list_html ($) { |
1616 |
my $page = shift; |
my $page = shift; |
1617 |
my %list = get ($page); |
my %list = get ($page); |
1618 |
my $r = ''; |
my $r = ''; |
1619 |
my %name = get_site_name; |
my @name = get_site_name; |
1620 |
for my $uri (sort keys %list) { |
for my $uri (sort keys %list) { |
1621 |
my $title; |
my $title; |
1622 |
for my $regex (keys %name) { |
for my $item (@name) { |
1623 |
if ($uri =~ /$regex/) { |
if ($uri =~ /$item->[0]/) { |
1624 |
$title = $uri; |
$title = $uri; |
1625 |
eval qq{\$title =~ s/^.*$regex.*\$/$name{$regex}/e} or die $@; |
eval qq{\$title =~ s/^.*$item->[0].*\$/$item->[1]/e} |
1626 |
|
or die $@ ;#. qq{\$title =~ s/^.*$item->[0].*\$/$item->[1]/e}; |
1627 |
last; |
last; |
1628 |
} |
} |
1629 |
} |
} |