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

Contents of /suikawiki/script/wiki.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.1.1.1 - (show annotations) (download) (vendor branch)
Sun Jun 2 04:26:22 2002 UTC (21 years, 11 months ago) by wakaba
Branch: walwiki
CVS Tags: release-2-0-beta1-wal1
Changes since 1.1: +1212 -1284 lines
*** empty log message ***

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

admin@suikawiki.org
ViewVC Help
Powered by ViewVC 1.1.24