50 |
# |
# |
51 |
# You MAY modify following variables. |
# You MAY modify following variables. |
52 |
# |
# |
53 |
|
$SuikaWiki::Plugin::plugin_directory = q(./SuikaWiki/Plugin/); |
54 |
my $file_touch = "$modifier_dir_data/touched.txt"; |
my $file_touch = "$modifier_dir_data/touched.txt"; |
55 |
my $file_resource = "$modifier_dir_data/resource.txt"; |
my $file_resource = "$modifier_dir_data/resource.txt"; |
56 |
my $file_FrontPage = "$modifier_dir_data/frontpage.txt"; |
my $file_FrontPage = "$modifier_dir_data/frontpage.txt"; |
98 |
my $embed_interwiki = '^\[\[#(box|text|password):(\S+)\]\]$'; # Walrus add (5) |
my $embed_interwiki = '^\[\[#(box|text|password):(\S+)\]\]$'; # Walrus add (5) |
99 |
my %embed_command = ( |
my %embed_command = ( |
100 |
searched => '^\[\[#searched:([^\]]+)\]\]$', |
searched => '^\[\[#searched:([^\]]+)\]\]$', |
101 |
form => qw/\[\[\#form:'((?:[^'\\]|\\.)+)':'((?:[^'\\]|\\.)+)'(?::'((?:[^'\\]|\\.)*)')?\]\]/, |
form => qw/\[\[\#form(?:\(([A-Za-z0-9-]+)\))?:'((?:[^'\\]|\\.)*)':'((?:[^'\\]|\\.)*)'(?::'((?:[^'\\]|\\.)*)')?\]\]/, |
102 |
); |
); |
103 |
############################## |
############################## |
104 |
my $info_LastModified = 'LastModified'; |
my $info_LastModified = 'LastModified'; |
119 |
$CompletedSuccessfully => 1, |
$CompletedSuccessfully => 1, |
120 |
#$FrontPage => 1, |
#$FrontPage => 1, |
121 |
WikiUserAgentList => 1, |
WikiUserAgentList => 1, |
122 |
|
WikiPluginInfo => 1, |
123 |
); |
); |
124 |
my %form; |
my %form; |
125 |
my %database; |
my %database; |
135 |
$RssPage => 'rss', |
$RssPage => 'rss', |
136 |
$AdminChangePassword => 'adminchangepasswordform', |
$AdminChangePassword => 'adminchangepasswordform', |
137 |
#$FrontPage => 'FrontPage', |
#$FrontPage => 'FrontPage', |
138 |
|
WikiPluginInfo => 'x_WikiPluginInfo', |
139 |
); |
); |
140 |
my %command_do = ( |
my %command_do = ( |
141 |
read => \&do_read, |
read => \&do_read, |
157 |
diff => \&do_diff, |
diff => \&do_diff, |
158 |
interwikibox => \&do_interwiki_box, # Walrus add (5) |
interwikibox => \&do_interwiki_box, # Walrus add (5) |
159 |
wikiform => \&do_wikiform, |
wikiform => \&do_wikiform, |
160 |
|
x_WikiPluginInfo => \&do_wikiplugininfo, |
161 |
); |
); |
162 |
############################## |
############################## |
163 |
my $walversion = '2.0.beta1.wal.1'; # Walrus add (1) |
my $walversion = '2.0.beta1.wal.1'; # Walrus add (1) |
164 |
############################## |
############################## |
165 |
# &test_convert; |
# &test_convert; |
166 |
my $UA = ''; ## User agent name |
my $UA = ''; ## User agent name |
|
&main; |
|
|
exit(0); |
|
167 |
############################## |
############################## |
168 |
|
|
169 |
sub main { |
sub main { |
767 |
sub inline { |
sub inline { |
768 |
my ($line) = @_; |
my ($line) = @_; |
769 |
$line = &escape($line); |
$line = &escape($line); |
770 |
$line =~ s{$embed_command{form}}{&make_custom_form ($1, $2, $3)}ge; |
$line =~ s{$embed_command{form}}{&make_custom_form ($1, $2, $3, $4)}ge; |
771 |
$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; |
772 |
$line =~ s:\[(WEAK)\[(.+?)\]\]:<span class="@{[lc $1]}">$2</span>:g; |
$line =~ s:\[(WEAK)\[(.+?)\]\]:<span class="@{[lc $1]}">$2</span>:g; |
773 |
$line =~ s:\[ABBR\[([^]]+)\] \[([^]]+)\]\]:<acronym title="$2">$1</acronym>:g; |
$line =~ s:\[ABBR\[([^]]+)\] \[([^]]+)\]\]:<acronym title="$2">$1</acronym>:g; |
850 |
} |
} |
851 |
|
|
852 |
my $FormIndex = 0; |
my $FormIndex = 0; |
853 |
sub make_custom_form ($$$) { |
sub make_custom_form ($$$$) { |
854 |
my ($definition, $template, $option) = @_; |
my ($wfname, $definition, $template, $option) = @_; |
|
$definition =~ s/\\(.)/$1/g; |
|
855 |
## $template and $option is currently not used in this procedure. |
## $template and $option is currently not used in this procedure. |
856 |
unless ($main::_EMBEDED) { |
unless ($main::_EMBEDED) { |
857 |
$FormIndex++; |
$FormIndex++; |
858 |
my $param = bless {}, 'SuikaWiki::Plugin'; |
if (length $definition) { |
859 |
my $lastmodified = &get_info($form{mypage}, $info_LastModified); |
my $param = bless {}, 'SuikaWiki::Plugin'; |
860 |
my $r = <<EOH; |
my $lastmodified = &get_info($form{mypage}, $info_LastModified); |
861 |
|
&load_formatter (qw/form_input form_option/); |
862 |
|
$definition = &unescape ($definition); |
863 |
|
$definition =~ s/\\(.)/$1/g; |
864 |
|
$definition .= ' %submit;' if $definition !~ /%submit/; |
865 |
|
$option = &unescape ($option); |
866 |
|
$option =~ s/\\(.)/$1/g; |
867 |
|
$fmt{form_option}->replace ($option, $param); |
868 |
|
my $target_page = $param->{output}->{page} || $form{mypage}; |
869 |
|
$param->{form_disabled} = 1 if $fixedpage{$target_page}; |
870 |
|
my $target_form = $param->{output}->{id}; |
871 |
|
my $r = <<EOH; |
872 |
<form method="post" action="$url_cgi" id="wikiform-$FormIndex" class="wikiform"> |
<form method="post" action="$url_cgi" id="wikiform-$FormIndex" class="wikiform"> |
873 |
<input type="hidden" name="mycmd" value="wikiform"> |
<input type="hidden" name="mycmd" value="@{[$param->{form_disabled}?'read':'wikiform']}"> |
874 |
<input type="hidden" name="mypage" value="@{[&escape($form{mypage})]}"> |
<input type="hidden" name="mypage" value="@{[&escape($target_page)]}"> |
875 |
<input type="hidden" name="myLastModified" value="$lastmodified"> |
<input type="hidden" name="myLastModified" value="$lastmodified"> |
876 |
<input type="hidden" name="mytouch" value="on"> |
<input type="hidden" name="mytouch" value="on"> |
877 |
<input type="hidden" name="wikiform_index" value="$FormIndex"> |
<input type="hidden" name="@{[$target_form? qq(wikiform_targetform" value="@{[&escape($target_form)]}) : qq(wikiform_index" value="$FormIndex)]}"> |
878 |
EOH |
EOH |
879 |
$r .= qq(<a name="wikiform-$FormIndex"></a>) if $UA =~ m#Mozilla/[12]\.#; |
$r .= qq(<a name="wikiform-$FormIndex"></a>) if $UA =~ m#Mozilla/[12]\.#; |
880 |
$r .= $fmt{form_input}->replace (&unescape ($definition), $param); |
$r .= $fmt{form_input}->replace ($definition, $param); |
881 |
$r .= <<EOH; |
$r .= <<EOH; |
882 |
</form> |
</form> |
883 |
EOH |
EOH |
884 |
|
$r; |
885 |
|
} else { ## No input-interface WikiForm |
886 |
|
qq(<a id="wikiform-$FormIndex" name="wikiform-$FormIndex"><!-- #form --></a>); |
887 |
|
} |
888 |
} else { |
} else { |
889 |
q(<ins class="wiki-error"><strong>Warning</strong>: form in embeded page is currently not supported.</ins>); |
q(<ins class="wiki-error"><strong>Warning</strong>: form in embeded page is currently not supported.</ins>); |
890 |
} |
} |
1285 |
$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]+)+$/; |
1286 |
&encode (&code_convert (\$p->{name}, $o->{charset} || 'shift_jis')); |
&encode (&code_convert (\$p->{name}, $o->{charset} || 'shift_jis')); |
1287 |
}; |
}; |
|
|
|
|
$fmt{form_input} = Message::Util::Formatter->new; |
|
|
for (@{$SuikaWiki::Plugin::List{wikiform_input}||[]}) { |
|
|
$_->load_formatter ($fmt{form_input}, type => 'wikiform_input'); |
|
|
} |
|
1288 |
} |
} |
1289 |
|
|
1290 |
|
|
1352 |
$namestr = qq( ''[[$namestr]]'': ); |
$namestr = qq( ''[[$namestr]]'': ); |
1353 |
} |
} |
1354 |
my $anchor = &get_new_anchor_index ($content); |
my $anchor = &get_new_anchor_index ($content); |
|
|
|
|
# $content =~ s/(?:-+\s)?\[([0-9]+)\]/$anchor = $1 if $1 > $anchor; $&/mge; |
|
|
# $anchor++; |
|
1355 |
my $i = 1; my $o = 0; |
my $i = 1; my $o = 0; |
1356 |
$content =~ s{(\Q$embed_comment\E|\Q$embed_rcomment\E)}{ |
$content =~ s{(\Q$embed_comment\E|\Q$embed_rcomment\E)}{ |
1357 |
my $embed = $1; |
my $embed = $1; |
1450 |
} |
} |
1451 |
} |
} |
1452 |
|
|
1453 |
sub do_wikiform { |
sub load_formatter (@) { |
1454 |
my $content = $database{$form{mypage}}; |
for my $t (@_) { |
|
my $anchor = &get_new_anchor_index ($content); |
|
|
for my $t (qw/form_template form_option/) { |
|
1455 |
unless ($fmt{$t}) { |
unless ($fmt{$t}) { |
1456 |
$fmt{$t} = Message::Util::Formatter->new; |
$fmt{$t} = Message::Util::Formatter->new; |
1457 |
for (@{$SuikaWiki::Plugin::List{'wiki'.$t}||[]}) { |
for (@{$SuikaWiki::Plugin::List{'wiki'.$t}||[]}) { |
1459 |
} |
} |
1460 |
} |
} |
1461 |
} |
} |
1462 |
|
} |
1463 |
|
|
1464 |
|
sub do_wikiform { |
1465 |
|
my $content = $database{$form{mypage}}; |
1466 |
|
my $anchor = &get_new_anchor_index ($content); |
1467 |
|
&load_formatter (qw/form_template form_option/); |
1468 |
my $write = 0; |
my $write = 0; |
1469 |
my $i = 1; |
my $i = 1; |
1470 |
$content =~ s{$embed_command{form}}{ |
$content =~ s{$embed_command{form}}{ |
1471 |
my ($embed, $template, $option) = ($&, $2, $3); |
my ($embed, $wfname, $template, $option) = ($&, $1, $3, $4); |
1472 |
$template =~ s/\\(.)/$1/g; |
if (($wfname && $wfname eq $form{wikiform_targetform}) |
1473 |
$option =~ s/\\(.)/$1/g; |
|| $i == $form{wikiform_index}) { |
1474 |
if ($i == $form{wikiform_index}) { |
$template =~ s/\\(.)/$1/g; |
1475 |
|
$option =~ s/\\(.)/$1/g; |
1476 |
my $param = bless {}, 'SuikaWiki::Plugin'; |
my $param = bless {}, 'SuikaWiki::Plugin'; |
1477 |
$param->{page} = $form{mypage}; |
$param->{page} = $form{mypage}; |
1478 |
$param->{form_index} = $i; |
$param->{form_index} = $i; |
1479 |
|
$param->{form_name} = $wfname; |
1480 |
$param->{anchor_index} = $anchor; |
$param->{anchor_index} = $anchor; |
1481 |
$param->{argv} = \%form; |
$param->{argv} = \%form; |
1482 |
$param->{default_name} = $1 if $content =~ /default-name="([^"]+)"/; |
$param->{default_name} = $1 if $content =~ /default-name="([^"]+)"/; |
1483 |
|
$param->{default_name} ||= $DEFAULT_embed_comment_name; |
1484 |
$fmt{form_option}->replace ($option, $param); |
$fmt{form_option}->replace ($option, $param); |
1485 |
my $t = $fmt{form_template}->replace ($template, $param); |
my $t = 1; |
1486 |
|
for (@{$param->{require}||[]}) { |
1487 |
|
(undef $t, last) unless length $param->{argv}->{'wikiform__'.$_}; |
1488 |
|
} |
1489 |
|
$t = $fmt{form_template}->replace ($template, $param) if $t; |
1490 |
if (length $t) { |
if (length $t) { |
1491 |
if ($param->{output}->{reverse}) { |
if ($param->{output}->{reverse}) { |
|
$embed = $t . "\n" . $embed; |
|
|
} else { |
|
1492 |
$embed .= "\n" . $t; |
$embed .= "\n" . $t; |
1493 |
|
} else { |
1494 |
|
$embed = $t . "\n" . $embed; |
1495 |
} |
} |
1496 |
$write = 1; |
$write = 1; |
1497 |
$form{__comment_anchor_index} = $anchor |
$form{__comment_anchor_index} = $anchor |
1498 |
unless $param->{anchor_index}; ## $anchor is used! |
if $param->{anchor_index_}; ## $anchor is used! |
1499 |
} |
} |
1500 |
|
$form{__wikiform_anchor_index} = $i; |
1501 |
|
undef $form{wikiform_targetform}; ## make sure never to match |
1502 |
|
undef $form{wikiform_index}; ## with WikiForm in rest of page |
1503 |
} |
} |
1504 |
$i++; $embed; |
$i++; $embed; |
1505 |
}ge; |
}ge; |
1508 |
#$content .= "\n" unless $content =~ /\n$/s; |
#$content .= "\n" unless $content =~ /\n$/s; |
1509 |
# |
# |
1510 |
} |
} |
|
$form{__wikiform_anchor_index} = $form{wikiform_index}; |
|
1511 |
if ($write) { |
if ($write) { |
1512 |
$form{mymsg} = $content; |
$form{mymsg} = $content; |
1513 |
$form{mytouch} = 'on'; |
$form{mytouch} = 'on'; |
1704 |
sub __get_database ($) { $database{ $_[0] } } |
sub __get_database ($) { $database{ $_[0] } } |
1705 |
sub __set_database ($$) { $database{ $_[0] } = $_[1] } |
sub __set_database ($$) { $database{ $_[0] } = $_[1] } |
1706 |
|
|
1707 |
|
sub do_wikiplugininfo { |
1708 |
|
&print_header (q(WikiPluginInfo)); |
1709 |
|
print text_to_html (&SuikaWiki::Plugin::make_info_page); |
1710 |
|
&print_footer (q(WikiPluginInfo)); |
1711 |
|
} |
1712 |
|
|
1713 |
package wiki::referer; |
package wiki::referer; |
1714 |
sub add ($$) { |
sub add ($$) { |
1715 |
my $page = shift; |
my $page = shift; |
1813 |
} |
} |
1814 |
|
|
1815 |
package SuikaWiki::Plugin; |
package SuikaWiki::Plugin; |
1816 |
|
our $plugin_directory; # defined in top of this file. |
1817 |
our %List; |
our %List; |
1818 |
|
|
1819 |
sub escape ($$) { main::escape ($_[1]) } |
sub escape ($$) { main::escape ($_[1]) } |
1829 |
} |
} |
1830 |
} |
} |
1831 |
|
|
1832 |
use SuikaWiki::Plugin::WikiFormBasic; |
sub import_plugins () { |
1833 |
|
opendir PDIR, $plugin_directory; |
1834 |
|
my @plugin = grep {s/\.pm$//} readdir (PDIR); |
1835 |
|
closedir PDIR; |
1836 |
|
for (@plugin) { |
1837 |
|
eval qq{ use SuikaWiki::Plugin::$_ } unless /[^A-Za-z0-9_]/; |
1838 |
|
push @{$List{_all}}, qq(SuikaWiki::Plugin::$_); |
1839 |
|
} |
1840 |
|
} |
1841 |
|
|
1842 |
|
sub make_info_page () { |
1843 |
|
my $r = <<EOH; |
1844 |
|
EOH |
1845 |
|
unless ($List{_all}) { |
1846 |
|
$r .= qq('''No plugin is installed!'''\n); |
1847 |
|
} else { |
1848 |
|
my $index = 0; |
1849 |
|
for my $package (sort @{$List{_all}}) { |
1850 |
|
$index++; |
1851 |
|
my $prop = $package->property (); |
1852 |
|
$r .= <<EOH; |
1853 |
|
*$package |
1854 |
|
|
1855 |
|
[$index] '''$prop->{name}''' (Version $prop->{version}) |
1856 |
|
<$prop->{uri}> |
1857 |
|
|
1858 |
|
Provide: |
1859 |
|
@{[do{my $t = ''; for my $f (@{$prop->{provide}||[]}) { |
1860 |
|
$t .= qq(-''$f''\n); |
1861 |
|
for (sort grep m#^\Q$f\E/#, keys %{$prop->{partinfo}}) { |
1862 |
|
$t .= qq(--''$_'' -- $prop->{partinfo}->{$_}\n); |
1863 |
|
} |
1864 |
|
}$t}]} |
1865 |
|
|
1866 |
|
EOH |
1867 |
|
} |
1868 |
|
} |
1869 |
|
$r; |
1870 |
|
} |
1871 |
|
|
1872 |
|
&import_plugins (); |
1873 |
|
|
1874 |
|
package main; |
1875 |
|
&main; |
1876 |
|
exit 0; |
1877 |
|
|
1878 |
1; |
1; |
1879 |
__END__ |
__END__ |