Mercurial > hg > Applications > casawiki
comparison wiki.cgi @ 0:a2f0a2c135cf
hg init
author | Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> |
---|---|
date | Sun, 06 Jun 2010 22:00:38 +0900 (2010-06-06) |
parents | |
children | d67370516d8c |
comparison
equal
deleted
inserted
replaced
-1:000000000000 | 0:a2f0a2c135cf |
---|---|
1 #!/usr/bin/perl -X | |
2 #!perl -X | |
3 # | |
4 # wiki.cgi - YukiWiki on Cassandra | |
5 # Shoshi TAMAKI | |
6 # | |
7 ############################## | |
8 # | |
9 # wiki.cgi - This is YukiWiki, yet another Wiki clone. | |
10 # | |
11 # Copyright (C) 2000-2004 by Hiroshi Yuki. | |
12 # <hyuki@hyuki.com> | |
13 # http://www.hyuki.com/yukiwiki/ | |
14 # | |
15 # This program is free software; you can redistribute it and/or | |
16 # modify it under the same terms as Perl itself. | |
17 # | |
18 ############################## | |
19 # Libraries. | |
20 use strict; | |
21 use lib qw(.); | |
22 use CGI qw(:standard); | |
23 use CGI::Carp qw(fatalsToBrowser); | |
24 use Yuki::RSS; | |
25 use Yuki::DiffText qw(difftext); | |
26 use Yuki::YukiWikiDB; | |
27 use Yuki::PluginManager; | |
28 use Cassandra::CassHash; | |
29 require 'jcode.pl'; | |
30 # use Jcode; | |
31 use Fcntl; | |
32 # Check if the server can use 'AnyDBM_File' or not. | |
33 # eval 'use AnyDBM_File'; | |
34 # my $error_AnyDBM_File = $@; | |
35 my $version = '2.1.3'; | |
36 ############################## | |
37 # | |
38 # You MUST modify following '$modifier_...' variables. | |
39 # | |
40 my $modifier_mail = 'hyuki@hyuki.com'; | |
41 my $modifier_url = 'http://www.hyuki.com/'; | |
42 my $modifier_name = 'Hiroshi Yuki'; | |
43 my $modifier_dir_data = '.'; # Your data directory (not URL, but DIRECTORY). | |
44 my $modifier_url_data = '.'; # Your data URL (not DIRECTORY, but URL). | |
45 my $modifier_rss_title = "YukiWiki $version"; | |
46 my $modifier_rss_link = 'http://www.hyuki.com/yukiwiki/wiki.cgi'; | |
47 my $modifier_rss_about = 'http://www.hyuki.com/yukiwiki/rss.xml'; | |
48 my $modifier_rss_description = 'This is YukiWiki, yet another Wiki clone'; | |
49 my $modifier_rss_timezone = '+09:00'; | |
50 ############################## | |
51 # | |
52 # You MAY modify following variables. | |
53 # | |
54 #my $modifier_dbtype = 'YukiWikiDB'; | |
55 my $modifier_dbtype = 'Cassandra::CassHash'; | |
56 my $modifier_sendmail = ''; | |
57 # my $modifier_sendmail = '/usr/sbin/sendmail -t -n'; | |
58 my $modifier_dir_plugin = './plugin'; | |
59 ############################## | |
60 # | |
61 # You MAY modify following variables. | |
62 # | |
63 my $file_touch = "$modifier_dir_data/touched.txt"; | |
64 my $file_resource = "$modifier_dir_data/resource.txt"; | |
65 my $file_FrontPage = "$modifier_dir_data/frontpage.txt"; | |
66 my $file_conflict = "$modifier_dir_data/conflict.txt"; | |
67 my $file_format = "$modifier_dir_data/format.txt"; | |
68 my $file_rss = "$modifier_dir_data/rss.xml"; | |
69 my $url_cgi = 'wiki.cgi'; | |
70 my $url_stylesheet = "$modifier_url_data/wiki.css"; | |
71 my $icontag = qq(<img src="$modifier_url_data/icon40x40.gif" alt="*" width="40" height="40" />); | |
72 my $maxrecent = 50; | |
73 my $max_message_length = 500_000; # -1 for unlimited. | |
74 my $cols = 80; | |
75 my $rows = 20; | |
76 ############################## | |
77 # | |
78 # You MAY modify following variables. | |
79 # | |
80 my $dataname = "$modifier_dir_data/wiki"; | |
81 my $infoname = "$modifier_dir_data/info"; | |
82 my $diffname = "$modifier_dir_data/diff"; | |
83 my $editchar = '?'; | |
84 my $subject_delimiter = ' - '; | |
85 my $use_autoimg = 1; # automatically convert image URL into <img> tag. | |
86 my $use_exists = 0; # If you can use 'exists' method for your DB. | |
87 my $use_FixedFrontPage = 0; | |
88 ############################## | |
89 my $InterWikiName = 'InterWikiName'; | |
90 my $RecentChanges = 'RecentChanges'; | |
91 my $AdminChangePassword = 'AdminChangePassword'; | |
92 my $CompletedSuccessfully = 'CompletedSuccessfully'; | |
93 my $FrontPage = 'FrontPage'; | |
94 my $IndexPage = 'IndexPage'; | |
95 my $SearchPage = 'SearchPage'; | |
96 my $CreatePage = 'CreatePage'; | |
97 my $ErrorPage = 'ErrorPage'; | |
98 my $RssPage = 'RssPage'; | |
99 my $AdminSpecialPage = 'Admin Special Page'; # must include spaces. | |
100 ############################## | |
101 my $wiki_name = '\b([A-Z][a-z]+([A-Z][a-z]+)+)\b'; | |
102 my $bracket_name = '\[\[(\S+?)\]\]'; | |
103 my $embedded_name = '\[\[(#\S+?)\]\]'; | |
104 my $interwiki_definition = '\[\[(\S+?)\ (\S+?)\]\]'; | |
105 my $interwiki_name = '([^:]+):([^:].*)'; | |
106 # Sorry for wierd regex. | |
107 my $inline_plugin = '\&(\w+)\((([^()]*(\([^()]*\))?)*)\)'; | |
108 ############################## | |
109 my $embed_comment = '[[#comment]]'; | |
110 my $embed_rcomment = '[[#rcomment]]'; | |
111 ############################## | |
112 my $info_ConflictChecker = 'ConflictChecker'; | |
113 my $info_LastModified = 'LastModified'; | |
114 my $info_IsFrozen = 'IsFrozen'; | |
115 my $info_AdminPassword = 'AdminPassword'; | |
116 ############################## | |
117 my $kanjicode = 'euc'; | |
118 my $charset = 'euc-jp'; | |
119 my $lang = 'ja'; | |
120 my %fixedpage = ( | |
121 $IndexPage => 1, | |
122 $CreatePage => 1, | |
123 $ErrorPage => 1, | |
124 $RssPage => 1, | |
125 $RecentChanges => 1, | |
126 $SearchPage => 1, | |
127 $AdminChangePassword => 1, | |
128 $CompletedSuccessfully => 1, | |
129 $FrontPage => $use_FixedFrontPage, | |
130 ); | |
131 my %form; | |
132 my %database; | |
133 my %infobase; | |
134 my %diffbase; | |
135 my %resource; | |
136 my %interwiki; | |
137 my $plugin_manager; | |
138 my $plugin_context = { | |
139 debug => 0, | |
140 database => \%database, | |
141 infobase => \%infobase, | |
142 resource => \%resource, | |
143 form => \%form, | |
144 interwiki => \%interwiki, | |
145 url_cgi => $url_cgi, | |
146 }; | |
147 ############################## | |
148 my %page_command = ( | |
149 $IndexPage => 'index', | |
150 $SearchPage => 'searchform', | |
151 $CreatePage => 'create', | |
152 $RssPage => 'rss', | |
153 $AdminChangePassword => 'adminchangepasswordform', | |
154 $FrontPage => 'FrontPage', | |
155 ); | |
156 my %command_do = ( | |
157 read => \&do_read, | |
158 edit => \&do_edit, | |
159 adminedit => \&do_adminedit, | |
160 adminchangepasswordform => \&do_adminchangepasswordform, | |
161 adminchangepassword => \&do_adminchangepassword, | |
162 write => \&do_write, | |
163 index => \&do_index, | |
164 searchform => \&do_searchform, | |
165 search => \&do_search, | |
166 create => \&do_create, | |
167 createresult => \&do_createresult, | |
168 FrontPage => \&do_FrontPage, | |
169 comment => \&do_comment, | |
170 rss => \&do_rss, | |
171 diff => \&do_diff, | |
172 ); | |
173 ############################## | |
174 # &test_convert; | |
175 &main; | |
176 exit(0); | |
177 ############################## | |
178 | |
179 sub main { | |
180 &init_resource; | |
181 # &check_modifiers; | |
182 &open_db; | |
183 &init_form; | |
184 &init_InterWikiName; | |
185 &init_plugin; | |
186 if ($command_do{$form{mycmd}}) { | |
187 &{$command_do{$form{mycmd}}}; | |
188 } else { | |
189 &do_FrontPage; | |
190 } | |
191 &close_db; | |
192 } | |
193 | |
194 sub do_read { | |
195 &print_header($form{mypage}); | |
196 &print_content($database{$form{mypage}}); | |
197 &print_footer($form{mypage}); | |
198 } | |
199 | |
200 sub do_edit { | |
201 my ($page) = &unarmor_name(&armor_name($form{mypage})); | |
202 &print_header($page); | |
203 if (not &is_editable($page)) { | |
204 &print_message($resource{cantchange}); | |
205 } elsif (&is_frozen($page)) { | |
206 &print_message($resource{cantchange}); | |
207 } else { | |
208 &print_editform($database{$page}, &get_info($page, $info_ConflictChecker), admin=>0); | |
209 } | |
210 &print_footer($page); | |
211 } | |
212 | |
213 sub do_adminedit { | |
214 my ($page) = &unarmor_name(&armor_name($form{mypage})); | |
215 &print_header($page); | |
216 if (not &is_editable($page)) { | |
217 &print_message($resource{cantchange}); | |
218 } else { | |
219 &print_message($resource{passwordneeded}); | |
220 &print_editform($database{$page}, &get_info($page, $info_ConflictChecker), admin=>1); | |
221 } | |
222 &print_footer($page); | |
223 } | |
224 | |
225 sub do_adminchangepasswordform { | |
226 &print_header($AdminChangePassword); | |
227 &print_passwordform; | |
228 &print_footer($AdminChangePassword); | |
229 } | |
230 | |
231 sub do_adminchangepassword { | |
232 if ($form{mynewpassword} ne $form{mynewpassword2}) { | |
233 &print_error($resource{passwordmismatcherror}); | |
234 } | |
235 my ($validpassword_crypt) = &get_info($AdminSpecialPage, $info_AdminPassword); | |
236 if ($validpassword_crypt) { | |
237 if (not &valid_password($form{myoldpassword})) { | |
238 &send_mail_to_admin(<<"EOD", "AdminChangePassword"); | |
239 myoldpassword=$form{myoldpassword} | |
240 mynewpassword=$form{mynewpassword} | |
241 mynewpassword2=$form{mynewpassword2} | |
242 EOD | |
243 &print_error($resource{passworderror}); | |
244 } | |
245 } | |
246 my ($sec, $min, $hour, $day, $mon, $year, $weekday) = localtime(time); | |
247 my (@token) = ('0'..'9', 'A'..'Z', 'a'..'z'); | |
248 my $salt1 = $token[(time | $$) % scalar(@token)]; | |
249 my $salt2 = $token[($sec + $min*60 + $hour*60*60) % scalar(@token)]; | |
250 my $crypted = crypt($form{mynewpassword}, "$salt1$salt2"); | |
251 &set_info($AdminSpecialPage, $info_AdminPassword, $crypted); | |
252 | |
253 &print_header($CompletedSuccessfully); | |
254 &print_message($resource{passwordchanged}); | |
255 &print_footer($CompletedSuccessfully); | |
256 } | |
257 | |
258 sub do_index { | |
259 &print_header($IndexPage); | |
260 print qq(<ul>); | |
261 foreach my $page (sort keys %database) { | |
262 if (&is_editable($page)) { | |
263 print qq(<li><a href="$url_cgi?@{[&encode($page)]}">@{[&escape($page)]}</a>@{[&escape(&get_subjectline($page))]}</li>); | |
264 # print qq(<li>@{[&get_info($page, $info_IsFrozen)]}</li>); | |
265 # print qq(<li>@{[0 + &is_frozen($page)]}</li>); | |
266 } | |
267 } | |
268 print qq(</ul>); | |
269 &print_footer($IndexPage); | |
270 } | |
271 | |
272 sub do_write { | |
273 if (&keyword_reject()) { | |
274 return; | |
275 } | |
276 | |
277 if (&frozen_reject()) { | |
278 return; | |
279 } | |
280 | |
281 if (&length_reject()) { | |
282 return; | |
283 } | |
284 | |
285 if (not &is_editable($form{mypage})) { | |
286 &print_header($form{mypage}); | |
287 &print_message($resource{cantchange}); | |
288 &print_footer($form{mypage}); | |
289 return; | |
290 } | |
291 | |
292 if (&conflict($form{mypage}, $form{mymsg})) { | |
293 return; | |
294 } | |
295 | |
296 # Making diff | |
297 if (1) { | |
298 &open_diff; | |
299 my @msg1 = split(/\r?\n/, $database{$form{mypage}}); | |
300 my @msg2 = split(/\r?\n/, $form{mymsg}); | |
301 $diffbase{$form{mypage}} = &difftext(\@msg1, \@msg2); | |
302 &close_diff; | |
303 } | |
304 | |
305 if ($form{mymsg}) { | |
306 $database{$form{mypage}} = $form{mymsg}; | |
307 &send_mail_to_admin($form{mypage}, "Modify"); | |
308 &set_info($form{mypage}, $info_ConflictChecker, '' . localtime); | |
309 if ($form{mytouch}) { | |
310 &set_info($form{mypage}, $info_LastModified, '' . localtime); | |
311 &update_recent_changes; | |
312 } | |
313 &set_info($form{mypage}, $info_IsFrozen, 0 + $form{myfrozen}); | |
314 &print_header($CompletedSuccessfully); | |
315 &print_message($resource{saved}); | |
316 &print_content("$resource{continuereading} @{[&armor_name($form{mypage})]}"); | |
317 &print_footer($CompletedSuccessfully); | |
318 } else { | |
319 &send_mail_to_admin($form{mypage}, "Delete"); | |
320 delete $database{$form{mypage}}; | |
321 delete $infobase{$form{mypage}}; | |
322 if ($form{mytouch}) { | |
323 &update_recent_changes; | |
324 } | |
325 &print_header($form{mypage}); | |
326 &print_message($resource{deleted}); | |
327 &print_footer($form{mypage}); | |
328 } | |
329 } | |
330 | |
331 sub do_searchform { | |
332 &print_header($SearchPage); | |
333 &print_searchform(""); | |
334 &print_footer($SearchPage); | |
335 } | |
336 | |
337 sub do_search { | |
338 my $word = &escape($form{mymsg}); | |
339 &print_header($SearchPage); | |
340 &print_searchform($word); | |
341 my $counter = 0; | |
342 foreach my $page (sort keys %database) { | |
343 next if $page =~ /^$RecentChanges$/; | |
344 if ($database{$page} =~ /\Q$form{mymsg}\E/ or $page =~ /\Q$form{mymsg}\E/) { | |
345 if ($counter == 0) { | |
346 print qq|<ul>|; | |
347 } | |
348 print qq(<li><a href ="$url_cgi?@{[&encode($page)]}">@{[&escape($page)]}</a>@{[&escape(&get_subjectline($page))]}</li>); | |
349 $counter++; | |
350 } | |
351 } | |
352 if ($counter == 0) { | |
353 &print_message($resource{notfound}); | |
354 } else { | |
355 print qq|</ul>|; | |
356 } | |
357 &print_footer($SearchPage); | |
358 } | |
359 | |
360 sub do_create { | |
361 &print_header($CreatePage); | |
362 print <<"EOD"; | |
363 <form action="$url_cgi" method="post"> | |
364 <input type="hidden" name="mycmd" value="edit"> | |
365 <strong>$resource{newpagename}</strong><br> | |
366 <input type="text" name="mypage" value="" size="20"> | |
367 <input type="submit" value="$resource{createbutton}"><br> | |
368 </form> | |
369 EOD | |
370 &print_footer($CreatePage); | |
371 } | |
372 | |
373 sub do_FrontPage { | |
374 if ($fixedpage{$FrontPage}) { | |
375 open(FILE, $file_FrontPage) or &print_error("($file_FrontPage)"); | |
376 my $content = join('', <FILE>); | |
377 &code_convert(\$content, $kanjicode); | |
378 close(FILE); | |
379 &print_header($FrontPage); | |
380 &print_content($content); | |
381 &print_footer($FrontPage); | |
382 } else { | |
383 $form{mycmd} = 'read'; | |
384 $form{mypage} = $FrontPage; | |
385 &do_read; | |
386 } | |
387 } | |
388 | |
389 sub print_error { | |
390 my ($msg) = @_; | |
391 &print_header($ErrorPage); | |
392 print qq(<p><strong class="error">$msg</strong></p>); | |
393 &print_plugin_log; | |
394 &print_footer($ErrorPage); | |
395 exit(0); | |
396 } | |
397 | |
398 sub print_header { | |
399 my ($page) = @_; | |
400 my $bodyclass = "normal"; | |
401 my $editable = 0; | |
402 my $admineditable = 0; | |
403 if (&is_frozen($page) and $form{mycmd} =~ /^(read|write)$/) { | |
404 $editable = 0; | |
405 $admineditable = 1; | |
406 $bodyclass = "frozen"; | |
407 } elsif (&is_editable($page) and $form{mycmd} =~ /^(read|write)$/) { | |
408 $admineditable = 1; | |
409 $editable = 1; | |
410 } else { | |
411 $editable = 0; | |
412 } | |
413 my $cookedpage = &encode($page); | |
414 my $escapedpage = &escape($page); | |
415 print <<"EOD"; | |
416 Content-type: text/html; charset=$charset | |
417 | |
418 <!DOCTYPE html | |
419 PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" | |
420 "http://www.w3.org/TR/html4/loose.dtd"> | |
421 <html lang="$lang"> | |
422 <head> | |
423 <meta http-equiv="Content-Language" content="$lang"> | |
424 <meta http-equiv="Content-Type" content="text/html; charset=$charset"> | |
425 <title>$escapedpage @{[&escape(&get_subjectline($page))]}</title> | |
426 <link rel="index" href="$url_cgi?$IndexPage"> | |
427 <link rev="made" href="mailto:$modifier_mail"> | |
428 <link rel="stylesheet" type="text/css" href="$url_stylesheet"> | |
429 <link rel="alternate" type="application/rss+xml" title="RSS" href="$modifier_rss_about" /> | |
430 </head> | |
431 <body class="$bodyclass"> | |
432 <div class="tools"> | |
433 @{[ $admineditable | |
434 ? qq(<a title="$resource{admineditthispage}" href="$url_cgi?mycmd=adminedit&mypage=$cookedpage">$resource{admineditbutton}</a> | ) | |
435 : qq() | |
436 ]} | |
437 @{[ $editable | |
438 ? qq(<a title="$resource{editthispage}" href="$url_cgi?mycmd=edit&mypage=$cookedpage">$resource{editbutton}</a> | ) | |
439 : qq() | |
440 ]} | |
441 @{[ $admineditable | |
442 ? qq(<a href="$url_cgi?mycmd=diff&mypage=$cookedpage">$resource{diffbutton}</a> | ) | |
443 : qq() | |
444 ]} | |
445 <a href="$url_cgi?$CreatePage">$resource{createbutton}</a> | | |
446 <a href="$url_cgi?$IndexPage">$resource{indexbutton}</a> | | |
447 <a href="$modifier_rss_about">$resource{rssbutton}</a> | | |
448 <a href="$url_cgi?$FrontPage">$FrontPage</a> | | |
449 <a href="$url_cgi?$SearchPage">$resource{searchbutton}</a> | | |
450 <a href="$url_cgi?$RecentChanges">$resource{recentchangesbutton}</a> | |
451 </div> | |
452 <h1 class="header"><a | |
453 title="$resource{searchthispage}" | |
454 href="$url_cgi?mycmd=search&mymsg=$cookedpage">@{[&escape($page)]}</a>@{[&escape(&get_subjectline($page))]}</h1> | |
455 EOD | |
456 } | |
457 | |
458 sub print_footer { | |
459 my ($page) = @_; | |
460 print <<"EOD"; | |
461 <hr> | |
462 <address class="footer"> | |
463 Powered by <a href="http://www.hyuki.com/yukiwiki/">YukiWiki</a> $version <br /> | |
464 Modified by <a href="$modifier_url">$modifier_name</a>. | |
465 </address> | |
466 <p class="footer"> | |
467 <a href="http://www.hyuki.com/yukiwiki/">$icontag</a> | |
468 </p> | |
469 </body> | |
470 </html> | |
471 EOD | |
472 } | |
473 | |
474 sub escape { | |
475 my $s = shift; | |
476 $s =~ s|\r\n|\n|g; | |
477 $s =~ s|\&|&|g; | |
478 $s =~ s|<|<|g; | |
479 $s =~ s|>|>|g; | |
480 $s =~ s|"|"|g; | |
481 return $s; | |
482 } | |
483 | |
484 sub unescape { | |
485 my $s = shift; | |
486 # $s =~ s|\n|\r\n|g; | |
487 $s =~ s|\&|\&|g; | |
488 $s =~ s|\<|\<|g; | |
489 $s =~ s|\>|\>|g; | |
490 $s =~ s|\"|\"|g; | |
491 return $s; | |
492 } | |
493 | |
494 sub print_content { | |
495 my ($rawcontent) = @_; | |
496 print &text_to_html($rawcontent, toc=>1); | |
497 } | |
498 | |
499 sub text_to_html { | |
500 my ($txt, %option) = @_; | |
501 my (@txt) = split(/\r?\n/, $txt); | |
502 my (@toc); | |
503 my $verbatim; | |
504 my $tocnum = 0; | |
505 my (@saved, @result); | |
506 unshift(@saved, "</p>"); | |
507 push(@result, "<p>"); | |
508 foreach (@txt) { | |
509 chomp; | |
510 | |
511 # verbatim. | |
512 if ($verbatim->{func}) { | |
513 if (/^\Q$verbatim->{done}\E$/) { | |
514 undef $verbatim; | |
515 push(@result, splice(@saved)); | |
516 } else { | |
517 push(@result, $verbatim->{func}->($_)); | |
518 } | |
519 next; | |
520 } | |
521 | |
522 # non-verbatim follows. | |
523 push(@result, shift(@saved)) if (@saved and $saved[0] eq '</pre>' and /^[^ \t]/); | |
524 if (/^(\*{1,3})(.+)/) { | |
525 # $hn = 'h2', 'h3' or 'h4' | |
526 my $hn = "h" . (length($1) + 1); | |
527 push(@toc, '-' x length($1) . qq( <a href="#i$tocnum">) . &remove_tag(&inline($2)) . qq(</a>\n)); | |
528 push(@result, splice(@saved), qq(<$hn><a name="i$tocnum"> </a>) . &inline($2) . qq(</$hn>)); | |
529 $tocnum++; | |
530 } elsif (/^(-{2,3})\($/) { | |
531 if ($& eq '--(') { | |
532 $verbatim = { func => \&inline, done => '--)', class => 'verbatim-soft' }; | |
533 } else { | |
534 $verbatim = { func => \&escape, done => '---)', class => 'verbatim-hard' }; | |
535 } | |
536 &back_push('pre', 1, \@saved, \@result, " class='$verbatim->{class}'"); | |
537 } elsif (/^----/) { | |
538 push(@result, splice(@saved), '<hr>'); | |
539 } elsif (/^(-{1,3})(.+)/) { | |
540 &back_push('ul', length($1), \@saved, \@result); | |
541 push(@result, '<li>' . &inline($2) . '</li>'); | |
542 } elsif (/^:([^:]+):(.+)/) { | |
543 &back_push('dl', 1, \@saved, \@result); | |
544 push(@result, '<dt>' . &inline($1) . '</dt>', '<dd>' . &inline($2) . '</dd>'); | |
545 } elsif (/^(>{1,3})(.+)/) { | |
546 &back_push('blockquote', length($1), \@saved, \@result); | |
547 push(@result, &inline($2)); | |
548 } elsif (/^$/) { | |
549 push(@result, splice(@saved)); | |
550 unshift(@saved, "</p>"); | |
551 push(@result, "<p>"); | |
552 } elsif (/^(\s+.*)$/) { | |
553 &back_push('pre', 1, \@saved, \@result); | |
554 push(@result, &escape($1)); # Not &inline, but &escape | |
555 } elsif (/^\,(.*?)[\x0D\x0A]*$/) { | |
556 &back_push('table', 1, \@saved, \@result, ' border="1"'); | |
557 ####### | |
558 # This part is taken from Mr. Ohzaki's Perl Memo and Makio Tsukamoto's WalWiki. | |
559 # XXXXX | |
560 my $tmp = "$1,"; | |
561 my @value = map {/^"(.*)"$/ ? scalar($_ = $1, s/""/"/g, $_) : $_} ($tmp =~ /("[^"]*(?:""[^"]*)*"|[^,]*),/g); | |
562 my @align = map {(s/^\s+//) ? ((s/\s+$//) ? ' align="center"' : ' align="right"') : ''} @value; | |
563 my @colspan = map {($_ eq '==') ? 0 : 1} @value; | |
564 for (my $i = 0; $i < @value; $i++) { | |
565 if ($colspan[$i]) { | |
566 while ($i + $colspan[$i] < @value and $value[$i + $colspan[$i]] eq '==') { | |
567 $colspan[$i]++; | |
568 } | |
569 $colspan[$i] = ($colspan[$i] > 1) ? sprintf(' colspan="%d"', $colspan[$i]) : ''; | |
570 $value[$i] = sprintf('<td%s%s>%s</td>', $align[$i], $colspan[$i], &inline($value[$i])); | |
571 } else { | |
572 $value[$i] = ''; | |
573 } | |
574 } | |
575 push(@result, join('', '<tr>', @value, '</tr>')); | |
576 # XXXXX | |
577 ####### | |
578 } elsif (/^\#(\w+)(\((.*)\))?/) { | |
579 # BlockPlugin. | |
580 my $original_line = $_; | |
581 my $plugin_name = $1; | |
582 my $argument = &escape($3); | |
583 my $result = $plugin_manager->call($plugin_name, 'block', $argument); | |
584 if (defined($result)) { | |
585 push(@result, splice(@saved)); | |
586 } else { | |
587 $result = $original_line; | |
588 } | |
589 push(@result, $result); | |
590 } else { | |
591 push(@result, &inline($_)); | |
592 } | |
593 } | |
594 push(@result, splice(@saved)); | |
595 | |
596 if ($option{toc}) { | |
597 # Convert @toc (table of contents) to HTML. | |
598 # This part is taken from Makio Tsukamoto's WalWiki. | |
599 my (@tocsaved, @tocresult); | |
600 foreach (@toc) { | |
601 if (/^(-{1,3})(.*)/) { | |
602 &back_push('ul', length($1), \@tocsaved, \@tocresult); | |
603 push(@tocresult, '<li>' . $2 . '</li>'); | |
604 } | |
605 } | |
606 push(@tocresult, splice(@tocsaved)); | |
607 | |
608 # Insert "table of contents". | |
609 if (@tocresult) { | |
610 unshift(@tocresult, qq(<h2>$resource{table_of_contents}</h2>)); | |
611 } | |
612 | |
613 return join("\n", @tocresult, @result); | |
614 } else { | |
615 return join("\n", @result); | |
616 } | |
617 } | |
618 | |
619 sub back_push { | |
620 my ($tag, $level, $savedref, $resultref, $attr) = @_; | |
621 while (@$savedref > $level) { | |
622 push(@$resultref, shift(@$savedref)); | |
623 } | |
624 if ($savedref->[0] ne "</$tag>") { | |
625 push(@$resultref, splice(@$savedref)); | |
626 } | |
627 while (@$savedref < $level) { | |
628 unshift(@$savedref, "</$tag>"); | |
629 push(@$resultref, "<$tag$attr>"); | |
630 } | |
631 } | |
632 | |
633 sub remove_tag { | |
634 my ($line) = @_; | |
635 $line =~ s|\<\/?[A-Za-z][^>]*?\>||g; | |
636 return $line; | |
637 } | |
638 | |
639 sub inline { | |
640 my ($line) = @_; | |
641 $line = &escape($line); | |
642 $line =~ s|'''([^']+?)'''|<i>$1</i>|g; # Italic | |
643 $line =~ s|''([^']+?)''|<b>$1</b>|g; # Bold | |
644 $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 | |
645 $line =~ s! | |
646 ( | |
647 ((mailto|http|https|ftp):([^\x00-\x20()<>\x7F-\xFF])*) # Direct http://... | |
648 | | |
649 ($bracket_name) # [[likethis]], [[#comment]], [[Friend:remotelink]] | |
650 | | |
651 ($interwiki_definition) # [[Friend http://somewhere/?q=sjis($1)]] | |
652 | | |
653 ($wiki_name) # LocalLinkLikeThis | |
654 | | |
655 ($inline_plugin) # &user_defined_plugin(123,hello) | |
656 ) | |
657 ! | |
658 &make_link($1) | |
659 !gex; | |
660 return $line; | |
661 } | |
662 | |
663 sub make_link { | |
664 my $chunk = shift; | |
665 if ($chunk =~ /^(http|https|ftp):/) { | |
666 if ($use_autoimg and $chunk =~ /\.(gif|png|jpeg|jpg)$/) { | |
667 return qq(<a href="$chunk"><img src="$chunk"></a>); | |
668 } else { | |
669 return qq(<a href="$chunk">$chunk</a>); | |
670 } | |
671 } elsif ($chunk =~ /^(mailto):(.*)/) { | |
672 return qq(<a href="$chunk">$2</a>); | |
673 } elsif ($chunk =~ /^$interwiki_definition$/) { | |
674 return qq(<span class="InterWiki">$chunk</span>); | |
675 } elsif ($chunk =~ /^$embedded_name$/) { | |
676 return &embedded_to_html($chunk); | |
677 } elsif ($chunk =~ /^$inline_plugin$/) { | |
678 # InlinePlugin. | |
679 my $plugin_name = $1; | |
680 my $argument = $2; | |
681 my $result = $plugin_manager->call($plugin_name, 'inline', $argument); | |
682 if (defined($result)) { | |
683 return $result; | |
684 } else { | |
685 return $chunk; | |
686 } | |
687 } else { | |
688 $chunk = &unarmor_name($chunk); | |
689 $chunk = &unescape($chunk); # To treat '&' or '>' or '<' correctly. | |
690 my $cookedchunk = &encode($chunk); | |
691 my $escapedchunk = &escape($chunk); | |
692 if ($chunk =~ /^$interwiki_name$/) { | |
693 my ($intername, $localname) = ($1, $2); | |
694 my $remoteurl = $interwiki{$intername}; | |
695 if ($remoteurl =~ /^(http|https|ftp):\/\//) { # Check if scheme if valid. | |
696 $remoteurl =~ s/\b(euc|sjis|ykwk|asis)\(\$1\)/&interwiki_convert($1, $localname)/e; | |
697 return qq(<a href="$remoteurl">$escapedchunk</a>); | |
698 } else { | |
699 return $escapedchunk; | |
700 } | |
701 } elsif ($database{$chunk}) { | |
702 my $subject = &escape(&get_subjectline($chunk, delimiter => '')); | |
703 return qq(<a title="$subject" href="$url_cgi?$cookedchunk">$escapedchunk</a>); | |
704 } elsif ($page_command{$chunk}) { | |
705 return qq(<a title="$escapedchunk" href="$url_cgi?$cookedchunk">$escapedchunk</a>); | |
706 } else { | |
707 return qq($escapedchunk<a title="$resource{editthispage}" class="editlink" href="$url_cgi?mycmd=edit&mypage=$cookedchunk">$editchar</a>); | |
708 } | |
709 } | |
710 } | |
711 | |
712 sub print_message { | |
713 my ($msg) = @_; | |
714 print qq(<p><strong>$msg</strong></p>); | |
715 } | |
716 | |
717 sub init_form { | |
718 if (param()) { | |
719 foreach my $var (param()) { | |
720 $form{$var} = param($var); | |
721 } | |
722 } else { | |
723 $ENV{QUERY_STRING} = $FrontPage; | |
724 } | |
725 | |
726 my $query = &decode($ENV{QUERY_STRING}); | |
727 if ($page_command{$query}) { | |
728 $form{mycmd} = $page_command{$query}; | |
729 $form{mypage} = $query; | |
730 } elsif ($query =~ /^($wiki_name)$/) { | |
731 $form{mycmd} = 'read'; | |
732 $form{mypage} = $1; | |
733 } elsif ($database{$query}) { | |
734 $form{mycmd} = 'read'; | |
735 $form{mypage} = $query; | |
736 } | |
737 | |
738 # mypreview_edit -> do_edit, with preview. | |
739 # mypreview_adminedit -> do_adminedit, with preview. | |
740 # mypreview_write -> do_write, without preview. | |
741 foreach (keys %form) { | |
742 if (/^mypreview_(.*)$/) { | |
743 $form{mycmd} = $1; | |
744 $form{mypreview} = 1; | |
745 } | |
746 } | |
747 | |
748 # | |
749 # $form{mycmd} is frozen here. | |
750 # | |
751 | |
752 $form{mymsg} = &code_convert(\$form{mymsg}, $kanjicode); | |
753 $form{myname} = &code_convert(\$form{myname}, $kanjicode); | |
754 } | |
755 | |
756 sub update_recent_changes { | |
757 my $update = "- @{[&get_now]} @{[&armor_name($form{mypage})]} @{[&get_subjectline($form{mypage})]}"; | |
758 my @oldupdates = split(/\r?\n/, $database{$RecentChanges}); | |
759 my @updates; | |
760 foreach (@oldupdates) { | |
761 /^\- \d\d\d\d\-\d\d\-\d\d \(...\) \d\d:\d\d:\d\d (\S+)/; # date format. | |
762 my $name = &unarmor_name($1); | |
763 if (&is_exist_page($name) and ($name ne $form{mypage})) { | |
764 push(@updates, $_); | |
765 } | |
766 } | |
767 if (&is_exist_page($form{mypage})) { | |
768 unshift(@updates, $update); | |
769 } | |
770 splice(@updates, $maxrecent + 1); | |
771 $database{$RecentChanges} = join("\n", @updates); | |
772 if ($file_touch) { | |
773 open(FILE, "> $file_touch"); | |
774 print FILE localtime() . "\n"; | |
775 close(FILE); | |
776 } | |
777 if ($file_rss) { | |
778 &update_rssfile; | |
779 } | |
780 } | |
781 | |
782 sub get_subjectline { | |
783 my ($page, %option) = @_; | |
784 if (not &is_editable($page)) { | |
785 return ""; | |
786 } else { | |
787 # Delimiter check. | |
788 my $delim = $subject_delimiter; | |
789 if (defined($option{delimiter})) { | |
790 $delim = $option{delimiter}; | |
791 } | |
792 | |
793 # Get the subject of the page. | |
794 my $subject = $database{$page}; | |
795 $subject =~ s/\r?\n.*//s; | |
796 return "$delim$subject"; | |
797 } | |
798 } | |
799 | |
800 sub send_mail_to_admin { | |
801 my ($page, $mode) = @_; | |
802 return unless $modifier_sendmail; | |
803 my $message = <<"EOD"; | |
804 To: $modifier_mail | |
805 From: $modifier_mail | |
806 Subject: [Wiki/$mode] | |
807 MIME-Version: 1.0 | |
808 Content-Type: text/plain; charset=ISO-2022-JP | |
809 Content-Transfer-Encoding: 7bit | |
810 | |
811 -------- | |
812 MODE = $mode | |
813 REMOTE_ADDR = $ENV{REMOTE_ADDR} | |
814 REMOTE_HOST = $ENV{REMOTE_HOST} | |
815 -------- | |
816 $page | |
817 -------- | |
818 $database{$page} | |
819 -------- | |
820 EOD | |
821 &code_convert(\$message, 'jis'); | |
822 open(MAIL, "| $modifier_sendmail"); | |
823 print MAIL $message; | |
824 close(MAIL); | |
825 } | |
826 | |
827 sub open_db { | |
828 if ($modifier_dbtype eq 'dbmopen') { | |
829 dbmopen(%database, $dataname, 0666) or &print_error("(dbmopen) $dataname"); | |
830 dbmopen(%infobase, $infoname, 0666) or &print_error("(dbmopen) $infoname"); | |
831 } elsif ($modifier_dbtype eq 'AnyDBM_File') { | |
832 tie(%database, "AnyDBM_File", $dataname, O_RDWR|O_CREAT, 0666) or &print_error("(tie AnyDBM_File) $dataname"); | |
833 tie(%infobase, "AnyDBM_File", $infoname, O_RDWR|O_CREAT, 0666) or &print_error("(tie AnyDBM_File) $infoname"); | |
834 } elsif ($modifier_dbtype eq 'Cassandra::CassHash') { | |
835 #use cassandra | |
836 tie(%database, "Cassandra::CassHash","localhost",9161,"Keyspace1","Standard1","yukiwiki3") or &print_error("(tie Cassandra::CassHash) $dataname"); | |
837 tie(%infobase, "Cassandra::CassHash","localhost",9161,"Keyspace1","Standard1","yukiwiki5") or &print_error("(tie Cassandra::CassHash) $infoname"); | |
838 } else { | |
839 tie(%database, "Yuki::YukiWikiDB", $dataname) or &print_error("(tie Yuki::YukiWikiDB) $dataname"); | |
840 tie(%infobase, "Yuki::YukiWikiDB", $infoname) or &print_error("(tie Yuki::YukiWikiDB) $infoname"); | |
841 } | |
842 } | |
843 | |
844 sub close_db { | |
845 if ($modifier_dbtype eq 'dbmopen') { | |
846 dbmclose(%database); | |
847 dbmclose(%infobase); | |
848 } elsif ($modifier_dbtype eq 'AnyDBM_File') { | |
849 untie(%database); | |
850 untie(%infobase); | |
851 } else { | |
852 untie(%database); | |
853 untie(%infobase); | |
854 } | |
855 } | |
856 | |
857 sub open_diff { | |
858 if ($modifier_dbtype eq 'dbmopen') { | |
859 dbmopen(%diffbase, $diffname, 0666) or &print_error("(dbmopen) $diffname"); | |
860 } elsif ($modifier_dbtype eq 'AnyDBM_File') { | |
861 tie(%diffbase, "AnyDBM_File", $diffname) or &print_error("(tie AnyDBM_File) $diffname"); | |
862 } elsif ($modifier_dbtype eq 'Cassandra::CassHash') { | |
863 #use cassandra | |
864 tie(%diffbase, "Cassandra::CassHash","localhost",9161,"Keyspace1","Standard1","yukiwiki4") or &print_error("(tie Cassandra::CassHash) $diffname"); | |
865 } else { | |
866 tie(%diffbase, "Yuki::YukiWikiDB", $diffname) or &print_error("(tie Yuki::YukiWikiDB) $diffname"); | |
867 } | |
868 } | |
869 | |
870 sub close_diff { | |
871 if ($modifier_dbtype eq 'dbmopen') { | |
872 dbmclose(%diffbase); | |
873 } elsif ($modifier_dbtype eq 'AnyDBM_File') { | |
874 untie(%diffbase); | |
875 } else { | |
876 untie(%diffbase); | |
877 } | |
878 } | |
879 | |
880 sub print_searchform { | |
881 my ($word) = @_; | |
882 print <<"EOD"; | |
883 <form action="$url_cgi" method="get"> | |
884 <input type="hidden" name="mycmd" value="search"> | |
885 <input type="text" name="mymsg" value="$word" size="20"> | |
886 <input type="submit" value="$resource{searchbutton}"> | |
887 </form> | |
888 EOD | |
889 } | |
890 | |
891 sub print_editform { | |
892 my ($mymsg, $conflictchecker, %mode) = @_; | |
893 my $frozen = &is_frozen($form{mypage}); | |
894 | |
895 if ($form{mypreview}) { | |
896 if ($form{mymsg}) { | |
897 unless ($mode{conflict}) { | |
898 print qq(<h3>$resource{previewtitle}</h3>\n); | |
899 print qq($resource{previewnotice}\n); | |
900 print qq(<div class="preview">\n); | |
901 &print_content($form{mymsg}); | |
902 print qq(</div>\n); | |
903 } | |
904 } else { | |
905 print qq($resource{previewempty}); | |
906 } | |
907 $mymsg = &escape($form{mymsg}); | |
908 } else { | |
909 $mymsg = &escape($mymsg); | |
910 } | |
911 | |
912 my $edit = $mode{admin} ? 'adminedit' : 'edit'; | |
913 my $escapedmypage = &escape($form{mypage}); | |
914 my $escapedmypassword = &escape($form{mypassword}); | |
915 | |
916 print <<"EOD"; | |
917 <form action="$url_cgi" method="post"> | |
918 @{[ $mode{admin} ? qq($resource{frozenpassword} <input type="password" name="mypassword" value="$escapedmypassword" size="10"><br>) : "" ]} | |
919 <input type="hidden" name="myConflictChecker" value="$conflictchecker"> | |
920 <input type="hidden" name="mypage" value="$escapedmypage"> | |
921 <textarea cols="$cols" rows="$rows" name="mymsg"> | |
922 $mymsg</textarea><br> | |
923 @{[ | |
924 $mode{admin} ? | |
925 qq( | |
926 <input type="radio" name="myfrozen" value="1" @{[$frozen ? qq(checked="checked") : ""]}>$resource{frozenbutton} | |
927 <input type="radio" name="myfrozen" value="0" @{[$frozen ? "" : qq(checked="checked")]}>$resource{notfrozenbutton}<br>) | |
928 : "" | |
929 ]} | |
930 @{[ | |
931 $mode{conflict} ? "" : | |
932 qq( | |
933 <input type="checkbox" name="mytouch" value="on" checked="checked">$resource{touch}<br> | |
934 <input type="submit" name="mypreview_$edit" value="$resource{previewbutton}"> | |
935 <input type="submit" name="mypreview_write" value="$resource{savebutton}"><br> | |
936 ) | |
937 ]} | |
938 </form> | |
939 EOD | |
940 unless ($mode{conflict}) { | |
941 # Show the format rule. | |
942 open(FILE, $file_format) or &print_error("($file_format)"); | |
943 my $content = join('', <FILE>); | |
944 &code_convert(\$content, $kanjicode); | |
945 close(FILE); | |
946 print &text_to_html($content, toc=>0); | |
947 } | |
948 | |
949 unless ($mode{conflict}) { | |
950 # Show plugin information. | |
951 my $plugin_usage = <<"EOD"; | |
952 *$resource{available_plugins} | |
953 EOD | |
954 foreach my $usage (@{$plugin_manager->usage}) { | |
955 $plugin_usage .= <<"EOD"; | |
956 ** $usage->{name} | |
957 ---( | |
958 $resource{plugin_usage_name}: $usage->{name} | |
959 $resource{plugin_usage_version}: $usage->{version} | |
960 $resource{plugin_usage_author}: $usage->{author} | |
961 $resource{plugin_usage_syntax}: $usage->{syntax} | |
962 $resource{plugin_usage_description}: $usage->{description} | |
963 $resource{plugin_usage_example}: $usage->{example} | |
964 ---) | |
965 EOD | |
966 } | |
967 &code_convert(\$plugin_usage, $kanjicode); | |
968 print &text_to_html($plugin_usage, toc=>0); | |
969 } | |
970 } | |
971 | |
972 sub print_passwordform { | |
973 print <<"EOD"; | |
974 <form action="$url_cgi" method="post"> | |
975 <input type="hidden" name="mycmd" value="adminchangepassword"> | |
976 $resource{oldpassword} <input type="password" name="myoldpassword" size="10"><br> | |
977 $resource{newpassword} <input type="password" name="mynewpassword" size="10"><br> | |
978 $resource{newpassword2} <input type="password" name="mynewpassword2" size="10"><br> | |
979 <input type="submit" value="$resource{changepasswordbutton}"><br> | |
980 </form> | |
981 EOD | |
982 } | |
983 | |
984 sub is_editable { | |
985 my ($page) = @_; | |
986 if (&is_bracket_name($page)) { | |
987 return 0; | |
988 } elsif ($fixedpage{$page}) { | |
989 return 0; | |
990 } elsif ($page =~ /\s/) { | |
991 return 0; | |
992 } elsif ($page =~ /^\#/) { | |
993 return 0; | |
994 } elsif ($page =~ /^$interwiki_name$/) { | |
995 return 0; | |
996 } elsif (not $page) { | |
997 return 0; | |
998 } else { | |
999 return 1; | |
1000 } | |
1001 } | |
1002 | |
1003 # armor_name: | |
1004 # WikiName -> WikiName | |
1005 # not_wiki_name -> [[not_wiki_name]] | |
1006 sub armor_name { | |
1007 my ($name) = @_; | |
1008 if ($name =~ /^$wiki_name$/) { | |
1009 return $name; | |
1010 } else { | |
1011 return "[[$name]]"; | |
1012 } | |
1013 } | |
1014 | |
1015 # unarmor_name: | |
1016 # [[bracket_name]] -> bracket_name | |
1017 # WikiName -> WikiName | |
1018 sub unarmor_name { | |
1019 my ($name) = @_; | |
1020 if ($name =~ /^$bracket_name$/) { | |
1021 return $1; | |
1022 } else { | |
1023 return $name; | |
1024 } | |
1025 } | |
1026 | |
1027 sub is_bracket_name { | |
1028 my ($name) = @_; | |
1029 if ($name =~ /^$bracket_name$/) { | |
1030 return 1; | |
1031 } else { | |
1032 return 0; | |
1033 } | |
1034 } | |
1035 | |
1036 sub decode { | |
1037 my ($s) = @_; | |
1038 $s =~ tr/+/ /; | |
1039 $s =~ s/%([A-Fa-f0-9][A-Fa-f0-9])/pack("C", hex($1))/eg; | |
1040 return $s; | |
1041 } | |
1042 | |
1043 # Thanks to WalWiki for [better encode]. | |
1044 sub encode { | |
1045 my ($encoded) = @_; | |
1046 $encoded =~ s/(\W)/'%' . unpack('H2', $1)/eg; | |
1047 return $encoded; | |
1048 } | |
1049 | |
1050 sub init_resource { | |
1051 open(FILE, $file_resource) or &print_error("(resource)"); | |
1052 while (<FILE>) { | |
1053 chomp; | |
1054 next if /^#/; | |
1055 my ($key, $value) = split(/=/, $_, 2); | |
1056 $resource{$key} = &code_convert(\$value, $kanjicode); | |
1057 } | |
1058 close(FILE); | |
1059 } | |
1060 | |
1061 sub conflict { | |
1062 my ($page, $rawmsg) = @_; | |
1063 if ($form{myConflictChecker} eq &get_info($page, $info_ConflictChecker)) { | |
1064 return 0; | |
1065 } | |
1066 open(FILE, $file_conflict) or &print_error("(conflict)"); | |
1067 my $content = join('', <FILE>); | |
1068 &code_convert(\$content, $kanjicode); | |
1069 close(FILE); | |
1070 &print_header($page); | |
1071 &print_content($content); | |
1072 &print_editform($rawmsg, $form{myConflictChecker}, frozen=>0, conflict=>1); | |
1073 &print_footer($page); | |
1074 return 1; | |
1075 } | |
1076 | |
1077 sub get_now { | |
1078 my (@week) = qw(Sun Mon Tue Wed Thu Fri Sat); | |
1079 my ($sec, $min, $hour, $day, $mon, $year, $weekday) = localtime(time); | |
1080 $year += 1900; | |
1081 $mon++; | |
1082 $mon = "0$mon" if $mon < 10; | |
1083 $day = "0$day" if $day < 10; | |
1084 $hour = "0$hour" if $hour < 10; | |
1085 $min = "0$min" if $min < 10; | |
1086 $sec = "0$sec" if $sec < 10; | |
1087 $weekday = $week[$weekday]; | |
1088 return "$year-$mon-$day ($weekday) $hour:$min:$sec"; | |
1089 } | |
1090 | |
1091 # [[YukiWiki http://www.hyuki.com/yukiwiki/wiki.cgi?euc($1)]] | |
1092 sub init_InterWikiName { | |
1093 my $content = $database{$InterWikiName}; | |
1094 while ($content =~ /\[\[(\S+) +(\S+)\]\]/g) { | |
1095 my ($name, $url) = ($1, $2); | |
1096 $interwiki{$name} = $url; | |
1097 } | |
1098 } | |
1099 | |
1100 sub interwiki_convert { | |
1101 my ($type, $localname) = @_; | |
1102 if ($type eq 'sjis' or $type eq 'euc') { | |
1103 &code_convert(\$localname, $type); | |
1104 return &encode($localname); | |
1105 } elsif ($type eq 'ykwk') { | |
1106 # for YukiWiki1 | |
1107 if ($localname =~ /^$wiki_name$/) { | |
1108 return $localname; | |
1109 } else { | |
1110 &code_convert(\$localname, 'sjis'); | |
1111 return &encode("[[" . $localname . "]]"); | |
1112 } | |
1113 } elsif ($type eq 'asis') { | |
1114 return $localname; | |
1115 } else { | |
1116 return $localname; | |
1117 } | |
1118 } | |
1119 | |
1120 sub get_info { | |
1121 my ($page, $key) = @_; | |
1122 my %info = map { split(/=/, $_, 2) } split(/\n/, $infobase{$page}); | |
1123 return $info{$key}; | |
1124 } | |
1125 | |
1126 sub set_info { | |
1127 my ($page, $key, $value) = @_; | |
1128 my %info = map { split(/=/, $_, 2) } split(/\n/, $infobase{$page}); | |
1129 $info{$key} = $value; | |
1130 my $s = ''; | |
1131 for (keys %info) { | |
1132 $s .= "$_=$info{$_}\n"; | |
1133 } | |
1134 $infobase{$page} = $s; | |
1135 } | |
1136 | |
1137 sub frozen_reject { | |
1138 my ($isfrozen) = &get_info($form{mypage}, $info_IsFrozen); | |
1139 my ($willbefrozen) = $form{myfrozen}; | |
1140 if (not $isfrozen and not $willbefrozen) { | |
1141 # You need no check. | |
1142 return 0; | |
1143 } elsif (valid_password($form{mypassword})) { | |
1144 # You are admin. | |
1145 return 0; | |
1146 } else { | |
1147 &print_error($resource{passworderror}); | |
1148 return 1; | |
1149 } | |
1150 } | |
1151 | |
1152 sub length_reject { | |
1153 if ($max_message_length < 0) { | |
1154 return 0; | |
1155 } | |
1156 if ($max_message_length < length($form{mymsg})) { | |
1157 &print_error($resource{toolongpost} . $max_message_length); | |
1158 return 1; | |
1159 } | |
1160 return 0; | |
1161 } | |
1162 | |
1163 sub valid_password { | |
1164 my ($givenpassword) = @_; | |
1165 my ($validpassword_crypt) = &get_info($AdminSpecialPage, $info_AdminPassword); | |
1166 if (crypt($givenpassword, $validpassword_crypt) eq $validpassword_crypt) { | |
1167 return 1; | |
1168 } else { | |
1169 return 0; | |
1170 } | |
1171 } | |
1172 | |
1173 sub is_frozen { | |
1174 my ($page) = @_; | |
1175 if (&get_info($page, $info_IsFrozen)) { | |
1176 return 1; | |
1177 } else { | |
1178 return 0; | |
1179 } | |
1180 } | |
1181 | |
1182 sub do_comment { | |
1183 my ($content) = $database{$form{mypage}}; | |
1184 my $datestr = &get_now; | |
1185 my $namestr = $form{myname} ? " ''[[$form{myname}]]'' : " : " "; | |
1186 if ($content =~ s/(^|\n)(\Q$embed_comment\E)/$1- $datestr$namestr$form{mymsg}\n$2/) { | |
1187 ; | |
1188 } else { | |
1189 $content =~ s/(^|\n)(\Q$embed_rcomment\E)/$1$2\n- $datestr$namestr$form{mymsg}/; | |
1190 } | |
1191 if ($form{mymsg}) { | |
1192 $form{mymsg} = $content; | |
1193 $form{mytouch} = 'on'; | |
1194 &do_write; | |
1195 } else { | |
1196 $form{mycmd} = 'read'; | |
1197 &do_read; | |
1198 } | |
1199 } | |
1200 | |
1201 sub embedded_to_html { | |
1202 my ($embedded) = @_; | |
1203 my $escapedmypage = &escape($form{mypage}); | |
1204 if ($embedded eq $embed_comment or $embedded eq $embed_rcomment) { | |
1205 my $conflictchecker = &get_info($form{mypage}, $info_ConflictChecker); | |
1206 return <<"EOD"; | |
1207 <form action="$url_cgi" method="post"> | |
1208 <input type="hidden" name="mycmd" value="comment"> | |
1209 <input type="hidden" name="mypage" value="$escapedmypage"> | |
1210 <input type="hidden" name="myConflictChecker" value="$conflictchecker"> | |
1211 <input type="hidden" name="mytouch" value="on"> | |
1212 $resource{yourname} | |
1213 <input type="text" name="myname" value="" size="10"> | |
1214 <input type="text" name="mymsg" value="" size="40"> | |
1215 <input type="submit" value="$resource{commentbutton}"> | |
1216 </form> | |
1217 EOD | |
1218 } else { | |
1219 return $embedded; | |
1220 } | |
1221 } | |
1222 | |
1223 sub code_convert { | |
1224 my ($contentref, $kanjicode) = @_; | |
1225 # &Jcode::convert($contentref, $kanjicode); # for Jcode.pm | |
1226 &jcode::convert($contentref, $kanjicode); # for jcode.pl | |
1227 return $$contentref; | |
1228 } | |
1229 | |
1230 sub test_convert { | |
1231 my $txt = &text_to_html(<<"EOD", toc=>1); | |
1232 *HEADER1 | |
1233 **HEADER1-1 | |
1234 -ITEM1 | |
1235 -ITEM2 | |
1236 -ITEM3 | |
1237 PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1 | |
1238 PAR1PAR1PAR1PAR1PAR1PAR1''BOLD''PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1 | |
1239 PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1 | |
1240 | |
1241 PAR2PAR2PAR2PAR2PAR2PAR2PAR2PAR2PAR2PAR2PAR2PAR2PAR2PAR2PAR2PAR2 | |
1242 PAR2PAR2PAR2PAR2PAR2PAR2'''ITALIC'''PAR2PAR2PAR2PAR2PAR2PAR2PAR2 | |
1243 PAR2PAR2PAR2PAR2PAR2PAR2PAR2PAR2PAR2PAR2PAR2PAR2PAR2PAR2PAR2PAR2 | |
1244 **HEADER1-2 | |
1245 :TERM1:DESCRIPTION1 AND ''BOLD'' | |
1246 PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1 | |
1247 PAR1PAR1PAR1PAR1PAR1PAR1''BOLD''PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1 | |
1248 PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1 | |
1249 :TERM2:DESCRIPTION2 | |
1250 :TERM3:DESCRIPTION3 | |
1251 ---- | |
1252 *HEADER2 | |
1253 **HEADER2-1 | |
1254 http://www.hyuki.com/ | |
1255 **HEADER2-2 | |
1256 | |
1257 [[YukiWiki2]] | |
1258 | |
1259 PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1 | |
1260 PAR1PAR1PAR1PAR1PAR1PAR1'''''BOLD ITALIC'''''PAR1PAR1PAR1PAR1PAR1 | |
1261 PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1 | |
1262 >PAR2PAR2PAR2PAR2PAR2PAR2PAR2PAR2PAR2PAR2PAR2PAR2PAR2PAR2PAR2PAR2 | |
1263 >PAR2PAR2PAR2PAR2PAR2PAR2'''ITALIC'''PAR2PAR2PAR2PAR2PAR2PAR2PAR2 | |
1264 >PAR2PAR2PAR2PAR2PAR2PAR2PAR2PAR2PAR2PAR2PAR2PAR2PAR2PAR2PAR2PAR2 | |
1265 | |
1266 LEVEL0LEVEL0LEVEL0LEVEL0LEVEL0LEVEL0LEVEL0 | |
1267 | |
1268 >LEVEL1 | |
1269 >LEVEL1 | |
1270 >LEVEL1 | |
1271 >>LEVEL2 | |
1272 >>LEVEL2 | |
1273 >>LEVEL2 | |
1274 >>>LEVEL3 | |
1275 -HELLO-1 | |
1276 --HELLO-2 | |
1277 (HELLO-2, HELLO-2, HELLO-2) | |
1278 ---HELLO-3 | |
1279 (HELLO-3, HELLO-3, HELLO-3) | |
1280 --HELLO-2 | |
1281 ---HELLO-3 | |
1282 --HELLO-2 | |
1283 ---HELLO-3 | |
1284 >>>LEVEL3 | |
1285 >>>LEVEL3 | |
1286 >>>LEVEL3 | |
1287 >>>LEVEL3 | |
1288 EOD | |
1289 print $txt; | |
1290 exit; | |
1291 } | |
1292 | |
1293 sub do_diff { | |
1294 if (not &is_editable($form{mypage})) { | |
1295 &do_read; | |
1296 return; | |
1297 } | |
1298 &open_diff; | |
1299 my $title = $form{mypage}; | |
1300 &print_header($title); | |
1301 $_ = &escape($diffbase{$form{mypage}}); | |
1302 &close_diff; | |
1303 print qq(<h3>$resource{difftitle}</h3>); | |
1304 print qq($resource{diffnotice}); | |
1305 print qq(<pre class="diff">); | |
1306 foreach (split(/\n/, $_)) { | |
1307 if (/^\+(.*)/) { | |
1308 print qq(<b class="added">$1</b>\n); | |
1309 } elsif (/^\-(.*)/) { | |
1310 print qq(<s class="deleted">$1</s>\n); | |
1311 } elsif (/^\=(.*)/) { | |
1312 print qq(<span class="same">$1</span>\n); | |
1313 } else { | |
1314 print qq|??? $_\n|; | |
1315 } | |
1316 } | |
1317 print qq(</pre>); | |
1318 print qq(<hr>); | |
1319 &print_footer($title); | |
1320 } | |
1321 | |
1322 sub do_rss { | |
1323 if ($file_rss) { | |
1324 print <<"EOD"; | |
1325 Status: 301 Moved Permanently | |
1326 Location: $modifier_rss_about | |
1327 | |
1328 EOD | |
1329 return; | |
1330 } | |
1331 } | |
1332 | |
1333 sub is_exist_page { | |
1334 my ($name) = @_; | |
1335 if ($use_exists) { | |
1336 return exists($database{$name}); | |
1337 } else { | |
1338 return $database{$name}; | |
1339 } | |
1340 } | |
1341 | |
1342 # sub check_modifiers { | |
1343 # if ($error_AnyDBM_File and $modifier_dbtype eq 'AnyDBM_File') { | |
1344 # &print_error($resource{anydbmfileerror}); | |
1345 # } | |
1346 # } | |
1347 | |
1348 # Initialize plugins. | |
1349 sub init_plugin { | |
1350 $plugin_manager = new Yuki::PluginManager($plugin_context, $modifier_dir_plugin); | |
1351 } | |
1352 | |
1353 sub print_plugin_log { | |
1354 if ($plugin_context->{debug}) { | |
1355 print "<pre>(print_plugin_log)\n", join("\n", @{$plugin_manager->{log}}), "</pre>"; | |
1356 } | |
1357 } | |
1358 | |
1359 sub keyword_reject { | |
1360 my $s = $form{mymsg}; | |
1361 my @reject_words = qw( | |
1362 buy-cheap.com | |
1363 ultram.online-buy.com | |
1364 ); | |
1365 for (@reject_words) { | |
1366 if ($s =~ /\Q$_\E/) { | |
1367 &send_mail_to_admin($form{mypage}, "Rejectword: $_"); | |
1368 sleep(30); | |
1369 return 1; | |
1370 } | |
1371 } | |
1372 return 0; | |
1373 } | |
1374 | |
1375 # Thanks to Makio Tsukamoto for dc_date. | |
1376 sub update_rssfile { | |
1377 my $rss = new Yuki::RSS( | |
1378 version => '1.0', | |
1379 encoding => $charset, | |
1380 ); | |
1381 $rss->channel( | |
1382 title => $modifier_rss_title, | |
1383 link => $modifier_rss_link, | |
1384 about => $modifier_rss_about, | |
1385 description => $modifier_rss_description, | |
1386 ); | |
1387 my $recentchanges = $database{$RecentChanges}; | |
1388 my $count = 0; | |
1389 foreach (split(/\n/, $recentchanges)) { | |
1390 last if ($count >= 15); | |
1391 /^\- (\d\d\d\d\-\d\d\-\d\d) \(...\) (\d\d:\d\d:\d\d) (\S+)/; # date format. | |
1392 my $dc_date = "$1T$2$modifier_rss_timezone"; | |
1393 my $title = &unarmor_name($3); | |
1394 my $escaped_title = &escape($title); | |
1395 my $link = $modifier_rss_link . '?' . &encode($title); | |
1396 my $description = $escaped_title . &escape(&get_subjectline($title)); | |
1397 $rss->add_item( | |
1398 title => $escaped_title, | |
1399 link => $link, | |
1400 description => $description, | |
1401 dc_date => $dc_date, | |
1402 ); | |
1403 $count++; | |
1404 } | |
1405 open(FILE, "> $file_rss") or &print_error("($file_rss)"); | |
1406 print FILE $rss->as_string; | |
1407 close(FILE); | |
1408 } | |
1409 | |
1410 1; | |
1411 __END__ | |
1412 =head1 NAME | |
1413 | |
1414 wiki.cgi - This is YukiWiki, yet another Wiki clone. | |
1415 | |
1416 =head1 DESCRIPTION | |
1417 | |
1418 YukiWiki is yet another Wiki clone. | |
1419 | |
1420 YukiWiki can treat Japanese WikiNames (enclosed with [[ and ]]). | |
1421 YukiWiki provides 'InterWiki' feature, RDF Site Summary (RSS), | |
1422 and some embedded commands (such as [[#comment]] to add comments). | |
1423 | |
1424 =head1 AUTHOR | |
1425 | |
1426 Hiroshi Yuki <hyuki@hyuki.com> http://www.hyuki.com/yukiwiki/ | |
1427 | |
1428 =head1 LICENSE | |
1429 | |
1430 Copyright (C) 2000-2006 by Hiroshi Yuki. | |
1431 | |
1432 This program is free software; you can redistribute it and/or | |
1433 modify it under the same terms as Perl itself. | |
1434 | |
1435 =cut |