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

Contents of /suikawiki/script/wiki.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.16 - (show annotations) (download)
Sun Jun 2 05:03:38 2002 UTC (21 years, 11 months ago) by wakaba
Branch: MAIN
Changes since 1.15: +1208 -1313 lines
2002-03-24  wakaba <w@suika.fam.cx>

	* wiki.cgi (inline): 
	- Ignore LinkLikeThis style anchor.
	- Allow [[space including anchor]].
	(make_link): Likewise.  Gets rid of angle branckets
	before make anchor.

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

admin@suikawiki.org
ViewVC Help
Powered by ViewVC 1.1.24