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

Contents of /suikawiki/script/wiki.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.25 - (hide annotations) (download)
Sat Sep 28 09:43:07 2002 UTC (22 years, 1 month ago) by wakaba
Branch: MAIN
Changes since 1.24: +68 -33 lines
2002-09-28  Wakaba <w@suika.fam.cx>

	* wiki.cgi:
	- Intoduce text/css mode.
	- Anchorize news: URIs.
	- (armor_name): Bug fix of not anchorizing traditional Wiki name.
	- Indenting heading 3-5 in TOC.
	- Multi-comment support.
	- (print_footer): Embed #comment.
	- (print_editform): Use NewPageTemplate when new page.
	* wiki-style.css: Removed.

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

admin@suikawiki.org
ViewVC Help
Powered by ViewVC 1.1.24