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

Contents of /suikawiki/script/wiki.cgi

Parent Directory Parent Directory | Revision Log Revision Log


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

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

admin@suikawiki.org
ViewVC Help
Powered by ViewVC 1.1.24