| 97 |
my $embed_interwiki = '^\[\[#(box|text|password):(\S+)\]\]$'; # Walrus add (5) |
my $embed_interwiki = '^\[\[#(box|text|password):(\S+)\]\]$'; # Walrus add (5) |
| 98 |
my %embed_command = ( |
my %embed_command = ( |
| 99 |
searched => '^\[\[#searched:([^\]]+)\]\]$', |
searched => '^\[\[#searched:([^\]]+)\]\]$', |
| 100 |
|
form => qw/\[\[\#form:'((?:[^'\\]|\\.)+)':'((?:[^'\\]|\\.)+)'(?::'((?:[^'\\]|\\.)*)')?\]\]/, |
| 101 |
); |
); |
| 102 |
############################## |
############################## |
| 103 |
my $info_LastModified = 'LastModified'; |
my $info_LastModified = 'LastModified'; |
| 153 |
rss => \&do_rss, |
rss => \&do_rss, |
| 154 |
diff => \&do_diff, |
diff => \&do_diff, |
| 155 |
interwikibox => \&do_interwiki_box, # Walrus add (5) |
interwikibox => \&do_interwiki_box, # Walrus add (5) |
| 156 |
|
wikiform => \&do_wikiform, |
| 157 |
); |
); |
| 158 |
############################## |
############################## |
|
my @ignore_html_page = ('FrontPage'); # Walrus add (6) |
|
|
my @ignore_html_tags = ('a', 'br', 'img'); # Walrus add (6) |
|
| 159 |
my $walversion = '2.0.beta1.wal.1'; # Walrus add (1) |
my $walversion = '2.0.beta1.wal.1'; # Walrus add (1) |
| 160 |
############################## |
############################## |
| 161 |
# &test_convert; |
# &test_convert; |
| 162 |
my $UA = ''; |
my $UA = ''; ## User agent name |
| 163 |
&main; |
&main; |
| 164 |
exit(0); |
exit(0); |
| 165 |
############################## |
############################## |
| 232 |
|
|
| 233 |
sub id_and_name ($) { |
sub id_and_name ($) { |
| 234 |
my $name = shift; |
my $name = shift; |
| 235 |
if ($UA =~ m#Mozilla/2#) { |
if ($UA =~ m#Mozilla/[12]\.#) { |
| 236 |
qq{id="$name"><a name="$name"></a}; |
qq{id="$name"><a name="$name"></a}; |
| 237 |
} else { |
} else { |
| 238 |
qq{id="$name"}; |
qq{id="$name"}; |
| 355 |
&update_recent_changes; |
&update_recent_changes; |
| 356 |
} |
} |
| 357 |
&set_info($form{mypage}, $info_IsFrozen, 0 + $form{myfrozen}); |
&set_info($form{mypage}, $info_IsFrozen, 0 + $form{myfrozen}); |
| 358 |
&print_header($CompletedSuccessfully, -noindex => 1, -goto => $url_cgi.'?mycmd=read;mypage='.&encode($form{mypage}).qq(;x-param=@{[time.[0..9]->[rand 10]]}).($form{__comment_anchor_index}?"#anchor-$form{__comment_anchor_index}":'')); |
my $fragment; |
| 359 |
|
if ($form{__comment_anchor_index}) { |
| 360 |
|
$fragment = qq(anchor-$form{__comment_anchor_index}); |
| 361 |
|
} elsif ($form{__wikiform_anchor_index}) { |
| 362 |
|
$fragment = qq(wikiform-$form{__wikiform_anchor_index}); |
| 363 |
|
} |
| 364 |
|
&print_header($CompletedSuccessfully, -noindex => 1, -goto => $url_cgi.'?mycmd=read;mypage='.&encode($form{mypage}).qq(;x-param=@{[time.[0..9]->[rand 10]]}).($fragment?'#'.$fragment:'')); |
| 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); |
| 467 |
} |
} |
| 468 |
$bodyclass .= " wiki-page-obsoleted" if $option{-content_format} =~ /obsoleted="yes"/; |
$bodyclass .= " wiki-page-obsoleted" if $option{-content_format} =~ /obsoleted="yes"/; |
| 469 |
if ($option{-goto}) { |
if ($option{-goto}) { |
| 470 |
if ($UA =~ m#Mozilla/2|Opera#) { |
if ($UA =~ m#Mozilla/[12]\.|Opera#) { |
| 471 |
$option{-goto} =~ tr/;/&/; |
$option{-goto} =~ tr/;/&/; |
| 472 |
print qq{Refresh: 0; url=$option{-goto}\n}; |
print qq{Refresh: 0; url=$option{-goto}\n}; |
| 473 |
|
$option{-goto} = qq(<meta http-equiv="refresh" content="0; url=$option{-goto}">); |
| 474 |
} else { |
} else { |
| 475 |
print qq{Refresh: 0; url="$option{-goto}"\n}; |
print qq{Refresh: 0; url="$option{-goto}"\n}; |
| 476 |
|
$option{-goto} = qq(<meta http-equiv="refresh" content="0; url="@{[&escape($option{-goto})]}"">); |
| 477 |
} |
} |
| 478 |
} |
} |
| 479 |
print qq{Last-Modified: $option{-last_modified}\n} if $option{-last_modified}; |
print qq{Last-Modified: $option{-last_modified}\n} if $option{-last_modified}; |
| 497 |
"http://www.w3.org/TR/html4/loose.dtd"> + RUBY --> |
"http://www.w3.org/TR/html4/loose.dtd"> + RUBY --> |
| 498 |
<html lang="$lang"> |
<html lang="$lang"> |
| 499 |
<head> |
<head> |
| 500 |
$meta_ct |
$meta_ct$option{-goto} |
| 501 |
<title>$escapedpage</title> |
<title>$escapedpage</title> |
| 502 |
<link rel="index" href="$url_cgi?$IndexPage"> |
<link rel="index" href="$url_cgi?$IndexPage"> |
| 503 |
<link rel="help" href="$url_cgi?WikiHelp"> |
<link rel="help" href="$url_cgi?WikiHelp"> |
| 575 |
|
|
| 576 |
sub print_footer { |
sub print_footer { |
| 577 |
my ($page, $lm) = @_; |
my ($page, $lm) = @_; |
| 578 |
|
my $epage = &encode ($page); |
| 579 |
$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) |
| 580 |
# Walrus mod (1) start |
# Walrus mod (1) start |
| 581 |
my $cvslog1 = q$Revision$; |
my $cvslog1 = q$Revision$; |
| 591 |
<a href="/map" title="このサーバーの案内">地図</a> |
<a href="/map" title="このサーバーの案内">地図</a> |
| 592 |
<a href="/search/" title="このサーバーの検索">検索</a>] |
<a href="/search/" title="このサーバーの検索">検索</a>] |
| 593 |
</div> |
</div> |
| 594 |
|
<div class="myuri"> |
| 595 |
|
<<a href="$url_cgi?$epage">$url_cgi?$epage</a>> |
| 596 |
|
</div> |
| 597 |
</div> |
</div> |
| 598 |
$walrus_log |
$walrus_log |
| 599 |
</body> |
</body> |
| 600 |
</html> |
</html> |
| 601 |
EOD |
EOD |
|
# print <<"EOD"; |
|
|
# <hr> |
|
|
# <address class="footer"> |
|
|
# <a href="http://www.hyuki.com/yukiwiki/">YukiWiki</a> $version |
|
|
# © 2000-2002 by <a href="http://www.hyuki.com/">Hiroshi Yuki</a>.<br /> |
|
|
# Modified by <a href="$modifier_url">$modifier_name</a>. |
|
|
# </address> |
|
|
# <p class="footer"> |
|
|
# <a href="http://www.hyuki.com/yukiwiki/">$icontag</a> |
|
|
# </p> |
|
|
# </body> |
|
|
# </html> |
|
|
# EOD |
|
|
# Walrus mod (1) end |
|
| 602 |
} |
} |
| 603 |
|
|
| 604 |
sub escape { |
sub escape { |
| 765 |
sub inline { |
sub inline { |
| 766 |
my ($line) = @_; |
my ($line) = @_; |
| 767 |
$line = &escape($line); |
$line = &escape($line); |
| 768 |
|
$line =~ s{$embed_command{form}}{&make_custom_form ($1, $2, $3)}ge; |
| 769 |
$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; |
| 770 |
$line =~ s:\[(WEAK)\[(.+?)\]\]:<span class="@{[lc $1]}">$2</span>:g; |
$line =~ s:\[(WEAK)\[(.+?)\]\]:<span class="@{[lc $1]}">$2</span>:g; |
| 771 |
$line =~ s:\[ABBR\[([^]]+)\] \[([^]]+)\]\]:<acronym title="$2">$1</acronym>:g; |
$line =~ s:\[ABBR\[([^]]+)\] \[([^]]+)\]\]:<acronym title="$2">$1</acronym>:g; |
| 847 |
} |
} |
| 848 |
} |
} |
| 849 |
|
|
| 850 |
|
my $FormIndex = 0; |
| 851 |
|
sub make_custom_form ($$$) { |
| 852 |
|
my ($definition, $template, $option) = @_; |
| 853 |
|
$definition =~ s/\\(.)/$1/g; |
| 854 |
|
## $template and $option is currently not used in this procedure. |
| 855 |
|
unless ($main::_EMBEDED) { |
| 856 |
|
$FormIndex++; |
| 857 |
|
my $param = bless {}, 'SuikaWiki::Plugin'; |
| 858 |
|
my $lastmodified = &get_info($form{mypage}, $info_LastModified); |
| 859 |
|
my $r = <<EOH; |
| 860 |
|
<form method="post" action="$url_cgi" id="wikiform-$FormIndex" class="wikiform"> |
| 861 |
|
<input type="hidden" name="mycmd" value="wikiform"> |
| 862 |
|
<input type="hidden" name="mypage" value="@{[&escape($form{mypage})]}"> |
| 863 |
|
<input type="hidden" name="myLastModified" value="$lastmodified"> |
| 864 |
|
<input type="hidden" name="mytouch" value="on"> |
| 865 |
|
<input type="hidden" name="wikiform_index" value="$FormIndex"> |
| 866 |
|
EOH |
| 867 |
|
$r .= qq(<a name="wikiform-$FormIndex"></a>) if $UA =~ m#Mozilla/[12]\.#; |
| 868 |
|
$r .= $fmt{form_input}->replace (&unescape ($definition), $param); |
| 869 |
|
$r .= <<EOH; |
| 870 |
|
</form> |
| 871 |
|
EOH |
| 872 |
|
} else { |
| 873 |
|
q(<ins class="wiki-error"><strong>Warning</strong>: form in embeded page is currently not supported.</ins>); |
| 874 |
|
} |
| 875 |
|
} |
| 876 |
|
|
| 877 |
## to be obsoleted |
## to be obsoleted |
| 878 |
sub make_link { |
sub make_link { |
| 879 |
my $chunk = shift; |
my $chunk = shift; |
| 946 |
# $form{mycmd} is frozen here. |
# $form{mycmd} is frozen here. |
| 947 |
# |
# |
| 948 |
|
|
| 949 |
|
for (grep /^wikiform__/, keys %form) { |
| 950 |
|
$form{$_} = &code_convert (\$form{$_}, $kanjicode); |
| 951 |
|
} |
| 952 |
$form{mymsg} = &code_convert(\$form{mymsg}, $kanjicode); |
$form{mymsg} = &code_convert(\$form{mymsg}, $kanjicode); |
| 953 |
$form{myname} = &code_convert(\$form{myname}, $kanjicode); |
$form{myname} = &code_convert(\$form{myname}, $kanjicode); |
| 954 |
} |
} |
| 956 |
sub update_recent_changes { |
sub update_recent_changes { |
| 957 |
my $update = "- @{[&get_now]} [[@{[&escape($form{mypage})]}]] @{[&get_subjectline($form{mypage})]}"; |
my $update = "- @{[&get_now]} [[@{[&escape($form{mypage})]}]] @{[&get_subjectline($form{mypage})]}"; |
| 958 |
my @oldupdates = split(/\r?\n/, $database{$RecentChanges}); |
my @oldupdates = split(/\r?\n/, $database{$RecentChanges}); |
| 959 |
|
shift (@oldupdates); ## '#?' magic line |
| 960 |
my @updates; |
my @updates; |
| 961 |
foreach (@oldupdates) { |
foreach (@oldupdates) { |
| 962 |
/^\- \d\d\d\d\-\d\d\-\d\d \([^)]+\) \d\d:\d\d \[\[(\S+?)\]\]/; |
/^\- \d\d\d\d\-\d\d\-\d\d \([^)]+\) \d\d:\d\d \[\[(\S+?)\]\]/; |
| 1269 |
$s = qq([[$s]]) if $s !~ /^[A-Z][a-z]+(?:[A-Z][a-z]+)+$/; |
$s = qq([[$s]]) if $s !~ /^[A-Z][a-z]+(?:[A-Z][a-z]+)+$/; |
| 1270 |
&encode (&code_convert (\$p->{name}, $o->{charset} || 'shift_jis')); |
&encode (&code_convert (\$p->{name}, $o->{charset} || 'shift_jis')); |
| 1271 |
}; |
}; |
| 1272 |
|
|
| 1273 |
|
$fmt{form_input} = Message::Util::Formatter->new; |
| 1274 |
|
for (@{$SuikaWiki::Plugin::List{wikiform_input}||[]}) { |
| 1275 |
|
$_->load_formatter ($fmt{form_input}, type => 'wikiform_input'); |
| 1276 |
|
} |
| 1277 |
} |
} |
| 1278 |
|
|
| 1279 |
|
|
| 1340 |
} elsif (length $namestr) { |
} elsif (length $namestr) { |
| 1341 |
$namestr = qq( ''[[$namestr]]'': ); |
$namestr = qq( ''[[$namestr]]'': ); |
| 1342 |
} |
} |
| 1343 |
my $anchor = 0; |
my $anchor = &get_new_anchor_index ($content); |
| 1344 |
$content =~ s/(?:-+\s)?\[([0-9]+)\]/$anchor = $1 if $1 > $anchor; $&/mge; |
|
| 1345 |
$anchor++; |
# $content =~ s/(?:-+\s)?\[([0-9]+)\]/$anchor = $1 if $1 > $anchor; $&/mge; |
| 1346 |
|
# $anchor++; |
| 1347 |
my $i = 1; my $o = 0; |
my $i = 1; my $o = 0; |
| 1348 |
$content =~ s{(\Q$embed_comment\E|\Q$embed_rcomment\E)}{ |
$content =~ s{(\Q$embed_comment\E|\Q$embed_rcomment\E)}{ |
| 1349 |
my $embed = $1; |
my $embed = $1; |
| 1372 |
} |
} |
| 1373 |
} |
} |
| 1374 |
|
|
| 1375 |
|
sub get_new_anchor_index ($) { |
| 1376 |
|
my $content = shift; |
| 1377 |
|
my $anchor = 0; |
| 1378 |
|
$content =~ s/^(?:[-=]+\s*)?\[([0-9]+)\]/$anchor = $1 if $1 > $anchor; $&/mge; |
| 1379 |
|
$anchor + 1; |
| 1380 |
|
} |
| 1381 |
|
|
| 1382 |
my $CommentIndex = 0; |
my $CommentIndex = 0; |
| 1383 |
sub embedded_to_html { |
sub embedded_to_html { |
| 1384 |
my ($embedded) = @_; |
my ($embedded) = @_; |
| 1442 |
} |
} |
| 1443 |
} |
} |
| 1444 |
|
|
| 1445 |
|
sub do_wikiform { |
| 1446 |
|
my $content = $database{$form{mypage}}; |
| 1447 |
|
my $anchor = &get_new_anchor_index ($content); |
| 1448 |
|
for my $t (qw/form_template form_option/) { |
| 1449 |
|
unless ($fmt{$t}) { |
| 1450 |
|
$fmt{$t} = Message::Util::Formatter->new; |
| 1451 |
|
for (@{$SuikaWiki::Plugin::List{'wiki'.$t}||[]}) { |
| 1452 |
|
$_->load_formatter ($fmt{$t}, type => 'wiki'.$t); |
| 1453 |
|
} |
| 1454 |
|
} |
| 1455 |
|
} |
| 1456 |
|
my $write = 0; |
| 1457 |
|
my $i = 1; |
| 1458 |
|
$content =~ s{$embed_command{form}}{ |
| 1459 |
|
my ($embed, $template, $option) = ($&, $2, $3); |
| 1460 |
|
$template =~ s/\\(.)/$1/g; |
| 1461 |
|
$option =~ s/\\(.)/$1/g; |
| 1462 |
|
if ($i == $form{wikiform_index}) { |
| 1463 |
|
my $param = bless {}, 'SuikaWiki::Plugin'; |
| 1464 |
|
$param->{page} = $form{mypage}; |
| 1465 |
|
$param->{form_index} = $i; |
| 1466 |
|
$param->{anchor_index} = $anchor; |
| 1467 |
|
$param->{argv} = \%form; |
| 1468 |
|
$param->{default_name} = $1 if $content =~ /default-name="([^"]+)"/; |
| 1469 |
|
$fmt{form_option}->replace ($option, $param); |
| 1470 |
|
my $t = $fmt{form_template}->replace ($template, $param); |
| 1471 |
|
if (length $t) { |
| 1472 |
|
if ($param->{output}->{reverse}) { |
| 1473 |
|
$embed = $t . "\n" . $embed; |
| 1474 |
|
} else { |
| 1475 |
|
$embed .= "\n" . $t; |
| 1476 |
|
} |
| 1477 |
|
$write = 1; |
| 1478 |
|
$form{__comment_anchor_index} = $anchor |
| 1479 |
|
unless $param->{anchor_index}; ## $anchor is used! |
| 1480 |
|
} |
| 1481 |
|
} |
| 1482 |
|
$i++; $embed; |
| 1483 |
|
}ge; |
| 1484 |
|
unless ($write) { |
| 1485 |
|
#$content = "#?SuikaWiki/0.9\n\n" unless $content; |
| 1486 |
|
#$content .= "\n" unless $content =~ /\n$/s; |
| 1487 |
|
# |
| 1488 |
|
} |
| 1489 |
|
$form{__wikiform_anchor_index} = $form{wikiform_index}; |
| 1490 |
|
if ($write) { |
| 1491 |
|
$form{mymsg} = $content; |
| 1492 |
|
$form{mytouch} = 'on'; |
| 1493 |
|
&do_write; |
| 1494 |
|
} else { |
| 1495 |
|
$form{mycmd} = 'read'; |
| 1496 |
|
&do_read; |
| 1497 |
|
} |
| 1498 |
|
} |
| 1499 |
|
|
| 1500 |
|
|
| 1501 |
# Walrus add (5) start |
# Walrus add (5) start |
| 1502 |
sub do_interwiki_box { |
sub do_interwiki_box { |
| 1503 |
my $remoteurl = $interwiki{$form{'myintername'}}; |
my $remoteurl = $interwiki{$form{'myintername'}}; |
| 1785 |
&main::__set_database ('WikiUserAgentList' => $s); |
&main::__set_database ('WikiUserAgentList' => $s); |
| 1786 |
} |
} |
| 1787 |
|
|
| 1788 |
|
package SuikaWiki::Plugin; |
| 1789 |
|
our %List; |
| 1790 |
|
|
| 1791 |
|
sub escape ($$) { main::escape ($_[1]) } |
| 1792 |
|
sub unescape ($$) { main::unescape ($_[1]) } |
| 1793 |
|
sub encode ($$) { main::encode ($_[1]) } |
| 1794 |
|
sub decode ($$) { main::decode ($_[1]) } |
| 1795 |
|
sub __get_datetime ($) { main::get_now () } |
| 1796 |
|
|
| 1797 |
|
sub regist ($@) { |
| 1798 |
|
my $pack = shift; |
| 1799 |
|
for (@_) { |
| 1800 |
|
push @{$List{$_}}, $pack; |
| 1801 |
|
} |
| 1802 |
|
} |
| 1803 |
|
|
| 1804 |
|
use SuikaWiki::Plugin::WikiFormBasic; |
| 1805 |
|
|
| 1806 |
1; |
1; |
| 1807 |
__END__ |
__END__ |
| 1808 |
=head1 NAME |
=head1 NAME |