/[pub]/suikawiki/script/wiki.cgi
Suika

Contents of /suikawiki/script/wiki.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.25 - (show annotations) (download)
Sat Sep 28 09:43:07 2002 UTC (21 years, 7 months ago) by wakaba
Branch: MAIN
Changes since 1.24: +68 -33 lines
2002-09-28  Wakaba <w@suika.fam.cx>

	* wiki.cgi:
	- Intoduce text/css mode.
	- Anchorize news: URIs.
	- (armor_name): Bug fix of not anchorizing traditional Wiki name.
	- Indenting heading 3-5 in TOC.
	- Multi-comment support.
	- (print_footer): Embed #comment.
	- (print_editform): Use NewPageTemplate when new page.
	* wiki-style.css: Removed.

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

admin@suikawiki.org
ViewVC Help
Powered by ViewVC 1.1.24