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

Contents of /suikawiki/script/wiki.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.19 - (hide annotations) (download)
Sun Jun 2 06:28:30 2002 UTC (21 years, 11 months ago) by wakaba
Branch: MAIN
Changes since 1.18: +10 -8 lines
2002-06-02  wakaba <w@suika.fam.cx>

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

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

admin@suikawiki.org
ViewVC Help
Powered by ViewVC 1.1.24