--- suikawiki/script/wiki.cgi 2002/04/23 10:14:12 1.15 +++ suikawiki/script/wiki.cgi 2002/06/02 05:03:38 1.16 @@ -1,1513 +1,1408 @@ #!/usr/bin/perl -use lib "../lib"; -use CGI::Carp 'fatalsToBrowser'; -use Algorithm::Diff qw(traverse_sequences); -# use strict; +#!perl # -# yukiwiki.cgi - Yet another WikiWikiWeb clone. +# wiki.cgi - This is YukiWiki, yet another Wiki clone. # -# Copyright (C) 2000,2001 by Hiroshi Yuki. +# Copyright (C) 2000-2002 by Hiroshi Yuki. # # http://www.hyuki.com/yukiwiki/ # -# This program is free software; you can redistribute it and/or modify -# it under the terms of the GNU General Public License as published by -# the Free Software Foundation; either version 2 of the License, or -# (at your option) any later version. +# This program is free software; you can redistribute it and/or +# modify it under the same terms as Perl itself. # -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# $Id: wiki.cgi,v 1.15 2002/04/23 10:14:12 wakaba Exp $ -############################## -my $version = "1.6.6"; -############################## -# 単独テストのときには 1 にする。 -my $testing = 0; -############################## -# 漢字ライブラリ -my $jcodelib = 'jcode.pl'; -############################## -# 保存・表示の漢字コード -my $kanjicode = 'euc'; # 'sjis' 'euc' -my $charset = 'euc-jisx0213'; # 'Shift_JIS' 'EUC-JP' -############################## -# dbmopenが使えるなら1、使えないなら0 -my $dbmopen = 0; -############################## -# データベース名（.pag, .dir, .dbなどは不要） -# $dbmopen = 1のときはデータベース名、 -# $dbmopen = 0のときはディレクトリ名になる。 -my $dbname = './wikidata'; -my $diffdbname = './wikidiff'; -############################## -# 修正者の氏名（自由に変更してください） -my $modifier = 'suika'; -############################## -# 修正者のWebページ（自由に変更してください） -my $modifierlink = 'http://suika.fam.cx/'; ############################## -# このページのURL -my $thisurl = 'wiki'; -############################## -# 開始ページ名 -my $toppage = 'HomePage'; -############################## -# 最終更新ページ名 -my $whatsnew = 'RecentChanges'; -############################## -# 最終更新に掲載するページ数 -my $maxnew = 50; -############################## -# アイコンファイル名（カラー版） -my $iconfile = ''; -############################## -# アイコンファイル名（モノクロ版） -# my $iconfile = ''; -############################## -# ページを変更したときにtouchするファイル（''なら何もしない） -my $touchfile = 'touch.txt'; -############################## -# プレビュー用の背景色 -my $preview_color = '#FFCCCC'; +# +# walwiki.cgi based on yukiwiki.cgi - Yet another WikiWikiWeb clone. +# +# WalWikiの現バージョンは、YukiWiki 2.0.beta1をベースにしています。 +# +# * 更新内容 +# +# 2.0.beta1.wal.1 on 2002/05/19,22:32:19 +# (1) Footerの変更 +# (2) WikiNameの拡張 : PerlCEも包含、PPMInstallは含まない +# (3) 別名リンク（[別名 URL]）に対応。 +# (4) ISBNをアマゾン.jpのAsociateプログラムリンクに変換。 +# (5) [[#box:InterWikiName]]でInterWikiなテキストボックス生成 +# (6) HTMLモード対応。 +# +# 旧2.0.alpha0.wal.3版までの修正の内、以下に変更があります。 +# ・以下はYukiWiki2に実装されたため、独自コードはなくなりました。 +# - インラインの画像変換 +# - YukiWikiDB対応 +# - テーブル +# - DB関連モジュールuseのeval化 +# - BracketNameによるキーからブラケットを排除 +# ・ISBN番号への対応はWalWiki2.0より、InterWikiへのAdd-Onになりました。 +# [[ISBN http://www.amazon.co.jp/exec/obidos/ASIN/isbn($1)/walrdigi-22]]のように登録。 +# +#======================================= + +# Walrus add (debug) start +my $walrus_log; +my $walrus_debugging = 0; +# Walrus add (debug) end + +# Libraries. +use strict; +use lib qw(./WalWiki/lib); +use CGI qw(:standard); +use CGI::Carp qw(fatalsToBrowser); +use Yuki::RSS; +use Yuki::DiffText qw(difftext); +use Yuki::YukiWikiDB; +use AnyDBM_File; +require 'jcode.pl'; +# use Jcode; +use Fcntl; +my $version = '2.0.beta1.2002-05-29'; ############################## -# 全ページのスタイル -my $style = <<'EOD'; -@import '/s/simpledoc'; -pre, dl, ul, ol, p, blockquote { line-height:120%; -margin-bottom: 1em} -a.wiki .mark {vertical-align: sub, color: GrayText} -a { text-decoration: none; } -a:link { color: #0000FF; background-color: #FFFFFF; } -a:visited { color: #9900CC; background-color: #FFFFFF; } -a:hover { text-decoration: underline; } -EOD +# +# You MUST modify following '$modifier_...' variables. +# +my $modifier_mail = 'w@suika.fam.cx'; # Your mail address, like 'walrus@digit.que.ne.jp'. +my $modifier_url = 'http://suika.fam.cx/~wakaba/'; # Your web page, like 'http://digit.que.ne.jp/work/'. +my $modifier_name = '和'; # Your name, like 'Makio Tsukamoto'. +# my $modifier_dbtype = 'AnyDBM_File'; # Fast, not available on some server, page size limited. +# my $modifier_dbtype = 'dbmopen'; # Fast, not available on some server, page size limited. +my $modifier_dbtype = 'YukiWikiDB'; # Slow, available on all environment. +# my $modifier_sendmail = '/usr/sbin/sendmail -t -n'; # Your sendmail. +my $modifier_sendmail = ''; # If you don't need mail notification. +my $modifier_dir_data = '../wiki'; # Your data directory. +my $modifier_rss_title = "WalWiki $walversion"; +my $modifier_rss_link = 'http://suika.fam.cx/~wakaba/-temp/wiki2/wiki'; # Blank is not allowed. +my $modifier_rss_description = 'This is WalWiki, yet another Wiki clone based on YukiWiki'; ############################## -# テキスト入力部分の大きさ +# +# You MAY modify following variables. +# +my $file_touch = "$modifier_dir_data/touched.txt"; +my $file_resource = "$modifier_dir_data/resource.txt"; +my $file_FrontPage = "$modifier_dir_data/frontpage.txt"; +my $file_conflict = "$modifier_dir_data/conflict.txt"; +my $file_format = "$modifier_dir_data/format.txt"; +my $url_cgi = 'wiki'; +my $url_stylesheet = './WalWiki/Theme/wiki.css'; +my $icontag = '*'; +my $maxrecent = 50; my $cols = 80; my $rows = 20; ############################## -my %form = (); -my %database = (); -my %diffbase = (); -my $diff_text = ''; -my @diff_added = (); -my @diff_deleted = (); -my $msgrefA; -my $msgrefB; -############################## -# 編集不可ページ名一覧 -my @uneditable = ( $whatsnew ); -############################## -# リンク用の正規表現 -# YukiWikiのリンクは2種類ある。 -# -# (1) WikiName (RecentChangesとかFrontPageのようなもの) -# (2) BracketName ([[結城浩]]とか[[トラブルシュート]]のようなもの) -# -# ※シフトJISの2バイト目には ']' が来うるので、 -# 文字']'を1つ多くとるようにしている。 # -my $WikiName = '([A-Z][a-z]+([A-Z][a-z]+)+)'; -my $BracketName = '\[\[([^>\x09]+?\]?)\]\]'; - -# アイコン部分のタグ -my $IconTag = ''; #<<"EOD"; -#[YukiWiki] -#EOD - -require "$jcodelib"; - -&init_form($kanjicode); - -if ($testing) { - %form = ( - # 'mycmd' => 'write', - 'mycmd' => 'read', - #'mycmd' => 'search', - #'mycmd' => 'edit', - 'mymsg' => <<"EOD", -はじめまして。 -これからいろいろ書き込みますね。 -LinkPageも見てください。 -TestPageはどうでしょうか。 -どうぞよろしく。 -http://www.hyuki.com/ -[[結城浩]] -EOD - 'mypage' => '<結城浩>', - 'myword' => '結', - # '3C8C8B8FE98D5F3E' => '', - # 'TestPage' => '', - ); -} +# You MAY, but do NOT NEED modify following variables. +# +my $dataname = "$modifier_dir_data/wiki"; +my $infoname = "$modifier_dir_data/info"; +my $diffname = "$modifier_dir_data/diff"; +my $editchar = '?'; +my $subject_delimiter = ' - '; +my $use_autoimg = 1; # automatically convert image URL into tag. +my $use_exists = 0; # If you can use 'exists' method for your DB. +############################## +my $InterWikiName = 'InterWikiName'; +my $RecentChanges = 'RecentChanges'; +my $AdminChangePassword = 'AdminChangePassword'; +my $CompletedSuccessfully = 'CompletedSuccessfully'; +my $FrontPage = 'FrontPage'; +my $IndexPage = 'IndexPage'; +my $SearchPage = 'SearchPage'; +my $CreatePage = 'CreatePage'; +my $ErrorPage = 'ErrorPage'; +my $RssPage = 'RssPage'; +my $AdminSpecialPage = 'Admin Special Page'; # must include spaces. +############################## +# my $wiki_name = '\b([A-Z][a-z]+([A-Z][a-z]+)+)\b'; # Walrus del (2) +my $wiki_name = '\b([A-Z][a-z]+([A-Z][a-z]*)+)\b'; # Walrus add (2) +my $bracket_name = '\[\[(\S+?)\]\]'; +my $embedded_name = '\[\[(#\S+?)\]\]'; +my $interwiki_definition = '\[\[(\S+?)\ (\S+?)\]\]'; +my $interwiki_name = '([^:]+):([^:].*)'; +############################## +my $embed_comment = '[[#comment]]'; +my $embed_rcomment = '[[#rcomment]]'; +my $embed_interwiki = '^\[\[#(box|text|password):(\S+)\]\]$'; # Walrus add (5) +############################## +my $info_LastModified = 'LastModified'; +my $info_IsFrozen = 'IsFrozen'; +my $info_AdminPassword = 'AdminPassword'; +############################## +my $kanjicode = 'euc'; +my $charset = 'EUC-JP'; +my $lang = 'ja'; +my %fixedpage = ( + $IndexPage => 1, + $CreatePage => 1, + $ErrorPage => 1, + $RssPage => 1, + $RecentChanges => 1, + $SearchPage => 1, + $AdminChangePassword => 1, + $CompletedSuccessfully => 1, + $FrontPage => 1, +); +my %form; +my %database; +my %infobase; +my %diffbase; +my %resource; +my %interwiki; +############################## +my %page_command = ( + $IndexPage => 'index', + $SearchPage => 'searchform', + $CreatePage => 'create', + $RssPage => 'rss', + $AdminChangePassword => 'adminchangepasswordform', + $FrontPage => 'FrontPage', +); +my %command_do = ( + read => \&do_read, + edit => \&do_edit, + adminedit => \&do_adminedit, + adminchangepasswordform => \&do_adminchangepasswordform, + adminchangepassword => \&do_adminchangepassword, + write => \&do_write, + index => \&do_index, + searchform => \&do_searchform, + search => \&do_search, + create => \&do_create, + createresult => \&do_createresult, + FrontPage => \&do_FrontPage, + comment => \&do_comment, + rss => \&do_rss, + diff => \&do_diff, + interwikibox => \&do_interwiki_box, # Walrus add (5) +); +############################## +my @ignore_html_page = ('FrontPage'); # Walrus add (6) +my @ignore_html_tags = ('a', 'br', 'img'); # Walrus add (6) +my $walversion = '2.0.beta1.wal.1'; # Walrus add (1) +############################## +# &test_convert; &main; exit(0); +############################## -# メイン sub main { - &normalize_form; - if ($dbmopen) { - if (!dbmopen(%database, $dbname, 0666)) { - &print_error("(dbmopen) $dbname が作れません。"); - } + &init_resource; + &open_db; + &init_form; + &init_InterWikiName; + if ($command_do{$form{mycmd}}) { + &{$command_do{$form{mycmd}}}; } else { - if (!tie(%database, "YukiWikiDB", $dbname)) { - &print_error("(tie error)"); - } - } - - # myspecial対応 - foreach (keys %form) { - if (/^myspecial_(.*)/) { - $form{mycmd} = $1; - last; - } - } - - if ($form{mycmd} eq 'read') { - &do_read; - } elsif ($form{mycmd} eq 'preview') { - &do_preview; - } elsif ($form{mycmd} eq 'write') { - &do_write; - } elsif ($form{mycmd} eq 'edit') { - &do_edit; - } elsif ($form{mycmd} eq 'reedit') { - &do_reedit; - } elsif ($form{mycmd} eq 'search') { - &do_search; - } elsif ($form{mycmd} eq 'list') { - &do_list; - } elsif ($form{mycmd} eq 'diff') { - &do_diff; - } else { - $form{mypage} = $toppage; - &do_read; - } - if ($dbmopen) { - dbmclose(%database); - } else { - untie(%database); + &do_FrontPage; } + &close_db; } -# ページの表示 sub do_read { - my $page_name = $form{mypage}; - my $percent_name = &encode_percent($page_name); - &print_header($page_name); - print qq|

$IconTag$page_name

\n|; - &print_toolbar($page_name); - print &convert_html(&get_page($page_name)); - &print_footer; + &print_header($form{mypage}); + &print_content($database{$form{mypage}}); + &print_footer($form{mypage}); } -# ページの編集 sub do_edit { - if (not &is_editable($form{mypage})) { - # 編集不可ページは表示のみ - &do_read; - return; + my ($page) = &unarmor_name(&armor_name($form{mypage})); + &print_header($page); + if (not &is_editable($page)) { + &print_message($resource{cantchange}); + } elsif (&is_frozen($page)) { + &print_message($resource{cantchange}); + } else { + &print_editform($database{$page}, &get_info($page, $info_LastModified), admin=>0); } - &editpage(&get_page($form{mypage})); + &print_footer($page); } -# ページの再編集 -sub do_reedit { - if (not &is_editable($form{mypage})) { - # 編集不可ページは表示のみ - &do_read; +sub do_adminedit { + my ($page) = &unarmor_name(&armor_name($form{mypage})); + &print_header($page); + if (not &is_editable($page)) { + &print_message($resource{cantchange}); } else { - &editpage($form{mymsg}); + &print_message($resource{passwordneeded}); + &print_editform($database{$page}, &get_info($page, $info_LastModified), admin=>1); } + &print_footer($page); } -sub editpage { - my $page_msg = shift; - my $page_name = $form{mypage}; - my $digest = &calc_message_digest($page_msg); - &print_header($page_name); - print qq|

$IconTag${page_name}の編集

\n|; - &print_toolbar($page_name); - $page_msg = &escape($page_msg); - print <<"EOD"; -
- - - -
- - -
-
-

テキスト整形のルール

- -

通常は入力した文字がそのまま出力されますが、 -以下のルールに従ってテキスト整形を行うことができます。

- - -EOD - &print_footer; +sub do_adminchangepasswordform { + &print_header($AdminChangePassword); + &print_passwordform; + &print_footer($AdminChangePassword); } -# ページの検索 -sub do_search { - if ($form{myword}) { - &print_header('検索結果'); - print qq|

$IconTag$form{myword}の検索結果

\n|; - &print_toolbar(); - print qq|\n|; - if ($count > 0) { - print qq|

$form{myword}を含むページは、上に示す$count ページです。

\n|; - } else { - print qq|

$form{myword}を含むページは見つかりません。

\n|; + } + my ($sec, $min, $hour, $day, $mon, $year, $weekday) = localtime(time); + my (@token) = ('0'..'9', 'A'..'Z', 'a'..'z'); + my $salt1 = $token[(time | $$) % scalar(@token)]; + my $salt2 = $token[($sec + $min*60 + $hour*60*60) % scalar(@token)]; + my $crypted = crypt($form{mynewpassword}, "$salt1$salt2"); + &set_info($AdminSpecialPage, $info_AdminPassword, $crypted); + + &print_header($CompletedSuccessfully); + &print_message($resource{passwordchanged}); + &print_footer($CompletedSuccessfully); +} + +sub do_index { + &print_header($IndexPage); + print qq(); + &print_footer($IndexPage); } -# ページの一覧 -sub do_list { - &print_header('ページ一覧'); - print qq|

$IconTag ページ一覧

\n|; - &print_toolbar(); - print qq|\n|; - &print_footer; -} - -# プレビュー -sub do_preview { - my $page_name = $form{mypage}; - my $escapedmsg = &escape($form{mymsg}); - &print_header($page_name); - print qq|

$IconTag${page_name}のプレビュー

\n|; - &print_toolbar($page_name); - # local $percent_name = &encode_percent($page_name); - print qq|

以下のプレビューを確認して、よければページ下部のボタンで更新してください。

\n|; - if ($form{mymsg}) { - print qq|
\n|; - # print &convert_html($escapedmsg); - print &convert_html($form{mymsg}); - print qq|
\n|; - } else { - print qq|

（ページの内容は空です。更新するとこのページは削除されます。）

\n|; +sub do_write { + if (&frozen_reject()) { + return; } - &print_preview_buttons($page_name, $escapedmsg, $form{mydigest}); - &print_footer; -} -sub print_preview_buttons { - my ($page_name, $escapedmsg, $digest) = @_; - print <<"EOD"; -
- -
- - - - -
-EOD -} - -# 書き込む -sub do_write { if (not &is_editable($form{mypage})) { - # 編集不可ページは表示のみ - &do_read; + &print_header($form{mypage}); + &print_message($resource{cantchange}); + &print_footer($form{mypage}); return; } - my $page_name = $form{mypage}; - - # digestを使って、更新の衝突チェック - my $original_digest = &calc_message_digest(&get_page($page_name)); - if ($form{mydigest} ne $original_digest) { - &print_header($page_name); - print qq|

$IconTag${page_name}で【更新の衝突】が起きました

\n|; - print <<"EOD"; -

あなたがこのページを編集している間に、 -他の人が同じページを更新してしまったようです。 -

-以下に、あなたの編集したテキストがありますので、 -あなたの編集内容が失われないように、 -いますぐ、メモ帳などにコピー＆ペーストしてください。 -

-コピー＆ペーストが済んでから、 -最新の内容を見て再度編集し直してください。 -最新の内容は -$form{mypage} -で見ることができます。 -

-EOD - # &print_toolbar($page_name); - &print_preview_buttons($page_name, &escape($form{mymsg}), $form{mydigest}); - &print_footer; + if (&conflict($form{mypage}, $form{mymsg})) { return; } - # diff生成 + # Making diff { - &opendiff; - my @msg1 = split(/\n/, &get_page($page_name)); + &open_diff; + my @msg1 = split(/\n/, $database{$form{mypage}}); my @msg2 = split(/\n/, $form{mymsg}); - $msgrefA = \@msg1; - $msgrefB = \@msg2; - &diff_check; - $diffbase{$form{mypage}} = $diff_text; - $diff_text = ''; - &closediff; + $diffbase{$form{mypage}} = &difftext(\@msg1, \@msg2); + &close_diff; } - &print_header($page_name); - &set_page($page_name, $form{mymsg}); if ($form{mymsg}) { - print qq|

$IconTag${page_name}を更新しました

\n|; - &print_toolbar($page_name); - print &convert_html(&get_page($page_name)); - } else { - print qq|

$IconTag${page_name}を削除しました

\n|; - &print_toolbar($page_name); - print qq|

${page_name}を削除しました。

\n|; - } - &print_footer; - # 更新されたのでタッチしておく。 - if ($touchfile) { - open(FILE, "> $touchfile"); - print FILE "\n"; - close(FILE); + $database{$form{mypage}} = $form{mymsg}; + &send_mail_to_admin($form{mypage}, "Modify"); + if ($form{mytouch}) { + &set_info($form{mypage}, $info_LastModified, '' . localtime); + &update_recent_changes; + } + &set_info($form{mypage}, $info_IsFrozen, 0 + $form{myfrozen}); + &print_header($CompletedSuccessfully); + &print_message($resource{saved}); + &print_content("$resource{continuereading} @{[&armor_name($form{mypage})]}"); + &print_footer($CompletedSuccessfully); + } else { + &send_mail_to_admin($form{mypage}, "Delete"); + delete $database{$form{mypage}}; + delete $infobase{$form{mypage}}; + if ($form{mytouch}) { + &update_recent_changes; + } + &print_header($form{mypage}); + &print_message($resource{deleted}); + &print_footer($form{mypage}); } } -# ページの変更点 -sub do_diff { - if (not &is_editable($form{mypage})) { - # 編集不可ページは表示のみ - &do_read; - return; - } - &opendiff; - &print_header($form{mypage} . 'の変更点'); - print qq|

$IconTag $form{mypage}の変更点

\n|; - &print_toolbar(); - $_ = &escape($diffbase{$form{mypage}}); - print <<"EOD"; - -
-EOD - print qq|
\n|;
-    foreach (split(/\n/, $_)) {
-        if (/^\+(.*)/) {
-            print qq|$1\n|;
-        } elsif (/^\-(.*)/) {
-            print qq|$1\n|;
-        } elsif (/^\=(.*)/) {
-            print qq|$1\n|;
-        } else {
-            print qq|??? $_\n|;
-        }
-    }
-    print qq|
\n|; - &print_footer; - &closediff; +sub do_searchform { + &print_header($SearchPage); + &print_searchform(""); + &print_footer($SearchPage); } -sub opendiff { - if ($dbmopen) { - if (!dbmopen(%diffbase, $diffdbname, 0666)) { - &print_error("(dbmopen) $diffdbname が作れません。"); +sub do_search { + my $word = &escape($form{mymsg}); + &print_header($SearchPage); + &print_searchform($word); + my $counter = 0; + foreach my $page (sort keys %database) { + next if $page =~ /^$RecentChanges$/; + if ($database{$page} =~ /\Q$form{mymsg}\E/ or $page =~ /\Q$form{mymsg}\E/) { + if ($counter == 0) { + print qq||; } + &print_footer($SearchPage); } -sub closediff { - if ($dbmopen) { - dbmclose(%diffbase); - } else { - untie(%diffbase); - } +sub do_create { + &print_header($CreatePage); + print <<"EOD"; +
+ + $resource{newpagename}
+ +
+
+EOD + &print_footer($CreatePage); } -# フォームからの情報を連想配列 %form に入れる -# &init_form('euc'); -sub init_form { - my ($charcode) = @_; - my $query; - if ($ENV{REQUEST_METHOD} =~ /^post$/i) { - read(STDIN, $query, $ENV{CONTENT_LENGTH}); - } else { - $query = $ENV{QUERY_STRING}; - } - my @assocarray = split(/[&;]/, $query); - foreach my $assoc (@assocarray) { - my ($property, $value) = split(/=/, $assoc); - $value =~ tr/+/ /; - $value =~ s/%([A-Fa-f0-9][A-Fa-f0-9])/pack("C", hex($1))/eg; - &jcode::convert(\$value, $charcode); - $form{$property} = $value; - } +sub do_FrontPage { + open(FILE, $file_FrontPage) or &print_error("($file_FrontPage)"); + my $content = join('', ); + &code_convert(\$content, $kanjicode); + close(FILE); + &print_header($FrontPage); + &print_content($content); + &print_footer($FrontPage); } -# エラーページを出力する sub print_error { my ($msg) = @_; - &print_header('Error'); - print "

$IconTag$msg

"; + &print_header($ErrorPage); + print qq(

$msg

); + &print_footer($ErrorPage); exit(0); } -sub escape { - my ($line) = shift; - $line =~ s|<|<|g; - $line =~ s|>|>|g; - $line =~ s|"|"|g; - # $line =~ s|\&|&|g; - return $line; -} - -sub inline { - my ($line) = shift; - $line = &escape($line); - $line =~ s|'''([^']+?)'''|$1|g; - $line =~ s|''([^']+?)''|$1|g; - $line =~ s! - ( - (?:<(?:mailto|http|https|ftp|urn):[\x21-\x7E]*)> - #| (?:$WikiName) # LocalLinkLikeThis - | (?:$BracketName) # [[日本語リンク]] - ) - ! - &make_link($1) - !gex; - return $line; -} - -# ページのタイトルからページの内容を得る -sub get_page { - my $page_name = shift; - return $database{$page_name} || $database{'[['.$page_name.']]'}; -} - -# ページの内容を与える -# &set_page($title, $txt) -sub set_page { - # ページを更新する - my $title = $_[0]; - $database{$title} = $_[1]; - # 空ページなら削除する - unless ($database{$title}) { - delete $database{$title}; - } - # RecentChangesを更新する - my $delim = ' - '; - my @pages = split(/\n/, $database{$whatsnew}); - my $datestr = &get_current_datestr; - unshift(@pages, qq|-$datestr$delim$title|); - # 同一ページの更新は最新のもののみにし、 - # 存在しないページはスキップする。 - my %count; - my @newpages; - foreach my $line (@pages) { - my ($prefix, $title) = split(/$delim/, $line); - $count{$title}++; - if ($count{$title} == 1 and exists($database{$title})) { - push(@newpages, qq|$prefix - $title|); - } - } - # ここで本当に更新 - $database{$whatsnew} = join("\n", splice(@newpages, 0, $maxnew)); -} - -# ページのヘッダを出力 sub print_header { - my $title = shift; + my ($page) = @_; + my $bodyclass = "normal"; + my $editable = 0; + my $admineditable = 0; + if (&is_frozen($page) and $form{mycmd} =~ /^(read|write)$/) { + $editable = 0; + $admineditable = 1; + $bodyclass = "frozen"; + } elsif (&is_editable($page) and $form{mycmd} =~ /^(read|write)$/) { + $admineditable = 1; + $editable = 1; + } else { + $editable = 0; + } + my $cookedpage = &encode($page); print <<"EOD"; -Content-type: text/html; charset=${charset} +Content-type: text/html; charset=$charset - -$title - + + + + + + $page @{[&escape(&get_subjectline($page))]} + + + - + +
+ @{[ $admineditable + ? qq($resource{admineditbutton} | ) + : qq() + ]} + @{[ $editable + ? qq($resource{editbutton} | ) + : qq() + ]} + @{[ $admineditable + ? qq($resource{diffbutton} | ) + : qq() + ]} + $resource{createbutton} | + $resource{indexbutton} | + $resource{rssbutton} | + $FrontPage | + $resource{searchbutton} | + $resource{recentchangesbutton} +
+

$page@{[&escape(&get_subjectline($page))]}

EOD } -# ツールバーを出力 -sub print_toolbar { - my $page_name = shift; - my $percent_name = &encode_percent($page_name); - my $editlink = ''; - if ($page_name ne '' and &is_editable($page_name)) { - $editlink = <<"EOD"; -編集 | -差分 | -EOD - } +sub print_footer { + my ($page) = @_; + $walrus_log = ($walrus_debugging) ? &text_to_html("----\n$walrus_log") : ''; # Walrus add (debug) + # Walrus mod (1) start + my $mod_info = $modifier_name ? qq(Modified by $modifier_name.) : ''; print <<"EOD"; +
+

- [ -トップ | -一覧 | -$editlink -単語検索 | -最近の更新 - ] +WalWiki $walversion © 2000-2002 by Makio Tsukamoto.
+based on YukiWiki $version © 2000-2002 by Hiroshi Yuki.
+$mod_info

-EOD -} - -# ページのフッタを出力 -sub print_footer { - print <<"EOD"; -
-[/ -地図 -検索]
+$walrus_log + + EOD - print <<'EOH'; -
-YukiWiki 1.6.6 -Copyright © 2000,2001 by Hiroshi Yuki. - -$Revision: 1.15 $ $Date: 2002/04/23 10:14:12 $ - -
- -EOH +# print <<"EOD"; +#
+#
+# YukiWiki $version +# © 2000-2002 by Hiroshi Yuki.
+# Modified by $modifier_name. +#
+#

+# $icontag +#

+# +# +# EOD + # Walrus mod (1) end } -# URLやページの名前からリンクを作る -sub make_link { - my $name = shift; - $name =~ s/^<(.*)>$/$1/; - $name =~ s/^\[\[(.*)\]\]$/$1/; - if ($name =~ /^(http|https|ftp).*?(\.png|\.jpeg|\.jpg)?$/) { - if ($2) { - return qq||; - } else { - return qq|<$name>|; - } - } elsif ($name =~ /^mailto:(.*)/) { - my $address = $1; - return qq|<$address>|; - } elsif ($name =~ m#^urn:[0-9A-Za-z_:;/.-]+#) { - return qq|<$name>|; - } else { - my $name2 = $name; $name2 =~ tr/\x20/-/; - if ($database{$name2}) { - my $percent_name = &encode_percent($name2); - return qq|$name|; - } elsif ($database{'[['.$name2.']]'}) { - my $percent_name = &encode_percent('[['.$name2.']]'); - return qq|$name|; - } else { - my $percent_name = &encode_percent($name2); - return qq|$name?|; - } - } -} - -# %xx の形式にエンコードする -# これは、 -# http://www.hyuki.com/yukiwiki/yukiwiki.cgi?mycmd=read&mypage=%3C%8C%8B%8F%E9%8D_%3E -# という形式のために使われる。 -# '<結城浩>' → '%3C%8C%8B%8F%E9%8D_%3E' -sub encode_percent { - my $name = shift; - my $encoded = ''; - foreach my $ch (split(//, $name)) { - if ($ch =~ /[A-Za-z0-9_]/) { - $encoded .= $ch; - } else { - $encoded .= '%' . sprintf("%02X", ord($ch)); - } - } - return $encoded; +sub escape { + my $s = shift; + $s =~ s|\r\n|\n|g; + $s =~ s|\&|&|g; + $s =~ s|<|<|g; + $s =~ s|>|>|g; + $s =~ s|"|"|g; + return $s; +} + +sub unescape { + my $s = shift; + # $s =~ s|\n|\r\n|g; + $s =~ s|\&|\&|g; + $s =~ s|\<|\<|g; + $s =~ s|\>|\>|g; + $s =~ s|\"|\"|g; + return $s; +} + +sub print_content { + my ($rawcontent) = @_; + print &text_to_html($rawcontent, toc=>1); } -# テキスト本体をHTMLに変換する -sub convert_html { - my ($txt) = shift; +sub text_to_html { + my ($txt, %option) = @_; my (@txt) = split(/\n/, $txt); - push (@result, '

'); ## ad hoc... + my (@toc); + my $tocnum = 0; + my (@saved, @result); + unshift(@saved, "

"); + push(@result, "

"); foreach (@txt) { chomp; - if (/^\*\*\*\*\*(.*)/) { - push(@result, splice(@saved), '

' . &inline($1) . '
'); - } elsif (/^\*\*\*\*(.*)/) { - push(@result, splice(@saved), '
' . &inline($1) . '
'); - } elsif (/^\*\*\*(.*)/) { - push(@result, splice(@saved), '

' . &inline($1) . '

'); + # Walrus mod (6) start + if ($saved[0] eq '') { + if (/<\/html>/i) { splice(@saved); } + else { push (@result, &html_to_ignored_html($_)); } + } elsif (/^/i and &is_ignore_html($form{mypage})) { + push(@result, splice(@saved)); + push(@saved, ''); } elsif (/^\*\*(.*)/) { - push(@result, splice(@saved), '

' . &inline($1) . '

'); + # if (/^\*\*(.*)/) { + # Walrus mod (6) end + push(@toc, qq(-- @{[&escape($1)]}\n)); + push(@result, splice(@saved), qq(

) . &inline($1) . '

'); + $tocnum++; } elsif (/^\*(.*)/) { - push(@result, splice(@saved), '

' . &inline($1) . '

'); + push(@toc, qq(- @{[&escape($1)]}\n)); + push(@result, splice(@saved), qq(

) . &inline($1) . '

'); + $tocnum++; } elsif (/^----/) { push(@result, splice(@saved), '
'); } elsif (/^(-{1,3})(.*)/) { - &back_push('ul', length($1)); - push(@result, '
  • ' . &inline($2) . '
    • '); - } elsif (/^(={1,3})(.*)/) { - &back_push('ol', length($1)); + &back_push('ul', length($1), \@saved, \@result); push(@result, '
  • ' . &inline($2) . '
    • '); } elsif (/^:([^:]+):(.*)/) { - &back_push('dl', 1); + &back_push('dl', 1, \@saved, \@result); push(@result, '
    ' . &inline($1) . '
    ', '
    ' . &inline($2) . '
    '); } elsif (/^(>{1,3})(.*)/) { - &back_push('blockquote', length($1)); + &back_push('blockquote', length($1), \@saved, \@result); push(@result, &inline($2)); } elsif (/^\s*$/) { push(@result, splice(@saved)); unshift(@saved, "

    "); push(@result, "

    "); } elsif (/^(\s+.*)$/) { - &back_push('pre', 1); - #push(@result, &escape($1)); # Not &inline, but &escape - push(@result, &inline($1)); # Not &inline, but &escape + &back_push('pre', 1, \@saved, \@result); + push(@result, &escape($1)); # Not &inline, but &escape +# } elsif (/^\,(.*)$/) { # Walrus del (BF) + } elsif (/^\,(.*?)[\x0D\x0A]*$/) { # Walrus add (BF) + &back_push('table', 1, \@saved, \@result, ' border="1"'); + ####### + # This part is taken from Mr. Ohzaki's Perl Memo and Makio Tsukamoto's WalWiki. + # XXXXX + my $tmp = "$1,"; + my @value = map {/^"(.*)"$/ ? scalar($_ = $1, s/""/"/g, $_) : $_} ($tmp =~ /("[^"]*(?:""[^"]*)*"|[^,]*),/g); + my @align = map {(s/^\s+//) ? ((s/\s+$//) ? ' align="center"' : ' align="right"') : ''} @value; + my @colspan = map {($_ eq '==') ? 0 : 1} @value; + for (my $i = 0; $i < @value; $i++) { + if ($colspan[$i]) { + while ($i + $colspan[$i] < @value and $value[$i + $colspan[$i]] eq '==') { + $colspan[$i]++; + } + $colspan[$i] = ($colspan[$i] > 1) ? sprintf(' colspan="%d"', $colspan[$i]) : ''; + $value[$i] = sprintf('%s', $align[$i], $colspan[$i], &inline($value[$i])); + } else { + $value[$i] = ''; + } + } + push(@result, join('', '', @value, '')); + # XXXXX + ####### } else { push(@result, &inline($_)); } } push(@result, splice(@saved)); - return join("\n", @result); + + if ($option{toc}) { + # Convert @toc (table of contents) to HTML. + # This part is taken from Makio Tsukamoto's WalWiki. + my (@tocsaved, @tocresult); + foreach (@toc) { + if (/^(-{1,3})(.*)/) { + &back_push('ul', length($1), \@tocsaved, \@tocresult); + push(@tocresult, '

  • ' . $2 . '
    • '); + } + } + push(@tocresult, splice(@tocsaved)); + return join("\n", @tocresult, @result); + } else { + return join("\n", @result); + } } -# &back_push($tag, $count) -# $tagのタグを$levelレベルまで詰める。 sub back_push { - my ($tag, $level) = @_; - while (@saved > $level) { - push(@result, shift(@saved)); - } - if ($saved[0] ne "") { - push(@result, splice(@saved)); - } - while (@saved < $level) { - unshift(@saved, ""); - push(@result, "<$tag>"); + my ($tag, $level, $savedref, $resultref, $attr) = @_; + while (@$savedref > $level) { + push(@$resultref, shift(@$savedref)); + } + if ($savedref->[0] ne "") { + push(@$resultref, splice(@$savedref)); + } + while (@$savedref < $level) { + unshift(@$savedref, ""); + push(@$resultref, "<$tag$attr>"); } } -# 編集可能ページか？ -sub is_editable {return 1; -## TODO: ... - my ($pagename) = @_; - foreach (@uneditable) { - if ($pagename eq $_) { - return 0; +sub inline { + my ($line) = @_; + $line = &escape($line); + $line =~ s|'''([^']+?)'''|$1|g; # Italic + $line =~ s|''([^']+?)''|$1|g; # Bold + $line =~ s|(\d\d\d\d-\d\d-\d\d \(\w\w\w\) \d\d:\d\d:\d\d)|$1|g; # Date + $line =~ s! + ( + ((mailto|http|https|ftp):([^\x00-\x20()<>\x7F-\xFF])*) # Direct http://... + | + ($bracket_name) # [[likethis]], [[#comment]], [[Friend:remotelink]] + | + ($interwiki_definition) # [[Friend http://somewhere/?q=sjis($1)]] + | + ($wiki_name) # LocalLinkLikeThis + ) + ! + &make_link($1) + !gex; + return $line; +} + +sub make_link { + my $chunk = shift; + # Walrus add (3) start + my $name = $chunk; + if ($chunk =~ /^\[\[([^ ]+?) ([^ ]+?)\]\]$/ and $form{mypage} ne $InterWikiName) { + ($name, $chunk) = ($1, $2); + } elsif ($chunk =~ /^mailto:(.*)$/) { + $name = $1; + } + if ($use_autoimg and $name =~ /^(http|https|ftp|):.+\.(png|gif|jpe?g)/) { + $name = qq() ; + } + $name = &unarmor_name($name); + # Walrus add (3) end + if ($chunk =~ /^(http|https|ftp):/) { + # Walrus mod (3) start +# if ($use_autoimg and $chunk =~ /\.(gif|png|jpeg|jpg)$/) { +# return qq(); +# } else { +# return qq($chunk); +# } + return qq($name); + # Walrus mod (3) end + } elsif ($chunk =~ /^(mailto):(.*)/) { +# return qq($2); # Walrus del (3) + return qq($name); # Walrus add (3) + } elsif ($chunk =~ /^$interwiki_definition$/) { +# return qq($chunk); # Walrus del (3) + return qq($name); # Walrus add (3) + } elsif ($chunk =~ /^$embedded_name$/) { + return &embedded_to_html($chunk); + } else { + $chunk = &unarmor_name($chunk); + $chunk = &unescape($chunk); # To treat '&' or '>' or '<' correctly. + my $cookedchunk = &encode($chunk); + if ($chunk =~ /^$interwiki_name$/) { + my ($intername, $localname) = ($1, $2); + my $remoteurl = $interwiki{$intername}; + if ($remoteurl) { +# $remoteurl =~ s/\b(euc|sjis|ykwk|asis)\(\$1\)/&interwiki_convert($1, $localname)/e; # Walrus del (4) + $remoteurl =~ s/\b(euc|sjis|ykwk|asis|isbn)\(\$1\)/&interwiki_convert($1, $localname)/e; # Walrus add (4) +# return qq($chunk); # Walrus del (3) + return qq($name); # Walrus add (3) + } else { +# return $chunk; # Walrus del (3) + return $name; # Walrus add (3) + } + } elsif ($database{$chunk}) { + my $subject = &escape(&get_subjectline($chunk, delimiter => '')); +# return qq($chunk); # Walrus del (3) + return qq($name); # Walrus add (3) + } elsif ($page_command{$chunk}) { +# return qq($chunk); # Walrus del (3) + return qq($name); # Walrus add (3) + } else { +# return qq($chunk$editchar); # Walrus del (3) + return qq($name$editchar); # Walrus add (3) } } - if (&is_valid_name($pagename)) { - return 1; +} + +# Walrus add (6) start +sub is_ignore_html { + my ($pagename) = @_; + foreach (@ignore_html_page) { + return 1 if ($pagename eq $_); } return 0; } +# Walrus add (6) end -# Validな名前か? -sub is_valid_name { - my ($pagename) = @_; - if ($pagename =~ /^$WikiName$/) { - return 1; - } elsif ($pagename =~ /^$BracketName$/) { - return 1; +# Walrus add (6) start +sub html_to_ignored_html { + my $str = shift(@_); + my $text_regex = q{[^<]*}; + my $tag_regex_ = q{[^"'<>]*(?:"[^"]*"[^"'<>]*|'[^']*'[^"'<>]*)*(?:>|(?=<)|$(?!\n))}; #'}}}} + my $comment_tag_regex = '-]*(?:-[^>-]+)*?)??)*(?:>|$(?!\n)|--.*$)'; + my $tag_regex = qq{$comment_tag_regex|<$tag_regex_}; + my $ignored = join('|', @ignore_html_tags); + my $result = ''; + while ($str =~ /($text_regex)($tag_regex)?/gso) { + last if $1 eq '' and $2 eq ''; + $result .= $1; + my $tag_tmp = $2; + $result .= ($tag_tmp =~ /^<\/?($ignored)(?![0-9A-Za-z])/i) ? $tag_tmp : &escape($tag_tmp); + if ($tag_tmp =~ /^<(XMP|PLAINTEXT|SCRIPT)(?![0-9A-Za-z])/i) { + $str =~ /(.*?)(?:<\/$1(?![0-9A-Za-z])$tag_regex_|$)/gsi; + $result .= &escape($1); + } + } + return $result; +} +# Walrus add (6) end + +sub print_message { + my ($msg) = @_; + print qq(

    $msg

    ); +} + +sub init_form { + if (param()) { + foreach my $var (param()) { + $form{$var} = param($var); + } } else { - return 0; + $ENV{QUERY_STRING} = $FrontPage; + } + + my $query = &decode($ENV{QUERY_STRING}); + if ($page_command{$query}) { + $form{mycmd} = $page_command{$query}; + $form{mypage} = $query; + } elsif ($query =~ /^($wiki_name)$/) { + $form{mycmd} = 'read'; + $form{mypage} = $1; + } elsif ($database{$query}) { + $form{mycmd} = 'read'; + $form{mypage} = $query; + } + + # mypreview_edit -> do_edit, with preview. + # mypreview_adminedit -> do_adminedit, with preview. + # mypreview_write -> do_write, without preview. + foreach (keys %form) { + if (/^mypreview_(.*)$/) { + $form{mycmd} = $1; + $form{mypreview} = 1; + } + } + + # + # $form{mycmd} is frozen here. + # + + $form{mymsg} = &code_convert(\$form{mymsg}, $kanjicode); + $form{myname} = &code_convert(\$form{myname}, $kanjicode); +} + +sub update_recent_changes { + my $update = "- @{[&get_now]} @{[&armor_name($form{mypage})]} @{[&get_subjectline($form{mypage})]}"; + my @oldupdates = split(/\r?\n/, $database{$RecentChanges}); + my @updates; + foreach (@oldupdates) { + /^\- \d\d\d\d\-\d\d\-\d\d \(...\) \d\d:\d\d:\d\d (\S+)/; # date format. + my $name = &unarmor_name($1); + if (&is_exist_page($name) and ($name ne $form{mypage})) { + push(@updates, $_); + } + } + if (&is_exist_page($form{mypage})) { + unshift(@updates, $update); + } + splice(@updates, $maxrecent + 1); + $database{$RecentChanges} = join("\n", @updates); + if ($file_touch) { + open(FILE, "> $file_touch"); + print FILE localtime() . "\n"; + close(FILE); } } -# 現在時刻の文字列を得る -sub get_current_datestr { - my (@wdays) = ( "日", "月", "火", "水", "木", "金", "土" ); - my ($sec, $min, $hour, $mday, $mon, $year, $wday) = localtime(time); - return sprintf("%4d-%02d-%02d (%s) %02d:%02d:%02d", - $year + 1900, $mon + 1, $mday, $wdays[$wday], $hour, $min, $sec); -} - -# URL?SomePageや、 -# URL?[[結城浩]]の形式だった場合、(not yet) -# 強制的にmycmdをreadにして$formの内容を設定する。 -sub normalize_form { - foreach my $key (keys %form) { - if ($key =~ /^$WikiName$/) { - $form{mycmd} = 'read'; - $form{mypage} = $1; - last; - } elsif ($key =~ /^$BracketName$/) { - $form{mycmd} = 'read'; - $form{mypage} = $1; - last; +sub get_subjectline { + my ($page, %option) = @_; + if (not &is_editable($page)) { + return ""; + } else { + # Delimiter check. + my $delim = $subject_delimiter; + if (defined($option{delimiter})) { + $delim = $option{delimiter}; } + + # Get the subject of the page. + my $subject = $database{$page}; + $subject =~ s/\r?\n.*//s; + return "$delim$subject"; } } -# 変換テストを行なうときのサンプル -sub print_sample { - my $txt = &convert_html(<<"EOD"); -*大見出し1 -**小見出し1-1 --項目1 --項目2 --項目3 -段落1段落1段落1段落1段落1段落1段落1段落1段落1段落1段落1段落1 -段落1段落1段落1段落1段落1段落''強調''1段落1段落1段落1段落1段落1 -段落1段落1段落1段落1段落1段落1段落1段落1段落1段落1段落1段落1 - -段落2段落2段落2段落2段落2段落2段落2段落2段落2段落2段落2段落2 -段落2段落2段落2段落2段落2段落2段落2段落2段落2段落2段落2段落2 -段落2段落2段落2段落2段落2段落2段落2段落2段落2段落2段落2段落2 -**小見出し1-2 -:用語1:いろいろ書いた解説文1と''強調単語'' -段落1段落1段落1段落1段落1段落1段落1段落1段落1段落1段落1段落1 -段落1段落1段落1段落1段落1段落1段落1段落1段落1段落1段落1段落1 -段落1段落1段落1段落1段落1段落1段落1段落1段落1段落1段落1段落1 -:用語2:いろいろ書いた解説文2 -:用語3:いろいろ書いた解説文3 ----- -*大見出し2 -**小見出し2-1 -<http://suika.fam.cx/> -**小見出し2-2 - -[[結城浩]] - -段落1段落1段落1段落1段落1段落1段落1段落1段落1段落1段落1段落1 -段落1段落1段落1段落'''強調'''1段落1段落1段落1段落1段落1段落1段落1 -段落1段落1段落1段落'''''強い強調'''''1段落1段落1段落1段落1段落1段落1段落1段落1 ->段落2段落2段落2段落2段落2段落2段落2段落2段落2段落2段落2段落2 ->段落2段落2段落2段落2段落2段落2段落2段落2段落2段落2段落2段落2 ->段落2段落2段落2段落2段落2段落2段落2段落2段落2段落2段落2段落2 - -レベル0レベル0レベル0レベル0レベル0レベル0 - ->レベル1 ->レベル1 ->レベル1 ->>レベル2 ->>レベル2 ->>レベル2 ->>>レベル3 --はろ1 ---はろ2 -ろろろろ2 ----はろ3 ---はろ2 ----はろ3 ---はろ2 ----はろ3 ->>>レベル3 ->>>レベル3 ->>>レベル3 +sub send_mail_to_admin { + my ($page, $mode) = @_; + return unless $modifier_sendmail; + my $message = <<"EOD"; +To: $modifier_mail +From: $modifier_mail +Subject: [Wiki] +MIME-Version: 1.0 +Content-Type: text/plain; charset=ISO-2022-JP +Content-Transfer-Encoding: 7bit + +-------- +MODE = $mode +REMOTE_ADDR = $ENV{REMOTE_ADDR} +REMOTE_HOST = $ENV{REMOTE_HOST} +-------- +$page +-------- +$database{$page} +-------- EOD - print $txt; - exit; + &code_convert(\$message, 'jis'); + open(MAIL, "| $modifier_sendmail"); + print MAIL $message; + close(MAIL); } -sub diff_check { - traverse_sequences( - $msgrefA, $msgrefB, - { - MATCH => \&df_match, - DISCARD_A => \&df_delete, - DISCARD_B => \&df_add, - } - ); - &diff_flush; +sub open_db { + if ($modifier_dbtype eq 'dbmopen') { + dbmopen(%database, $dataname, 0666) or &print_error("(dbmopen) $dataname"); + dbmopen(%infobase, $infoname, 0666) or &print_error("(dbmopen) $infoname"); + } elsif ($modifier_dbtype eq 'AnyDBM_File') { + tie(%database, "AnyDBM_File", $dataname, O_RDWR|O_CREAT, 0666) or &print_error("(tie AnyDBM_File) $dataname"); + tie(%infobase, "AnyDBM_File", $infoname, O_RDWR|O_CREAT, 0666) or &print_error("(tie AnyDBM_File) $infoname"); + } else { + tie(%database, "Yuki::YukiWikiDB", $dataname) or &print_error("(tie Yuki::YukiWikiDB) $dataname"); + tie(%infobase, "Yuki::YukiWikiDB", $infoname) or &print_error("(tie Yuki::YukiWikiDB) $infoname"); + } } -sub diff_flush { - $diff_text .= join('', map { "-$_\n" } splice(@diff_deleted)); - $diff_text .= join('', map { "+$_\n" } splice(@diff_added)); +sub close_db { + if ($modifier_dbtype eq 'dbmopen') { + dbmclose(%database); + dbmclose(%infobase); + } elsif ($modifier_dbtype eq 'AnyDBM_File') { + untie(%database); + untie(%infobase); + } else { + untie(%database); + untie(%infobase); + } } -sub df_match { - my ($a, $b) = @_; - &diff_flush; - $diff_text .= "=$msgrefA->[$a]\n"; +sub open_diff { + if ($modifier_dbtype eq 'dbmopen') { + dbmopen(%diffbase, $diffname, 0666) or &print_error("(dbmopen) $diffname"); + } elsif ($modifier_dbtype eq 'AnyDBM_File') { + tie(%diffbase, "AnyDBM_File", $diffname, O_RDWR|O_CREAT, 0666) or &print_error("(tie AnyDBM_File) $diffname"); + } else { + tie(%diffbase, "Yuki::YukiWikiDB", $diffname) or &print_error("(tie Yuki::YukiWikiDB) $diffname"); + } } -sub df_delete { - my ($a, $b) = @_; - push(@diff_deleted, $msgrefA->[$a]); +sub close_diff { + if ($modifier_dbtype eq 'dbmopen') { + dbmclose(%diffbase); + } elsif ($modifier_dbtype eq 'AnyDBM_File') { + untie(%diffbase); + } else { + untie(%diffbase); + } } -sub df_add { - my ($a, $b) = @_; - push(@diff_added, $msgrefB->[$b]); +sub print_searchform { + my ($word) = @_; + print <<"EOD"; +
    + + + +
    +EOD } -sub calc_message_digest { # You have to use MD5... - my $text = shift; - my @text = split(//, $text); - my $len = length($text); - my $checksum = 0; - foreach (@text) { - $checksum += ord($_); - $checksum = ($checksum * 2) % 65536 + (($checksum & 32768) ? 1 : 0); # 16bit rotate +sub print_editform { + my ($mymsg, $lastmodified, %mode) = @_; + my $frozen = &is_frozen($form{mypage}); + + if ($form{mypreview}) { + if ($form{mymsg}) { + unless ($mode{conflict}) { + print qq(

    $resource{previewtitle}

    \n); + print qq($resource{previewnotice}\n); + print qq(
    \n); + &print_content($form{mymsg}); + print qq(
    \n); + } + } else { + print qq($resource{previewempty}); + } + $mymsg = &escape($form{mymsg}); + } else { + $mymsg = &escape($mymsg); } - return "$len:$checksum"; -} -# Definition of YukiWikiDB -package YukiWikiDB; + my $edit = $mode{admin} ? 'adminedit' : 'edit'; -my $debug = 1; + print <<"EOD"; +
    + @{[ $mode{admin} ? qq($resource{frozenpassword}
    ) : "" ]} + + +
    +@{[ + $mode{admin} ? + qq( + $resource{frozenbutton} + $resource{notfrozenbutton}
    ) + : "" +]} +@{[ + $mode{conflict} ? "" : + qq( + $resource{touch}
    + +
    + ) +]} +
    +EOD + unless ($mode{conflict}) { + # Show the format rule. + open(FILE, $file_format) or &print_error("($file_format)"); + my $content = join('', ); + &code_convert(\$content, $kanjicode); + close(FILE); + print &text_to_html($content, toc=>0); + } +} -# Constructor -sub new { - return shift->TIEHASH(@_); +sub print_passwordform { + print <<"EOD"; +
    + + $resource{oldpassword}
    + $resource{newpassword}
    + $resource{newpassword2}
    +
    +
    +EOD } -# tying -sub TIEHASH { - my ($class, $dbname) = @_; - my $self = { - dir => $dbname, - keys => [], - }; - if (not -d $self->{dir}) { - if (!mkdir($self->{dir}, 0777)) { - print "mkdir(" . $self->{dir} . ") fail\n" if ($debug); - return undef; - } +sub is_editable { + my ($page) = @_; + if (&is_bracket_name($page)) { + return 0; + } elsif ($fixedpage{$page}) { + return 0; + } elsif ($page =~ /\s/) { + return 0; + } elsif ($page =~ /^\#/) { + return 0; + } elsif ($page =~ /^$interwiki_name$/) { + return 0; + } else { + return 1; } - return bless($self, $class); } -# Store -sub STORE { - my ($self, $key, $val) = @_; - my $file = &make_filename($self, $key); - if (open(FILE,"> $file")) { - binmode(FILE); - print FILE $val; - close(FILE); - return $self->{$key} = $val; +# armor_name: +# WikiName -> WikiName +# not_wiki_name -> [[not_wiki_name]] +sub armor_name { + my ($name) = @_; + if ($name =~ /^$wiki_name$/) { + return $name; } else { - print "$file create error."; + return "[[$name]]"; } } -# Fetch -sub FETCH { - my ($self, $key) = @_; - my $file = &make_filename($self, $key); - if (open(FILE, $file)) { - local $/; - $self->{$key} = ; - close(FILE); +# unarmor_name: +# [[bracket_name]] -> bracket_name +# WikiName -> WikiName +sub unarmor_name { + my ($name) = @_; + if ($name =~ /^$bracket_name$/) { + return $1; + } else { + return $name; } - return $self->{$key}; } -# Exists -sub EXISTS { - my ($self, $key) = @_; - my $file = &make_filename($self, $key); - return -e($file); +sub is_bracket_name { + my ($name) = @_; + if ($name =~ /^$bracket_name$/) { + return 1; + } else { + return 0; + } } -# Delete -sub DELETE { - my ($self, $key) = @_; - my $file = &make_filename($self, $key); - unlink $file; - return delete $self->{$key}; +sub decode { + my ($s) = @_; + $s =~ tr/+/ /; + $s =~ s/%([A-Fa-f0-9][A-Fa-f0-9])/pack("C", hex($1))/eg; + return $s; } -sub FIRSTKEY { - my ($self) = @_; - opendir(DIR, $self->{dir}) or die $self->{dir}; - @{$self->{keys}} = grep /\.txt$/, readdir(DIR); - foreach my $name (@{$self->{keys}}) { - $name =~ s/\.txt$//; - $name =~ s/[0-9A-F][0-9A-F]/pack("C", hex($&))/eg; +sub encode { + my ($s) = @_; + my $encoded = ''; + foreach my $ch (split(//, $s)) { + if ($ch =~ /[A-Za-z0-9_]/) { + $encoded .= $ch; + } else { + $encoded .= '%' . sprintf("%02X", ord($ch)); + } } - return shift @{$self->{keys}}; + return $encoded; } -sub NEXTKEY { - my ($self) = @_; - return shift @{$self->{keys}}; +sub init_resource { + open(FILE, $file_resource) or &print_error("(resource)"); + while () { + chomp; + next if /^#/; + my ($key, $value) = split(/=/, $_, 2); + $resource{$key} = &code_convert(\$value, $kanjicode); + } + close(FILE); } -sub make_filename { - my ($self, $key) = @_; - my $enkey = ''; - foreach my $ch (split(//, $key)) { - $enkey .= sprintf("%02X", ord($ch)); +sub conflict { + my ($page, $rawmsg) = @_; + if ($form{myLastModified} eq &get_info($page, $info_LastModified)) { + return 0; + } + open(FILE, $file_conflict) or &print_error("(conflict)"); + my $content = join('', ); + &code_convert(\$content, $kanjicode); + close(FILE); + &print_header($page); + &print_content($content); + &print_editform($rawmsg, $form{myLastModified}, frozen=>0, conflict=>1); + &print_footer($page); + return 1; +} + +sub get_now { + my (@week) = qw(Sun Mon Tue Wed Thu Fri Sat); + my ($sec, $min, $hour, $day, $mon, $year, $weekday) = localtime(time); + $year += 1900; + $mon++; + $mon = "0$mon" if $mon < 10; + $day = "0$day" if $day < 10; + $hour = "0$hour" if $hour < 10; + $min = "0$min" if $min < 10; + $sec = "0$sec" if $sec < 10; + $weekday = $week[$weekday]; + return "$year-$mon-$day ($weekday) $hour:$min:$sec"; +} + +# [[YukiWiki http://www.hyuki.com/yukiwiki/wiki.cgi?euc($1)]] +sub init_InterWikiName { + my $content = $database{$InterWikiName}; + while ($content =~ /\[\[(\S+) +(\S+)\]\]/g) { + my ($name, $url) = ($1, $2); + $interwiki{$name} = $url; } - return $self->{dir} . "/$enkey.txt"; } -__END__ - -=head1 NAME - -YukiWiki - 自由にページを追加・削除・編集できるWebページ構築CGI - - Copyright (C) 2000,2001 by Hiroshi Yuki. - 結城浩 - http://www.hyuki.com/ - http://www.hyuki.com/yukiwiki/ - -=head1 SYNOPSIS - - http://www.hyuki.com/yukiwiki/yukiwiki.cgi - -=head1 DESCRIPTION - -YukiWiki（結城ウィキィ）は参加者が自由にページを追加・削除・編集できる -不思議なWebページ群を作るCGIです。 -Webで動作する掲示板とちょっと似ていますが、 -Web掲示板が単にメッセージを追加するだけなのに対して、 -YukiWikiは、Webページ全体を自由に変更することができます。 - -YukiWikiは、Cunningham & CunninghamのWikiWikiWebの -仕様を参考にして独自に作られました。 - -YukiWikiはPerlで書かれたCGIスクリプトとして実現されていますので、 -Perlが動作するWebサーバならば比較的容易に設置できます。 - -あとはdbmopenが使える環境ならば設置できます(Version 1.5.0以降ならdbmopenが使えなくても設置できます)。 - - -YukiWikiはフリーソフトです。 -ご自由にお使いください。 - -=head1 設置方法 - -=head2 入手 - -YukiWikiの最新版は、 -http://www.hyuki.com/yukiwiki/ -から入手できます。 - -=head2 ファイル一覧 - - readme.txt ドキュメント - yukiwiki.cgi YukiWiki本体 - yukiwiki.gif ロゴ（カラー版） - yukimono.gif ロゴ（モノクロ版） - jcode.pl 漢字コードライブラリ - -=head2 インストール - -=over 4 - -=item 1. - -アーカイブを解く。 - -=item 2. - -yukiwiki.cgiのはじめの方にある設定を確認します。 -通常は何もしなくてよいが、 -はじめは$touchfileを''にした方がよいでしょう。 - -=item 3. - -yukiwiki.cgiとjcode.plを同じところに設置します。 - -=item 4. - -サイズ0のyukiwiki.dbというファイルを設置します。 -（Perlシステムによってはyukiwiki.pag, yukiwiki.dir） - -=item 5. - -yukiwiki.cgiにブラウザからアクセスします。 - -=back - -=head2 パーミッション - - ファイル パーミッション 転送モード - yukiwiki.cgi 755 ASCII - yukiwiki.gif 644 BINARY - yukimono.gif 644 BINARY - jcode.pl 644 ASCII - - $dbmopen = 1; にした場合: - yukiwiki.db 666 BINARY - (yukiwiki.pag, yukiwiki.dirの場合もあり） - - $dbmopen = 0; にした場合: (カレントディレクトリを777にしておく) - . 777 (転送しない) - -=head1 データのバックアップ方法 - -$dbmopen = 1;の場合は、 -データはすべてyukiwiki.db(.dir, .pag)に入る。 -これをバックアップすればよい。 - -$dbmopen = 0;の場合は、 -yukiwikiというディレクトリができるので、 -これ以下をバックアップすればよい。 - -=head1 新しいページの作り方 - -=over 4 - -=item 1. - -まず、適当なページ（例えばFrontPage）を選び、 -ページの下にある「編集」リンクをたどります。 - -=item 2. - -するとテキスト入力ができる状態になるので、 -そこにNewPageのような単語 -（大文字小文字混在している英文字列） -を書いて「保存」します。 - -=item 3. - -保存すると、FrontPageのページが書き換わり、 -あなたが書いたNewPageという文字列の後ろに ? というリンクが表示されます。 -この ? はそのページがまだ存在しないことを示す印です。 - -=item 4. - -その ? をクリックすると新しいページNewPageができますので、 -あなたの好きな文章をその新しいページに書いて保存します。 - -=item 5. - -NewPageページができるとFrontPageの ? は消えて、リンクとなります。 - -=back - -=head1 テキスト整形のルール - -=over 4 - -=item * - -連続した複数行はフィルされて表示されます。 - -=item * - -空行は段落C<<

    >>の区切りとなります。 - -=item * - -HTMLのタグは書けません。 - -=item * - -B<''ボールド''>のようにシングルクォート二つではさむと、 -ボールドC<< >>になります。 - -=item * - -B<'''イタリック'''>のようにシングルクォート三つではさむと、 -イタリックC<< >>になります。 - -=item * - -B<---->のようにマイナス4つがあると、 -水平線C<<

    >>になります。 - -=item * - -行をB<*>ではじめると、 -大見出しC<<

    >>になります。 - -=item * - -行をB<**>ではじめると、 -小見出しC<<

    >>になります。 - -=item * - -行をマイナス-ではじめると、 -箇条書きC<<
      >>になります。 -マイナスの数が増えるとレベルが下がります（3レベルまで） - - -項目1 - --項目1-1 - --項目1-2 - -項目2 - -項目3 - --項目3-1 - ---項目3-1-1 - ---項目3-1-2 - --項目3-2 - -=item * - -コロンを使うと、 -用語と解説文のリストC<<
      >>が書けます。 - - :用語1:いろいろ書いた解説文1 - :用語2:いろいろ書いた解説文2 - :用語3:いろいろ書いた解説文3 - -=item * - -リンク - -=over 4 - -=item * - -LinkToSomePageやFrontPageのように、 -英単語の最初の一文字を大文字にしたものが -二つ以上連続したものはYukiWikiのページ名となり、 -それが文章中に含まれるとリンクになります。 - -=item * - -http://www.hyuki.com/ のようなURLは自動的にリンクになります。 - -=item * - -二重の大かっこ[[ ]]でくくった文字列も、 -YukiWikiのページ名になります。 -大かっこの中にはスペースを含めてはいけません。 -日本語も使えます。 - -=back - -=item * - -行頭がスペースやタブで始まっていると、 -それは整形済みの段落C<< 
       >>として扱われます。
-プログラムの表示などに使うと便利です。
-
-
-=item *
 
-行を > ではじめると、
-引用文C<< 
       >>が書けます。
->の数が多いとインデントが深くなります（3レベルまで）。
-
-    >文章
-    >文章
-    >>さらなる引用
-    >文章
-
-=back
-
-=head1 更新履歴
-
-=over 4
-
-=item *
-
-2001年10月20日、Version 1.6.6。
-
-更新の衝突対策。
-元ページの簡単なチェックサムを取っておき、
-更新前にチェックサムを比較する。
-修正個所はdigestという文字列を検索すれば分かる。
-本来はMD5などでちゃんとやった方がいいのだけれど。
-
-衝突時に表示されるメッセージなどは「極悪」さんのページを参考にした。
-
-=item *
-
-2001年10月17日、Version 1.6.5。
-
-プレビュー画面で、更新ボタンを押したときに送信される
-メッセージの内容をinput要素のtype="hidden"を使って埋め込むのをやめる。
-代わりに、textarea要素を使う。
-再プレビュー用にmyspecial_を導入。でもきれいな対策ではない。
-
-=item *
-
-2001年8月30日、Version 1.6.4。
-
-URLでダイレクトにページ名を指定しても、
-$WikiNameと$BracketName以外のページを作れないようにした。
-(is_valid_nameとis_editable参照)。
-
-=item *
-
-2001年8月30日、Version 1.6.3。
-
-RecentChangesを編集・再編集不可とした。
-編集不可ページは@uneditableにページ名を入れる。
-
-=item *
-
-2001年2月25日、Version 1.6.1, 1.6.2。
-
-差分機能のバグ修正。
-do_previewで'>'が扱えないバグを修正
-（ユーザからの指摘）。
-
-=item *
-
-2001年2月22日、Version 1.6.0。
-差分機能を実装した。
-
-=item *
-
-2001年2月19日、Version 1.5.4。
-画像ファイルへのリンクは画像にしてみた。
-
-=item *
-
-2001年2月19日、Version 1.5.3。
-RecentChangesの中に削除したページがあるのをやめた。
-use strict;で引っかかる部分を少し整理(完全ではない)。
-
-=item *
-
-2001年2月16日、Version 1.5.2。
-textareaに表示およびプレビューする前に < や > を < や > に変換した
-(do_preview, editpage, print_preview_buttons)。
-
-=item *
-
-2000年12月27日、Version 1.5.1。
-プレビュー画面を整理した。
-
-=item *
-
-2000年12月22日、Version 1.5.0。
-全体的にずいぶん書き直した。
-一覧を別途作成するようにした(do_list)。
-書き込む前に確認画面を出すようにした(do_preview)。
-テキストの書き方を編集画面に入れた(do_edit, do_reedit)。
-WhatsNew→RecentChanges、TopPage→FrontPageに変更した。
-
-=item *
-
-2000年12月20日、Version 1.1.0。
-tieを利用して、dbmopenが使えない場合でも動作するように修正。
-利用者の1人である「極悪」さんから
-送っていただいたコードを元にしています。
-
-=item *
-
-2000年9月5日、Version 1.0.2。
-  → 
-利用者からの指摘による。感謝。
-
-=item *
-
-2000年8月6日、Version 1.0.1を公開。
-C MAGAZINE（ソフトバンクパブリッシング）
-2000年10月号連載記事向け公開版。
-[[ ]] の最後が「望」のようにシフトJISで
-0x5Dになる場合の回避を行なった。
-
-=item *
-
-2000年8月5日、Version 1.0.0を公開。
-
-=item *
-
-2000年7月23日、Version 0.82を公開。
-編集時のリンクミス。
-