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

Diff of /suikawiki/script/wiki.cgi

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.11 by wakaba, Sun Mar 24 01:12:13 2002 UTC revision 1.51 by w, Sun Jan 26 02:30:24 2003 UTC
# Line 1  Line 1 
1  #!/usr/bin/perl  #!/usr/bin/perl
2  use lib "../lib";  ## wiki.cgi - This is SuikaWiki, yet another WikiEngine
3  use CGI::Carp 'fatalsToBrowser';  
4  use Algorithm::Diff qw(traverse_sequences);  use strict;
5  # use strict;  use lib qw(./lib);
6  #  use CGI::Carp qw(fatalsToBrowser);
7  # yukiwiki.cgi - Yet another WikiWikiWeb clone.  binmode STDOUT; binmode STDIN;
8  #  our $VERSION = do{my @r=(q$Revision$=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};
9  # Copyright (C) 2000,2001 by Hiroshi Yuki.  require 'wikidata/suikawiki-config.ph'; ## site configuration script
10  # <hyuki@hyuki.com>  require Yuki::YukiWikiCache;
11  # http://www.hyuki.com/yukiwiki/  use Fcntl;
12  #  our %fmt;       ## formatter objects
13  # This program is free software; you can redistribute it and/or modify  our %embed_command = (
14  # it under the terms of the GNU General Public License as published by          searched        => '^\[\[#searched:([^\]]+)\]\]$',
15  # the Free Software Foundation; either version 2 of the License, or          form    => qr/\[\[\#form(?:\(([A-Za-z0-9-]+)\))?:'((?:[^'\\]|\\.)*)':'((?:[^'\\]|\\.)*)'(?::'((?:[^'\\]|\\.)*)')?\]\]/,
16  # (at your option) any later version.  );
17  #  our ($modifier_dbtype,$url_cgi,%uri,%PathTo);
18  # This program is distributed in the hope that it will be useful,  our (%PageName,$kanjicode,$lang,%ViewDefinition);
19  # but WITHOUT ANY WARRANTY; without even the implied warranty of  
20  # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the  my %form;
21  # GNU General Public License for more details.  our %database;
22  #  our $database = bless {}, 'wiki::dummy';
23  # $Id$  my %interwiki;
24  ##############################  my %command_do = (
25  my $version = "1.6.6";      default => \&do_view,
26  ##############################      adminchangepassword => \&do_adminchangepassword,
27  # 単独テストのときには 1 にする。      write => \&do_write,
28  my $testing = 0;      searchform => \&do_searchform,
29  ##############################      comment => \&do_comment,
30  # 漢字ライブラリ      RandomJump  => \&do_random_jump,
31  my $jcodelib = 'jcode.pl';      wikiform    => \&do_wikiform,
32  ##############################  );
33  # 保存・表示の漢字コード  our $UA = '';  ## User agent name
34  my $kanjicode = 'euc';     # 'sjis' 'euc'  $| = 1;
 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';  
 ##############################  
 # 全ページのスタイル  
 my $style = <<'EOD';  
 pre, dl, ul, ol, p, blockquote { line-height:120%; }  
 a { text-decoration: none; }  
 a:link { color: #0000FF; background-color: #FFFFFF; }  
 a:visited { color: #9900CC; background-color: #FFFFFF; }  
 a:hover { text-decoration: underline; }  
 EOD  
 ##############################  
 # テキスト入力部分の大きさ  
 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";  
 #<a href="http://www.hyuki.com/yukiwiki/"><img src="$iconfile"  
 # border="0" width="80" height="80" alt="[YukiWiki]" /></a>  
 #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' => '',  
     );  
 }  
 &main;  
 exit(0);  
35    
 # メイン  
36  sub main {  sub main {
37      &normalize_form;      $UA = $main::ENV{HTTP_USER_AGENT};
38      if ($dbmopen) {      &open_db;
39          if (!dbmopen(%database, $dbname, 0666)) {      &init_form;
40              &print_error("(dbmopen) $dbname が作れません。");      if ($command_do{$form{mycmd}}) {
41          }          &{$command_do{$form{mycmd}}};
42      } else {      } else {
43          if (!tie(%database, "YukiWikiDB", $dbname)) {          &{$command_do{default}};
             &print_error("(tie error)");  
         }  
     }  
   
     # myspecial対応  
     foreach (keys %form) {  
         if (/^myspecial_(.*)/) {  
             $form{mycmd} = $1;  
             last;  
         }  
44      }      }
45        &close_db;
46    }
47    
48      if ($form{mycmd} eq 'read') {  sub do_view {
49          &do_read;    my $content = $database{$form{mypage}};
50      } elsif ($form{mycmd} eq 'preview') {    my $lm = $database->mtime ($form{mypage});
51          &do_preview;    wiki::referer::add ($form{mypage}, $ENV{HTTP_REFERER});
52      } elsif ($form{mycmd} eq 'write') {    wiki::useragent::add ($ENV{HTTP_USER_AGENT});
53          &do_write;    &load_formatter ('view');
54      } elsif ($form{mycmd} eq 'edit') {      my $view = $form{mycmd};
55          &do_edit;      if ($view eq 'edit') {
56      } elsif ($form{mycmd} eq 'reedit') {        $view = 'adminedit' if $form{admin};
57          &do_reedit;      } elsif ($view =~ /[^0-9A-Za-z]/) {
58      } elsif ($form{mycmd} eq 'search') {        $view = 'default'
59          &do_search;      }
60      } elsif ($form{mycmd} eq 'list') {      if ($view eq 'default' || !$view) {
61          &do_list;        ## BUG: this code is not strict
62      } elsif ($form{mycmd} eq 'diff') {        if ($main::ENV{HTTP_COOKIE} =~ /SelectedMode=([0-9A-Za-z]+)/) {
63          &do_diff;          $view = $1;
64      } else {        } else {
65          $form{mypage} = $toppage;          $view = 'read';
66          &do_read;        }
67      }      }
68      if ($dbmopen) {    my ($magic, $content) = &SuikaWiki::Plugin::magic_and_content (undef, $content);
69          dbmclose(%database);    $magic ||= '#?SuikaWiki/0.9';
70      my $o = bless {param => \%form, page => $form{mypage}, toc => [],
71                     magic => $magic, content => $content,
72                     formatter => $fmt{view}, &_compatible_options ()}, 'SuikaWiki::Plugin';
73      if (!ref $ViewDefinition{$view} || !&{$ViewDefinition{$view}->{check}} ($o)) {
74        print "Status: 406 Unsupported Media Type\n";
75        $view = '-UnsupportedMediaType';
76      }
77      my $media = $ViewDefinition{$view}->{media};
78      if ($ViewDefinition{$view}->{xmedia} && $UA =~ /Gecko/) {
79        $media = $ViewDefinition{$view}->{xmedia};
80        $o->{media} = $media;
81      } elsif ($UA =~ m#Mozilla/0\..+Windows#) {
82        $kanjicode = 'shift_jis';
83      }
84        if ($magic =~ m!^\#\?SuikaWiki/0.9!) {
85          &print_header ($form{mypage}, -last_modified => ($magic =~ /interactive="yes"/ ? time : $lm),
86            -expires => ($magic =~ /interactive="yes"/ ? 1 : undef), o => $o,
87            -media => $media, -magic => $magic,  content => $content);
88      } else {      } else {
89          untie(%database);        &print_header($form{mypage}, -media => $media,
90                                       -magic => $magic, -last_modified => $lm, o => $o);
91      }      }
92      if ($kanjicode ne 'euc') {
93        my $s = $fmt{view}->replace ($ViewDefinition{$view}->{template} => $o);
94        print &code_convert (\$s => $kanjicode);
95      } else {
96        print $fmt{view}->replace ($ViewDefinition{$view}->{template} => $o);
97      }
98    }
99    
100    sub _do_view_msg (%) {
101      my %option = @_;
102      &load_formatter ('view');
103      my $o = bless {param => \%form, page => $option{-page}, toc => [], condition => \%option,
104                     formatter => $fmt{view}, &_compatible_options ()}, 'SuikaWiki::Plugin';
105      unless (&{$ViewDefinition{$option{-view}}->{check}} ($o)) {
106        print "Status: 406 Unsupported Media Type\n";
107        $option{-view} = '-UnsupportedMediaType';
108      }
109      my $media = $ViewDefinition{$option{-view}}->{media};
110      if ($ViewDefinition{$option{-view}}->{xmedia} && $UA =~ /Gecko/) {
111        $media = $ViewDefinition{$option{-view}}->{xmedia};
112        $o->{media} = $media;
113      }
114      &print_header($option{-page}, -media => $media, o => $o, -goto => $option{-goto});
115      print $fmt{view}->replace ($ViewDefinition{$option{-view}}->{template} => $o);
116  }  }
117    
118  # ページの表示  sub id_and_name ($) {
119  sub do_read {      my $name = shift;
120      my $page_name = $form{mypage};      if ($UA =~ m#Mozilla/[12]\.|Microsoft Internet Explorer#) {
121      my $percent_name = &encode_percent($page_name);        qq{id="$name"><a name="$name"></a};
     &print_header($page_name);  
     print qq|<h1>$IconTag<a href="$thisurl?mycmd=search;myword=$percent_name">$page_name</a></h1>\n|;  
     &print_toolbar($page_name);  
     print &convert_html(&get_page($page_name));  
     &print_footer;  
 }  
   
 # ページの編集  
 sub do_edit {  
     if (not &is_editable($form{mypage})) {  
         # 編集不可ページは表示のみ  
         &do_read;  
         return;  
     }  
     &editpage(&get_page($form{mypage}));  
 }  
   
 # ページの再編集  
 sub do_reedit {  
     if (not &is_editable($form{mypage})) {  
         # 編集不可ページは表示のみ  
         &do_read;  
122      } else {      } else {
123          &editpage($form{mymsg});          qq{id="$name"};
124      }      }
125  }  }
126    
127  sub editpage {  sub do_adminchangepassword {
128      my $page_msg = shift;      if ($form{mynewpassword} ne $form{mynewpassword2}) {
129      my $page_name = $form{mypage};          &_do_view_msg (-view => '-error', -page => $form{mypage},
130      my $digest = &calc_message_digest($page_msg);                         error_message => &Resource ('Error:PasswordMismatch'));
131      &print_header($page_name);          return;
132      print qq|<h1>$IconTag${page_name}の編集</h1>\n|;      }
133      &print_toolbar($page_name);      my ($validpassword_crypt) = $database->meta (AdminPassword => $PageName{AdminSpecialPage});
134      $page_msg = &escape($page_msg);      if ($validpassword_crypt) {
135      print <<"EOD";          if (not &valid_password($form{myoldpassword})) {
136  <form action="$thisurl" method="post">              &_do_view_msg (-view => '-error', -page => $form{mypage},
137  <!--<input type="hidden" name="mycmd" value="preview">-->                             error_message => &Resource ('Error:PasswordIsIncorrect'));
138  <input type="hidden" name="mypage" value="$page_name">              return;
 <input type="hidden" name="mydigest" value="$digest">  
 <textarea cols="$cols" rows="$rows" name="mymsg" wrap="virtual">$page_msg</textarea><br>  
 <input type="submit" name="myspecial_preview" value="確認">  
 <input type="submit" name="myspecial_write" value="確認せず変更">  
 </form>  
 <hr>  
 <h3>テキスト整形のルール</h3>  
   
 <p>通常は入力した文字がそのまま出力されますが、  
 以下のルールに従ってテキスト整形を行うことができます。</p>  
   
 <ul>  
 <li>  
 空行は段落の区切りとなります。  
   
 <li>  
 HTMLのタグは書けません。  
   
 <li>  
 ''強調''のようにシングルクォート二つではさむと、強調になります。  
   
 <li>  
 '''更に強調'''のようにシングルクォート三つではさむと、更に強調になります。  
   
 <li>  
 ----のようにマイナス4つがあると、水平線になります。  
   
 <li>  
 *を行頭に書くと大見出しになります。  
   
 <li>  
 **を行頭に書くと小見出しになります。  
   
 <li>  
 -を行頭に書くと箇条書きになります。- -- --- の3レベルがあります。  
   
 <li>  
 :を行頭に書くと用語と解説文が作れます。  
   
 <pre>  
     :用語1:いろいろ書いた解説文1  
     :用語2:いろいろ書いた解説文2  
     :用語3:いろいろ書いた解説文3  
 </pre>  
   
 <li>  
 http://www.hyuki.com/ のようなURLは自動的にリンクになります。  
   
 <li>  
 YukiWikiのように大文字小文字を混ぜた英文字列を書くと、  
 YukiWikiのページ名になります。  
   
 <li>  
 [[結城浩]]のように二重の大かっこ[[ ]]でくくった文字列を書くと、  
 YukiWikiのページ名になります。  
 大かっこの中にはスペースを含めてはいけません。  
 日本語も使えます。  
   
 <li>  
 行頭がスペースで始まっていると、  
 その段落は整形済み扱われます。  
 プログラムを書き込むときに使うと便利です。  
   
 <li>  
 &gt; を行頭に書くと、  
 引用文が書けます。  
 &gt; の数が多いとインデントが深くなります（3レベルまで）。  
   
 </ul>  
 EOD  
     &print_footer;  
 }  
   
 # ページの検索  
 sub do_search {  
     if ($form{myword}) {  
         &print_header('検索結果');  
         print qq|<h1>$IconTag$form{myword}の検索結果</h1>\n|;  
         &print_toolbar();  
         print qq|<ul>\n|;  
         my $count = 0;  
         foreach my $page_name (sort keys %database) {    # sortするのは無謀かな  
             if ($database{$page_name} =~ /\Q$form{'myword'}\E/) {  
                 my $encoded = &encode_percent($page_name);  
                 print qq|<li><a href="$thisurl?mycmd=read;mypage=$encoded">$page_name</a>\n|;  
                 $count++;  
             }  
         }  
         print qq|</ul>\n|;  
         if ($count > 0) {  
             print qq|<p><strong>$form{myword}</strong>を含むページは、上に示す<strong>$count</strong> ページです。</p>\n|;  
         } else {  
             print qq|<p><strong>$form{myword}</strong>を含むページは見つかりません。</p>\n|;  
139          }          }
     } else {  
         &print_header('単語検索');  
         print qq|<h1>$IconTag単語検索</h1>\n|;  
         &print_toolbar();  
     }  
     print <<"EOD";  
 <p>  
 <form action="$thisurl" method="post">  
 <input type="hidden" name="mycmd" value="search">  
 <input type="text" name="myword" size="20" value="$form{myword}">  
 <input type="submit" value="単語検索">  
 </form>  
 </p>  
 EOD  
     &print_footer;  
 }  
   
 # ページの一覧  
 sub do_list {  
     &print_header('ページ一覧');  
     print qq|<h1>$IconTag ページ一覧</h1>\n|;  
     &print_toolbar();  
     print qq|<ul>\n|;  
     foreach my $page_name (sort keys %database) {    # sortするのは無謀かな  
         my $encoded = &encode_percent($page_name);  
         print qq|<li><a href="$thisurl?mycmd=read;mypage=$encoded">$page_name</a>\n|  
     }  
     print qq|</ul>\n|;  
     &print_footer;  
 }  
   
 # プレビュー  
 sub do_preview {  
     my $page_name = $form{mypage};  
     my $escapedmsg = &escape($form{mymsg});  
     &print_header($page_name);  
     print qq|<h1>$IconTag${page_name}のプレビュー</h1>\n|;  
     &print_toolbar($page_name);  
     # local $percent_name = &encode_percent($page_name);  
     print qq|<p>以下のプレビューを確認して、よければページ下部のボタンで更新してください。</p>\n|;  
     if ($form{mymsg}) {  
         print qq|<table width="100%" bgcolor="$preview_color" ><tr><td>\n|;  
         # print &convert_html($escapedmsg);  
         print &convert_html($form{mymsg});  
         print qq|</td></tr></table>\n|;  
     } else {  
         print qq|<p>（ページの内容は空です。更新するとこのページは<strong>削除</strong>されます。）</p>\n|;  
140      }      }
141      &print_preview_buttons($page_name, $escapedmsg, $form{mydigest});      my ($sec, $min, $hour, $day, $mon, $year, $weekday) = localtime(time);
142      &print_footer;      my (@token) = ('0'..'9', 'A'..'Z', 'a'..'z');
143        my $salt1 = $token[(time | $$) % scalar(@token)];
144        my $salt2 = $token[($sec + $min*60 + $hour*60*60) % scalar(@token)];
145        my $crypted = crypt($form{mynewpassword}, "$salt1$salt2");
146        $database->meta (AdminPassword => $PageName{AdminSpecialPage} => $crypted);
147        
148        &_do_view_msg (-view => '-wrote', -page => $form{mypage});
149  }  }
150    
151  sub print_preview_buttons {  sub valid_password ($) {
152      my ($page_name, $escapedmsg, $digest) = @_;      my ($validpassword_crypt) = $database->meta (AdminPassword => $PageName{AdminSpecialPage});
153      print <<"EOD";      return crypt (shift, $validpassword_crypt) eq $validpassword_crypt ? 1 : 0;
     <form action="$thisurl" method="post">  
     <textarea cols="$cols" rows="$rows" name="mymsg" wrap="virtual">$escapedmsg</textarea>  
     <br />  
     <input type="hidden" name="mypage" value="$page_name">  
     <input type="hidden" name="mydigest" value="$digest">  
     <input type="submit" name="myspecial_preview" value="再度プレビュー">  
     <input type="submit" name="myspecial_write" value="ページの更新">  
     </form>  
 EOD  
154  }  }
155    
 # 書き込む  
156  sub do_write {  sub do_write {
157      if (not &is_editable($form{mypage})) {      if (&frozen_reject()) {
         # 編集不可ページは表示のみ  
         &do_read;  
158          return;          return;
159      }      }
160    
161      my $page_name = $form{mypage};      if (not &is_editable($form{mypage})) {
162            &_do_view_msg (-view => '-error', -page => $form{mypage},
163      # digestを使って、更新の衝突チェック                         error_message => &Resource ('Error:ThisPageIsUneditable'));
     my $original_digest = &calc_message_digest(&get_page($page_name));  
     if ($form{mydigest} ne $original_digest) {  
         &print_header($page_name);  
         print qq|<h1>$IconTag${page_name}で【更新の衝突】が起きました</h1>\n|;  
         print <<"EOD";  
 <p>あなたがこのページを編集している間に、  
 他の人が同じページを更新してしまったようです。  
 </p><p>  
 以下に、あなたの編集したテキストがありますので、  
 あなたの編集内容が失われないように、  
 いますぐ、メモ帳などにコピー＆ペーストしてください。  
 </p><p>  
 コピー＆ペーストが済んでから、  
 最新の内容を見て再度編集し直してください。  
 最新の内容は  
 <a target="_blank" href="$thisurl?mycmd=read;mypage=$form{mypage}">$form{mypage}</a>  
 で見ることができます。  
 </p>  
 EOD  
         # &print_toolbar($page_name);  
         &print_preview_buttons($page_name, &escape($form{mymsg}), $form{mydigest});  
         &print_footer;  
164          return;          return;
165      }      }
166    
167      # diff生成      ## Check confliction
168      {      if ($form{myLastModified} ne $database->mtime ($form{mypage})) {
169          &opendiff;        &_do_view_msg (-view => '-conflict', -page => $form{mypage});
170          my @msg1 = split(/\n/, &get_page($page_name));        return;
         my @msg2 = split(/\n/, $form{mymsg});  
         $msgrefA = \@msg1;  
         $msgrefB = \@msg2;  
         &diff_check;  
         $diffbase{$form{mypage}} = $diff_text;  
         $diff_text = '';  
         &closediff;  
171      }      }
172    
     &print_header($page_name);  
     &set_page($page_name, $form{mymsg});  
173      if ($form{mymsg}) {      if ($form{mymsg}) {
174          print qq|<h1>$IconTag${page_name}を更新しました</h1>\n|;          if ($form{mytouch} || !ref $database) {
175          &print_toolbar($page_name);            $database{$form{mypage}} = $form{mymsg};
         print &convert_html(&get_page($page_name));  
     } else {  
         print qq|<h1>$IconTag${page_name}を削除しました</h1>\n|;  
         &print_toolbar($page_name);  
         print qq|<p>${page_name}を削除しました。</p>\n|;  
     }  
     &print_footer;  
     # 更新されたのでタッチしておく。  
     if ($touchfile) {  
         open(FILE, "> $touchfile");  
         print FILE "\n";  
         close(FILE);  
     }  
 }  
   
 # ページの変更点  
 sub do_diff {  
     if (not &is_editable($form{mypage})) {  
         # 編集不可ページは表示のみ  
         &do_read;  
         return;  
     }  
     &opendiff;  
     &print_header($form{mypage} . 'の変更点');  
     print qq|<h1>$IconTag <a href="$thisurl?mycmd=read&mypage=$form{mypage}">$form{mypage}</a>の変更点</h1>\n|;  
     &print_toolbar();  
     $_ = &escape($diffbase{$form{mypage}});  
     print <<"EOD";  
 <ul>  
 <li>追加された行は<ins>青色</ins>です。  
 <li>削除された行は<del>赤色</del>です。  
 <li><a href="$thisurl?mycmd=read;mypage=$form{mypage}">$form{mypage}</a>へ行く。  
 </ul>  
 <hr />  
 EOD  
     print qq|<pre>\n|;  
     foreach (split(/\n/, $_)) {  
         if (/^\+(.*)/) {  
             print qq|<ins>$1</ins>\n|;  
         } elsif (/^\-(.*)/) {  
             print qq|<del>$1</del>\n|;  
         } elsif (/^\=(.*)/) {  
             print qq|$1\n|;  
176          } else {          } else {
177              print qq|??? $_\n|;            $database->STORE ($form{mypage} => $form{mymsg}, -touch => 0);
         }  
     }  
     print qq|</pre>\n|;  
     &print_footer;  
     &closediff;  
 }  
   
 sub opendiff {  
     if ($dbmopen) {  
         if (!dbmopen(%diffbase, $diffdbname, 0666)) {  
             &print_error("(dbmopen) $diffdbname が作れません。");  
178          }          }
179            $database->meta (IsFrozen => $form{mypage} => 0 + $form{myfrozen});
180            my $fragment = '';
181            $fragment .= qq(;after_edit_cmd=@{[&encode($form{after_edit_cmd})]}) if $form{after_edit_cmd};
182            if ($form{__comment_anchor_index}) {
183                $fragment .= qq(#anchor-$form{__comment_anchor_index});
184            } elsif ($form{__wikiform_anchor_index}) {
185                $fragment .= qq(#wikiform-$form{__wikiform_anchor_index});
186            }
187            &_do_view_msg (-view => '-wrote', -page => $form{mypage}, -goto => $url_cgi.'?mycmd='.&encode($form{after_edit_cmd}||'default').';mypage='.&encode($form{mypage}).qq(;x-param=@{[time.[0..9]->[rand 10]]}$fragment));
188      } else {      } else {
189          if (!tie(%diffbase, "YukiWikiDB", $diffdbname)) {          delete $database{$form{mypage}};
190              &print_error("(tie error)");          &_do_view_msg (-view => '-deleted', -page => $form{mypage});
         }  
191      }      }
192  }  }
193    
194  sub closediff {  sub _compatible_options () {
195      if ($dbmopen) {    (use_anchor_name => ($UA =~ m#Mozilla/[12]\.|Microsoft Internet Explorer# ? 1 : 0));
         dbmclose(%diffbase);  
     } else {  
         untie(%diffbase);  
     }  
196  }  }
197    
198  # フォームからの情報を連想配列 %form に入れる  sub get_search_result ($;%) {
199  # &init_form('euc');    my $word = lc shift;
200  sub init_form {    my $SearchResult = SuikaWiki::Plugin->cache ('search');
201      my ($charcode) = @_;    my %option = @_;
202      my $query;    my @r;
203      if ($ENV{REQUEST_METHOD} =~ /^post$/i) {    unless (defined $SearchResult->{$word}) {
204          read(STDIN, $query, $ENV{CONTENT_LENGTH});      for my $page (keys %database) {
205      } else {        next if !$option{-match_myself} && ($page eq $word);
206          $query = $ENV{QUERY_STRING};        my $content = lc $database{$page};
207          $content =~ s/^[^\x0A\x0D]+[\x0D\x0A]+//s;
208          if (index (lc $page, $word) > -1) {
209            my $c = $content =~ s/\Q$word\E//g;
210            push @r, [$page, $c+20];
211          } elsif (index ($word, lc $page) > -1) {
212            my $c = $content =~ s/\Q$word\E//g;
213            push @r, [$page, $c+10];
214          } elsif (my $c = $content =~ s/\Q$word\E//g) {
215            push @r, [$page, $c];
216          }
217      }      }
218      my @assocarray = split(/[&;]/, $query);      @r = sort {$b->[1] <=> $a->[1] || $a->[0] cmp $b->[0]} @r;
219      foreach my $assoc (@assocarray) {      $SearchResult->{$word} = join "\x1E", map {$_->[0]."\x1F".$_->[1]} @r;
220          my ($property, $value) = split(/=/, $assoc);    } else {
221          $value =~ tr/+/ /;      @r = map {[split /\x1F/, $_, 2]} split /\x1E/, $SearchResult->{$word};
222          $value =~ s/%([A-Fa-f0-9][A-Fa-f0-9])/pack("C", hex($1))/eg;    }
223          &jcode::convert(\$value, $charcode);    #my $em = sub { my $s = shift; $s =~ s#(\Q$word\E)#<em>$1</em>#gi; $s };
224          $form{$property} = $value;    my $r = join "\n", map {qq(<li>[$_->[1]] <a href ="$url_cgi?@{[&encode($_->[0])]}" class="wiki">@{[&escape($_->[0])]}</a> <span class="wikipage-summary">@{[&escape(&get_subjectline($_->[0]))]}</span></li>)} @r;
225      $r = qq|<ul class="search-result">$r</ul>| if $r;
226      wantarray? ($r, scalar @r): $r;
227    }
228    
229    sub do_random_jump {
230      my @list = keys %database;
231      my $name = &encode ($list[rand @list]);
232      print "Location: $uri{wiki}?$name\n";
233      print "\n";
234    }
235    
236    sub print_header ($;%) {
237        my ($page, %option) = @_;
238        my @head;
239        $option{o}->{-header}->{class} = &is_frozen($page) ? 'frozen' : '';
240        $option{o}->{-header}->{class} .= " wiki-page-obsoleted" if $option{-magic} =~ /obsoleted="yes"/;
241        if ($option{-goto}) {
242          if ($UA =~ m#Opera|MSIE 2\.#) {
243              ## WARNING: This code may output unsafe HTML document if
244              ##          $option{-goto} is not clean.
245              $option{-goto} =~ tr/;/&/ if $UA =~ m#Opera#;
246              print qq{Refresh: 0; url=$option{-goto}\n};
247              push @head, qq(<meta http-equiv="refresh" content="0; url=$option{-goto}">);
248          } elsif ($UA =~ /Gecko/) {
249              print qq{Refresh: 0; url="$option{-goto}"\n};
250              push @head, qq(<meta http-equiv="refresh" content="0; url=&quot;@{[&escape($option{-goto})]}&quot;" />);
251          } else {
252              $option{-goto} =~ tr/;/&/ if $UA =~ m#Mozilla/[1-4]\.#;
253              print qq{Refresh: 0; url="$option{-goto}"\n};
254              push @head, qq(<meta http-equiv="refresh" content="0; url=&quot;@{[&escape($option{-goto})]}&quot;">);
255          }
256      }      }
257  }      print qq{Last-Modified: @{[scalar gmtime $option{-last_modified}]}\n} if $option{-last_modified};
258        if ($option{-expires} != -1) {
259  # エラーページを出力する        if (defined $option{-expires}) {  ## TODO: Don't use asctime
260  sub print_error {          print qq{Expires: @{[scalar gmtime (time + $option{-expires})]}\n};
261      my ($msg) = @_;        } elsif ($option{-media}->{expires} != -1) {
262      &print_header('Error');          print qq{Expires: @{[scalar gmtime (time + $option{-media}->{expires})]}\n};
263      print "<h1>$IconTag$msg</h1></body></html>";        }
     exit(0);  
 }  
   
 sub escape {  
     my ($line) = shift;  
     $line =~ s|<|&lt;|g;  
     $line =~ s|>|&gt;|g;  
     $line =~ s|"|&quot;|g;  
     # $line =~ s|\&|&amp;|g;  
     return $line;  
 }  
   
 sub inline {  
     my ($line) = shift;  
     $line = &escape($line);  
     $line =~ s|'''([^']+?)'''|<strong>$1</strong>|g;  
     $line =~ s|''([^']+?)''|<em>$1</em>|g;            
     $line =~ s!  
        (  
          (?:&lt;(?:mailto|http|https|ftp|urn):[\x21-\x7E]*)&gt;  
        #| (?:$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|);  
         }  
264      }      }
265      # ここで本当に更新      if ($option{-media}->{charset} && $UA =~ m#Mozilla/[12]\.#) {
266      $database{$whatsnew} = join("\n", splice(@newpages, 0, $maxnew));          my $ct = qq{$option{-media}->{type}; charset=@{[&get_charset_name($kanjicode,compatible=>1)]}};
267  }          print qq{Content-Type: $ct\n};
268            $option{o}->{-header}->{meta_ct} = qq{<meta http-equiv="content-type" content="$ct">\n};
269        } elsif (!$option{-media}->{charset} || $UA =~ m#Infomosaic|Mozilla/0\.#) {
270            print qq{Content-Type: $option{-media}->{type}\n};
271            $option{o}->{-header}->{meta_ct} = qq{<meta http-equiv="content-type" content="$option{-media}->{type}; charset=@{[&get_charset_name($kanjicode,compatible=>1)]}">\n};
272        } else {
273            my $type = $option{-media}->{type};
274            $type = 'application/xml' if $type eq 'application/rss+xml';
275            print qq{Content-Type: $type; charset=@{[&get_charset_name($kanjicode)]}\n};
276        }
277        print <<"EOD";      ## TODO:
278    Content-Language: $lang
279    Content-Style-Type: text/css
280    
 # ページのヘッダを出力  
 sub print_header {  
     my $title = shift;  
     print <<"EOD";  
 Content-type: text/html; charset=${charset}  
   
 <html><head>  
 <title>$title</title>  
 <style type="text/css">  
 $style  
 </style>  
 </head>  
 <body>  
281  EOD  EOD
282      $option{o}->{-header}->{links} = join "\n", (@head);
283  }  }
284    
285  # ツールバーを出力  sub get_charset_name ($;%) {
286  sub print_toolbar {      my ($charset, %option) = (lc shift, @_);
287      my $page_name = shift;      if ($charset =~ 'euc') {
288      my $percent_name = &encode_percent($page_name);          $charset = $option{compatible} ? 'x-euc-jp' : 'euc-jp';
289      my $editlink = '';      } elsif ($charset =~ 'sjis' || $charset =~ 'shift') {
290      if ($page_name ne '' and &is_editable($page_name)) {          $charset = $option{compatible} ? 'x-sjis' : 'shift_jis';
291          $editlink = <<"EOD";      } elsif ($charset =~ 'jis') {
292  <a href="$thisurl?mycmd=edit;mypage=$percent_name">編集</a> |          $charset = 'iso-2022-jp';
 <a href="$thisurl?mycmd=diff;mypage=$percent_name">差分</a> |  
 EOD  
293      }      }
294      print <<"EOD";      $charset;
 <p>  
  [  
 <a href="$thisurl?mycmd=read;mypage=$toppage">トップ</a> |  
 <a href="$thisurl?mycmd=list">一覧</a> |  
 $editlink  
 <a href="$thisurl?mycmd=search">単語検索</a> |  
 <a href="$thisurl?mycmd=read;mypage=$whatsnew">最近の更新</a>  
  ]  
 </p>  
 EOD  
295  }  }
296    
297  # ページのフッタを出力  sub escape {
298  sub print_footer {      my $s = shift;
299      print <<"EOD";      $s =~ s|\x0D\x0A|\x0A|g;
300  <div class="navigation">      $s =~ s|&|&amp;|g;
301  <a href="http://www.hyuki.com/yukiwiki/">YukiWiki</a> 1.6.6 Copyright (C) 2000,2001 by <a href="http://www.hyuki.com/">Hiroshi Yuki.</a>      $s =~ s|<|&lt;|g;
302  + <a href="$modifierlink">$modifier</a> ${version}.      $s =~ s|>|&gt;|g;
303  [<a href="/" title="このサーバーの首頁">/</a>      $s =~ s|"|&quot;|g;
304  <a href="/map" title="このサーバーの案内">地図</a>      return $s;
305  <a href="/search/" title="このサーバーの検索">検索</a>]  }
306  </div>  
307  <div class="update">  sub unescape {
308  <a href="/gate/cvs/wakaba/wiki/" title="CVS Repository">      my $s = shift;
309  \$Revision$      # $s =~ s|\n|\r\n|g;
310  \$Date$      $s =~ s|&lt;|<|g;
311  </a>      $s =~ s|&gt;|>|g;
312  </div>      $s =~ s|&quot;|"|g;
313  </body></html>      $s =~ s|&amp;|&|g;
314  EOD      return $s;
315  }  }
316    
317  # URLやページの名前からリンクを作る  sub convert_format ($$$;%) {
318  sub make_link {    my ($content, $d => $t, %option) = @_;
319      my $name = shift;    &load_formatter ('format');
320      $name =~ s/^&lt;(.*)&gt;$/$1/;    my $f = SuikaWiki::Plugin->format_converter ($d => $t);
321      $name =~ s/^\[\[(.*)\]\]$/$1/;    if (ref $f) {
322      if ($name =~ /^(http|https|ftp).*?(\.png|\.jpeg|\.jpg)?$/) {      $option{content} = $content;
323          if ($2) {      $option{from} = $d;
324              return qq|<a href="$name"><img border="0" src="$name" /></a>|;      $option{to} = $t;
325          } else {      &$f ({}, bless (\%option, 'SuikaWiki::Plugin'));
326              return qq|&lt;<a href="$name">$name</a>&gt;|;    } elsif ($t =~ /HTML|xml/) {
327        length $content ? '<pre>'.&escape($content).'</pre>' : '';
328      } else {
329        $content;
330      }
331    }
332    
333    sub text_to_html {
334        my ($txt, %option) = @_;
335        my $toc = $option{-toc} || (ref $option{toc} ? $option{toc} : []);
336        my $tocnum = 0;
337        
338        ## Load constants
339        my %const;
340        if ($option{magic} =~ /import="([^"]+)"/) {
341          for (split /\s*,\s*/, $1) {
342            my $wp = $database{$_};
343            if ($wp =~ m!^\#\?SuikaWikiConst/(?:0.9|1.0)!) {
344              wiki::suikawikiconst::to_hash ($wp => \%const);
345          }          }
     } elsif ($name =~ /^mailto:(.*)/) {  
         my $address = $1;  
         return qq|&lt;<a href="$name">$address</a>&gt;|;  
     } elsif ($name =~ m#^urn:[0-9A-Za-z_:;/.-]+#) {  
         return qq|&lt;<a href="/uri-res/N2L?${name}">$name</a>&gt;|;  
     } else {  
       my $name2 = $name; $name2 =~ tr/\x20/-/;  
       if ($database{$name2}) {  
         my $percent_name = &encode_percent($name2);  
         return qq|<a href="$thisurl?mycmd=read;mypage=$percent_name" class="wiki">$name</a>|;  
       } elsif ($database{'[['.$name2.']]'}) {  
         my $percent_name = &encode_percent('[['.$name2.']]');  
         return qq|<a href="$thisurl?mycmd=read;mypage=$percent_name" class="wiki">$name</a>|;  
       } else {  
         my $percent_name = &encode_percent($name2);  
         return qq|<a href="$thisurl?mycmd=edit;mypage=$percent_name" class="wiki newpage">$name<span class="mark">?</span></a>|;  
346        }        }
347      }      }
348  }      
349        $txt =~ s{__&&([^&]+)&&__}{defined $const{$1}?$const{$1}:qq(__&&$1&&__)}ge;
 # %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;  
 }  
   
 # テキスト本体をHTMLに変換する  
 sub convert_html {  
     my ($txt) = shift;  
350      my (@txt) = split(/\n/, $txt);      my (@txt) = split(/\n/, $txt);
351        my (@saved, @result);
352        unshift(@saved, "</p>");
353        push(@result, "<p>");
354      foreach (@txt) {      foreach (@txt) {
355          chomp;          chomp;
356          if (/^\*\*(.*)/) {          if (/^\*\*\*\*\*([^\x0D\x0A]*)/) {
357              push(@result, splice(@saved), '<h3>' . &inline($1) . '</h3>');              push @$toc, [5, "i$tocnum" => ($1 || $tocnum)];
358          } elsif (/^\*(.*)/) {              push(@result, splice(@saved), qq(<h6 @{[&id_and_name("i$tocnum")]}>) . &inline($1, %option, const => \%const) . '</h6>');
359              push(@result, splice(@saved), '<h2>' . &inline($1) . '</h2>');              $tocnum++;
360          } elsif (/^----/) {          } elsif (/^\*\*\*\*([^\x0D\x0A]*)/) {
361              push(@result, splice(@saved), '<hr>');              push @$toc, [4, "i$tocnum" => ($1 || $tocnum)];
362          } elsif (/^(-{1,3})(.*)/) {              push(@result, splice(@saved), qq(<h5 @{[&id_and_name("i$tocnum")]}>) . &inline($1, %option, const => \%const) . '</h5>');
363              &back_push('ul', length($1));              $tocnum++;
364              push(@result, '<li>' . &inline($2) . '</li>');          } elsif (/^\*\*\*([^\x0D\x0A]*)/) {
365                push @$toc, [3, "i$tocnum" => ($1 || $tocnum)];
366                push(@result, splice(@saved), qq(<h4 @{[&id_and_name("i$tocnum")]}>) . &inline($1, %option, const => \%const) . '</h4>');
367                $tocnum++;
368            } elsif (/^\*\*([^\x0D\x0A]*)/) {
369            # if (/^\*\*(.*)/) {
370            # Walrus mod (6) end
371                push @$toc, [2, "i$tocnum" => ($1 || $tocnum)];
372                push(@result, splice(@saved), qq(<h3 @{[&id_and_name("i$tocnum")]}>) . &inline($1, %option, const => \%const) . '</h3>');
373                $tocnum++;
374            } elsif (/^\*([^\x0D\x0A]*)/) {
375                push @$toc, [1, "i$tocnum" => ($1 || $tocnum)];
376                push(@result, splice(@saved), qq(<h2 @{[&id_and_name("i$tocnum")]}>) . &inline($1, %option, const => \%const) . '</h2>');
377                $tocnum++;
378            } elsif (/^(={1,6})(.*)/) {
379                &back_push('ol', length($1), \@saved, \@result);
380                push(@result, '<li>' . &inline($2, %option, const => \%const) . '</li>');
381            } elsif (/^(-{1,6})(.*)/) {
382              &back_push('ul', length($1), \@saved, \@result);
383              my ($pf, $l) = ('', $2);
384              if (!$main::_EMBEDED && $l =~ s/^\s*\[([0-9]+)\]//) {
385                my $num = 0+$1;
386                $pf = qq(<a name="anchor-$num" id="anchor-$num" class="anchor">[$num]</a>);
387              }
388              push(@result, '<li>' . $pf . &inline ($l, %option, const => \%const) . '</li>');
389          } elsif (/^:([^:]+):(.*)/) {          } elsif (/^:([^:]+):(.*)/) {
390              &back_push('dl', 1);              &back_push('dl', 1, \@saved, \@result);
391              push(@result, '<dt>' . &inline($1) . '</dt>', '<dd>' . &inline($2) . '</dd>');              push(@result, '<dt>' . &inline($1, %option, const => \%const) . '</dt>', '<dd>' . &inline($2, %option, const => \%const) . '</dd>');
392          } elsif (/^(>{1,3})(.*)/) {          } elsif (/^(?!>>\d)(>{1,5})(.*)/) {
393              &back_push('blockquote', length($1));              &back_push('blockquote', length($1), \@saved, \@result);
394              push(@result, &inline($2));              push @result, "<p>";
395                push(@result, &inline($2, %option, const => \%const));
396                unshift @saved, "</p>";
397          } elsif (/^\s*$/) {          } elsif (/^\s*$/) {
398              push(@result, splice(@saved));              push(@result, splice(@saved));
             unshift(@saved, "</p>");  
399              push(@result, "<p>");              push(@result, "<p>");
400                unshift(@saved, "</p>");
401          } elsif (/^(\s+.*)$/) {          } elsif (/^(\s+.*)$/) {
402              &back_push('pre', 1);              &back_push('pre', 1, \@saved, \@result);
403              push(@result, &escape($1)); # Not &inline, but &escape              push(@result, &inline($1, %option, const => \%const));
404            } elsif (/^\,(.*?)[\x0D\x0A]*$/) {
405                &back_push('table', 1, \@saved, \@result);
406                #######
407                # This part is taken from Mr. Ohzaki's Perl Memo and Makio Tsukamoto's WalWiki.
408                # XXXXX
409                my $tmp = "$1,";
410                my @value = map {/^"(.*)"$/ ? scalar($_ = $1, s/""/"/g, $_) : $_} ($tmp =~ /("[^"]*(?:""[^"]*)*"|[^,]*),/g);
411                my @align = map {(s/^\s+//) ? ((s/\s+$//) ? ' align="center"' : ' align="right"') : ''} @value;
412                my @colspan = map {($_ eq '==') ? 0 : 1} @value;
413                for (my $i = 0; $i < @value; $i++) {
414                    if ($colspan[$i]) {
415                        while ($i + $colspan[$i] < @value and $value[$i + $colspan[$i]] eq '==') {
416                            $colspan[$i]++;
417                        }
418                        $colspan[$i] = ($colspan[$i] > 1) ? sprintf(' colspan="%d"', $colspan[$i]) : '';
419                        $value[$i] = sprintf('<td%s%s>%s</td>', $align[$i], $colspan[$i], &inline($value[$i], %option, const => \%const));
420                    } else {
421                        $value[$i] = '';
422                    }
423                }
424                push(@result, join('', '<tr>', @value, '</tr>'));
425                # XXXXX
426                #######
427            } elsif (/^\[(INS|DEL|PRE)\[\s*$/) {
428                push @result, splice (@saved), '<'.lc($1).'>';
429                unshift @saved, "</p>";
430                push @result, "<p>";
431            } elsif (/^\](INS|DEL|PRE)\]\s*$/) {
432                push @result, splice (@saved), '</'.lc($1).'>';
433            } elsif (/^\[([0-9]+)\](.*)$/ && !$main::_EMBEDED) {
434              my $num = 0+$1;
435              push @result, qq(<a name="anchor-$num" id="anchor-$num" class="anchor">[$num]</a>);
436              push @result, &inline ($2, %option, const => \%const);
437          } else {          } else {
438              push(@result, &inline($_));              push(@result, &inline($_, %option, const => \%const));
439          }          }
440      }      }
441      push(@result, splice(@saved));      push(@result, splice(@saved));
442      return join("\n", @result);      
443        my $r = join("\n", @result);
444        $r =~ s#<p>\x0D?\x0A</p>##g;
445        $r =~ s#[\x0D\x0A]+</#</#g;
446        $r =~ s#<pre>\x0D?\x0A#<pre>#g;
447        $r;
448  }  }
449    
 # &back_push($tag, $count)  
 # $tagのタグを$levelレベルまで詰める。  
450  sub back_push {  sub back_push {
451      my ($tag, $level) = @_;      my ($tag, $level, $savedref, $resultref, $attr) = @_;
452      while (@saved > $level) {      while (@$savedref > $level) {
453          push(@result, shift(@saved));          push(@$resultref, shift(@$savedref));
     }  
     if ($saved[0] ne "</$tag>") {  
         push(@result, splice(@saved));  
     }  
     while (@saved < $level) {  
         unshift(@saved, "</$tag>");  
         push(@result, "<$tag>");  
454      }      }
455  }      if ($savedref->[0] ne "</$tag>") {
456            push(@$resultref, splice(@$savedref));
 # 編集可能ページか？  
 sub is_editable {return 1;  
 ## TODO: ...  
     my ($pagename) = @_;  
     foreach (@uneditable) {  
         if ($pagename eq $_) {  
             return 0;  
         }  
457      }      }
458      if (&is_valid_name($pagename)) {      while (@$savedref < $level) {
459          return 1;          unshift(@$savedref, "</$tag>");
460            push(@$resultref, "<$tag$attr>");
461      }      }
     return 0;  
462  }  }
463    
464  # Validな名前か?  sub inline ($;%) {
465  sub is_valid_name {      my ($line, %option) = @_;
466      my ($pagename) = @_;      $line = &escape($line);
467      if ($pagename =~ /^$WikiName$/) {      $line =~ s{$embed_command{form}}{&make_custom_form ($1, $2, $3, $4, \%option)}ge;
468          return 1;      $line =~ s{\[(INS|DEL|SUP|SUB|VAR|CODE|KBD|SAMP|DFN)(?:\(([A-Za-z0-9\x20-]+)\))?\[(.+?)\]\]}{<@{[lc $1]}@{[$2 ? qq( class="$2") : '']}>$3</@{[lc $1]}>}g;
469      } elsif ($pagename =~ /^$BracketName$/) {      $line =~ s:\[(WEAK)\[(.+?)\]\]:<span class="@{[lc $1]}">$2</span>:g;
470          return 1;      $line =~ s:\[ABBR\[([^]]+)\] \[([^]]+)\]\]:<acronym title="$2">$1</acronym>:g;
471        $line =~ s:\[RUBYB\[([^]]+)\] \[([^]]+)\] \[([^]]+)\]\]:<span class="ruby"><ruby class="rb"><rb>$1</rb><rp>(</rp><rt>$2</rt><rp>)</rp></ruby><span class="rp"> (</span><span class="rt-below">$3</span><span class="rp">) </span></span>:g;
472        $line =~ s:\[RUBY\[([^]]+)\] \[([^]]+)\]\]:<ruby><rb>$1</rb><rp>(</rp><rt>$2</rt><rp>)</rp></ruby>:g;
473        $line =~ s:\[RUBYB\[([^]]+)\] \[([^]]+)\]\]:<span class="ruby"><span class="rb">$1</span><span class="rp"> (</span><span class="rt-below">$2</span><span class="rp">) </span></span>:g;
474        $line =~ s|'''([^']+)'''|<strong>$1</strong>|g;
475        $line =~ s|''([^']+)''|<em>$1</em>|g;
476        $line =~ s{
477          (\[\[(\#\S+?)\]\])
478          |\[\[([^[]+?)](?:&gt;&gt;([0-9]+))?]
479          |&gt;&gt;([0-9]+)
480          |&lt;([A-Za-z0-9%]+:(?:(?!&gt;).)+)&gt;
481        }{
482          my ($l, $page,$anchor, $anum, $uri) = ($1, $3,$4, 0+$5, $6);
483          if ($l) {
484            &embedded_to_html($1);
485          } elsif (defined $page) {
486            &make_wikilink ($page, anchor => 0+$anchor);
487          } elsif ($anum) {
488            qq(<a href="#anchor-$anum" class="wiki-anchor">&gt;&gt;$anum</a>);
489          } elsif ($uri) {
490            &make_urilink ($uri);
491          }
492        }gex;
493        return $line;
494    }
495    
496    sub make_wikilink ($%) {
497      my ($ename, %option) = @_;
498      my $name = &unescape ($ename);
499      $option{latest} = $option{latest} ? qq(mycmd=default;x-param=@{[time.[0..9]->[rand 10]]};mypage=) : '';
500      if ($database{$name}) {
501        my $subject = &escape (&get_subjectline ($name, delimiter => ''));
502        if ($option{anchor}) {
503          return qq(<a title="$subject" href="$uri{wiki}?$option{latest}@{[&encode($name)]}#anchor-$option{anchor}" class="wiki">$ename&gt;&gt;$option{anchor}</a>);
504      } else {      } else {
505          return 0;        return qq(<a title="$subject" href="$uri{wiki}?$option{latest}@{[&encode($name)]}" class="wiki">$ename</a>);
506      }      }
507  }    } else {
508        return qq(<a title="@{[&Resource('JumpAndEditWikiPage',escape=>1)]}" href="$uri{wiki}?$option{latest}@{[&escape($name)]}" class="wiki not-exist">$ename<span class="mark">@{[&Resource('JumpAndEditWikiPageMark',escape=>1)]}</span></a>);
509      }
510    }
511    
512    sub make_urilink ($;%) {
513      require URI;
514      my $uri = shift;
515      if ($uri =~ s/^IW://) {       ## InterWiki (not URI)
516        $uri = &unescape ($uri);
517        if ($uri =~ /^([^\x00-\x2F\x3A-\x40\x5B-\x60\x7B-\x7F]+|"(?:\\.|[^"\\])+"):([^\x00-\x2F\x3A-\x40\x5B-\x60\x7B-\x7F]+|"(?:\\.|[^"\\])+")$/) {
518          my ($site, $name) = ($1, $2);
519          for ($site, $name) {
520            if (s/^"//) { s/"$//; s/\\(.)/$1/g }
521          }
522          &init_InterWikiName () unless $interwiki{'[[]]'};
523          if ($interwiki{$site}) {
524            &load_formatter ('interwiki');
525            my $uri = &escape ($fmt{interwiki}->replace ($interwiki{$site} => {site => $site, name => $name}));
526            $site = &escape ($site); $name = &escape ($name);
527            qq(&lt;<a href="$uri" class="out-of-wiki interwiki" title="$name ($site); URI: &lt;$uri&gt;"><span class="interwiki-site">$site:</span><span class="interwiki-name">$name</span></a>&gt;);
528          } else {
529            qq(&lt;@{[&Resource('Error:UnknownInterWikiName=',escape=>1)]}@{[&escape ($site)]}&gt;);
530          }
531        } else {
532          qq(&lt;@{[&Resource('Error:InvalidInterWiki=',escape=>1)]}@{[&escape($uri)]}&gt;);
533        }
534      } elsif ($uri =~ /^urn:/) {   ## URN
535        my $uri2 = &escape (URI->new ('/uri-res/N2L?'.&unescape ($uri), 'http')->canonical);
536        qq(&lt;<a href="$uri2" title="URI: &lt;$uri&gt; (via &lt;$uri2&gt;)" class="out-of-wiki urn">$uri</a>&gt;);
537      } elsif ($uri =~ s/^MAIL://) {        ## mail address (not URI)
538        my $uri2 = &escape (URI->new ('mailto:'.&unescape ($uri))->canonical);
539        qq(&lt;<a href="$uri2" class="out-of-wiki mail">$uri</a>&gt;);
540      } elsif ($uri =~ s/^IMG(?:\([^)]+\))?://) {   ## image (not URI itself)
541        my $uri2 = &escape (URI->new (&unescape ($uri))->canonical);
542        qq(<img src="$uri2" alt="" title="URI: &lt;$uri2&gt;" class="out-of-wiki">);
543      } else {      ## misc. URI
544        CGI::Carp::warningsToBrowser (0);
545        my $uri2 = &escape (URI->new (&unescape ($uri))->canonical);
546        CGI::Carp::warningsToBrowser (1);
547        qq(&lt;<a href="$uri2" title="URI: &lt;$uri2&gt;" class="out-of-wiki">$uri</a>&gt;);
548      }
549    }
550    
551    {my %FormIndex;
552    sub make_custom_form ($$$$%) {
553        my ($wfname, $definition, $template, $foption, $option) = @_;
554        ## $template is currently not used in this procedure.
555        #unless ($main::_EMBEDED) {
556            $FormIndex{$option->{page}}++;
557            if (length $definition) {
558                my $param = bless {depth=>10}, 'SuikaWiki::Plugin';
559                my $lastmodified = $database->mtime ($option->{page});
560                &load_formatter (qw/form_input form_option/);
561                $definition = &unescape ($definition);
562                $definition =~ s/\\(.)/$1/g;
563                $foption = &unescape ($foption);
564                $foption =~ s/\\(.)/$1/g;
565                $fmt{form_option}->replace ($foption, $param);
566                $param->{output}->{form} = 1 unless defined $param->{output}->{form};
567                $param->{output}->{form} = 0 if $main::_EMBEDED;
568                $definition .= ' %submit;' if $definition !~ /%submit/ && !$param->{output}->{nosubmit} && $param->{output}->{form};
569                $param->{output}->{page} ||= $option->{page};
570                $param->{form_disabled} = 1 if $database->meta (IsFrozen => $option->{page});
571                my $target_form = $param->{output}->{id};
572                my $r = '';
573                $r = <<EOH if $param->{output}->{form};
574    <form method="post" action="$url_cgi" id="wikiform-$FormIndex{$option->{page}}" class="wikiform">
575      <input type="hidden" name="mycmd" value="@{[$param->{form_disabled}?'default':'wikiform']}" />
576      <input type="hidden" name="mypage" value="@{[&escape($param->{output}->{page})]}" />
577      <input type="hidden" name="myLastModified" value="$lastmodified" />
578      <input type="hidden" name="mytouch" value="on" />
579      <input type="hidden" name="@{[$target_form? qq(wikiform_targetform" value="@{[&escape($target_form)]}) : qq(wikiform_index" value="$FormIndex{$option->{page}})]}" />
580    EOH
581                $r .= qq(<a name="wikiform-$FormIndex{$option->{page}}"></a>) if $UA =~ m#Mozilla/[12]\.#;
582                $r .= $fmt{form_input}->replace ($definition, $param);
583                $r .= "</form>\n" if $param->{output}->{form};
584                $r;
585           } else {  ## No input-interface WikiForm
586             qq(<a id="wikiform-$FormIndex{$option->{page}}" name="wikiform-$FormIndex{$option->{page}}"><!-- #form --></a>);
587           }
588        #} else {
589        #    qq(<ins class="wiki-error">@{[&Resource('Error:WikiForm:EmbedIsNotSupported',escape=>1)]}</ins>);
590        #}
591    }}
592    
593  # 現在時刻の文字列を得る  sub init_form {
594  sub get_current_datestr {      ## TODO: Support multipart/form-data
595      my (@wdays) = ( "日", "月", "火", "水", "木", "金", "土" );      my $query = '';
596      my ($sec, $min, $hour, $mday, $mon, $year, $wday) = localtime(time);      if (uc $main::ENV{REQUEST_METHOD} eq 'POST') {
597      return sprintf("%4d-%02d-%02d (%s) %02d:%02d:%02d",        read STDIN, $query, $main::ENV{CONTENT_LENGTH};
598          $year + 1900, $mon + 1, $mday, $wdays[$wday], $hour, $min, $sec);      }
599  }      $query .= ($query ? ';' : '') . $main::ENV{QUERY_STRING};
600        if ($main::ENV{REQUEST_METHOD} ne 'POST' && $main::ENV{QUERY_STRING} && $main::ENV{QUERY_STRING} !~ /[&;=]/) {
601  # URL?SomePageや、        my $query = &decode($main::ENV{QUERY_STRING});
602  # URL?[[結城浩]]の形式だった場合、(not yet)        $query = &code_convert(\$query, $kanjicode);
603  # 強制的にmycmdをreadにして$formの内容を設定する。          $form{mypage} = $query;
604  sub normalize_form {          $form{mycmd} = 'default';
605      foreach my $key (keys %form) {      } else {
606          if ($key =~ /^$WikiName$/) {        for (split /[;&]/, $query) {
607              $form{mycmd} = 'read';          if (my ($n, $v) = split /=/, $_, 2) {
608              $form{mypage} = $1;            for ($n, $v) {tr/+/ /; s/%([0-9A-Fa-f][0-9A-Fa-f])/pack 'C', hex $1/ge};
609              last;            $form{$n} = $v;
610          } elsif ($key =~ /^$BracketName$/) {          }
611              $form{mycmd} = 'read';        }
612              $form{mypage} = $1;        unless (defined $form{mypage}) {
613              last;          $form{mypage} = $form{epage};
614            $form{mypage} =~ s/([0-9A-F]{2})/ord hex $1/g;
615          }
616        }
617        $form{mypage} ||= $PageName{FrontPage};
618        $form{mypage} =~ tr/\x00-\x1F\x7F//d;
619        $form{mycmd} ||= 'default';
620    
621        # mypreview_edit        -> do_edit, with preview.
622        # mypreview_adminedit   -> do_adminedit, with preview.
623        # mypreview_write       -> do_write, without preview.
624        foreach (keys %form) {
625            if (/^mypreview_(.*)$/) {
626                $form{mycmd} = $1;
627                $form{mypreview} = 1;
628          }          }
629      }      }
 }  
630    
631  # 変換テストを行なうときのサンプル      #
632  sub print_sample {      # $form{mycmd} is frozen here.
633      my $txt = &convert_html(<<"EOD");      #
634  *大見出し1  
635  **小見出し1-1      for (grep /^wikiform__/, keys %form) {
636  -項目1          $form{$_} = &code_convert (\$form{$_}, $kanjicode);
637  -項目2      }
638  -項目3      $form{mymsg} = &code_convert(\$form{mymsg}, $kanjicode);
639  段落1段落1段落1段落1段落1段落1段落1段落1段落1段落1段落1段落1      $form{myname} = &code_convert(\$form{myname}, $kanjicode);
640  段落1段落1段落1段落1段落1段落''強調''1段落1段落1段落1段落1段落1  }
641  段落1段落1段落1段落1段落1段落1段落1段落1段落1段落1段落1段落1  
642    sub get_subjectline {
643  段落2段落2段落2段落2段落2段落2段落2段落2段落2段落2段落2段落2      my ($page, %option) = @_;
644  段落2段落2段落2段落2段落2段落2段落2段落2段落2段落2段落2段落2      my $SubjectLine = SuikaWiki::Plugin->cache ('headline');
645  段落2段落2段落2段落2段落2段落2段落2段落2段落2段落2段落2段落2      unless (defined $SubjectLine->{$page}) {
646  **小見出し1-2        if (not &is_editable($page)) {
647  :用語1:いろいろ書いた解説文1と''強調単語''          $SubjectLine->{$page} = "";
648  段落1段落1段落1段落1段落1段落1段落1段落1段落1段落1段落1段落1        } else {
649  段落1段落1段落1段落1段落1段落1段落1段落1段落1段落1段落1段落1          $SubjectLine->{$page} = do {
650  段落1段落1段落1段落1段落1段落1段落1段落1段落1段落1段落1段落1            my $s=$database{$page};
651  :用語2:いろいろ書いた解説文2            $s =~ s!^\#\?[^\x0A\x0D]+[\x0A\x0D]*!!s;
652  :用語3:いろいろ書いた解説文3            $s =~ s/\x0D?\x0A.*//s;
653  ----          $s};
654  *大見出し2        }
655  **小見出し2-1      }
656  &lt;http://suika.fam.cx/&gt;      if (length $SubjectLine->{$page}) {
657  **小見出し2-2        $option{delimiter} = defined $option{delimiter} ? $option{delimiter} : &Resource('Title-Summary Delimiter');
658          $option{delimiter}.$SubjectLine->{$page}.$option{tail};
659  [[結城浩]]      } else {
660          '';
661  段落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  
 EOD  
     print $txt;  
     exit;  
662  }  }
663    
664  sub diff_check {  sub open_db {
665      traverse_sequences(      if ($modifier_dbtype eq 'dbmopen') {
666              $msgrefA, $msgrefB,          dbmopen(%database, $PathTo{WikiDataBase}, 0666) or die "(dbmopen) $PathTo{WikiDataBase}";
667              {      } elsif ($modifier_dbtype eq 'AnyDBM_File') {
668                  MATCH => \&df_match,          eval q{use AnyDBM_File};
669                  DISCARD_A => \&df_delete,          tie(%database, "AnyDBM_File", $PathTo{WikiDataBase}, O_RDWR|O_CREAT, 0666) or die ("(tie AnyDBM_File) $PathTo{WikiDataBase}");
670                  DISCARD_B => \&df_add,      } elsif ($modifier_dbtype eq 'Yuki::YukiWikiDB') {
671              }          eval q{use Yuki::YukiWikiDB};
672      );          tie(%database, "Yuki::YukiWikiDB", $PathTo{WikiDataBase}) or die ("(tie Yuki::YukiWikiDB) $PathTo{WikiDataBase}");
673      &diff_flush;      } else {    ## Yuki::YukiWikiDB || Yuki::YukiWikiDBMeta
674            eval qq{use $modifier_dbtype};
675            $database = tie(%database, $modifier_dbtype => $PathTo{WikiDataBase}, -lock => 2, -backup => $wiki::diff::UseDiff) or die ("(tie $modifier_dbtype) $PathTo{WikiDataBase}");
676        }
677  }  }
678    
679  sub diff_flush {  sub close_db {
680      $diff_text .= join('', map { "-$_\n" } splice(@diff_deleted));      if ($modifier_dbtype eq 'dbmopen') {
681      $diff_text .= join('', map { "+$_\n" } splice(@diff_added));          dbmclose(%database);
682        } else {
683            untie(%database);
684        }
685  }  }
686    
687  sub df_match {  sub editform (@) {
688      my ($a, $b) = @_;    my %option = @_;
689      &diff_flush;    my $frozen = &is_frozen ($option{page});
690      $diff_text .= "=$msgrefA->[$a]\n";    $option{content} = $database{$option{page}} unless defined $option{content};
691      $option{content} = $database{NewPageTemplate} unless length $option{content};
692      $option{last_modified} = $database->mtime ($option{page}) unless defined $option{last_modified};
693      my $f = '';
694      my $magic = '';
695      $magic = $1 if $option{content} =~ m/^([^\x0A\x0D]+)/s;
696      
697      my $selected = 'default';
698      if ($form{after_edit_cmd}) {
699        $selected = $form{after_edit_cmd};
700      } elsif ($magic =~ /Const|Config|CSS/) {
701        $selected = 'edit';
702      }
703      my $afteredit = <<EOH;
704    <select name="after_edit_cmd">
705    <option value="default" label="@{[&Resource('Edit:SaveAndDefault',escape=>1)]}"@{[$selected eq 'default' ? ' selected="selected"':'']}>@{[&Resource('Edit:SaveAndDefault',escape=>1)]}</option>
706    <option value="read" label="@{[&Resource('Edit:SaveAndView',escape=>1)]}"@{[$selected eq 'read' ? ' selected="selected"':'']}>@{[&Resource('Edit:SaveAndView',escape=>1)]}</option>
707    <option value="edit" label="@{[&Resource('Edit:SaveAndEdit',escape=>1)]}"@{[$selected eq 'edit' ? ' selected="selected"':'']}>@{[&Resource('Edit:SaveAndEdit',escape=>1)]}</option>
708    </select>
709    EOH
710      $f .= <<"EOD";
711    <form action="$uri{wiki}" method="post">
712        @{[ $option{conflict} ? '' : qq(<label><input type="submit" name="mypreview_write" value="@{[&Resource('Edit:Save',escape=>1)]}" /><kbd>S</kbd></label>) ]}
713        @{[ $option{admin} ? qq(<label>@{[&Resource('Edit:Password=',escape=>1)]}<input type="password" name="mypassword" value="" size="10" /></label>) : "" ]} [@{[&get_new_anchor_index($option{content})]}]<br />
714        <input type="hidden" name="myLastModified" value="$option{last_modified}" />
715        <input type="hidden" name="mypage" value="@{[&escape($form{mypage})]}" />
716        <textarea cols="@{[&Resource('Edit:Form:Cols')+0||80]}" rows="@{[&Resource('Edit:Form:Rows')+0||20]}" name="mymsg" tabindex="1">@{[&escape($option{content})]}</textarea><br />
717    @{[
718        $option{admin} ?
719        qq(
720        <label><input type="radio" name="myfrozen" value="1" @{[$frozen ? qq(checked="checked") : ""]} />@{[&Resource('Edit:Freeze',escape=>1)]}</label>
721        <label><input type="radio" name="myfrozen" value="0" @{[$frozen ? "" : qq(checked="checked")]} />@{[&Resource('Edit:DontFreeze',escape=>1)]}</label><br />)
722        : ""
723    ]}
724    @{[
725        $option{conflict} ? "" :
726        qq(
727            <label><input type="checkbox" name="mytouch" value="on" checked="checked" />@{[&Resource('Edit:UpdateTimeStamp',escape=>1)]}</label><br />
728            <label><input type="submit" name="mypreview_write" value="@{[&Resource('Edit:Save',escape=>1)]}" accesskey="S" /><kbd>S</kbd></label>
729           $afteredit
730        )
731    ]}
732    </form>
733    EOD
734        $f;
735  }  }
736    
737  sub df_delete {  sub is_editable {
738      my ($a, $b) = @_;      my ($page) = @_;
739      push(@diff_deleted, $msgrefA->[$a]);      $page =~ /[\x00-\x20\x7F]/ ? 0 : 1;
740  }  }
741    
742  sub df_add {  sub decode {
743      my ($a, $b) = @_;      my ($s) = @_;
744      push(@diff_added, $msgrefB->[$b]);      $s =~ tr/+/ /;
745        $s =~ s/%([A-Fa-f0-9][A-Fa-f0-9])/pack("C", hex($1))/eg;
746        return $s;
747  }  }
748    
749  sub calc_message_digest {   # You have to use MD5...  sub encode {
750      my $text = shift;    my $s = shift;
751      my @text = split(//, $text);    $s =~ s/([^0-9A-Za-z_-])/sprintf '%%%02X', ord $1/ge;
752      my $len = length($text);    $s;
     my $checksum = 0;  
     foreach (@text) {  
         $checksum += ord($_);  
         $checksum = ($checksum * 2) % 65536 + (($checksum & 32768) ? 1 : 0); # 16bit rotate  
     }  
     return "$len:$checksum";  
753  }  }
754    
755  # Definition of YukiWikiDB  sub get_now {
756  package YukiWikiDB;      my ($sec, $min, $hour, $day, $mon, $year) = localtime(time);
757        $year += 1900;
758  my $debug = 1;      $mon++;
759        $mon = "0$mon" if $mon < 10;
760  # Constructor      $day = "0$day" if $day < 10;
761  sub new {      $hour = "0$hour" if $hour < 10;
762      return shift->TIEHASH(@_);      $min = "0$min" if $min < 10;
763        #$sec = "0$sec" if $sec < 10;
764        return "$year-$mon-$day $hour:$min";
765  }  }
766    
767  # tying  sub init_InterWikiName {
768  sub TIEHASH {    my @content = split /\n/, $database{InterWikiName};
769      my ($class, $dbname) = @_;    for (@content) {
770      my $self = {      if (/^([^#]\S*)\s+(\S[^\x0A\x0D]+)/) {
771          dir => $dbname,        $interwiki{$1} = $2;
         keys => [],  
     };  
     if (not -d $self->{dir}) {  
         if (!mkdir($self->{dir}, 0777)) {  
             print "mkdir(" . $self->{dir} . ") fail\n" if ($debug);  
             return undef;  
         }  
772      }      }
773      return bless($self, $class);    }
774      $interwiki{'[[]]'} = 1;       ## dummy
775  }  }
776    
777  # Store  sub frozen_reject {
778  sub STORE {      my ($isfrozen) = $database->meta (IsFrozen => $form{mypage});
779      my ($self, $key, $val) = @_;      my ($willbefrozen) = $form{myfrozen};
780      my $file = &make_filename($self, $key);      if (not $isfrozen and not $willbefrozen) {
781      if (open(FILE,"> $file")) {          # You need no check.
782          binmode(FILE);          return 0;
783          print FILE $val;      } elsif (valid_password($form{mypassword})) {
784          close(FILE);          # You are admin.
785          return $self->{$key} = $val;          return 0;
786      } else {      } else {
787          print "$file create error.";          &_do_view_msg (-view => '-error', -page => $form{mypage},
788                           error_message => &Resource ('Error:PasswordIsIncorrect'));
789            exit;
790      }      }
791  }  }
792    
793  # Fetch  sub is_frozen ($) { $database->meta (IsFrozen => $_[0]) ? 1 : 0 }
794  sub FETCH {  
795      my ($self, $key) = @_;  sub do_comment {
796      my $file = &make_filename($self, $key);      my ($content) = $database{$form{mypage}};
797      if (open(FILE, $file)) {      my $default_name;   ## this code is not strict.
798          local $/;      $default_name = $1 if $content =~ /default-name="([^"]+)"/;
799          $self->{$key} = <FILE>;      my $datestr = '[WEAK['.&get_now.']]';
800          close(FILE);      my $namestr = $form{myname} || $default_name || &Resource('WikiForm:WikiComment:DefaultName');
801        ($namestr = '', $datestr = '') if $form{myname} eq 'nodate';
802        if ($namestr =~ /^(?:>>)?[0-9]/) {
803          $namestr = qq( ''$namestr'': );
804        } elsif (length $namestr) {
805          $namestr = qq( ''[[$namestr]]'': );
806        }
807        my $anchor = &get_new_anchor_index ($content);
808        my $i = 1;  my $o = 0;
809        $content =~ s{(\[\[\#r?comment\]\])}{
810          my $embed = $1;
811          if ($i == $form{comment_index}) {
812            if ($embed ne '[[#rcomment]]') {
813              $embed = "- [$anchor] $datestr$namestr$form{mymsg}\n$embed";  $o = 1;
814            } else {
815              $embed .= "\n- [$anchor] $datestr$namestr$form{mymsg}";  $o = 1;
816            }
817          }
818          $i++; $embed;
819        }ge;
820        unless ($o) {
821          $content = "#?SuikaWiki/0.9\n\n" unless $content;
822          $content .= "\n" unless $content =~ /\n$/s;
823          $content .= "- [$anchor] $datestr$namestr$form{mymsg}\n";
824        }
825        $form{__comment_anchor_index} = $anchor;
826        if ($form{mymsg} || $form{myname}) {
827            $form{mymsg} = $content;
828            $form{mytouch} = 'on';
829            &do_write;
830        } else {    ## Don't write
831            $form{mycmd} = 'default';
832            &do_view;
833      }      }
     return $self->{$key};  
834  }  }
835    
836  # Exists  sub get_new_anchor_index ($) {
837  sub EXISTS {      my $content = shift;
838      my ($self, $key) = @_;      my $anchor = 0;
839      my $file = &make_filename($self, $key);      $content =~ s/^(?:[-=]+\s*)?\[([0-9]+)\]/$anchor = $1 if $1 > $anchor; $&/mge;
840      return -e($file);      $anchor + 1;
841    }
842    
843    my $CommentIndex = 0;
844    sub embedded_to_html {
845        my ($embedded) = @_;
846        if ($embedded eq '[[#comment]]' or $embedded eq '[[#rcomment]]') {
847          unless ($main::_EMBEDED) {
848            my $lastmodified = $database->mtime ($form{mypage});
849            return <<"EOD";
850    <form action="$url_cgi" method="post" id="x-comment-@{[++$CommentIndex]}" class="comment"><p>
851        <input type="hidden" name="mycmd" value="comment" />
852        <input type="hidden" name="mypage" value="$form{mypage}" />
853        <input type="hidden" name="myLastModified" value="$lastmodified" />
854        <input type="hidden" name="mytouch" value="on" />
855        <input type="hidden" name="comment_index" value="$CommentIndex" />
856        @{[&Resource('WikiForm:WikiComment:Name=',escape=>1)]}
857        <input type="text" name="myname" value="" size="10" class="comment-name" />
858        <input type="text" name="mymsg" value="" size="60" class="comment-msg" />
859        <input type="submit" value="@{[&Resource('WikiForm:Add',escape=>1)]}" title="@{[&Resource('WikiForm:AddLong',escape=>1)]}" class="comment-submit" />
860    </p></form>
861    EOD
862         } else {
863            return <<"EOD";
864    <del><form action="$url_cgi" method="get">
865        <input type="hidden" name="mycmd" value="default" />
866        <input type="hidden" name="mypage" value="$form{mypage}" />
867        @{[&Resource('WikiForm:WikiComment:Name=',escape=>1)]}
868        <input type="text" name="myname" value="" size="10" disabled="disabled" />
869        <input type="text" name="mymsg" value="" size="60" disabled="disabled" />
870    </form></del>
871    EOD
872        }
873      } elsif ($embedded =~ /$embed_command{searched}/) {
874        return get_search_result ($1, -match_myself => 1);
875      } elsif ($embedded =~ /^\[\[\#embed:(.+)\]\]$/) {
876        my ($name, $r) = ($1, '');
877        if ($main::_EMBEDED != 1) {
878          my ($cf, $content) = SuikaWiki::Plugin->magic_and_conten ($database{$name});
879          $cf ||= '#?SuikaWiki/0.9';
880          if ($cf =~ m!^#\?SuikaWiki/0.9(?:$|\s)!) {
881            $main::_EMBEDED = 1;
882            $r = &text_to_html ($content, magic => $cf, page => $name);
883            $main::_EMBEDED = 0;
884          } elsif (length $content) {
885            $r = "<pre>@{[&escape ($content)]}</pre>";
886          } else {
887            $r = &text_to_html ("[INS[\n[[$name]]: @{[&Resource('Embed:PageNotFound')]}\n]INS]\n", magic => '#?SuikaWiki/0.9');
888          }
889        } else {    ## nested #EMBED
890          $r = &text_to_html ("[INS[\n[[$name]]: @{[&Resource('Embed:Nested',escape=>1)]}\n]INS]\n", magic => '#?SuikaWiki/0.9');
891        }
892        return qq(<blockquote title="@{[&escape($name)]}" class="wiki-embed">$r<div class="cite-note">『<cite><a href="$url_cgi?@{[&encode($name)]}" class="wiki">@{[&escape($name)]}</a></cite>』</div></blockquote>);
893      } elsif ($embedded =~ /^\[\[\#randomlink:(.+)\]\]$/) {
894        return qq(<a href="$url_cgi?mycmd=RandomJump;x-param=@{[time.[0..9]->[rand 10]]}" class="wiki randomlink">$1</a>);
895      } else {
896        return $embedded;
897      }
898    }
899    
900    sub load_formatter (@) {
901        for my $t (@_) {
902            unless ($fmt{$t}) {
903                require Message::Util::Formatter;
904                $fmt{$t} = Message::Util::Formatter->new;
905                for (@{$SuikaWiki::Plugin::List{'wiki'.$t}||[]}) {
906                    $_->load_formatter ($fmt{$t}, type => 'wiki'.$t);
907                }
908            }
909        }
910  }  }
911    
912  # Delete  sub do_wikiform {
913  sub DELETE {      my $content = $database{$form{mypage}};
914      my ($self, $key) = @_;      my $anchor = &get_new_anchor_index ($content);
915      my $file = &make_filename($self, $key);      &load_formatter (qw/form_template form_option/);
916      unlink $file;      my $write = 0;
917      return delete $self->{$key};      my $i = 1;
918        $content =~ s{$embed_command{form}}{
919            my ($embed, $wfname, $template, $option) = ($&, $1, $3, $4);
920            if (($wfname && $wfname eq $form{wikiform_targetform})
921                || $i == $form{wikiform_index}) {
922                $template =~ s/\\(.)/$1/g;
923                $option =~ s/\\(.)/$1/g;
924                my $param = bless {depth=>10}, 'SuikaWiki::Plugin';
925                $param->{page} = $form{mypage};
926                $param->{form_index} = $i;
927                $param->{form_name} = $wfname;
928                $param->{anchor_index} = $anchor;
929                $param->{argv} = \%form;
930                $param->{default_name} = $1 if $content =~ /default-name="([^"]+)"/;
931                $param->{default_name} ||= &Resource('WikiForm:WikiComment:DefaultName');
932                $fmt{form_option}->replace ($option, $param);
933                my $t = 1;
934                for (keys %{$param->{require}||{}}) {
935                    (undef $t, last) unless length $param->{argv}->{'wikiform__'.$_};
936                }
937                $t = $fmt{form_template}->replace ($template, $param) if $t;
938                if (length $t) {
939                    if ($param->{output}->{reverse}) {
940                        $embed .= "\n" . $t;
941                    } else {
942                        $embed = $t . "\n" . $embed;
943                    }
944                    $write = 1;
945                    $form{__comment_anchor_index} = $anchor
946                      if $param->{anchor_index_};  ## $anchor is used!
947                }
948                $form{__wikiform_anchor_index} = $i;
949                undef $form{wikiform_targetform};  ## Make sure never to match
950                undef $form{wikiform_index};       ## with WikiForm in rest of page!
951            }
952            $i++; $embed;
953        }ge;
954        unless ($write) {
955          #$content = "#?SuikaWiki/0.9\n\n" unless $content;
956          #$content .= "\n" unless $content =~ /\n$/s;
957          #
958        }
959        if ($write) {
960            $form{mymsg} = $content;
961            $form{mytouch} = 'on';
962            &do_write;
963        } else {    ## Don't write!
964            $form{mycmd} = 'default';
965            &do_view;
966        }
967    }
968    
969    sub code_convert {
970      require Jcode;
971        my ($contentref, $code) = (shift, shift || $kanjicode);
972        if    ($code =~ /euc/) { $code = 'euc' }
973        elsif ($code =~ /iso/) { $code = 'jis' }
974        elsif ($code =~ /shi/) { $code = 'sjis' }
975        elsif ($code =~ /utf/) { $code = 'utf8' }
976        $$contentref = Jcode->new ($contentref)->tr ("\xA3\xB0-\xA3\xB9\xA3\xC1-\xA3\xDA\xA3\xE1-\xA3\xFA\xA1\xF5\xA1\xA4\xA1\xA5\xA1\xA7\xA1\xA8\xA1\xA9\xA1\xAA\xA1\xAE\xA1\xB0\xA1\xB2\xA1\xBF\xA1\xC3\xA1\xCA\xA1\xCB\xA1\xCE\xA1\xCF\xA1\xD0\xA1\xD1\xA1\xDC\xA1\xF0\xA1\xF3\xA1\xF4\xA1\xF6\xA1\xF7\xA1\xE1\xA2\xAF\xA2\xB0\xA2\xB2\xA2\xB1\xA1\xE4\xA1\xE3\xA1\xC0\xA1\xA1" => q(0-9A-Za-z&,.:;?!`^_/|()[]{}+$%#*@='"~-><\ ))->$code;
977        return $$contentref;
978    }
979    
980    sub _rfc3339_date ($) {
981      my @time = gmtime (shift);
982      sprintf '%04d-%02d-%02dT%02d:%02d:%02d+00:00', $time[5]+1900,$time[4]+1,@time[3,2,1,0];
983    }
984    
985    my %_Resource;
986    sub Resource ($;%) {
987      my ($s, %o) = @_;
988      unless (defined $_Resource{$s}) {
989        $_Resource{$_[0]} = &wiki::resource::get ($s, $_Resource{__option});
990      }
991      $o{escape} ? &escape ($_Resource{$s}) : $_Resource{$s};
992    }
993    
994    package wiki::referer;
995    sub add ($$) {
996      my $page = shift;
997      my $uri = shift;
998      unless (ref $uri) {
999        require URI;
1000        $uri = URI->new ($uri);
1001        ## Some schemes do not have query part.
1002        eval q{ $uri->query (undef) if $uri->query =~ /^[0-9]{6,8}$/ };
1003        $uri->fragment (undef);
1004      }
1005      $uri = $uri->canonical;
1006      return unless $uri;
1007      for my $regex (&get_dont_record) {
1008        return if $uri =~ /$regex/;
1009      }
1010      my %list = get ($page);
1011      $list{ $uri }++;
1012      set ($page, \%list);
1013    }
1014    sub get ($) { split /"/, $main::database->meta (Referer => $_[0]) }
1015    sub set ($%) {
1016      my $page = shift;
1017      my $list = shift;
1018      $main::database->meta (Referer => $page => join '"', %$list);
1019    }
1020    
1021    sub get_dont_record () {
1022      map {s/\$/\\\$/g; s/\@/\\\@/g; $_}
1023      grep !/^#/,
1024      split /[\x0D\x0A]+/, $main::database{RefererDontRecord};
1025    }
1026    sub get_site_name () {
1027      my @lines = grep /[^#]/, split /[\x0D\x0A]+/, $main::database{RefererSiteName};
1028      my @item;
1029      for (@lines) {
1030        next if /^#/;
1031        my ($uri, $name) = split /\s+/, $_, 2;
1032        $uri =~ s/\$/\\\$/g;  $uri =~ s/\@/\\\@/g;  $uri =~ s/\//\\\//g;
1033        $name =~ s!([()/\\])!\\$1!g;  $name =~ s/\$([0-9]+)/).__decode (\${$1}).q(/g;
1034        push @item, [$uri, qq(q($name))];
1035      }
1036      @item;
1037    }
1038    
1039    sub list_html ($) {
1040      my $page = shift;
1041      my %list = get ($page);
1042      my $r = '';
1043      my @name = get_site_name;
1044      for my $uri (sort keys %list) {
1045        my $title;
1046        for my $item (@name) {
1047          if ($uri =~ /$item->[0]/) {
1048            $title = $uri;
1049            eval qq{\$title =~ s/^.*$item->[0].*\$/$item->[1]/e}
1050              or die $@ ;#. qq{\$title =~ s/^.*$item->[0].*\$/$item->[1]/e};
1051            last;
1052          }
1053        }
1054        my $euri = main::escape ($uri);
1055        if ($title) {
1056          $r .= qq(<li>[$list{$uri}] <a href="$euri" title="URI: &lt;$euri&gt;">@{[main::escape ($title)]}</a></li>\n);
1057        } else {
1058          $r .= qq(<li>[$list{$uri}] &lt;<a href="$euri">$euri</a>&gt;</li>\n);
1059        }
1060      }
1061      $r ? qq(<ul>$r</ul>\n) : '';
1062  }  }
1063    
1064  sub FIRSTKEY {  sub __decode ($) {
1065      my ($self) = @_;    my $s = shift;
1066      opendir(DIR, $self->{dir}) or die $self->{dir};    $s =~ tr/+/ /;
1067      @{$self->{keys}} = grep /\.txt$/, readdir(DIR);    $s =~ s/%([0-9A-Fa-f][0-9A-Fa-f])/chr hex $1/ge;
1068      foreach my $name (@{$self->{keys}}) {    main::code_convert (\$s);
1069          $name =~ s/\.txt$//;  }
1070          $name =~ s/[0-9A-F][0-9A-F]/pack("C", hex($&))/eg;  
1071    package wiki::useragent;
1072    our $UseLog;
1073    
1074    sub add ($) {
1075      my $s = shift;
1076      return unless length $s;
1077      return unless $UseLog;
1078      $s =~ s/([\x00-\x08\x0A-\x1F\x25\x7F-\xFF])/sprintf '%%%02X', unpack 'C', $1/ge;
1079      my %ua;
1080      for (split /\n/, $main::database{$main::PageName{UserAgentList}}) {
1081        if (/^-\[(\d+)\] (.+)$/) {
1082          my ($t, $n) = ($1, $2);
1083          $n =~ tr/\x0A\x0D//d;
1084          $ua{$n} = $t;
1085        }
1086      }
1087      $ua{$s}++;
1088      my $s = qq(#?SuikaWiki/0.9\n);
1089      for (sort {$ua{$a} <=> $ua{$b}} keys %ua) {
1090        $s .= sprintf qq(-[%d] %s\n), $ua{$_}, $_;
1091      }
1092      $main::database->STORE ($main::PageName{UserAgentList} => $s, -touch => 0);
1093    }
1094    
1095    package wiki::suikawikiconst;
1096    
1097    sub to_hash ($;$) {
1098      my $page = shift;
1099      my $h = shift || {};
1100      my $val;
1101      for my $line (split /\n/, $page) {
1102        next if $line =~ /^#/;
1103        $line =~ tr/\x0A\x0D//d;
1104        if ($val && $line =~ s/^\s+//) {
1105          $h->{$val} .= length $h->{$val} ? "\n" . $line : $line;
1106        } elsif ($line =~ /^(.+):/) {
1107          $val = $1; $h->{$val} = '';
1108        }
1109      }
1110      $h;
1111    }
1112    
1113    package wiki::dummy;
1114    sub mtime (@) {undef}
1115    sub meta (@) {undef}
1116    sub Yuki::YukiWikiDB2::meta (@) {undef}
1117    
1118    package SuikaWiki::Plugin;
1119      our ($plugin_directory, %List, %Index, %Cache);
1120      push @main::INC, $plugin_directory.'/../..';
1121    
1122    sub escape ($$) { main::escape ($_[1]) }
1123    sub unescape ($$) { main::unescape ($_[1]) }
1124    sub encode ($$) { main::encode ($_[1]) }
1125    sub decode ($$) { main::decode ($_[1]) }
1126    sub __get_datetime ($) { main::get_now () }
1127    sub resource ($$;%) { shift; &main::Resource (@_) }
1128    sub uri ($$) { $main::uri{$_[1]} }
1129    sub new_index ($$) { ++$Index{$_[1]} }
1130    sub user_agent_names ($) { $main::UA }
1131    sub magic_and_content ($$) {
1132      my ($magic, $page) = ('', $_[1]);
1133      $magic = $1 if $page =~ s!^((?:\#\?|/\*|<\?)[^\x02\x0A\x0D]+)[\x02\x0A\x0D]+!!s;
1134      ($magic, $page);
1135    }
1136    sub formatter ($$) {
1137      &main::load_formatter ($_[1]);
1138      $main::fmt{$_[1]};
1139    }
1140    sub format_converter ($$$) {
1141      &main::load_formatter ('format');
1142      $main::fmt{format}->{($_[1]=~/([A-Za-z0-9]\S+)/?$1:'SuikaWiki/0.9').'_to_'.$_[2]}
1143      || $main::fmt{format}->{($_[1]=~/([A-Za-z0-9](?:(?!\/)\S)+)/?$1:'SuikaWiki').'_to_'.$_[2]};
1144    }
1145    sub cache ($$) {
1146      my $name = $_[1];
1147      unless (ref $Cache{$name}) {
1148        my %cache;
1149        tie (%cache, 'Yuki::YukiWikiCache', -file => $main::PathTo{CachePrefix}.$name);
1150        $Cache{$name} = \%cache;
1151      }
1152      $Cache{$name};
1153    }
1154    
1155    sub regist ($@) {
1156        my $pack = shift;
1157        for (@_) {
1158            push @{$List{$_}}, $pack;
1159        }
1160    }
1161    
1162    sub import_plugins () {
1163        opendir PDIR, $plugin_directory;
1164        my @plugin = grep {s/\.pm$//} readdir (PDIR);
1165        closedir PDIR;
1166        for (@plugin) {
1167            eval qq{ use SuikaWiki::Plugin::$_ } unless /[^A-Za-z0-9_]/;
1168            push @{$List{_all}}, qq(SuikaWiki::Plugin::$_);
1169        }
1170    }
1171    
1172    &import_plugins ();
1173    
1174    package wiki::conneg;
1175    
1176    ## BUG: this parser isn't strict.
1177    sub get_accept_lang (;$) {
1178      my $alang = shift || $main::ENV{HTTP_ACCEPT_LANGUAGE};
1179      my %alang = (ja => 0.0002, en => 0.0001);
1180      if ($UA =~ m#Mozilla/0\.#) {
1181        $alang{ja} = 0.00001;
1182      }
1183      my $i = 0.1;
1184      for (split /\s*,\s*/, $alang) {
1185        tr/\x09\x0A\x0D\x20//d;
1186        if (/((?:(?!;q=).)+)(?:;q="?([0-9.]+)"?)?/) {
1187          my $l = lc $1; $l =~ tr/\x22\x5C//d;
1188          $alang{$l} = (defined $2 ? $2 : 1.000)*1000;
1189          $alang{$l} += $i unless $alang{$l} == 0;
1190          $i -= 0.001;
1191        }
1192      }
1193      \%alang;
1194    }
1195    
1196    package wiki::resource;
1197    
1198    sub get ($;\%) {
1199      my ($resname, $option) = @_;
1200      $option->{accept_language} ||= &wiki::conneg::get_accept_lang ();
1201      $option->{resource} ||= {};
1202      my $v;
1203      for my $lang (sort {$option->{accept_language}->{$b} <=> $option->{accept_language}->{$a}} grep {$option->{accept_language}->{$_}!=0} keys %{$option->{accept_language}}) {
1204        while (length $lang) {
1205          unless ($option->{accept_language}->{defined $option->{accept_language}->{$lang} ? $lang : '*'} == 0) {
1206            $option->{resource}->{$lang} ||= &wiki::suikawikiconst::to_hash ($main::database{'WikiResource:'.$lang});
1207            $v = $option->{resource}->{$lang}->{$resname};
1208            last if defined $v;
1209          }
1210          $lang =~ s/[^+-]*$//; $lang =~ s/[+-]$//;
1211      }      }
1212      return shift @{$self->{keys}};      last if defined $v;
1213      }
1214      defined $v ? $v : $resname;
1215  }  }
1216    
1217  sub NEXTKEY {  package main;
1218      my ($self) = @_;  &main;
1219      return shift @{$self->{keys}};  exit 0;
 }  
1220    
1221  sub make_filename {  1;
     my ($self, $key) = @_;  
     my $enkey = '';  
     foreach my $ch (split(//, $key)) {  
         $enkey .= sprintf("%02X", ord($ch));  
     }  
     return $self->{dir} . "/$enkey.txt";  
 }  
1222  __END__  __END__
   
1223  =head1 NAME  =head1 NAME
1224    
1225  YukiWiki - 自由にページを追加・削除・編集できるWebページ構築CGI  wiki.cgi --- SuikaWiki: Yet yet another WikiEngine
   
     Copyright (C) 2000,2001 by Hiroshi Yuki.  
     結城浩 <hyuki@hyuki.com>  
     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<< <p> >>の区切りとなります。  
   
 =item *  
   
 HTMLのタグは書けません。  
   
 =item *  
   
 B<''ボールド''>のようにシングルクォート二つではさむと、  
 ボールドC<< <b> >>になります。  
   
 =item *  
   
 B<'''イタリック'''>のようにシングルクォート三つではさむと、  
 イタリックC<< <i> >>になります。  
   
 =item *  
   
 B<---->のようにマイナス4つがあると、  
 水平線C<< <hr> >>になります。  
   
 =item *  
   
 行をB<*>ではじめると、  
 大見出しC<< <h2> >>になります。  
   
 =item *  
   
 行をB<**>ではじめると、  
 小見出しC<< <h3> >>になります。  
   
 =item *  
   
 行をマイナス-ではじめると、  
 箇条書きC<< <ul> >>になります。  
 マイナスの数が増えるとレベルが下がります（3レベルまで）  
   
     -項目1  
     --項目1-1  
     --項目1-2  
     -項目2  
     -項目3  
     --項目3-1  
     ---項目3-1-1  
     ---項目3-1-2  
     --項目3-2  
   
 =item *  
   
 コロンを使うと、  
 用語と解説文のリストC<< <dl> >>が書けます。  
   
     :用語1:いろいろ書いた解説文1  
     :用語2:いろいろ書いた解説文2  
     :用語3:いろいろ書いた解説文3  
   
 =item *  
   
 リンク  
   
 =over 4  
   
 =item *  
   
 LinkToSomePageやFrontPageのように、  
 英単語の最初の一文字を大文字にしたものが  
 二つ以上連続したものはYukiWikiのページ名となり、  
 それが文章中に含まれるとリンクになります。  
   
 =item *  
   
 http://www.hyuki.com/ のようなURLは自動的にリンクになります。  
   
 =item *  
   
 二重の大かっこ[[ ]]でくくった文字列も、  
 YukiWikiのページ名になります。  
 大かっこの中にはスペースを含めてはいけません。  
 日本語も使えます。  
   
 =back  
   
 =item *  
   
 行頭がスペースやタブで始まっていると、  
 それは整形済みの段落C<< <pre> >>として扱われます。  
 プログラムの表示などに使うと便利です。  
   
   
 =item *  
   
 行を > ではじめると、  
 引用文C<< <blockquote> >>が書けます。  
 >の数が多いとインデントが深くなります（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に表示およびプレビューする前に < や > を &lt; や &gt; に変換した  
 (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。  
  <body color=...> → <body bgcolor=...>  
 利用者からの指摘による。感謝。  
   
 =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を公開。  
 編集時のリンクミス。  
 <textarea>の属性変更。  
   
 =item *  
   
 2000年7月22日、Version 0.81を公開。  
 ロゴを組み込む。  
   
 =item *  
   
 2000年7月21日、Version 0.80を公開。  
 PODをCGI中に書き込む。  
   
 =item *  
   
 2000年7月19日、Version 0.70を公開。  
 '''イタリック'''や、--、---、>>、>>>などを実装。  
   
 =item *  
   
 2000年7月18日、Version 0.60を公開。  
 *太字*を''太字''に変更  
   
 =item *  
   
 2000年7月17日、Version 0.50を公開。  
   
 =item *  
   
 2000年7月17日、さらにいろいろ追加する。  
   
 =item *  
   
 2000年7月16日、いろいろ追加。  
   
 =item *  
   
 2000年7月15日、公開。  
   
 =back  
   
 =head1 TODO  
   
     - テキスト表示モード  
     - Charsetを明示。  
     - textarea中の閉じタグ対応  
     - メニューの英語表記付記  
     - プレビューのボタンで、mymsgをinputのvalueに入れているが、改行をそのままvalueにいれてはいけないのではないか。  
     - 「再編集」の機能はブラウザの back で充分ではないか。プレビューはもっとシンプルに。  
     - ページタイトル（Wikiname）が検索にかかるようにする。  
     - InterWiki風の機能「URLを隠しつつ、リンクを張る」  
   
 =head1 作者  
   
     Copyright (C) 2000 by Hiroshi Yuki.  
     結城浩 <hyuki@hyuki.com>  
     http://www.hyuki.com/  
     http://www.hyuki.com/yukiwiki/  
   
 質問、意見、バグ報告は hyuki@hyuki.com にメールしてください。  
   
 =head1 配布条件  
   
 YukiWikiは、  
 GNU General Public Licenseにて公開します。  
   
 YukiWikiはフリーソフトです。  
 ご自由にお使いください。  
 自分好みのYukiWikiが作れるようにシンプルにしてあります。  
   
 =head1 謝辞  
   
 本家のWikiWikiを作ったCunningham & Cunningham, Inc.に  
 感謝します。  
   
 YukiWikiを楽しんで使ってくださる  
 ネット上の方々に感謝します。  
   
 YukiWikiのロゴをデザインしてくださった橋本礼奈さん  
 http://city.hokkai.or.jp/~reina/  
 に感謝します。  
   
 tieを使った版の元になるコードを送ってくださった  
 「極悪」さんに感謝します。  
   
 =head1 参照リンク  
   
 =over 4  
1226    
1227  =item *  =head1 SEE ALSO
1228    
1229  YukiWikiホームページ  <IW:SuikaWiki:SuikaWiki>
 http://www.hyuki.com/yukiwiki/  
1230    
1231  =item *  =head1 AUTHORS
1232    
1233  本家のWikiWiki  Hiroshi Yuki <hyuki@hyuki.com> <http://www.hyuki.com/yukiwiki/>
 http://c2.com/cgi/wiki?WikiWikiWeb  
1234    
1235  =item *  Makio Tsukamoto <http://digit.que.ne.jp/>
1236    
1237  本家のWikiWikiの作者(Cunningham & Cunningham, Inc.)  Wakaba <w@suika.fam.cx>
 http://c2.com/  
1238    
1239  =item *  =head1 LICENSE
1240    
1241  YukiWikiのロゴデザインをしてくださった橋本礼奈さんのページ  Copyright (C) 2000-2003 AUTHORS
 http://city.hokkai.or.jp/~reina/  
1242    
1243  =back  This program is free software; you can redistribute it and/or
1244    modify it under the same terms as Perl itself.
1245    
1246  =cut  =cut
Legend:
Removed from v.1.11  
changed lines
  Added in v.1.51
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24