16 |
# my $modifier_dbtype = 'dbmopen'; # Fast, not available on some server, page size limited. |
# my $modifier_dbtype = 'dbmopen'; # Fast, not available on some server, page size limited. |
17 |
my $modifier_dbtype = 'YukiWikiDB'; # Slow, available on all environment. |
my $modifier_dbtype = 'YukiWikiDB'; # Slow, available on all environment. |
18 |
my $modifier_dir_data = './wikidata'; # Your data directory. |
my $modifier_dir_data = './wikidata'; # Your data directory. |
19 |
our $url_cgi = '/~wakaba/-temp/wiki/wiki'; ## MUST be started by '/' |
our $url_cgi = '/~wakaba/-temp/wiki/wiki'; |
20 |
############################## |
## - MUST be started by '/' |
21 |
# |
## - MUST NOT include [&<>"] and/or non-URI characters |
|
# You MAY modify following variables. |
|
|
# |
|
|
$SuikaWiki::Plugin::plugin_directory = q(./SuikaWiki/Plugin/); |
|
|
my $file_touch = "$modifier_dir_data/touched.txt"; |
|
22 |
our %uri; |
our %uri; |
23 |
$uri{stylesheet} = $url_cgi.'?mycmd=TEXT_CSS;mypage=WikiHTMLStyle'; |
$uri{wiki} = $url_cgi; |
24 |
$uri{cvs_wikipage} = '/gate/cvs/wakaba/suikawiki/wiki/'; |
$uri{cvs_wikipage} = '/gate/cvs/wakaba/suikawiki/wiki/'; |
25 |
|
$SuikaWiki::Plugin::plugin_directory = q(./SuikaWiki/Plugin/); |
26 |
|
my $file_touch = "$modifier_dir_data/touched.txt"; |
27 |
############################## |
############################## |
28 |
# |
# |
29 |
# You MAY, but do NOT NEED modify following variables. |
# You MAY, but do NOT NEED modify following variables. |
40 |
my $ErrorPage = 'ErrorPage'; |
my $ErrorPage = 'ErrorPage'; |
41 |
my $RssPage = 'RssPage'; |
my $RssPage = 'RssPage'; |
42 |
my $AdminSpecialPage = 'Admin Special Page'; # must include spaces. |
my $AdminSpecialPage = 'Admin Special Page'; # must include spaces. |
43 |
|
my %PageName = ( |
44 |
|
DefaultStyleForHTML => 'WikiHTMLStyle', |
45 |
|
); |
46 |
############################## |
############################## |
47 |
my %fmt; ## formatter objects |
my %fmt; ## formatter objects |
48 |
my %embed_command = ( |
my %embed_command = ( |
57 |
my $lang = 'ja'; |
my $lang = 'ja'; |
58 |
my %fixedpage = ( |
my %fixedpage = ( |
59 |
$IndexPage => 1, |
$IndexPage => 1, |
|
$CreatePage => 1, |
|
60 |
$ErrorPage => 1, |
$ErrorPage => 1, |
61 |
$RssPage => 1, |
$RssPage => 1, |
62 |
RecentChanges => 1, |
RecentChanges => 1, |
|
$SearchPage => 1, |
|
63 |
AdminChangePassword => 1, |
AdminChangePassword => 1, |
64 |
CompletedSuccessfully => 1, |
CompletedSuccessfully => 1, |
65 |
WikiUserAgentList => 1, |
WikiUserAgentList => 1, |
|
WikiPluginInfo => 1, |
|
66 |
); |
); |
67 |
my %form; |
my %form; |
68 |
my %database; |
my %database; |
72 |
############################## |
############################## |
73 |
my %page_command = ( |
my %page_command = ( |
74 |
$IndexPage => 'index', |
$IndexPage => 'index', |
|
$SearchPage => 'searchform', |
|
|
$CreatePage => 'create', |
|
75 |
$RssPage => 'rss', |
$RssPage => 'rss', |
76 |
AdminChangePassword => 'adminchangepasswordform', |
AdminChangePassword => 'adminchangepasswordform', |
|
WikiPluginInfo => 'x_WikiPluginInfo', |
|
77 |
); |
); |
78 |
my %command_do = ( |
my %command_do = ( |
79 |
read => \&do_read, |
read => \&do_read, |
85 |
write => \&do_write, |
write => \&do_write, |
86 |
index => \&do_index, |
index => \&do_index, |
87 |
searchform => \&do_searchform, |
searchform => \&do_searchform, |
|
search => \&do_search, |
|
|
create => \&do_create, |
|
|
createresult => \&do_createresult, |
|
88 |
comment => \&do_comment, |
comment => \&do_comment, |
89 |
RandomJump => \&do_random_jump, |
RandomJump => \&do_random_jump, |
90 |
rss => \&do_rss, |
rss => \&do_rss, |
91 |
diff => \&do_diff, |
diff => \&do_diff, |
92 |
wikiform => \&do_wikiform, |
wikiform => \&do_wikiform, |
|
x_WikiPluginInfo => \&do_wikiplugininfo, |
|
93 |
map => \&do_map, |
map => \&do_map, |
94 |
); |
); |
95 |
my $UA = ''; ## User agent name |
my $UA = ''; ## User agent name |
103 |
if ($command_do{$form{mycmd}}) { |
if ($command_do{$form{mycmd}}) { |
104 |
&{$command_do{$form{mycmd}}}; |
&{$command_do{$form{mycmd}}}; |
105 |
} else { |
} else { |
106 |
&{$command_do{$form{read}}}; |
&{$command_do{read}}; |
107 |
} |
} |
108 |
&close_db; |
&close_db; |
109 |
} |
} |
128 |
$cf = $1 if $content =~ s#^(?:/\*\s*|[\#<]\?)?([A-Z][A-Za-z0-9-]+/[0-9.]+(?:[^0-9.\x0D\x0A][^\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]*)?)[\x0D\x0A]+##s; |
129 |
if ($cf =~ m!^(?:\#\?)?SuikaWiki/0.9(?:$|\s)!) { |
if ($cf =~ m!^(?:\#\?)?SuikaWiki/0.9(?:$|\s)!) { |
130 |
#print gmtime."Header...\n"; |
#print gmtime."Header...\n"; |
131 |
&print_header ($form{mypage}, -last_modified => $lm, |
&print_header ($form{mypage}, -last_modified => $lm, -expires => time + 120, |
132 |
-content_format => $cf, -noindex => $cf =~ /obsoleted="yes"/); |
-content_format => $cf, -noindex => ($cf =~ /obsoleted="yes"/ ? 1 : 0)); |
133 |
#print "\n". gmtime."Body...\n"; |
#print "\n". gmtime."Body...\n"; |
134 |
&print_content ($content, content_format => $cf, last_modified => $lm, |
&print_content ($content, content_format => $cf, last_modified => $lm, |
135 |
-toc => \@toc); |
-toc => \@toc); |
136 |
print &text_to_html (q([[#comment]])) if $cf !~ /obsoleted="yes"/ && !$fixedpage{$form{mypage}}; |
print &text_to_html (q([[#comment]])) if $cf !~ /obsoleted="yes"/ && !$fixedpage{$form{mypage}}; |
137 |
} else { |
} else { |
138 |
&print_header($form{mypage}, -last_modified => $lm); |
&print_header($form{mypage}, -expires => time + 120, -last_modified => $lm); |
139 |
print "<pre>@{[&escape($content)]}</pre>"; |
print "<pre>@{[&escape($content)]}</pre>"; |
140 |
} |
} |
141 |
if ($c) { |
if ($c) { |
158 |
my $lm = gmtime &get_info($form{mypage}, $info_LastModified); |
my $lm = gmtime &get_info($form{mypage}, $info_LastModified); |
159 |
print "Content-Type: text/css; charset=@{[&get_charset_name($kanjicode)]}\n"; |
print "Content-Type: text/css; charset=@{[&get_charset_name($kanjicode)]}\n"; |
160 |
print "Last-Modified: $lm\n"; |
print "Last-Modified: $lm\n"; |
161 |
|
print "Expires: @{[scalar gmtime time+3600]}\n"; ## TODO: don't use asctime |
162 |
print "\n"; |
print "\n"; |
163 |
print $content; |
print $content; |
164 |
} else { |
} else { |
180 |
|
|
181 |
sub do_edit { |
sub do_edit { |
182 |
my ($page) = &unarmor_name(&armor_name($form{mypage})); |
my ($page) = &unarmor_name(&armor_name($form{mypage})); |
|
&print_header($page, -noindex => 1); |
|
183 |
if (not &is_editable($page)) { |
if (not &is_editable($page)) { |
184 |
|
&print_header($page, -noindex => 1); |
185 |
&print_message(&Resource('Error:ThisPageIsUneditable')); |
&print_message(&Resource('Error:ThisPageIsUneditable')); |
186 |
} elsif (&is_frozen($page)) { |
} elsif (&is_frozen($page)) { |
187 |
|
&print_header($page, -noindex => 1); |
188 |
&print_message(&Resource('Error:ThisPageIsUneditable')); |
&print_message(&Resource('Error:ThisPageIsUneditable')); |
189 |
} else { |
} else { |
190 |
|
&print_header($page, -noindex => 1, -expires => time+60); |
191 |
&print_editform($database{$page}, &get_info($page, $info_LastModified), admin=>0); |
&print_editform($database{$page}, &get_info($page, $info_LastModified), admin=>0); |
192 |
} |
} |
193 |
wiki::referer::add ($form{mypage}, $ENV{HTTP_REFERER}); |
wiki::referer::add ($form{mypage}, $ENV{HTTP_REFERER}); |
329 |
} |
} |
330 |
} |
} |
331 |
|
|
|
sub do_searchform { |
|
|
&print_header($SearchPage); |
|
|
&print_searchform(""); |
|
|
&print_footer($SearchPage); |
|
|
} |
|
|
|
|
|
sub do_search { |
|
|
my $word = $form{mymsg}; |
|
|
&print_header($SearchPage); |
|
|
&print_searchform(&escape($word)); |
|
|
print scalar get_search_result ($word, -output_not_found => 1, -match_myself => 1); |
|
|
&print_footer($SearchPage); |
|
|
} |
|
|
|
|
332 |
sub get_search_result ($;%) { |
sub get_search_result ($;%) { |
333 |
my $word = lc shift; |
my $word = lc shift; |
334 |
my %option = @_; |
my %option = @_; |
352 |
wantarray? ($r, scalar @r): $r; |
wantarray? ($r, scalar @r): $r; |
353 |
} |
} |
354 |
|
|
|
sub do_create { |
|
|
&print_header($CreatePage); |
|
|
print <<"EOD"; |
|
|
<form action="$url_cgi" method="post"> |
|
|
<input type="hidden" name="mycmd" value="edit"> |
|
|
<strong>@{[&Resource('InputPageNameEdited',escape=>1)]}</strong><br> |
|
|
<input type="text" name="mypage" value="" size="20"> |
|
|
<input type="submit" value="@{[&Resource('WikiForm:Create',escape=>1)]}"><br> |
|
|
</form> |
|
|
EOD |
|
|
&print_footer($CreatePage); |
|
|
} |
|
|
|
|
355 |
sub do_random_jump { |
sub do_random_jump { |
356 |
my @list = keys %database; |
my @list = keys %database; |
357 |
my $name = &encode ($list[rand @list]); |
my $name = &encode ($list[rand @list]); |
388 |
} |
} |
389 |
} |
} |
390 |
print qq{Last-Modified: @{[scalar gmtime $option{-last_modified}]}\n} if $option{-last_modified}; |
print qq{Last-Modified: @{[scalar gmtime $option{-last_modified}]}\n} if $option{-last_modified}; |
391 |
|
if ($option{-expires}) { |
392 |
|
print qq{Expires: @{[scalar gmtime $option{-expires}]}\n}; |
393 |
|
} |
394 |
if ($UA =~ m#Mozilla/2#) { |
if ($UA =~ m#Mozilla/2#) { |
395 |
my $ct = qq{text/html; charset=@{[&get_charset_name($kanjicode,compatible=>1)]}}; |
my $ct = qq{text/html; charset=@{[&get_charset_name($kanjicode,compatible=>1)]}}; |
396 |
print qq{Content-Type: $ct\n}; |
print qq{Content-Type: $ct\n}; |
401 |
print qq{Content-Type: text/html; charset=@{[&get_charset_name($kanjicode)]}\n}; |
print qq{Content-Type: text/html; charset=@{[&get_charset_name($kanjicode)]}\n}; |
402 |
} |
} |
403 |
push @head, qq(<title>@{[&escape($page)]}</title>); |
push @head, qq(<title>@{[&escape($page)]}</title>); |
404 |
push @head, qq(<link rel="stylesheet" type="text/css" href="@{[&escape($uri{stylesheet})]}") |
if ($UA !~ m#Mozilla/[1-4]\.# || $UA =~ m#MSIE (?:[4-9]\.|\d\d)#) { |
405 |
if $UA !~ m#Mozilla/[1-4]\.# || $UA =~ m#MSIE (?:[4-9]\.|\d\d)#; |
push @head, qq(<link rel="stylesheet" type="text/css" href="@{[&escape($uri{wiki}.'?mycmd=TEXT_CSS;mypage='.&encode($PageName{DefaultStyleForHTML}).';x-lm='.&get_info($PageName{DefaultStyleForHTML}, $info_LastModified))]}"); |
406 |
|
} |
407 |
push @head, q(<meta name="ROBOTS" content="NOINDEX">) if $option{-noindex}; |
push @head, q(<meta name="ROBOTS" content="NOINDEX">) if $option{-noindex}; |
408 |
my ($Links, $links) = &make_navigate_links ($page); |
my ($Links, $links) = &make_navigate_links ($page); |
409 |
#print $Links; ## Link: fields |
#print $Links; ## Link: fields |
730 |
return qq(<a title="$subject" href="$url_cgi?@{[&encode($name)]}" class="wiki">$ename</a>); |
return qq(<a title="$subject" href="$url_cgi?@{[&encode($name)]}" class="wiki">$ename</a>); |
731 |
} |
} |
732 |
} else { |
} else { |
733 |
return qq(<a title="@{[&Resource('JumpAndEditWikiPage',escape=>1)]}" href="$url_cgi?mycmd=edit;mypage=@{[&escape($name)]}" class="wiki not-exist">$ename<span class="mark">@{[&Resource('JumpAndEditWikiPageMark',escape=>1)]}</span></a>); |
return qq(<a title="@{[&Resource('JumpAndEditWikiPage',escape=>1)]}" href="$url_cgi?@{[&escape($name)]}" class="wiki not-exist">$ename<span class="mark">@{[&Resource('JumpAndEditWikiPageMark',escape=>1)]}</span></a>); |
734 |
} |
} |
735 |
} |
} |
736 |
|
|
788 |
$option = &unescape ($option); |
$option = &unescape ($option); |
789 |
$option =~ s/\\(.)/$1/g; |
$option =~ s/\\(.)/$1/g; |
790 |
$fmt{form_option}->replace ($option, $param); |
$fmt{form_option}->replace ($option, $param); |
791 |
$definition .= ' %submit;' if $definition !~ /%submit/ && !$param->{output}->{nosubmit}; |
$param->{output}->{form} = 1 unless defined $param->{output}->{form}; |
792 |
|
$definition .= ' %submit;' if $definition !~ /%submit/ && !$param->{output}->{nosubmit} && $param->{output}->{form}; |
793 |
my $target_page = $param->{output}->{page} || $form{mypage}; |
my $target_page = $param->{output}->{page} || $form{mypage}; |
794 |
$param->{form_disabled} = 1 if $fixedpage{$target_page}; |
$param->{form_disabled} = 1 if $fixedpage{$target_page}; |
795 |
my $target_form = $param->{output}->{id}; |
my $target_form = $param->{output}->{id}; |
796 |
my $r = <<EOH; |
my $r = ''; |
797 |
|
$r = <<EOH if $param->{output}->{form}; |
798 |
<form method="post" action="$url_cgi" id="wikiform-$FormIndex" class="wikiform"> |
<form method="post" action="$url_cgi" id="wikiform-$FormIndex" class="wikiform"> |
799 |
<input type="hidden" name="mycmd" value="@{[$param->{form_disabled}?'read':'wikiform']}"> |
<input type="hidden" name="mycmd" value="@{[$param->{form_disabled}?'read':'wikiform']}"> |
800 |
<input type="hidden" name="mypage" value="@{[&escape($target_page)]}"> |
<input type="hidden" name="mypage" value="@{[&escape($target_page)]}"> |
804 |
EOH |
EOH |
805 |
$r .= qq(<a name="wikiform-$FormIndex"></a>) if $UA =~ m#Mozilla/[12]\.#; |
$r .= qq(<a name="wikiform-$FormIndex"></a>) if $UA =~ m#Mozilla/[12]\.#; |
806 |
$r .= $fmt{form_input}->replace ($definition, $param); |
$r .= $fmt{form_input}->replace ($definition, $param); |
807 |
$r .= <<EOH; |
$r .= "</form>\n" if $param->{output}->{form}; |
|
</form> |
|
|
EOH |
|
808 |
$r; |
$r; |
809 |
} else { ## No input-interface WikiForm |
} else { ## No input-interface WikiForm |
810 |
qq(<a id="wikiform-$FormIndex" name="wikiform-$FormIndex"><!-- #form --></a>); |
qq(<a id="wikiform-$FormIndex" name="wikiform-$FormIndex"><!-- #form --></a>); |
826 |
read STDIN, $query, $main::ENV{CONTENT_LENGTH}; |
read STDIN, $query, $main::ENV{CONTENT_LENGTH}; |
827 |
} |
} |
828 |
$query .= ($query ? ';' : '') . $main::ENV{QUERY_STRING}; |
$query .= ($query ? ';' : '') . $main::ENV{QUERY_STRING}; |
829 |
if ($main::ENV{QUERY_STRING} && $main::ENV{QUERY_STRING} !~ /[&;=]/) { |
if ($main::ENV{REQUEST_METHOD} ne 'POST' && $main::ENV{QUERY_STRING} && $main::ENV{QUERY_STRING} !~ /[&;=]/) { |
830 |
my $query = &decode($main::ENV{QUERY_STRING}); |
my $query = &decode($main::ENV{QUERY_STRING}); |
831 |
$query = &code_convert(\$query, $kanjicode); |
$query = &code_convert(\$query, $kanjicode); |
832 |
if ($page_command{$query}) { |
if ($page_command{$query}) { |
964 |
} |
} |
965 |
} |
} |
966 |
|
|
|
sub print_searchform { |
|
|
my ($word) = @_; |
|
|
print <<"EOD"; |
|
|
<form action="$url_cgi" method="get"> |
|
|
<input type="hidden" name="mycmd" value="read"> |
|
|
<input type="text" name="mypage" value="$word" size="20"> |
|
|
<input type="submit" value="@{[&Resource('WikiForm:Search',escape=>1)]}"> |
|
|
</form> |
|
|
EOD |
|
|
} |
|
|
|
|
967 |
sub print_editform { |
sub print_editform { |
968 |
my ($mymsg, $lastmodified, %mode) = @_; |
my ($mymsg, $lastmodified, %mode) = @_; |
969 |
my $frozen = &is_frozen($form{mypage}); |
my $frozen = &is_frozen($form{mypage}); |
1459 |
sub __get_database ($) { $database{ $_[0] } } |
sub __get_database ($) { $database{ $_[0] } } |
1460 |
sub __set_database ($$) { $database{ $_[0] } = $_[1] } |
sub __set_database ($$) { $database{ $_[0] } = $_[1] } |
1461 |
|
|
|
sub do_wikiplugininfo { |
|
|
&print_header (q(WikiPluginInfo)); |
|
|
print text_to_html (&SuikaWiki::Plugin::make_info_page); |
|
|
&print_footer (q(WikiPluginInfo)); |
|
|
} |
|
|
|
|
1462 |
sub do_map { |
sub do_map { |
1463 |
my $page = $form{mypage}; |
my $page = $form{mypage}; |
1464 |
&print_header ($page); |
&print_header ($page); |
1619 |
sub encode ($$) { main::encode ($_[1]) } |
sub encode ($$) { main::encode ($_[1]) } |
1620 |
sub decode ($$) { main::decode ($_[1]) } |
sub decode ($$) { main::decode ($_[1]) } |
1621 |
sub __get_datetime ($) { main::get_now () } |
sub __get_datetime ($) { main::get_now () } |
1622 |
|
sub resource ($$;%) { shift; &main::Resource (@_) } |
1623 |
|
sub uri ($$) { $main::uri{$_[1]} } |
1624 |
|
|
1625 |
sub regist ($@) { |
sub regist ($@) { |
1626 |
my $pack = shift; |
my $pack = shift; |
1639 |
} |
} |
1640 |
} |
} |
1641 |
|
|
|
sub make_info_page () { |
|
|
my $r = <<EOH; |
|
|
EOH |
|
|
unless ($List{_all}) { |
|
|
$r .= qq('''No plugin is installed!'''\n); |
|
|
} else { |
|
|
my $index = 0; |
|
|
for my $package (sort @{$List{_all}}) { |
|
|
$index++; |
|
|
my $prop = $package->property (); |
|
|
$r .= <<EOH; |
|
|
*$package |
|
|
|
|
|
[$index] '''$prop->{name}''' (Version $prop->{version}) |
|
|
<$prop->{uri}> |
|
|
|
|
|
Provide: |
|
|
@{[do{my $t = ''; for my $f (@{$prop->{provide}||[]}) { |
|
|
$t .= qq(-''$f''\n); |
|
|
for (sort grep m#^\Q$f\E/#, keys %{$prop->{partinfo}}) { |
|
|
$t .= qq(--''$_'' -- $prop->{partinfo}->{$_}\n); |
|
|
} |
|
|
}$t}]} |
|
|
|
|
|
EOH |
|
|
} |
|
|
} |
|
|
$r; |
|
|
} |
|
|
|
|
1642 |
&import_plugins (); |
&import_plugins (); |
1643 |
|
|
1644 |
package wiki::conneg; |
package wiki::conneg; |