/[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.41 by wakaba, Wed Dec 25 02:04:11 2002 UTC revision 1.46 by w, Thu Jan 2 12:14:15 2003 UTC
# Line 5  Line 5 
5  # modify it under the same terms as Perl itself.  # modify it under the same terms as Perl itself.
6    
7  use strict;  use strict;
8  use lib qw(./WalWiki/lib);  use lib qw(./lib);
9  use CGI::Carp qw(fatalsToBrowser);  use CGI::Carp qw(fatalsToBrowser);
10  use Yuki::DiffText qw(difftext);  our $VERSION = do{my @r=(q$Revision$=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};
11    
12    require 'wikidata/suikawiki-config.ph';
13  use Fcntl;  use Fcntl;
 #  
 # You MUST modify following '$modifier_...' variables.  
 #  
 # 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_dir_data = './wikidata'; # Your data directory.  
 our $url_cgi = '/~wakaba/-temp/wiki/wiki';      ## MUST be started by '/'  
 ##############################  
 #  
 # You MAY modify following variables.  
 #  
 $SuikaWiki::Plugin::plugin_directory = q(./SuikaWiki/Plugin/);  
 my $file_touch = "$modifier_dir_data/touched.txt";  
 our %uri;  
 $uri{stylesheet} = $url_cgi.'?mycmd=TEXT_CSS;mypage=WikiHTMLStyle';  
 $uri{cvs_wikipage} = '/gate/cvs/wakaba/suikawiki/wiki/';  
 ##############################  
 #  
 # 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 $use_exists = 0; # If you can use 'exists' method for your DB.  
 ##############################  
 my $FrontPage = 'HomePage';  
 my $IndexPage = 'IndexPage';  
 my $SearchPage = 'SearchPage';  
 my $CreatePage = 'CreatePage';  
 my $ErrorPage = 'ErrorPage';  
 my $RssPage = 'RssPage';  
 my $AdminSpecialPage = 'Admin Special Page'; # must include spaces.  
14  ##############################  ##############################
15  my %fmt;        ## formatter objects  my %fmt;        ## formatter objects
16  my %embed_command = (  my %embed_command = (
17          searched        => '^\[\[#searched:([^\]]+)\]\]$',          searched        => '^\[\[#searched:([^\]]+)\]\]$',
18          form    => qw/\[\[\#form(?:\(([A-Za-z0-9-]+)\))?:'((?:[^'\\]|\\.)*)':'((?:[^'\\]|\\.)*)'(?::'((?:[^'\\]|\\.)*)')?\]\]/,          form    => qr/\[\[\#form(?:\(([A-Za-z0-9-]+)\))?:'((?:[^'\\]|\\.)*)':'((?:[^'\\]|\\.)*)'(?::'((?:[^'\\]|\\.)*)')?\]\]/,
19  );  );
20    our ($modifier_dbtype,$url_cgi,%uri,%PathTo,$use_exists);
21    our (%PageName,$kanjicode,$lang,%FixedPage);
22    
23  ##############################  ##############################
24  my $info_LastModified = 'LastModified';  my $info_LastModified = 'LastModified';
25  my $info_IsFrozen = 'IsFrozen';  my $info_IsFrozen = 'IsFrozen';
26  ##############################  ##############################
 my $kanjicode = 'euc';  
 my $lang = 'ja';  
 my %fixedpage = (  
     $IndexPage => 1,  
     $CreatePage => 1,  
     $ErrorPage => 1,  
     $RssPage => 1,  
     RecentChanges => 1,  
     $SearchPage => 1,  
     AdminChangePassword => 1,  
     CompletedSuccessfully => 1,  
     WikiUserAgentList => 1,  
     WikiPluginInfo    => 1,  
 );  
27  my %form;  my %form;
28  my %database;  our %database;
29    our $database;
30  my %infobase;  my %infobase;
 my %diffbase;  
31  my %interwiki;  my %interwiki;
32  ##############################  ##############################
33  my %page_command = (  my %page_command = (
34      $IndexPage => 'index',      $PageName{RssPage} => 'rss',
     $SearchPage => 'searchform',  
     $CreatePage => 'create',  
     $RssPage => 'rss',  
     AdminChangePassword => 'adminchangepasswordform',  
     WikiPluginInfo       => 'x_WikiPluginInfo',  
35  );  );
36  my %command_do = (  my %command_do = (
37      read => \&do_read,      read => \&do_read,
38      TEXT_CSS => \&do_output_css,      TEXT_CSS => \&do_output_css,
39      edit => \&do_edit,      edit => \&do_edit,
40      adminedit => \&do_adminedit,      adminedit => \&do_adminedit,
     adminchangepasswordform => \&do_adminchangepasswordform,  
41      adminchangepassword => \&do_adminchangepassword,      adminchangepassword => \&do_adminchangepassword,
42      write => \&do_write,      write => \&do_write,
     index => \&do_index,  
43      searchform => \&do_searchform,      searchform => \&do_searchform,
     search => \&do_search,  
     create => \&do_create,  
     createresult => \&do_createresult,  
44      comment => \&do_comment,      comment => \&do_comment,
45      RandomJump  => \&do_random_jump,      RandomJump  => \&do_random_jump,
46      rss => \&do_rss,      rss => \&do_rss,
47      diff => \&do_diff,      diff => \&do_diff,
48      wikiform    => \&do_wikiform,      wikiform    => \&do_wikiform,
     x_WikiPluginInfo    => \&do_wikiplugininfo,  
49      map => \&do_map,      map => \&do_map,
50  );  );
51  my $UA = '';  ## User agent name  my $UA = '';  ## User agent name
# Line 112  sub main { Line 59  sub main {
59      if ($command_do{$form{mycmd}}) {      if ($command_do{$form{mycmd}}) {
60          &{$command_do{$form{mycmd}}};          &{$command_do{$form{mycmd}}};
61      } else {      } else {
62          &{$command_do{$form{read}}};          &{$command_do{read}};
63      }      }
64      &close_db;      &close_db;
65  }  }
# Line 137  sub do_read { Line 84  sub do_read {
84      $cf = $1 if $content =~ s#^(?:/\*\s*|[\#<]\?)?([A-Z][A-Za-z0-9-]+/[0-9.]+(?:[^0-9.\x0D\x0A][^\x0D\x0A]*)?)[\x0D\x0A]+##s;      $cf = $1 if $content =~ s#^(?:/\*\s*|[\#<]\?)?([A-Z][A-Za-z0-9-]+/[0-9.]+(?:[^0-9.\x0D\x0A][^\x0D\x0A]*)?)[\x0D\x0A]+##s;
85      if ($cf =~ m!^(?:\#\?)?SuikaWiki/0.9(?:$|\s)!) {      if ($cf =~ m!^(?:\#\?)?SuikaWiki/0.9(?:$|\s)!) {
86      #print gmtime."Header...\n";      #print gmtime."Header...\n";
87        &print_header ($form{mypage}, -last_modified => $lm,        &print_header ($form{mypage}, -last_modified => $lm, -expires => time + 120,
88          -content_format => $cf, -noindex => $cf =~ /obsoleted="yes"/);          -content_format => $cf, -noindex => ($cf =~ /obsoleted="yes"/ ? 1 : 0));
89          #print "\n". gmtime."Body...\n";          #print "\n". gmtime."Body...\n";
90        &print_content ($content, content_format => $cf, last_modified => $lm,        &print_content ($content, content_format => $cf, last_modified => $lm,
91          -toc => \@toc);          -toc => \@toc);
92        print &text_to_html (q([[#comment]])) if $cf !~ /obsoleted="yes"/ && !$fixedpage{$form{mypage}};        print &text_to_html (q([[#comment]])) if $cf !~ /obsoleted="yes"/ && !$FixedPage{$form{mypage}};
93      } else {      } else {
94        &print_header($form{mypage}, -last_modified => $lm);        &print_header($form{mypage}, -expires => time + 120, -last_modified => $lm);
95        print "<pre>@{[&escape($content)]}</pre>";        print "<pre>@{[&escape($content)]}</pre>";
96      }      }
97      if ($c) {      if ($c) {
# Line 167  sub do_output_css { Line 114  sub do_output_css {
114      my $lm = gmtime &get_info($form{mypage}, $info_LastModified);      my $lm = gmtime &get_info($form{mypage}, $info_LastModified);
115      print "Content-Type: text/css; charset=@{[&get_charset_name($kanjicode)]}\n";      print "Content-Type: text/css; charset=@{[&get_charset_name($kanjicode)]}\n";
116      print "Last-Modified: $lm\n";      print "Last-Modified: $lm\n";
117        print "Expires: @{[scalar gmtime time+3600]}\n";    ## TODO: don't use asctime
118      print "\n";      print "\n";
119      print $content;      print $content;
120    } else {    } else {
# Line 188  sub id_and_name ($) { Line 136  sub id_and_name ($) {
136    
137  sub do_edit {  sub do_edit {
138      my ($page) = &unarmor_name(&armor_name($form{mypage}));      my ($page) = &unarmor_name(&armor_name($form{mypage}));
     &print_header($page, -noindex => 1);  
139      if (not &is_editable($page)) {      if (not &is_editable($page)) {
140            &print_header($page, -noindex => 1, -expires => time+60);
141          &print_message(&Resource('Error:ThisPageIsUneditable'));          &print_message(&Resource('Error:ThisPageIsUneditable'));
142      } elsif (&is_frozen($page)) {      } elsif (&is_frozen($page)) {
143            &print_header($page, -noindex => 1, -expires => time+60);
144          &print_message(&Resource('Error:ThisPageIsUneditable'));          &print_message(&Resource('Error:ThisPageIsUneditable'));
145      } else {      } else {
146            &print_header($page, -noindex => 1, -expires => time+60);
147          &print_editform($database{$page}, &get_info($page, $info_LastModified), admin=>0);          &print_editform($database{$page}, &get_info($page, $info_LastModified), admin=>0);
148      }      }
149      wiki::referer::add ($form{mypage}, $ENV{HTTP_REFERER});      wiki::referer::add ($form{mypage}, $ENV{HTTP_REFERER});
# Line 212  sub do_edit { Line 162  sub do_edit {
162    
163  sub do_adminedit {  sub do_adminedit {
164      my ($page) = &unarmor_name(&armor_name($form{mypage}));      my ($page) = &unarmor_name(&armor_name($form{mypage}));
165      &print_header($page, -noindex => 1);      &print_header($page, -noindex => 1, -expires => time+60);
166      if (not &is_editable($page)) {      if (not &is_editable($page)) {
167          &print_message(&Resource('Error:ThisPageIsUneditable'));          &print_message(&Resource('Error:ThisPageIsUneditable'));
168      } else {      } else {
# Line 222  sub do_adminedit { Line 172  sub do_adminedit {
172      &print_footer($page);      &print_footer($page);
173  }  }
174    
 sub do_adminchangepasswordform {  
     &print_header('AdminChangePassword', -noindex => 1);  
     &print_passwordform;  
     &print_footer('AdminChangePassword');  
 }  
   
175  sub do_adminchangepassword {  sub do_adminchangepassword {
176      if ($form{mynewpassword} ne $form{mynewpassword2}) {      if ($form{mynewpassword} ne $form{mynewpassword2}) {
177          &print_error(&Resource('Error:PasswordMismatch'));          &print_error(&Resource('Error:PasswordMismatch'));
178      }      }
179      my ($validpassword_crypt) = &get_info($AdminSpecialPage, 'AdminPassword');      my ($validpassword_crypt) = &get_info($PageName{AdminSpecialPage}, 'AdminPassword');
180      if ($validpassword_crypt) {      if ($validpassword_crypt) {
181          if (not &valid_password($form{myoldpassword})) {          if (not &valid_password($form{myoldpassword})) {
 #            &send_mail_to_admin(<<"EOD", "AdminChangePassword");  
 #myoldpassword=$form{myoldpassword}  
 #mynewpassword=$form{mynewpassword}  
 #mynewpassword2=$form{mynewpassword2}  
 #EOD  
182              &print_error(&Resource('Error:PasswordIsIncorrect'));              &print_error(&Resource('Error:PasswordIsIncorrect'));
183          }          }
184      }      }
# Line 248  sub do_adminchangepassword { Line 187  sub do_adminchangepassword {
187      my $salt1 = $token[(time | $$) % scalar(@token)];      my $salt1 = $token[(time | $$) % scalar(@token)];
188      my $salt2 = $token[($sec + $min*60 + $hour*60*60) % scalar(@token)];      my $salt2 = $token[($sec + $min*60 + $hour*60*60) % scalar(@token)];
189      my $crypted = crypt($form{mynewpassword}, "$salt1$salt2");      my $crypted = crypt($form{mynewpassword}, "$salt1$salt2");
190      &set_info($AdminSpecialPage, 'AdminPassword', $crypted);      &set_info($PageName{AdminSpecialPage}, 'AdminPassword', $crypted);
191    
192      &print_header('CompletedSuccessfully', -noindex => 1);      &print_header('CompletedSuccessfully', -noindex => 1);
193      &print_message(&Resource('Error:PasswordIsChanged'));      &print_message(&Resource('Error:PasswordIsChanged'));
194      &print_footer('CompletedSuccessfully');      &print_footer('CompletedSuccessfully');
195  }  }
196    
197  sub do_index {  sub valid_password ($) {
198    wiki::referer::add ($form{mypage}, $ENV{HTTP_REFERER});      my ($validpassword_crypt) = &get_info($PageName{AdminSpecialPage}, 'AdminPassword');
199    wiki::useragent::add ($ENV{HTTP_USER_AGENT});      return crypt (shift, $validpassword_crypt) eq $validpassword_crypt ? 1 : 0;
     &print_header($IndexPage);  
     print qq(<ul>);  
     foreach my $page (sort keys %database) {  
         if (&is_editable($page)) {  
             print qq(<li><a href="$url_cgi?@{[&encode($page)]}">@{[&escape($page)]}</a>@{[&escape(&get_subjectline($page))]}</li>);  
         }  
     }  
     print qq(</ul>);  
     my ($r, $c) = get_search_result ($form{mypage});  
     if ($c) {  
       print qq{<h2 @{[&id_and_name('wikipage-see-also')]}>@{[&Resource('SeeAlso',escape=>1)]}</h2>};  
       print $r;  
     }  
     my $rl = wiki::referer::list_html ($form{mypage});  
     if ($rl) {  
         print qq(<div @{[&id_and_name('wikipage-referer')]}><h2>@{[&Resource('Referers',escape=>1)]}</h2>\n$rl</div>\n);  
     }  
     &print_footer($IndexPage);  
200  }  }
201    
202  sub do_write {  sub do_write {
# Line 294  sub do_write { Line 215  sub do_write {
215          return;          return;
216      }      }
217    
     # Making diff  
     {  
         &open_diff;  
         my @msg1 = split(/\n/, $database{$form{mypage}});  
         my @msg2 = split(/\n/, $form{mymsg});  
         $diffbase{$form{mypage}} = &difftext(\@msg1, \@msg2);  
         &close_diff;  
     }  
   
218      if ($form{mymsg}) {      if ($form{mymsg}) {
219          $database{$form{mypage}} = $form{mymsg};          if ($form{mytouch} || !ref $database) {
220          #&send_mail_to_admin($form{mypage}, "Modify");            $database{$form{mypage}} = $form{mymsg};
221          if ($form{mytouch}) {          } else {
222              &set_info($form{mypage}, $info_LastModified, time);            $database->STORE ($form{mypage} => $form{mymsg}, -touch => 0);
             &update_recent_changes;  
223          }          }
224          &set_info($form{mypage}, $info_IsFrozen, 0 + $form{myfrozen});          &set_info($form{mypage}, $info_IsFrozen, 0 + $form{myfrozen});
225          my $fragment = '';          my $fragment = '';
# Line 323  sub do_write { Line 234  sub do_write {
234          &print_content(&Resource('Error:ContinueReading')." @{[&armor_name($form{mypage})]}");          &print_content(&Resource('Error:ContinueReading')." @{[&armor_name($form{mypage})]}");
235          &print_footer('CompletedSuccessfully');          &print_footer('CompletedSuccessfully');
236      } else {      } else {
         #&send_mail_to_admin($form{mypage}, "Delete");  
237          delete $database{$form{mypage}};          delete $database{$form{mypage}};
238          delete $infobase{$form{mypage}};          delete $infobase{$form{mypage}};
         if ($form{mytouch}) {  
             &update_recent_changes;  
         }  
239          &print_header($form{mypage}, -noindex => 1);          &print_header($form{mypage}, -noindex => 1);
240          &print_message(&Resource('Error:PageIsDeletedSuccessfully'));          &print_message(&Resource('Error:PageIsDeletedSuccessfully'));
241          &print_footer($form{mypage});          &print_footer($form{mypage});
242      }      }
243  }  }
244    
 sub do_searchform {  
     &print_header($SearchPage);  
     &print_searchform("");  
     &print_footer($SearchPage);  
 }  
   
 sub do_search {  
     my $word = $form{mymsg};  
     &print_header($SearchPage);  
     &print_searchform(&escape($word));  
     print scalar get_search_result ($word, -output_not_found => 1, -match_myself => 1);  
     &print_footer($SearchPage);  
 }  
   
245  sub get_search_result ($;%) {  sub get_search_result ($;%) {
246    my $word = lc shift;    my $word = lc shift;
247    my %option = @_;    my %option = @_;
# Line 372  sub get_search_result ($;%) { Line 265  sub get_search_result ($;%) {
265    wantarray? ($r, scalar @r): $r;    wantarray? ($r, scalar @r): $r;
266  }  }
267    
 sub do_create {  
     &print_header($CreatePage);  
     print <<"EOD";  
 <form action="$url_cgi" method="post">  
     <input type="hidden" name="mycmd" value="edit">  
     <strong>@{[&Resource('InputPageNameEdited',escape=>1)]}</strong><br>  
     <input type="text" name="mypage" value="" size="20">  
     <input type="submit" value="@{[&Resource('WikiForm:Create',escape=>1)]}"><br>  
 </form>  
 EOD  
     &print_footer($CreatePage);  
 }  
   
268  sub do_random_jump {  sub do_random_jump {
269    my @list = keys %database;    my @list = keys %database;
270    my $name = &encode ($list[rand @list]);    my $name = &encode ($list[rand @list]);
# Line 396  sub do_random_jump { Line 276  sub do_random_jump {
276    
277  sub print_error {  sub print_error {
278      my ($msg) = @_;      my ($msg) = @_;
279      &print_header($ErrorPage, -noindex => 1);      &print_header($PageName{ErrorPage}, -noindex => 1);
280      print qq(<p><strong class="error">$msg</strong></p>);      print qq(<p><strong class="error">$msg</strong></p>);
281      &print_footer($ErrorPage);      &print_footer($PageName{ErrorPage});
282      exit(0);      exit(0);
283  }  }
284    
# Line 421  sub print_header ($;%) { Line 301  sub print_header ($;%) {
301        }        }
302      }      }
303      print qq{Last-Modified: @{[scalar gmtime $option{-last_modified}]}\n} if $option{-last_modified};      print qq{Last-Modified: @{[scalar gmtime $option{-last_modified}]}\n} if $option{-last_modified};
304        if ($option{-expires}) {
305          print qq{Expires: @{[scalar gmtime $option{-expires}]}\n};
306        }
307      if ($UA =~ m#Mozilla/2#) {      if ($UA =~ m#Mozilla/2#) {
308          my $ct = qq{text/html; charset=@{[&get_charset_name($kanjicode,compatible=>1)]}};          my $ct = qq{text/html; charset=@{[&get_charset_name($kanjicode,compatible=>1)]}};
309          print qq{Content-Type: $ct\n};          print qq{Content-Type: $ct\n};
# Line 431  sub print_header ($;%) { Line 314  sub print_header ($;%) {
314          print qq{Content-Type: text/html; charset=@{[&get_charset_name($kanjicode)]}\n};          print qq{Content-Type: text/html; charset=@{[&get_charset_name($kanjicode)]}\n};
315      }      }
316      push @head, qq(<title>@{[&escape($page)]}</title>);      push @head, qq(<title>@{[&escape($page)]}</title>);
317      push @head, qq(<link rel="stylesheet" type="text/css" href="@{[&escape($uri{stylesheet})]}")      if ($UA !~ m#Mozilla/[1-4]\.# || $UA =~ m#MSIE (?:[4-9]\.|\d\d)#) {
318        if $UA !~ m#Mozilla/[1-4]\.# || $UA =~ m#MSIE (?:[4-9]\.|\d\d)#;        push @head, qq(<link rel="stylesheet" type="text/css" href="@{[&escape($uri{wiki}.'?mycmd=TEXT_CSS;mypage='.&encode($PageName{DefaultStyleForHTML}).';x-lm='.&get_info($PageName{DefaultStyleForHTML}, $info_LastModified))]}");
319        }
320      push @head, q(<meta name="ROBOTS" content="NOINDEX">) if $option{-noindex};      push @head, q(<meta name="ROBOTS" content="NOINDEX">) if $option{-noindex};
321      my ($Links, $links) = &make_navigate_links ($page);      my ($Links, $links) = &make_navigate_links ($page);
322      #print $Links;      ## Link: fields      #print $Links;      ## Link: fields
# Line 479  sub print_navigate_links (@) { Line 363  sub print_navigate_links (@) {
363      ]}      ]}
364      <a href="$url_cgi?mycmd=read;mypage=$cookedpage;x-param=@{[time.[0..9]->[rand 10]]}" class="wiki-cmd" title="@{[&Resource('ViewThisPageLong',escape=>1)]}">@{[&Resource('ViewThisPage',escape=>1)]}</a> |      <a href="$url_cgi?mycmd=read;mypage=$cookedpage;x-param=@{[time.[0..9]->[rand 10]]}" class="wiki-cmd" title="@{[&Resource('ViewThisPageLong',escape=>1)]}">@{[&Resource('ViewThisPage',escape=>1)]}</a> |
365      <a href="$url_cgi?mycmd=map;mypage=$cookedpage" class="wiki-cmd" title="@{[&Resource('ShowMapOfThisPageLong',escape=>1)]}">@{[&Resource('ShowMapOfThisPage',escape=>1)]}</a> |      <a href="$url_cgi?mycmd=map;mypage=$cookedpage" class="wiki-cmd" title="@{[&Resource('ShowMapOfThisPageLong',escape=>1)]}">@{[&Resource('ShowMapOfThisPage',escape=>1)]}</a> |
366      <a href="$url_cgi?$CreatePage" class="wiki" title="@{[&Resource('GoToCreatePageLong',escape=>1)]}">@{[&Resource('GoToCreatePage',escape=>1)]}</a> |      <a href="$url_cgi?$PageName{CreatePage}" class="wiki" title="@{[&Resource('GoToCreatePageLong',escape=>1)]}">@{[&Resource('GoToCreatePage',escape=>1)]}</a> |
367      <a href="$url_cgi?$IndexPage" class="wiki" title="@{[&Resource('GoToIndexPageLong',escape=>1)]}">@{[&Resource('GoToIndexPage',escape=>1)]}</a> |      <a href="$url_cgi?$PageName{IndexPage}" class="wiki" title="@{[&Resource('GoToIndexPageLong',escape=>1)]}">@{[&Resource('GoToIndexPage',escape=>1)]}</a> |
368      <a href="$url_cgi?$FrontPage" class="wiki" title="@{[&Resource('GoToHomePageLong',escape=>1)]}">@{[&Resource('GoToHomePage',escape=>1)]}</a> |      <a href="$url_cgi?$PageName{FrontPage}" class="wiki" title="@{[&Resource('GoToHomePageLong',escape=>1)]}">@{[&Resource('GoToHomePage',escape=>1)]}</a> |
369      <a href="$url_cgi?$SearchPage" class="wiki" title="@{[&Resource('GoToSearchPageLong',escape=>1)]}">@{[&Resource('GoToSearchPage',escape=>1)]}</a> |      <a href="$url_cgi?$PageName{SearchPage}" class="wiki" title="@{[&Resource('GoToSearchPageLong',escape=>1)]}">@{[&Resource('GoToSearchPage',escape=>1)]}</a> |
370      <a href="$url_cgi?mycmd=RandomJump;x-param=@{[time.[0..9]->[rand 10]]}" class="wiki randomlink" title="@{[&Resource('GoSomewhereLong',escape=>1)]}">@{[&Resource('GoSomewhere',escape=>1)]}</a> |      <a href="$url_cgi?mycmd=RandomJump;x-param=@{[time.[0..9]->[rand 10]]}" class="wiki randomlink" title="@{[&Resource('GoSomewhereLong',escape=>1)]}">@{[&Resource('GoSomewhere',escape=>1)]}</a> |
371      <a href="$url_cgi?RecentChanges" class="wiki" title="@{[&Resource('GoToRecentChangesLong',escape=>1)]}">@{[&Resource('GoToRecentChanges',escape=>1)]}</a>      <a href="$url_cgi?$PageName{RecentChanges}" class="wiki" title="@{[&Resource('GoToRecentChangesLong',escape=>1)]}">@{[&Resource('GoToRecentChanges',escape=>1)]}</a>
372  </div>  </div>
373  EOH  EOH
374  }  }
# Line 496  sub make_navigate_links ($) { Line 380  sub make_navigate_links ($) {
380      push @link, {rel=>'edit', href=>"$url_cgi?mycmd=adminedit;mypage=@{[&encode($page)]}", class=>"wiki-command", title=>&Resource('AdminEditThisPageLink')} if &is_editable ($page) || &is_frozen ($page);      push @link, {rel=>'edit', href=>"$url_cgi?mycmd=adminedit;mypage=@{[&encode($page)]}", class=>"wiki-command", title=>&Resource('AdminEditThisPageLink')} if &is_editable ($page) || &is_frozen ($page);
381      push @link, {rel=>'view', href=>"$url_cgi?mycmd=read;mypage=@{[&encode($page)]};x-p=@{[time.[0..9]->[rand 10]]}", class=>'wiki-command', title=>&Resource('ViewThisPageLink')};      push @link, {rel=>'view', href=>"$url_cgi?mycmd=read;mypage=@{[&encode($page)]};x-p=@{[time.[0..9]->[rand 10]]}", class=>'wiki-command', title=>&Resource('ViewThisPageLink')};
382      push @link, {rel=>'myself', href=>"$url_cgi?@{[&encode($page)]}", class=>'wiki', title=>&Resource('GoToMyselfLink')};      push @link, {rel=>'myself', href=>"$url_cgi?@{[&encode($page)]}", class=>'wiki', title=>&Resource('GoToMyselfLink')};
383      push @link, {rel=>'index', href=>"$url_cgi?$IndexPage", class=>'wiki', title=>&Resource('GoToIndexPageLink')};      push @link, {rel=>'index', href=>"$url_cgi?$PageName{IndexPage}", class=>'wiki', title=>&Resource('GoToIndexPageLink')};
384      push @link, {rel=>'home', href=>"$url_cgi?$FrontPage", class=>'wiki', title=>&Resource('GoToHomePageLink')};      push @link, {rel=>'home', href=>"$url_cgi?$PageName{FrontPage}", class=>'wiki', title=>&Resource('GoToHomePageLink')};
385      push @link, {rel=>'News', href=>"$url_cgi?WikiNews", class=>'wiki', title=>&Resource('GoToWikiNewsLink')};      push @link, {rel=>'News', href=>"$url_cgi?WikiNews", class=>'wiki', title=>&Resource('GoToWikiNewsLink')};
386      push @link, {rel=>'News', href=>"$url_cgi?RecentChanges", class=>"wiki", title=>&Resource('GoToRecentChangesLink')};      push @link, {rel=>'News', href=>"$url_cgi?$PageName{RecentChanges}", class=>"wiki", title=>&Resource('GoToRecentChangesLink')};
387      push @link, {rel=>'News', href=>"$url_cgi?$RssPage", class=>"wiki", title=>&Resource('GoToRssPageLink'), type=>'application/xml'};      push @link, {rel=>'News', href=>"$url_cgi?$PageName{RssPage}", class=>"wiki", title=>&Resource('GoToRssPageLink'), type=>'application/xml'};
388      push @link, {rel=>'search', href=>"$url_cgi?$SearchPage", class=>'wiki', title=>&Resource('GoToSearchPageLink')};      push @link, {rel=>'search', href=>"$url_cgi?$PageName{SearchPage}", class=>'wiki', title=>&Resource('GoToSearchPageLink')};
389      push @link, {rel=>'help', href=>"$url_cgi?WikiHelp", class=>'wiki', title=>&Resource('GoToWikiHelpLink')};      push @link, {rel=>'help', href=>"$url_cgi?WikiHelp", class=>'wiki', title=>&Resource('GoToWikiHelpLink')};
390      push @link, {rel=>'copyright', href=>"$url_cgi?WikiPageLicense", class=>'wiki', title=>&Resource('GoToWikiPageLicenseLink')};      push @link, {rel=>'copyright', href=>"$url_cgi?WikiPageLicense", class=>'wiki', title=>&Resource('GoToWikiPageLicenseLink')};
391      push @link, {rel=>'jump', href=>qq(javascript:var%20WikiName=prompt('Please%20input%20the%20WikiName:','','Jump%20to%20SuikaWiki');if(WikiName)%7B_content.location.href='$url_cgi%3F'+encodeURIComponent(WikiName)%7D), class=>'wiki-cmd', title=>&Resource('JumpToLink')};      push @link, {rel=>'jump', href=>qq(javascript:var%20WikiName=prompt('Please%20input%20the%20WikiName:','','Jump%20to%20SuikaWiki');if(WikiName)%7B_content.location.href='$url_cgi%3F'+encodeURIComponent(WikiName)%7D), class=>'wiki-cmd', title=>&Resource('JumpToLink')};
392      push @link, {rel=>'jump', href=>qq(javascript:var%20WikiName=prompt('Please%20input%20the%20WikiName:','','Jump%20to%20SuikaWiki');if(WikiName)%7B_content.location.href='$url_cgi%3Fmycmd=edit;mypage='+encodeURIComponent(WikiName)%7D), class=>'wiki-cmd', title=>&Resource('JumpToEditLink')};      push @link, {rel=>'jump', href=>qq(javascript:var%20WikiName=prompt('Please%20input%20the%20WikiName:','','Jump%20to%20SuikaWiki');if(WikiName)%7B_content.location.href='$url_cgi%3Fmycmd=edit;mypage='+encodeURIComponent(WikiName)%7D), class=>'wiki-cmd', title=>&Resource('JumpToEditLink')};
393      push @link, {rel=>'lucky', href=>"$url_cgi?mycmd=RandomJump;x-param=@{[time.[0..9]->[rand 10]]}", class=>'wiki randomlink', title=>&Resource('GoSomewhereLink')};      push @link, {rel=>'lucky', href=>"$url_cgi?mycmd=RandomJump;x-param=@{[time.[0..9]->[rand 10]]}", class=>'wiki randomlink', title=>&Resource('GoSomewhereLink')};
394      push @link, {rel=>'history', href=>$uri{cvs_wikipage}.do{my $s=$page;$s=~s/(.)/sprintf '%02X', ord $1/ges;$s}.'.txt', title=>&Resource('ViewHistoryOfThisPageLink'),hreflang=>'en'} if $uri{cvs_wikipage};      push @link, {rel=>'history', href=>$uri{cvs_wikipage}.do{my $s=$page;$s=~s/(.)/sprintf '%02X', ord $1/ges;$s}.'.txt', title=>&Resource('ViewHistoryOfThisPageLink'),hreflang=>'en'} if $uri{cvs_wikipage};
395      push @link, {rel=>'history', href=>"$url_cgi?mycmd=diff;mypage=@{[&encode($page)]}", title=>&Resource('ViewDiffOfThisPageLink'), class=>'wiki-command'};      push @link, {rel=>'history', href=>"$url_cgi?mycmd=diff;mypage=@{[&encode($page)]}", title=>&Resource('ViewDiffOfThisPageLink'), class=>'wiki-command'} if $wiki::diff::UseDiff;
396      push @link, {rel=>'contents', href=>"$url_cgi?mycmd=map;mypage=@{[&encode($page)]}", title=>&Resource('ShowMapOfThisPageLink'), class=>'wiki-command'};      push @link, {rel=>'contents', href=>"$url_cgi?mycmd=map;mypage=@{[&encode($page)]}", title=>&Resource('ShowMapOfThisPageLink'), class=>'wiki-command'};
397      my ($Links, $links) = ('', '');      my ($Links, $links) = ('', '');
398      for my $e (@link) {      for my $e (@link) {
# Line 725  sub inline ($;%) { Line 609  sub inline ($;%) {
609      $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;      $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;
610      $line =~ s:\[RUBY\[([^]]+)\] \[([^]]+)\]\]:<ruby><rb>$1</rb><rp>(</rp><rt>$2</rt><rp>)</rp></ruby>:g;      $line =~ s:\[RUBY\[([^]]+)\] \[([^]]+)\]\]:<ruby><rb>$1</rb><rp>(</rp><rt>$2</rt><rp>)</rp></ruby>:g;
611      $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;      $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;
     $line =~ s%\[Q\[([^]]+)\](?: \[&lt;([\x21-\x5A\x5E-\x7E]+)&gt;\])?\]%¡Ö<q@{[$2?qq( cite="$2"):'']}>$1</q>¡×%g;  
612      $line =~ s|'''([^']+)'''|<strong>$1</strong>|g;      $line =~ s|'''([^']+)'''|<strong>$1</strong>|g;
613      $line =~ s|''([^']+)''|<em>$1</em>|g;      $line =~ s|''([^']+)''|<em>$1</em>|g;
614      $line =~ s{      $line =~ s{
# Line 736  sub inline ($;%) { Line 619  sub inline ($;%) {
619      }{      }{
620        my ($l, $page,$anchor, $anum, $uri) = ($1, $3,$4, 0+$5, $6);        my ($l, $page,$anchor, $anum, $uri) = ($1, $3,$4, 0+$5, $6);
621        if ($l) {        if ($l) {
622          return &embedded_to_html($1);          &embedded_to_html($1);
623        } elsif (defined $page) {        } elsif (defined $page) {
624          &make_wikilink ($page, anchor => 0+$anchor);          &make_wikilink ($page, anchor => 0+$anchor);
625        } elsif ($anum) {        } elsif ($anum) {
# Line 759  sub make_wikilink ($%) { Line 642  sub make_wikilink ($%) {
642        return qq(<a title="$subject" href="$url_cgi?@{[&encode($name)]}" class="wiki">$ename</a>);        return qq(<a title="$subject" href="$url_cgi?@{[&encode($name)]}" class="wiki">$ename</a>);
643      }      }
644    } else {    } else {
645      return qq(<a title="@{[&Resource('JumpAndEditWikiPage',escape=>1)]}" href="$url_cgi?mycmd=edit;mypage=@{[&escape($name)]}" class="wiki not-exist">$ename<span class="mark">@{[&Resource('JumpAndEditWikiPageMark',escape=>1)]}</span></a>);      return qq(<a title="@{[&Resource('JumpAndEditWikiPage',escape=>1)]}" href="$url_cgi?@{[&escape($name)]}" class="wiki not-exist">$ename<span class="mark">@{[&Resource('JumpAndEditWikiPageMark',escape=>1)]}</span></a>);
646    }    }
647  }  }
648    
# Line 817  sub make_custom_form ($$$$) { Line 700  sub make_custom_form ($$$$) {
700              $option = &unescape ($option);              $option = &unescape ($option);
701              $option =~ s/\\(.)/$1/g;              $option =~ s/\\(.)/$1/g;
702              $fmt{form_option}->replace ($option, $param);              $fmt{form_option}->replace ($option, $param);
703              $definition .= ' %submit;' if $definition !~ /%submit/ && !$param->{output}->{nosubmit};              $param->{output}->{form} = 1 unless defined $param->{output}->{form};
704                $definition .= ' %submit;' if $definition !~ /%submit/ && !$param->{output}->{nosubmit} && $param->{output}->{form};
705              my $target_page = $param->{output}->{page} || $form{mypage};              my $target_page = $param->{output}->{page} || $form{mypage};
706              $param->{form_disabled} = 1 if $fixedpage{$target_page};              $param->{form_disabled} = 1 if $FixedPage{$target_page};
707              my $target_form = $param->{output}->{id};              my $target_form = $param->{output}->{id};
708              my $r = <<EOH;              my $r = '';
709                $r = <<EOH if $param->{output}->{form};
710  <form method="post" action="$url_cgi" id="wikiform-$FormIndex" class="wikiform">  <form method="post" action="$url_cgi" id="wikiform-$FormIndex" class="wikiform">
711    <input type="hidden" name="mycmd" value="@{[$param->{form_disabled}?'read':'wikiform']}">    <input type="hidden" name="mycmd" value="@{[$param->{form_disabled}?'read':'wikiform']}">
712    <input type="hidden" name="mypage" value="@{[&escape($target_page)]}">    <input type="hidden" name="mypage" value="@{[&escape($target_page)]}">
# Line 831  sub make_custom_form ($$$$) { Line 716  sub make_custom_form ($$$$) {
716  EOH  EOH
717              $r .= qq(<a name="wikiform-$FormIndex"></a>) if $UA =~ m#Mozilla/[12]\.#;              $r .= qq(<a name="wikiform-$FormIndex"></a>) if $UA =~ m#Mozilla/[12]\.#;
718              $r .= $fmt{form_input}->replace ($definition, $param);              $r .= $fmt{form_input}->replace ($definition, $param);
719              $r .= <<EOH;              $r .= "</form>\n" if $param->{output}->{form};
 </form>  
 EOH  
720              $r;              $r;
721         } else {  ## No input-interface WikiForm         } else {  ## No input-interface WikiForm
722             qq(<a id="wikiform-$FormIndex" name="wikiform-$FormIndex"><!-- #form --></a>);             qq(<a id="wikiform-$FormIndex" name="wikiform-$FormIndex"><!-- #form --></a>);
# Line 855  sub init_form { Line 738  sub init_form {
738        read STDIN, $query, $main::ENV{CONTENT_LENGTH};        read STDIN, $query, $main::ENV{CONTENT_LENGTH};
739      }      }
740      $query .= ($query ? ';' : '') . $main::ENV{QUERY_STRING};      $query .= ($query ? ';' : '') . $main::ENV{QUERY_STRING};
741      if ($main::ENV{QUERY_STRING} && $main::ENV{QUERY_STRING} !~ /[&;=]/) {      if ($main::ENV{REQUEST_METHOD} ne 'POST' && $main::ENV{QUERY_STRING} && $main::ENV{QUERY_STRING} !~ /[&;=]/) {
742        my $query = &decode($main::ENV{QUERY_STRING});        my $query = &decode($main::ENV{QUERY_STRING});
743        $query = &code_convert(\$query, $kanjicode);        $query = &code_convert(\$query, $kanjicode);
744        if ($page_command{$query}) {        if ($page_command{$query}) {
# Line 872  sub init_form { Line 755  sub init_form {
755            $form{$n} = $v;            $form{$n} = $v;
756          }          }
757        }        }
758          unless (defined $form{mypage}) {
759            $form{mypage} = $form{epage};
760            $form{mypage} =~ s/([0-9A-F]{2})/ord hex $1/g;
761          }
762        if ($page_command{$form{mypage}} && $form{mycmd} eq 'read') {        if ($page_command{$form{mypage}} && $form{mycmd} eq 'read') {
763          $form{mypage} = &code_convert(\$form{mypage}, $kanjicode);          $form{mypage} = &code_convert(\$form{mypage}, $kanjicode);
764          $form{mycmd} = $page_command{$form{mypage}};          $form{mycmd} = $page_command{$form{mypage}};
# Line 901  sub init_form { Line 788  sub init_form {
788      $form{myname} = &code_convert(\$form{myname}, $kanjicode);      $form{myname} = &code_convert(\$form{myname}, $kanjicode);
789  }  }
790    
 sub update_recent_changes {  
     my $update = "- @{[&get_now]} [[$form{mypage}]] @{[&get_subjectline($form{mypage})]}";  
     my @oldupdates = split(/\x0D?\x0A/, $database{RecentChanges});  
     shift @oldupdates; ## '#?' magic line  
     my @updates;  
     foreach (@oldupdates) {  
         /^\- \d\d\d\d\-\d\d\-\d\d \d\d:\d\d \[\[([^]]+)\]\]/;  
         my $name = $1;  
         if ($name ne $form{mypage}) {  
             push @updates, $_;  
         }  
     }  
     if (&is_exist_page($form{mypage})) {  
       unshift @updates, $update;  
     }  
     splice @updates, (&Resource ('RecentChanges:Max') || 50) + 1;  
     $database{RecentChanges} = "#?SuikaWiki/0.9\n" . join("\n", @updates);  
     if ($file_touch) {  
         open(FILE, "> $file_touch");  
         print FILE localtime() . "\n";  
         close(FILE);  
     }  
 }  
   
791  {my %SubjectLine;  {my %SubjectLine;
792  sub get_subjectline {  sub get_subjectline {
793      my ($page, %option) = @_;      my ($page, %option) = @_;
# Line 947  sub get_subjectline { Line 810  sub get_subjectline {
810    
811  sub open_db {  sub open_db {
812      if ($modifier_dbtype eq 'dbmopen') {      if ($modifier_dbtype eq 'dbmopen') {
813          dbmopen(%database, $dataname, 0666) or &print_error("(dbmopen) $dataname");          dbmopen(%database, $PathTo{WikiDataBase}, 0666) or &print_error("(dbmopen) $PathTo{WikiDataBase}");
814          dbmopen(%infobase, $infoname, 0666) or &print_error("(dbmopen) $infoname");          dbmopen(%infobase, $PathTo{WikiInfoBase}, 0666) or &print_error("(dbmopen) $PathTo{WikiInfoBase}");
815      } elsif ($modifier_dbtype eq 'AnyDBM_File') {      } elsif ($modifier_dbtype eq 'AnyDBM_File') {
816          eval q{use AnyDBM_File};          eval q{use AnyDBM_File};
817          tie(%database, "AnyDBM_File", $dataname, O_RDWR|O_CREAT, 0666) or &print_error("(tie AnyDBM_File) $dataname");          tie(%database, "AnyDBM_File", $PathTo{WikiDataBase}, O_RDWR|O_CREAT, 0666) or &print_error("(tie AnyDBM_File) $PathTo{WikiDataBase}");
818          tie(%infobase, "AnyDBM_File", $infoname, O_RDWR|O_CREAT, 0666) or &print_error("(tie AnyDBM_File) $infoname");          tie(%infobase, "AnyDBM_File", $PathTo{WikiInfoBase}, O_RDWR|O_CREAT, 0666) or &print_error("(tie AnyDBM_File) $PathTo{WikiInfoBase}");
819      } else {      } elsif ($modifier_dbtype eq 'YukiWikiDB') {
820          eval q{use Yuki::YukiWikiDB};          eval q{use Yuki::YukiWikiDB};
821          tie(%database, "Yuki::YukiWikiDB", $dataname) or &print_error("(tie Yuki::YukiWikiDB) $dataname");          tie(%database, "Yuki::YukiWikiDB", $PathTo{WikiDataBase}) or &print_error("(tie Yuki::YukiWikiDB) $PathTo{WikiDataBase}");
822          tie(%infobase, "Yuki::YukiWikiDB", $infoname) or &print_error("(tie Yuki::YukiWikiDB) $infoname");          tie(%infobase, "Yuki::YukiWikiDB", $PathTo{WikiInfoBase}) or &print_error("(tie Yuki::YukiWikiDB) $PathTo{WikiInfoBase}");
823        } else {
824            eval qq{use $modifier_dbtype};
825            $database = tie(%database, $modifier_dbtype => $PathTo{WikiDataBase}, -lock => 2, -backup => $wiki::diff::UseDiff) or &print_error("(tie $modifier_dbtype) $PathTo{WikiDataBase}");
826            tie(%infobase, $modifier_dbtype => $PathTo{WikiInfoBase}, -lock => 2) or &print_error("(tie $modifier_dbtype) $PathTo{WikiInfoBase}");
827      }      }
828  }  }
829    
# Line 964  sub close_db { Line 831  sub close_db {
831      if ($modifier_dbtype eq 'dbmopen') {      if ($modifier_dbtype eq 'dbmopen') {
832          dbmclose(%database);          dbmclose(%database);
833          dbmclose(%infobase);          dbmclose(%infobase);
     } elsif ($modifier_dbtype eq 'AnyDBM_File') {  
         untie(%database);  
         untie(%infobase);  
834      } else {      } else {
835          untie(%database);          untie(%database);
836          untie(%infobase);          untie(%infobase);
837      }      }
838  }  }
839    
 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 close_diff {  
     if ($modifier_dbtype eq 'dbmopen') {  
         dbmclose(%diffbase);  
     } elsif ($modifier_dbtype eq 'AnyDBM_File') {  
         untie(%diffbase);  
     } else {  
         untie(%diffbase);  
     }  
 }  
   
 sub print_searchform {  
     my ($word) = @_;  
     print <<"EOD";  
 <form action="$url_cgi" method="get">  
     <input type="hidden" name="mycmd" value="read">  
     <input type="text" name="mypage" value="$word" size="20">  
     <input type="submit" value="@{[&Resource('WikiForm:Search',escape=>1)]}">  
 </form>  
 EOD  
 }  
   
840  sub print_editform {  sub print_editform {
841      my ($mymsg, $lastmodified, %mode) = @_;      my ($mymsg, $lastmodified, %mode) = @_;
842      my $frozen = &is_frozen($form{mypage});      my $frozen = &is_frozen($form{mypage});
# Line 1028  sub print_editform { Line 861  sub print_editform {
861      $magic = $1 if $mymsg =~ m/^([^\x0A\x0D]+)/s;      $magic = $1 if $mymsg =~ m/^([^\x0A\x0D]+)/s;
862    
863      my $edit = $mode{admin} ? 'adminedit' : 'edit';      my $edit = $mode{admin} ? 'adminedit' : 'edit';
     my $escapedmypage = &escape($form{mypage});  
     my $escapedmypassword = &escape($form{mypassword});  
864      my $selected = 'read';      my $selected = 'read';
865      if ($form{after_edit_cmd}) {      if ($form{after_edit_cmd}) {
866          $selected = $form{after_edit_cmd};          $selected = $form{after_edit_cmd};
# Line 1047  EOH Line 878  EOH
878  <form action="$url_cgi" method="post">  <form action="$url_cgi" method="post">
879  <h2>@{[&Resource('Edit:Title',escape=>1)]}</h2>  <h2>@{[&Resource('Edit:Title',escape=>1)]}</h2>
880      @{[ $mode{conflict} ? '' : qq(<input type="submit" name="mypreview_write" value="@{[&Resource('Edit:Save',escape=>1)]}"><kbd>S</kbd>) ]}      @{[ $mode{conflict} ? '' : qq(<input type="submit" name="mypreview_write" value="@{[&Resource('Edit:Save',escape=>1)]}"><kbd>S</kbd>) ]}
881      @{[ $mode{admin} ? qq(<label>@{[&Resource('Edit:Password=',escape=>1)]}<input type="password" name="mypassword" value="$escapedmypassword" size="10"></label>) : "" ]} [@{[do {my $n = 0;      @{[ $mode{admin} ? qq(<label>@{[&Resource('Edit:Password=',escape=>1)]}<input type="password" name="mypassword" value="" size="10"></label>) : "" ]} [@{[do {my $n = 0;
882                 $mymsg =~ s/(?:-+\s)?\[([0-9]+)\]/$n = $1 if $1 > $n; $&/mge;                 $mymsg =~ s/(?:-+\s)?\[([0-9]+)\]/$n = $1 if $1 > $n; $&/mge;
883                 ++$n}]}]<br>                 ++$n}]}]<br>
884      <input type="hidden" name="myLastModified" value="$lastmodified">      <input type="hidden" name="myLastModified" value="$lastmodified">
885      <input type="hidden" name="mypage" value="$escapedmypage">      <input type="hidden" name="mypage" value="@{[&escape($form{mypage})]}">
886      <textarea cols="@{[&Resource('Edit:Form:Cols')+0||80]}" rows="@{[&Resource('Edit:Form:Rows')+0||20]}" name="mymsg" tabindex="1">$mymsg</textarea><br>      <textarea cols="@{[&Resource('Edit:Form:Cols')+0||80]}" rows="@{[&Resource('Edit:Form:Rows')+0||20]}" name="mymsg" tabindex="1">$mymsg</textarea><br>
887  @{[  @{[
888      $mode{admin} ?      $mode{admin} ?
# Line 1063  EOH Line 894  EOH
894  @{[  @{[
895      $mode{conflict} ? "" :      $mode{conflict} ? "" :
896      qq(      qq(
897          <input type="checkbox" name="mytouch" value="on" checked="checked">@{[&Resource('Edit:UpdateTimeStamp',escape=>1)]}<br>          <label><input type="checkbox" name="mytouch" value="on" checked="checked">@{[&Resource('Edit:UpdateTimeStamp',escape=>1)]}</label><br>
898          <input type="submit" name="mypreview_$edit" value="@{[&Resource('Edit:Preview',escape=>1)]}">          <input type="submit" name="mypreview_$edit" value="@{[&Resource('Edit:Preview',escape=>1)]}">
899          <input type="submit" name="mypreview_write" value="@{[&Resource('Edit:Save',escape=>1)]}" accesskey="S"><kbd>S</kbd>          <label><input type="submit" name="mypreview_write" value="@{[&Resource('Edit:Save',escape=>1)]}" accesskey="S"><kbd>S</kbd></label>
900         $afteredit         $afteredit
        <br>  
901      )      )
902  ]}  ]}
903  </form>  </form>
# Line 1080  EOD Line 910  EOD
910      }      }
911  }  }
912    
 sub print_passwordform {  
         print <<"EOD";  
 <form action="$url_cgi" method="post">  
     <input type="hidden" name="mycmd" value="adminchangepassword">  
     <label>@{[&Resource('Password:Old=',escape=>1)]}<input type="password" name="myoldpassword" size="10"></label><br>  
     <label>@{[&Resource('Password:New1=',escape=>1)]}<input type="password" name="mynewpassword" size="10"></label><br>  
     <label>@{[&Resource('Password:New2=',escape=>1)]}<input type="password" name="mynewpassword2" size="10"></label><br>  
     <input type="submit" value="@{[&Resource('WikiForm:Change',escape=>1)]}"><br>  
 </form>  
 EOD  
 }  
   
913  sub is_editable {  sub is_editable {
914      my ($page) = @_;      my ($page) = @_;
915      if ($fixedpage{$page} || $page =~ /\s/ || $page =~ /^\#/) {      if ($FixedPage{$page} || $page =~ /\s/ || $page =~ /^\#/) {
916          return 0;          return 0;
917      } else {      } else {
918          return 1;          return 1;
# Line 1205  sub frozen_reject { Line 1023  sub frozen_reject {
1023      }      }
1024  }  }
1025    
 sub valid_password {  
     my ($givenpassword) = @_;  
     my ($validpassword_crypt) = &get_info($AdminSpecialPage, 'AdminPassword');  
     if (crypt($givenpassword, $validpassword_crypt) eq $validpassword_crypt) {  
         return 1;  
     } else {  
         return 0;  
     }  
 }  
   
1026  sub is_frozen {  sub is_frozen {
1027      my ($page) = @_;      my ($page) = @_;
1028      if (&get_info($page, $info_IsFrozen)) {      if (&get_info($page, $info_IsFrozen)) {
# Line 1405  sub code_convert { Line 1213  sub code_convert {
1213      $code = 'euc' if $code =~ /euc/;      $code = 'euc' if $code =~ /euc/;
1214      $code = 'sjis' if $code =~ /shift/;      $code = 'sjis' if $code =~ /shift/;
1215      $code = 'utf8' if $code =~ /utf/;      $code = 'utf8' if $code =~ /utf/;
1216      #&Jcode::convert($contentref, $code);       # for Jcode.pm      $$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;
 #    &jcode::convert($contentref, $code);       # for jcode.pl  
     #&Jcode::tr ($contentref, "\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&,.:;?!`^_/|()[]{}+$%#*@='"~-><\ )) if $code eq 'euc';  
     Jcode->new ($contentref)->h2z->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;  
1217      return $$contentref;      return $$contentref;
1218  }  }
1219    
1220  sub do_diff {  sub do_diff {
     if (not &is_editable($form{mypage})) {  
         &do_read;  
         return;  
     }  
     &open_diff;  
1221      my $title = $form{mypage};      my $title = $form{mypage};
1222      &print_header($title, -noindex => 1);      &print_header($title, -noindex => 1);
1223      $_ = &escape($diffbase{$form{mypage}});      print qq(<h2>@{[&Resource('Diff:Title',escape=>1)]}</h2>);
     &close_diff;  
     print qq(<h3>@{[&Resource('Diff:Title',escape=>1)]}</h3>);  
1224      print qq(<p>@{[&Resource('Diff:Notice',escape=>1)]}</p>);      print qq(<p>@{[&Resource('Diff:Notice',escape=>1)]}</p>);
1225      print qq(<pre class="diff">);      print qq(<pre class="diff">);
1226      foreach (split(/\n/, $_)) {      for (split(/\n/, &escape ($database->traverse_diff ($form{mypage})))) {
1227          if (/^\+(.*)/) {          if (/^\+(.*)/) {
1228              print qq(<ins class="added">$1</ins>\n);              print qq(<ins class="added">$1</ins>\n);
1229          } elsif (/^\-(.*)/) {          } elsif (/^\-(.*)/) {
# Line 1499  sub is_exist_page { Line 1297  sub is_exist_page {
1297  sub __get_database ($) { $database{ $_[0] } }  sub __get_database ($) { $database{ $_[0] } }
1298  sub __set_database ($$) { $database{ $_[0] } = $_[1] }  sub __set_database ($$) { $database{ $_[0] } = $_[1] }
1299    
 sub do_wikiplugininfo {  
     &print_header (q(WikiPluginInfo));  
     print text_to_html (&SuikaWiki::Plugin::make_info_page);  
     &print_footer (q(WikiPluginInfo));  
 }  
   
1300  sub do_map {  sub do_map {
1301      my $page = $form{mypage};      my $page = $form{mypage};
1302      &print_header ($page);      &print_header ($page);
# Line 1618  sub __decode ($) { Line 1410  sub __decode ($) {
1410  }  }
1411    
1412  package wiki::useragent;  package wiki::useragent;
1413    our $UseLog;
1414    
1415  sub add ($) {  sub add ($) {
1416    my $s = shift;    my $s = shift;
1417    return unless length $s;    return unless length $s;
1418      return unless $UseLog;
1419    $s =~ s/([\x00-\x08\x0A-\x1F\x25\x7F-\xFF])/sprintf '%%%02X', unpack 'C', $1/ge;    $s =~ s/([\x00-\x08\x0A-\x1F\x25\x7F-\xFF])/sprintf '%%%02X', unpack 'C', $1/ge;
1420    my %ua;    my %ua;
1421    for (split /\n/, &main::__get_database('WikiUserAgentList')) {    for (split /\n/, &main::__get_database($main::PageName{UserAgentList})) {
1422      if (/^-\[(\d+)\] (.+)$/) {      if (/^-\[(\d+)\] (.+)$/) {
1423        my ($t, $n) = ($1, $2);        my ($t, $n) = ($1, $2);
1424        $n =~ tr/\x0A\x0D//d;        $n =~ tr/\x0A\x0D//d;
# Line 1636  sub add ($) { Line 1430  sub add ($) {
1430    for (sort {$ua{$a} <=> $ua{$b}} keys %ua) {    for (sort {$ua{$a} <=> $ua{$b}} keys %ua) {
1431      $s .= sprintf qq(-[%d] %s\n), $ua{$_}, $_;      $s .= sprintf qq(-[%d] %s\n), $ua{$_}, $_;
1432    }    }
1433    &main::__set_database ('WikiUserAgentList' => $s);    $main::database->STORE ($main::PageName{UserAgentList} => $s, -touch => 0);
1434  }  }
1435    
1436  package wiki::suikawikiconst;  package wiki::suikawikiconst;
# Line 1665  sub unescape ($$) { main::unescape ($_[1 Line 1459  sub unescape ($$) { main::unescape ($_[1
1459  sub encode ($$) { main::encode ($_[1]) }  sub encode ($$) { main::encode ($_[1]) }
1460  sub decode ($$) { main::decode ($_[1]) }  sub decode ($$) { main::decode ($_[1]) }
1461  sub __get_datetime ($) { main::get_now () }  sub __get_datetime ($) { main::get_now () }
1462    sub resource ($$;%) { shift; &main::Resource (@_) }
1463    sub uri ($$) { $main::uri{$_[1]} }
1464    
1465  sub regist ($@) {  sub regist ($@) {
1466      my $pack = shift;      my $pack = shift;
# Line 1683  sub import_plugins () { Line 1479  sub import_plugins () {
1479      }      }
1480  }  }
1481    
 sub make_info_page () {  
     my $r = <<EOH;  
 EOH  
     unless ($List{_all}) {  
         $r .= qq('''No plugin is installed!'''\n);  
     } else {  
         my $index = 0;  
         for my $package (sort @{$List{_all}}) {  
             $index++;  
             my $prop = $package->property ();  
             $r .= <<EOH;  
 *$package  
   
 [$index] '''$prop->{name}''' (Version $prop->{version})  
 <$prop->{uri}>  
   
 Provide:  
 @{[do{my $t = ''; for my $f (@{$prop->{provide}||[]}) {  
     $t .= qq(-''$f''\n);  
     for (sort grep m#^\Q$f\E/#, keys %{$prop->{partinfo}}) {  
          $t .= qq(--''$_'' -- $prop->{partinfo}->{$_}\n);  
     }  
 }$t}]}  
   
 EOH  
         }  
     }  
     $r;  
 }  
   
1482  &import_plugins ();  &import_plugins ();
1483    
1484  package wiki::conneg;  package wiki::conneg;
# Line 1811  exit 0; Line 1577  exit 0;
1577  __END__  __END__
1578  =head1 NAME  =head1 NAME
1579    
1580  wiki.cgi - This is YukiWiki, yet another Wiki clone.  wiki.cgi --- SuikaWiki: Yet yet another Wiki engine
 walwiki.cgi based on yukiwiki.cgi - Yet another WikiWikiWeb clone.  
   
 =head1 DESCRIPTION  
   
 YukiWiki is yet another Wiki clone.  
1581    
1582  YukiWiki can treat Japanese WikiNames (enclosed with [[ and ]]).  =head1 AUTHORS
 YukiWiki provides 'InterWiki' feature, RDF Site Summary (RSS),  
 and some embedded commands (such as [[#comment]] to add comments).  
1583    
1584  Read F<readme_en.txt> (English) or F<readme_ja.txt> (Japanese) in more detail.  Hiroshi Yuki <hyuki@hyuki.com> <http://www.hyuki.com/yukiwiki/>
1585    
1586  =head1 AUTHOR  Makio Tsukamoto <http://digit.que.ne.jp/>
1587    
1588  Hiroshi Yuki <hyuki@hyuki.com> http://www.hyuki.com/yukiwiki/  Wakaba <w@suika.fam.cx>
1589    
1590  =head1 LICENSE  =head1 LICENSE
1591    
1592  Copyright (C) 2000-2002 by Hiroshi Yuki.  Copyright (C) 2000-2003 AUTHORS
1593    
1594  This program is free software; you can redistribute it and/or  This program is free software; you can redistribute it and/or
1595  modify it under the same terms as Perl itself.  modify it under the same terms as Perl itself.
Legend:
Removed from v.1.41  
changed lines
  Added in v.1.46
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24