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

Contents of /suikawiki/script/wiki.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.21 - (show annotations) (download)
Sun Jun 2 07:15:20 2002 UTC (21 years, 11 months ago) by wakaba
Branch: MAIN
Changes since 1.20: +3 -3 lines
2002-06-02  wakaba <w@suika.fam.cx>

	* wiki.cgi: Sync with WalWiki 2.0.beta.1.wal.1.
	* wiki-style.css: New file.

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

admin@suikawiki.org
ViewVC Help
Powered by ViewVC 1.1.24