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

Contents of /suikawiki/script/wiki.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.17 - (show annotations) (download)
Sun Jun 2 05:41:49 2002 UTC (21 years, 11 months ago) by wakaba
Branch: MAIN
Changes since 1.16: +2 -1 lines
*** empty log message ***

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 = './WalWiki/Theme/wiki.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 = 'FrontPage';
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
407 <!DOCTYPE html
408 PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN"
409 "http://www.w3.org/TR/html4/loose.dtd">
410 <html lang="$lang">
411 <head>
412 <meta http-equiv="Content-Language" content="$lang">
413 <meta http-equiv="Content-Type" content="text/html; charset=$charset">
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 $mod_info = $modifier_name ? qq(Modified by <a href="$modifier_url">$modifier_name</a>.) : '';
451 print <<"EOD";
452 <div class="footer">
453 <hr />
454 <p>
455 <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 />
456 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 />
457 $mod_info
458 </p>
459 </div>
460 $walrus_log <!-- Walrus add (debug) -->
461 </body>
462 </html>
463 EOD
464 # print <<"EOD";
465 # <hr>
466 # <address class="footer">
467 # <a href="http://www.hyuki.com/yukiwiki/">YukiWiki</a> $version
468 # &copy; 2000-2002 by <a href="http://www.hyuki.com/">Hiroshi Yuki</a>.<br />
469 # Modified by <a href="$modifier_url">$modifier_name</a>.
470 # </address>
471 # <p class="footer">
472 # <a href="http://www.hyuki.com/yukiwiki/">$icontag</a>
473 # </p>
474 # </body>
475 # </html>
476 # EOD
477 # Walrus mod (1) end
478 }
479
480 sub escape {
481 my $s = shift;
482 $s =~ s|\r\n|\n|g;
483 $s =~ s|\&|&amp;|g;
484 $s =~ s|<|&lt;|g;
485 $s =~ s|>|&gt;|g;
486 $s =~ s|"|&quot;|g;
487 return $s;
488 }
489
490 sub unescape {
491 my $s = shift;
492 # $s =~ s|\n|\r\n|g;
493 $s =~ s|\&amp;|\&|g;
494 $s =~ s|\&lt;|\<|g;
495 $s =~ s|\&gt;|\>|g;
496 $s =~ s|\&quot;|\"|g;
497 return $s;
498 }
499
500 sub print_content {
501 my ($rawcontent) = @_;
502 print &text_to_html($rawcontent, toc=>1);
503 }
504
505 sub text_to_html {
506 my ($txt, %option) = @_;
507 my (@txt) = split(/\n/, $txt);
508 my (@toc);
509 my $tocnum = 0;
510 my (@saved, @result);
511 unshift(@saved, "</p>");
512 push(@result, "<p>");
513 foreach (@txt) {
514 chomp;
515 # Walrus mod (6) start
516 if ($saved[0] eq '</html>') {
517 if (/<\/html>/i) { splice(@saved); }
518 else { push (@result, &html_to_ignored_html($_)); }
519 } elsif (/^<html>/i and &is_ignore_html($form{mypage})) {
520 push(@result, splice(@saved));
521 push(@saved, '</html>');
522 } elsif (/^\*\*(.*)/) {
523 # if (/^\*\*(.*)/) {
524 # Walrus mod (6) end
525 push(@toc, qq(-- <a href="#i$tocnum">@{[&escape($1)]}</a>\n));
526 push(@result, splice(@saved), qq(<h3><a name="i$tocnum"> </a>) . &inline($1) . '</h3>');
527 $tocnum++;
528 } elsif (/^\*(.*)/) {
529 push(@toc, qq(- <a href="#i$tocnum">@{[&escape($1)]}</a>\n));
530 push(@result, splice(@saved), qq(<h2><a name="i$tocnum"> </a>) . &inline($1) . '</h2>');
531 $tocnum++;
532 } elsif (/^----/) {
533 push(@result, splice(@saved), '<hr>');
534 } elsif (/^(-{1,3})(.*)/) {
535 &back_push('ul', length($1), \@saved, \@result);
536 push(@result, '<li>' . &inline($2) . '</li>');
537 } elsif (/^:([^:]+):(.*)/) {
538 &back_push('dl', 1, \@saved, \@result);
539 push(@result, '<dt>' . &inline($1) . '</dt>', '<dd>' . &inline($2) . '</dd>');
540 } elsif (/^(>{1,3})(.*)/) {
541 &back_push('blockquote', length($1), \@saved, \@result);
542 push(@result, &inline($2));
543 } elsif (/^\s*$/) {
544 push(@result, splice(@saved));
545 unshift(@saved, "</p>");
546 push(@result, "<p>");
547 } elsif (/^(\s+.*)$/) {
548 &back_push('pre', 1, \@saved, \@result);
549 push(@result, &escape($1)); # Not &inline, but &escape
550 # } elsif (/^\,(.*)$/) { # Walrus del (BF)
551 } elsif (/^\,(.*?)[\x0D\x0A]*$/) { # Walrus add (BF)
552 &back_push('table', 1, \@saved, \@result, ' border="1"');
553 #######
554 # This part is taken from Mr. Ohzaki's Perl Memo and Makio Tsukamoto's WalWiki.
555 # XXXXX
556 my $tmp = "$1,";
557 my @value = map {/^"(.*)"$/ ? scalar($_ = $1, s/""/"/g, $_) : $_} ($tmp =~ /("[^"]*(?:""[^"]*)*"|[^,]*),/g);
558 my @align = map {(s/^\s+//) ? ((s/\s+$//) ? ' align="center"' : ' align="right"') : ''} @value;
559 my @colspan = map {($_ eq '==') ? 0 : 1} @value;
560 for (my $i = 0; $i < @value; $i++) {
561 if ($colspan[$i]) {
562 while ($i + $colspan[$i] < @value and $value[$i + $colspan[$i]] eq '==') {
563 $colspan[$i]++;
564 }
565 $colspan[$i] = ($colspan[$i] > 1) ? sprintf(' colspan="%d"', $colspan[$i]) : '';
566 $value[$i] = sprintf('<td%s%s>%s</td>', $align[$i], $colspan[$i], &inline($value[$i]));
567 } else {
568 $value[$i] = '';
569 }
570 }
571 push(@result, join('', '<tr>', @value, '</tr>'));
572 # XXXXX
573 #######
574 } else {
575 push(@result, &inline($_));
576 }
577 }
578 push(@result, splice(@saved));
579
580 if ($option{toc}) {
581 # Convert @toc (table of contents) to HTML.
582 # This part is taken from Makio Tsukamoto's WalWiki.
583 my (@tocsaved, @tocresult);
584 foreach (@toc) {
585 if (/^(-{1,3})(.*)/) {
586 &back_push('ul', length($1), \@tocsaved, \@tocresult);
587 push(@tocresult, '<li>' . $2 . '</li>');
588 }
589 }
590 push(@tocresult, splice(@tocsaved));
591 return join("\n", @tocresult, @result);
592 } else {
593 return join("\n", @result);
594 }
595 }
596
597 sub back_push {
598 my ($tag, $level, $savedref, $resultref, $attr) = @_;
599 while (@$savedref > $level) {
600 push(@$resultref, shift(@$savedref));
601 }
602 if ($savedref->[0] ne "</$tag>") {
603 push(@$resultref, splice(@$savedref));
604 }
605 while (@$savedref < $level) {
606 unshift(@$savedref, "</$tag>");
607 push(@$resultref, "<$tag$attr>");
608 }
609 }
610
611 sub inline {
612 my ($line) = @_;
613 $line = &escape($line);
614 $line =~ s|'''([^']+?)'''|<i>$1</i>|g; # Italic
615 $line =~ s|''([^']+?)''|<b>$1</b>|g; # Bold
616 $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
617 $line =~ s!
618 (
619 ((mailto|http|https|ftp):([^\x00-\x20()<>\x7F-\xFF])*) # Direct http://...
620 |
621 ($bracket_name) # [[likethis]], [[#comment]], [[Friend:remotelink]]
622 |
623 ($interwiki_definition) # [[Friend http://somewhere/?q=sjis($1)]]
624 |
625 ($wiki_name) # LocalLinkLikeThis
626 )
627 !
628 &make_link($1)
629 !gex;
630 return $line;
631 }
632
633 sub make_link {
634 my $chunk = shift;
635 # Walrus add (3) start
636 my $name = $chunk;
637 if ($chunk =~ /^\[\[([^ ]+?) ([^ ]+?)\]\]$/ and $form{mypage} ne $InterWikiName) {
638 ($name, $chunk) = ($1, $2);
639 } elsif ($chunk =~ /^mailto:(.*)$/) {
640 $name = $1;
641 }
642 if ($use_autoimg and $name =~ /^(http|https|ftp|):.+\.(png|gif|jpe?g)/) {
643 $name = qq(<img src="$name">) ;
644 }
645 $name = &unarmor_name($name);
646 # Walrus add (3) end
647 if ($chunk =~ /^(http|https|ftp):/) {
648 # Walrus mod (3) start
649 # if ($use_autoimg and $chunk =~ /\.(gif|png|jpeg|jpg)$/) {
650 # return qq(<a href="$chunk"><img src="$chunk"></a>);
651 # } else {
652 # return qq(<a href="$chunk">$chunk</a>);
653 # }
654 return qq(<a href="$chunk">$name</a>);
655 # Walrus mod (3) end
656 } elsif ($chunk =~ /^(mailto):(.*)/) {
657 # return qq(<a href="$chunk">$2</a>); # Walrus del (3)
658 return qq(<a href="$chunk">$name</a>); # Walrus add (3)
659 } elsif ($chunk =~ /^$interwiki_definition$/) {
660 # return qq(<span class="InterWiki">$chunk</span>); # Walrus del (3)
661 return qq(<span class="InterWiki">$name</span>); # Walrus add (3)
662 } elsif ($chunk =~ /^$embedded_name$/) {
663 return &embedded_to_html($chunk);
664 } else {
665 $chunk = &unarmor_name($chunk);
666 $chunk = &unescape($chunk); # To treat '&' or '>' or '<' correctly.
667 my $cookedchunk = &encode($chunk);
668 if ($chunk =~ /^$interwiki_name$/) {
669 my ($intername, $localname) = ($1, $2);
670 my $remoteurl = $interwiki{$intername};
671 if ($remoteurl) {
672 # $remoteurl =~ s/\b(euc|sjis|ykwk|asis)\(\$1\)/&interwiki_convert($1, $localname)/e; # Walrus del (4)
673 $remoteurl =~ s/\b(euc|sjis|ykwk|asis|isbn)\(\$1\)/&interwiki_convert($1, $localname)/e; # Walrus add (4)
674 # return qq(<a href="$remoteurl">$chunk</a>); # Walrus del (3)
675 return qq(<a href="$remoteurl">$name</a>); # Walrus add (3)
676 } else {
677 # return $chunk; # Walrus del (3)
678 return $name; # Walrus add (3)
679 }
680 } elsif ($database{$chunk}) {
681 my $subject = &escape(&get_subjectline($chunk, delimiter => ''));
682 # return qq(<a title="$subject" href="$url_cgi?$cookedchunk">$chunk</a>); # Walrus del (3)
683 return qq(<a title="$subject" href="$url_cgi?$cookedchunk">$name</a>); # Walrus add (3)
684 } elsif ($page_command{$chunk}) {
685 # return qq(<a title="$chunk" href="$url_cgi?$cookedchunk">$chunk</a>); # Walrus del (3)
686 return qq(<a title="$chunk" href="$url_cgi?$cookedchunk">$name</a>); # Walrus add (3)
687 } else {
688 # return qq($chunk<a title="$resource{editthispage}" href="$url_cgi?mycmd=edit&amp;mypage=$cookedchunk">$editchar</a>); # Walrus del (3)
689 return qq($name<a title="$resource{editthispage}" href="$url_cgi?mycmd=edit&amp;mypage=$cookedchunk">$editchar</a>); # Walrus add (3)
690 }
691 }
692 }
693
694 # Walrus add (6) start
695 sub is_ignore_html {
696 my ($pagename) = @_;
697 foreach (@ignore_html_page) {
698 return 1 if ($pagename eq $_);
699 }
700 return 0;
701 }
702 # Walrus add (6) end
703
704 # Walrus add (6) start
705 sub html_to_ignored_html {
706 my $str = shift(@_);
707 my $text_regex = q{[^<]*};
708 my $tag_regex_ = q{[^"'<>]*(?:"[^"]*"[^"'<>]*|'[^']*'[^"'<>]*)*(?:>|(?=<)|$(?!\n))}; #'}}}}
709 my $comment_tag_regex = '<!(?:--[^-]*-(?:[^-]+-)*?-(?:[^>-]*(?:-[^>-]+)*?)??)*(?:>|$(?!\n)|--.*$)';
710 my $tag_regex = qq{$comment_tag_regex|<$tag_regex_};
711 my $ignored = join('|', @ignore_html_tags);
712 my $result = '';
713 while ($str =~ /($text_regex)($tag_regex)?/gso) {
714 last if $1 eq '' and $2 eq '';
715 $result .= $1;
716 my $tag_tmp = $2;
717 $result .= ($tag_tmp =~ /^<\/?($ignored)(?![0-9A-Za-z])/i) ? $tag_tmp : &escape($tag_tmp);
718 if ($tag_tmp =~ /^<(XMP|PLAINTEXT|SCRIPT)(?![0-9A-Za-z])/i) {
719 $str =~ /(.*?)(?:<\/$1(?![0-9A-Za-z])$tag_regex_|$)/gsi;
720 $result .= &escape($1);
721 }
722 }
723 return $result;
724 }
725 # Walrus add (6) end
726
727 sub print_message {
728 my ($msg) = @_;
729 print qq(<p><strong>$msg</strong></p>);
730 }
731
732 sub init_form {
733 if (param()) {
734 foreach my $var (param()) {
735 $form{$var} = param($var);
736 }
737 } else {
738 $ENV{QUERY_STRING} = $FrontPage;
739 }
740
741 my $query = &decode($ENV{QUERY_STRING});
742 if ($page_command{$query}) {
743 $form{mycmd} = $page_command{$query};
744 $form{mypage} = $query;
745 } elsif ($query =~ /^($wiki_name)$/) {
746 $form{mycmd} = 'read';
747 $form{mypage} = $1;
748 } elsif ($database{$query}) {
749 $form{mycmd} = 'read';
750 $form{mypage} = $query;
751 }
752
753 # mypreview_edit -> do_edit, with preview.
754 # mypreview_adminedit -> do_adminedit, with preview.
755 # mypreview_write -> do_write, without preview.
756 foreach (keys %form) {
757 if (/^mypreview_(.*)$/) {
758 $form{mycmd} = $1;
759 $form{mypreview} = 1;
760 }
761 }
762
763 #
764 # $form{mycmd} is frozen here.
765 #
766
767 $form{mymsg} = &code_convert(\$form{mymsg}, $kanjicode);
768 $form{myname} = &code_convert(\$form{myname}, $kanjicode);
769 }
770
771 sub update_recent_changes {
772 my $update = "- @{[&get_now]} @{[&armor_name($form{mypage})]} @{[&get_subjectline($form{mypage})]}";
773 my @oldupdates = split(/\r?\n/, $database{$RecentChanges});
774 my @updates;
775 foreach (@oldupdates) {
776 /^\- \d\d\d\d\-\d\d\-\d\d \(...\) \d\d:\d\d:\d\d (\S+)/; # date format.
777 my $name = &unarmor_name($1);
778 if (&is_exist_page($name) and ($name ne $form{mypage})) {
779 push(@updates, $_);
780 }
781 }
782 if (&is_exist_page($form{mypage})) {
783 unshift(@updates, $update);
784 }
785 splice(@updates, $maxrecent + 1);
786 $database{$RecentChanges} = join("\n", @updates);
787 if ($file_touch) {
788 open(FILE, "> $file_touch");
789 print FILE localtime() . "\n";
790 close(FILE);
791 }
792 }
793
794 sub get_subjectline {
795 my ($page, %option) = @_;
796 if (not &is_editable($page)) {
797 return "";
798 } else {
799 # Delimiter check.
800 my $delim = $subject_delimiter;
801 if (defined($option{delimiter})) {
802 $delim = $option{delimiter};
803 }
804
805 # Get the subject of the page.
806 my $subject = $database{$page};
807 $subject =~ s/\r?\n.*//s;
808 return "$delim$subject";
809 }
810 }
811
812 sub send_mail_to_admin {
813 my ($page, $mode) = @_;
814 return unless $modifier_sendmail;
815 my $message = <<"EOD";
816 To: $modifier_mail
817 From: $modifier_mail
818 Subject: [Wiki]
819 MIME-Version: 1.0
820 Content-Type: text/plain; charset=ISO-2022-JP
821 Content-Transfer-Encoding: 7bit
822
823 --------
824 MODE = $mode
825 REMOTE_ADDR = $ENV{REMOTE_ADDR}
826 REMOTE_HOST = $ENV{REMOTE_HOST}
827 --------
828 $page
829 --------
830 $database{$page}
831 --------
832 EOD
833 &code_convert(\$message, 'jis');
834 open(MAIL, "| $modifier_sendmail");
835 print MAIL $message;
836 close(MAIL);
837 }
838
839 sub open_db {
840 if ($modifier_dbtype eq 'dbmopen') {
841 dbmopen(%database, $dataname, 0666) or &print_error("(dbmopen) $dataname");
842 dbmopen(%infobase, $infoname, 0666) or &print_error("(dbmopen) $infoname");
843 } elsif ($modifier_dbtype eq 'AnyDBM_File') {
844 tie(%database, "AnyDBM_File", $dataname, O_RDWR|O_CREAT, 0666) or &print_error("(tie AnyDBM_File) $dataname");
845 tie(%infobase, "AnyDBM_File", $infoname, O_RDWR|O_CREAT, 0666) or &print_error("(tie AnyDBM_File) $infoname");
846 } else {
847 tie(%database, "Yuki::YukiWikiDB", $dataname) or &print_error("(tie Yuki::YukiWikiDB) $dataname");
848 tie(%infobase, "Yuki::YukiWikiDB", $infoname) or &print_error("(tie Yuki::YukiWikiDB) $infoname");
849 }
850 }
851
852 sub close_db {
853 if ($modifier_dbtype eq 'dbmopen') {
854 dbmclose(%database);
855 dbmclose(%infobase);
856 } elsif ($modifier_dbtype eq 'AnyDBM_File') {
857 untie(%database);
858 untie(%infobase);
859 } else {
860 untie(%database);
861 untie(%infobase);
862 }
863 }
864
865 sub open_diff {
866 if ($modifier_dbtype eq 'dbmopen') {
867 dbmopen(%diffbase, $diffname, 0666) or &print_error("(dbmopen) $diffname");
868 } elsif ($modifier_dbtype eq 'AnyDBM_File') {
869 tie(%diffbase, "AnyDBM_File", $diffname, O_RDWR|O_CREAT, 0666) or &print_error("(tie AnyDBM_File) $diffname");
870 } else {
871 tie(%diffbase, "Yuki::YukiWikiDB", $diffname) or &print_error("(tie Yuki::YukiWikiDB) $diffname");
872 }
873 }
874
875 sub close_diff {
876 if ($modifier_dbtype eq 'dbmopen') {
877 dbmclose(%diffbase);
878 } elsif ($modifier_dbtype eq 'AnyDBM_File') {
879 untie(%diffbase);
880 } else {
881 untie(%diffbase);
882 }
883 }
884
885 sub print_searchform {
886 my ($word) = @_;
887 print <<"EOD";
888 <form action="$url_cgi" method="get">
889 <input type="hidden" name="mycmd" value="search">
890 <input type="text" name="mymsg" value="$word" size="20">
891 <input type="submit" value="$resource{searchbutton}">
892 </form>
893 EOD
894 }
895
896 sub print_editform {
897 my ($mymsg, $lastmodified, %mode) = @_;
898 my $frozen = &is_frozen($form{mypage});
899
900 if ($form{mypreview}) {
901 if ($form{mymsg}) {
902 unless ($mode{conflict}) {
903 print qq(<h3>$resource{previewtitle}</h3>\n);
904 print qq($resource{previewnotice}\n);
905 print qq(<div class="preview">\n);
906 &print_content($form{mymsg});
907 print qq(</div>\n);
908 }
909 } else {
910 print qq($resource{previewempty});
911 }
912 $mymsg = &escape($form{mymsg});
913 } else {
914 $mymsg = &escape($mymsg);
915 }
916
917 my $edit = $mode{admin} ? 'adminedit' : 'edit';
918
919 print <<"EOD";
920 <form action="$url_cgi" method="post">
921 @{[ $mode{admin} ? qq($resource{frozenpassword} <input type="password" name="mypassword" value="$form{mypassword}" size="10"><br>) : "" ]}
922 <input type="hidden" name="myLastModified" value="$lastmodified">
923 <input type="hidden" name="mypage" value="$form{mypage}">
924 <textarea cols="$cols" rows="$rows" name="mymsg" wrap="off">$mymsg</textarea><br>
925 @{[
926 $mode{admin} ?
927 qq(
928 <input type="radio" name="myfrozen" value="1" @{[$frozen ? qq(checked="checked") : ""]}>$resource{frozenbutton}
929 <input type="radio" name="myfrozen" value="0" @{[$frozen ? "" : qq(checked="checked")]}>$resource{notfrozenbutton}<br>)
930 : ""
931 ]}
932 @{[
933 $mode{conflict} ? "" :
934 qq(
935 <input type="checkbox" name="mytouch" value="on" checked="checked">$resource{touch}<br>
936 <input type="submit" name="mypreview_$edit" value="$resource{previewbutton}">
937 <input type="submit" name="mypreview_write" value="$resource{savebutton}"><br>
938 )
939 ]}
940 </form>
941 EOD
942 unless ($mode{conflict}) {
943 # Show the format rule.
944 open(FILE, $file_format) or &print_error("($file_format)");
945 my $content = join('', <FILE>);
946 &code_convert(\$content, $kanjicode);
947 close(FILE);
948 print &text_to_html($content, toc=>0);
949 }
950 }
951
952 sub print_passwordform {
953 print <<"EOD";
954 <form action="$url_cgi" method="post">
955 <input type="hidden" name="mycmd" value="adminchangepassword">
956 $resource{oldpassword} <input type="password" name="myoldpassword" size="10"><br>
957 $resource{newpassword} <input type="password" name="mynewpassword" size="10"><br>
958 $resource{newpassword2} <input type="password" name="mynewpassword2" size="10"><br>
959 <input type="submit" value="$resource{changepasswordbutton}"><br>
960 </form>
961 EOD
962 }
963
964 sub is_editable {
965 my ($page) = @_;
966 if (&is_bracket_name($page)) {
967 return 0;
968 } elsif ($fixedpage{$page}) {
969 return 0;
970 } elsif ($page =~ /\s/) {
971 return 0;
972 } elsif ($page =~ /^\#/) {
973 return 0;
974 } elsif ($page =~ /^$interwiki_name$/) {
975 return 0;
976 } else {
977 return 1;
978 }
979 }
980
981 # armor_name:
982 # WikiName -> WikiName
983 # not_wiki_name -> [[not_wiki_name]]
984 sub armor_name {
985 my ($name) = @_;
986 if ($name =~ /^$wiki_name$/) {
987 return $name;
988 } else {
989 return "[[$name]]";
990 }
991 }
992
993 # unarmor_name:
994 # [[bracket_name]] -> bracket_name
995 # WikiName -> WikiName
996 sub unarmor_name {
997 my ($name) = @_;
998 if ($name =~ /^$bracket_name$/) {
999 return $1;
1000 } else {
1001 return $name;
1002 }
1003 }
1004
1005 sub is_bracket_name {
1006 my ($name) = @_;
1007 if ($name =~ /^$bracket_name$/) {
1008 return 1;
1009 } else {
1010 return 0;
1011 }
1012 }
1013
1014 sub decode {
1015 my ($s) = @_;
1016 $s =~ tr/+/ /;
1017 $s =~ s/%([A-Fa-f0-9][A-Fa-f0-9])/pack("C", hex($1))/eg;
1018 return $s;
1019 }
1020
1021 sub encode {
1022 my ($s) = @_;
1023 my $encoded = '';
1024 foreach my $ch (split(//, $s)) {
1025 if ($ch =~ /[A-Za-z0-9_]/) {
1026 $encoded .= $ch;
1027 } else {
1028 $encoded .= '%' . sprintf("%02X", ord($ch));
1029 }
1030 }
1031 return $encoded;
1032 }
1033
1034 sub init_resource {
1035 open(FILE, $file_resource) or &print_error("(resource)");
1036 while (<FILE>) {
1037 chomp;
1038 next if /^#/;
1039 my ($key, $value) = split(/=/, $_, 2);
1040 $resource{$key} = &code_convert(\$value, $kanjicode);
1041 }
1042 close(FILE);
1043 }
1044
1045 sub conflict {
1046 my ($page, $rawmsg) = @_;
1047 if ($form{myLastModified} eq &get_info($page, $info_LastModified)) {
1048 return 0;
1049 }
1050 open(FILE, $file_conflict) or &print_error("(conflict)");
1051 my $content = join('', <FILE>);
1052 &code_convert(\$content, $kanjicode);
1053 close(FILE);
1054 &print_header($page);
1055 &print_content($content);
1056 &print_editform($rawmsg, $form{myLastModified}, frozen=>0, conflict=>1);
1057 &print_footer($page);
1058 return 1;
1059 }
1060
1061 sub get_now {
1062 my (@week) = qw(Sun Mon Tue Wed Thu Fri Sat);
1063 my ($sec, $min, $hour, $day, $mon, $year, $weekday) = localtime(time);
1064 $year += 1900;
1065 $mon++;
1066 $mon = "0$mon" if $mon < 10;
1067 $day = "0$day" if $day < 10;
1068 $hour = "0$hour" if $hour < 10;
1069 $min = "0$min" if $min < 10;
1070 $sec = "0$sec" if $sec < 10;
1071 $weekday = $week[$weekday];
1072 return "$year-$mon-$day ($weekday) $hour:$min:$sec";
1073 }
1074
1075 # [[YukiWiki http://www.hyuki.com/yukiwiki/wiki.cgi?euc($1)]]
1076 sub init_InterWikiName {
1077 my $content = $database{$InterWikiName};
1078 while ($content =~ /\[\[(\S+) +(\S+)\]\]/g) {
1079 my ($name, $url) = ($1, $2);
1080 $interwiki{$name} = $url;
1081 }
1082 }
1083
1084 sub interwiki_convert {
1085 my ($type, $localname) = @_;
1086 if ($type eq 'sjis' or $type eq 'euc') {
1087 &code_convert(\$localname, $type);
1088 return &encode($localname);
1089 } elsif ($type eq 'ykwk') {
1090 # for YukiWiki1
1091 if ($localname =~ /^$wiki_name$/) {
1092 return $localname;
1093 } else {
1094 &code_convert(\$localname, 'sjis');
1095 return &encode("[[" . $localname . "]]");
1096 }
1097 } elsif ($type eq 'asis') {
1098 return $localname;
1099 # Walrus add (4) start
1100 } elsif ($type eq 'isbn') {
1101 $localname = join('', ($localname =~ /[0-9x]/g)) if ($localname =~ /^(\d-?){9}[\dx]$/);
1102 return $localname;
1103 # Walrus add (4) end
1104 } else {
1105 return $localname;
1106 }
1107 }
1108
1109 sub get_info {
1110 my ($page, $key) = @_;
1111 my %info = map { split(/=/, $_, 2) } split(/\n/, $infobase{$page});
1112 return $info{$key};
1113 }
1114
1115 sub set_info {
1116 my ($page, $key, $value) = @_;
1117 my %info = map { split(/=/, $_, 2) } split(/\n/, $infobase{$page});
1118 $info{$key} = $value;
1119 my $s = '';
1120 for (keys %info) {
1121 $s .= "$_=$info{$_}\n";
1122 }
1123 $infobase{$page} = $s;
1124 }
1125
1126 sub frozen_reject {
1127 my ($isfrozen) = &get_info($form{mypage}, $info_IsFrozen);
1128 my ($willbefrozen) = $form{myfrozen};
1129 if (not $isfrozen and not $willbefrozen) {
1130 # You need no check.
1131 return 0;
1132 } elsif (valid_password($form{mypassword})) {
1133 # You are admin.
1134 return 0;
1135 } else {
1136 &print_error($resource{passworderror});
1137 return 1;
1138 }
1139 }
1140
1141 sub valid_password {
1142 my ($givenpassword) = @_;
1143 my ($validpassword_crypt) = &get_info($AdminSpecialPage, $info_AdminPassword);
1144 if (crypt($givenpassword, $validpassword_crypt) eq $validpassword_crypt) {
1145 return 1;
1146 } else {
1147 return 0;
1148 }
1149 }
1150
1151 sub is_frozen {
1152 my ($page) = @_;
1153 if (&get_info($page, $info_IsFrozen)) {
1154 return 1;
1155 } else {
1156 return 0;
1157 }
1158 }
1159
1160 sub do_comment {
1161 my ($content) = $database{$form{mypage}};
1162 my $datestr = &get_now;
1163 my $namestr = $form{myname} ? " ''[[$form{myname}]]'' : " : " ";
1164 if ($content =~ s/(\Q$embed_comment\E)/- $datestr$namestr$form{mymsg}\n$1/) {
1165 ;
1166 } else {
1167 $content =~ s/(\Q$embed_rcomment\E)/$1\n- $datestr$namestr$form{mymsg}/;
1168 }
1169 if ($form{mymsg}) {
1170 $form{mymsg} = $content;
1171 $form{mytouch} = 'on';
1172 &do_write;
1173 } else {
1174 $form{mycmd} = 'read';
1175 &do_read;
1176 }
1177 }
1178
1179 sub embedded_to_html {
1180 my ($embedded) = @_;
1181 if ($embedded eq $embed_comment or $embedded eq $embed_rcomment) {
1182 my $lastmodified = &get_info($form{mypage}, $info_LastModified);
1183 return <<"EOD";
1184 <form action="$url_cgi" method="post">
1185 <input type="hidden" name="mycmd" value="comment">
1186 <input type="hidden" name="mypage" value="$form{mypage}">
1187 <input type="hidden" name="myLastModified" value="$lastmodified">
1188 <input type="hidden" name="mytouch" value="on">
1189 $resource{yourname}
1190 <input type="text" name="myname" value="" size="10">
1191 <input type="text" name="mymsg" value="" size="40">
1192 <input type="submit" value="$resource{commentbutton}">
1193 </form>
1194 EOD
1195 # Walrus add (5) start
1196 } elsif ($embedded =~ /$embed_interwiki/ and my $remoteurl = $interwiki{$2}) {
1197 $_ = &make_interwiki_box($1, $2);
1198 return ($_) ? $_ : $embedded;
1199 # Walrus add (5) end
1200 } else {
1201 return $embedded;
1202 }
1203 }
1204
1205 # Walrus add (5) start
1206 sub do_interwiki_box {
1207 my $remoteurl = $interwiki{$form{'myintername'}};
1208 if ($remoteurl) {
1209 $remoteurl =~ s/\b(euc|sjis|ykwk|asis|isbn)\(\$1\)/&interwiki_convert($1, $form{'mylocalname'})/e;
1210 print "Location: $remoteurl\n\n";
1211 exit(1);
1212 } else {
1213 &do_read;
1214 }
1215 }
1216 # Walrus add (5) end
1217
1218 # Walrus add (5) start
1219 sub make_interwiki_box {
1220 my ($localname, $intername) = @_;
1221 my %ignoretype = (
1222 'box' => 'text',
1223 'text' => 'text',
1224 'pass' => 'password',
1225 'password' => 'password'
1226 );
1227 my $converted = ($ignoretype{$localname}) ? <<EOD : undef;
1228 <form action="$url_cgi" method="post">
1229 <input type="hidden" name="mycmd" value="interwikibox">
1230 <input type="hidden" name="mypage" value="$form{mypage}">
1231 <input type="hidden" name="myintername" value="$intername">
1232 $intername:
1233 <input type="$ignoretype{$localname}" name="mylocalname" value="" size="10">
1234 <input type="submit" value="Submit">
1235 </form>
1236 EOD
1237 }
1238 # Walrus add (5) end
1239
1240 sub code_convert {
1241 my ($contentref, $kanjicode) = @_;
1242 # &Jcode::convert($contentref, $kanjicode); # for Jcode.pm
1243 &jcode::convert($contentref, $kanjicode); # for jcode.pl
1244 return $$contentref;
1245 }
1246
1247 sub test_convert {
1248 my $txt = &text_to_html(<<"EOD", toc=>1);
1249 *HEADER1
1250 **HEADER1-1
1251 -ITEM1
1252 -ITEM2
1253 -ITEM3
1254 PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1
1255 PAR1PAR1PAR1PAR1PAR1PAR1''BOLD''PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1
1256 PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1
1257
1258 PAR2PAR2PAR2PAR2PAR2PAR2PAR2PAR2PAR2PAR2PAR2PAR2PAR2PAR2PAR2PAR2
1259 PAR2PAR2PAR2PAR2PAR2PAR2'''ITALIC'''PAR2PAR2PAR2PAR2PAR2PAR2PAR2
1260 PAR2PAR2PAR2PAR2PAR2PAR2PAR2PAR2PAR2PAR2PAR2PAR2PAR2PAR2PAR2PAR2
1261 **HEADER1-2
1262 :TERM1:DESCRIPTION1 AND ''BOLD''
1263 PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1
1264 PAR1PAR1PAR1PAR1PAR1PAR1''BOLD''PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1
1265 PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1
1266 :TERM2:DESCRIPTION2
1267 :TERM3:DESCRIPTION3
1268 ----
1269 *HEADER2
1270 **HEADER2-1
1271 http://www.hyuki.com/
1272 **HEADER2-2
1273
1274 [[YukiWiki2]]
1275
1276 PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1
1277 PAR1PAR1PAR1PAR1PAR1PAR1'''''BOLD ITALIC'''''PAR1PAR1PAR1PAR1PAR1
1278 PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1
1279 >PAR2PAR2PAR2PAR2PAR2PAR2PAR2PAR2PAR2PAR2PAR2PAR2PAR2PAR2PAR2PAR2
1280 >PAR2PAR2PAR2PAR2PAR2PAR2'''ITALIC'''PAR2PAR2PAR2PAR2PAR2PAR2PAR2
1281 >PAR2PAR2PAR2PAR2PAR2PAR2PAR2PAR2PAR2PAR2PAR2PAR2PAR2PAR2PAR2PAR2
1282
1283 LEVEL0LEVEL0LEVEL0LEVEL0LEVEL0LEVEL0LEVEL0
1284
1285 >LEVEL1
1286 >LEVEL1
1287 >LEVEL1
1288 >>LEVEL2
1289 >>LEVEL2
1290 >>LEVEL2
1291 >>>LEVEL3
1292 -HELLO-1
1293 --HELLO-2
1294 (HELLO-2, HELLO-2, HELLO-2)
1295 ---HELLO-3
1296 (HELLO-3, HELLO-3, HELLO-3)
1297 --HELLO-2
1298 ---HELLO-3
1299 --HELLO-2
1300 ---HELLO-3
1301 >>>LEVEL3
1302 >>>LEVEL3
1303 >>>LEVEL3
1304 >>>LEVEL3
1305 EOD
1306 print $txt;
1307 exit;
1308 }
1309
1310 sub do_diff {
1311 if (not &is_editable($form{mypage})) {
1312 &do_read;
1313 return;
1314 }
1315 &open_diff;
1316 my $title = $form{mypage};
1317 &print_header($title);
1318 $_ = &escape($diffbase{$form{mypage}});
1319 &close_diff;
1320 print qq(<h3>$resource{difftitle}</h3>);
1321 print qq($resource{diffnotice});
1322 print qq(<pre class="diff">);
1323 foreach (split(/\n/, $_)) {
1324 if (/^\+(.*)/) {
1325 print qq(<b class="added">$1</b>\n);
1326 } elsif (/^\-(.*)/) {
1327 print qq(<s class="deleted">$1</s>\n);
1328 } elsif (/^\=(.*)/) {
1329 print qq(<span class="same">$1</span>\n);
1330 } else {
1331 print qq|??? $_\n|;
1332 }
1333 }
1334 print qq(</pre>);
1335 print qq(<hr>);
1336 &print_footer($title);
1337 }
1338
1339 sub do_rss {
1340 my $rss = new Yuki::RSS(
1341 version => '1.0',
1342 encoding => $charset,
1343 );
1344 $rss->channel(
1345 title => $modifier_rss_title,
1346 link => $modifier_rss_link,
1347 description => $modifier_rss_description,
1348 );
1349 my $recentchanges = $database{$RecentChanges};
1350 my $count = 0;
1351 foreach (split(/\n/, $recentchanges)) {
1352 last if ($count >= 15);
1353 /^\- \d\d\d\d\-\d\d\-\d\d \(...\) \d\d:\d\d:\d\d (\S+)/; # date format.
1354 my $title = &unarmor_name($1);
1355 my $escaped_title = &escape($title);
1356 my $link = $modifier_rss_link . '?' . &encode($title);
1357 my $description = $escaped_title . &escape(&get_subjectline($title));
1358 $rss->add_item(
1359 title => $escaped_title,
1360 link => $link,
1361 description => $description,
1362 );
1363 $count++;
1364 }
1365 # print RSS information (as XML).
1366 print <<"EOD"
1367 Content-type: text/xml
1368
1369 @{[$rss->as_string]}
1370 EOD
1371 }
1372
1373 sub is_exist_page {
1374 my ($name) = @_;
1375 if ($use_exists) {
1376 return exists($database{$name});
1377 } else {
1378 return $database{$name};
1379 }
1380 }
1381
1382 1;
1383 __END__
1384 =head1 NAME
1385
1386 wiki.cgi - This is YukiWiki, yet another Wiki clone.
1387
1388 =head1 DESCRIPTION
1389
1390 YukiWiki is yet another Wiki clone.
1391
1392 YukiWiki can treat Japanese WikiNames (enclosed with [[ and ]]).
1393 YukiWiki provides 'InterWiki' feature, RDF Site Summary (RSS),
1394 and some embedded commands (such as [[#comment]] to add comments).
1395
1396 Read F<readme_en.txt> (English) or F<readme_ja.txt> (Japanese) in more detail.
1397
1398 =head1 AUTHOR
1399
1400 Hiroshi Yuki <hyuki@hyuki.com> http://www.hyuki.com/yukiwiki/
1401
1402 =head1 LICENSE
1403
1404 Copyright (C) 2000-2002 by Hiroshi Yuki.
1405
1406 This program is free software; you can redistribute it and/or
1407 modify it under the same terms as Perl itself.
1408
1409 =cut

admin@suikawiki.org
ViewVC Help
Powered by ViewVC 1.1.24