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 |