/[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.45 by w, Thu Jan 2 00:34:04 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    
11    require 'wikidata/suikawiki-config.ph';
12  use Yuki::DiffText qw(difftext);  use Yuki::DiffText qw(difftext);
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;  my %database;
29  my %infobase;  my %infobase;
# Line 73  my %diffbase; Line 31  my %diffbase;
31  my %interwiki;  my %interwiki;
32  ##############################  ##############################
33  my %page_command = (  my %page_command = (
34      $IndexPage => 'index',      $PageName{IndexPage} => 'index',
35      $SearchPage => 'searchform',      $PageName{RssPage} => 'rss',
     $CreatePage => 'create',  
     $RssPage => 'rss',  
     AdminChangePassword => 'adminchangepasswordform',  
     WikiPluginInfo       => 'x_WikiPluginInfo',  
36  );  );
37  my %command_do = (  my %command_do = (
38      read => \&do_read,      read => \&do_read,
39      TEXT_CSS => \&do_output_css,      TEXT_CSS => \&do_output_css,
40      edit => \&do_edit,      edit => \&do_edit,
41      adminedit => \&do_adminedit,      adminedit => \&do_adminedit,
     adminchangepasswordform => \&do_adminchangepasswordform,  
42      adminchangepassword => \&do_adminchangepassword,      adminchangepassword => \&do_adminchangepassword,
43      write => \&do_write,      write => \&do_write,
44      index => \&do_index,      index => \&do_index,
45      searchform => \&do_searchform,      searchform => \&do_searchform,
     search => \&do_search,  
     create => \&do_create,  
     createresult => \&do_createresult,  
46      comment => \&do_comment,      comment => \&do_comment,
47      RandomJump  => \&do_random_jump,      RandomJump  => \&do_random_jump,
48      rss => \&do_rss,      rss => \&do_rss,
49      diff => \&do_diff,      diff => \&do_diff,
50      wikiform    => \&do_wikiform,      wikiform    => \&do_wikiform,
     x_WikiPluginInfo    => \&do_wikiplugininfo,  
51      map => \&do_map,      map => \&do_map,
52  );  );
53  my $UA = '';  ## User agent name  my $UA = '';  ## User agent name
# Line 112  sub main { Line 61  sub main {
61      if ($command_do{$form{mycmd}}) {      if ($command_do{$form{mycmd}}) {
62          &{$command_do{$form{mycmd}}};          &{$command_do{$form{mycmd}}};
63      } else {      } else {
64          &{$command_do{$form{read}}};          &{$command_do{read}};
65      }      }
66      &close_db;      &close_db;
67  }  }
# Line 137  sub do_read { Line 86  sub do_read {
86      $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;
87      if ($cf =~ m!^(?:\#\?)?SuikaWiki/0.9(?:$|\s)!) {      if ($cf =~ m!^(?:\#\?)?SuikaWiki/0.9(?:$|\s)!) {
88      #print gmtime."Header...\n";      #print gmtime."Header...\n";
89        &print_header ($form{mypage}, -last_modified => $lm,        &print_header ($form{mypage}, -last_modified => $lm, -expires => time + 120,
90          -content_format => $cf, -noindex => $cf =~ /obsoleted="yes"/);          -content_format => $cf, -noindex => ($cf =~ /obsoleted="yes"/ ? 1 : 0));
91          #print "\n". gmtime."Body...\n";          #print "\n". gmtime."Body...\n";
92        &print_content ($content, content_format => $cf, last_modified => $lm,        &print_content ($content, content_format => $cf, last_modified => $lm,
93          -toc => \@toc);          -toc => \@toc);
94        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}};
95      } else {      } else {
96        &print_header($form{mypage}, -last_modified => $lm);        &print_header($form{mypage}, -expires => time + 120, -last_modified => $lm);
97        print "<pre>@{[&escape($content)]}</pre>";        print "<pre>@{[&escape($content)]}</pre>";
98      }      }
99      if ($c) {      if ($c) {
# Line 167  sub do_output_css { Line 116  sub do_output_css {
116      my $lm = gmtime &get_info($form{mypage}, $info_LastModified);      my $lm = gmtime &get_info($form{mypage}, $info_LastModified);
117      print "Content-Type: text/css; charset=@{[&get_charset_name($kanjicode)]}\n";      print "Content-Type: text/css; charset=@{[&get_charset_name($kanjicode)]}\n";
118      print "Last-Modified: $lm\n";      print "Last-Modified: $lm\n";
119        print "Expires: @{[scalar gmtime time+3600]}\n";    ## TODO: don't use asctime
120      print "\n";      print "\n";
121      print $content;      print $content;
122    } else {    } else {
# Line 188  sub id_and_name ($) { Line 138  sub id_and_name ($) {
138    
139  sub do_edit {  sub do_edit {
140      my ($page) = &unarmor_name(&armor_name($form{mypage}));      my ($page) = &unarmor_name(&armor_name($form{mypage}));
     &print_header($page, -noindex => 1);  
141      if (not &is_editable($page)) {      if (not &is_editable($page)) {
142            &print_header($page, -noindex => 1, -expires => time+60);
143          &print_message(&Resource('Error:ThisPageIsUneditable'));          &print_message(&Resource('Error:ThisPageIsUneditable'));
144      } elsif (&is_frozen($page)) {      } elsif (&is_frozen($page)) {
145            &print_header($page, -noindex => 1, -expires => time+60);
146          &print_message(&Resource('Error:ThisPageIsUneditable'));          &print_message(&Resource('Error:ThisPageIsUneditable'));
147      } else {      } else {
148            &print_header($page, -noindex => 1, -expires => time+60);
149          &print_editform($database{$page}, &get_info($page, $info_LastModified), admin=>0);          &print_editform($database{$page}, &get_info($page, $info_LastModified), admin=>0);
150      }      }
151      wiki::referer::add ($form{mypage}, $ENV{HTTP_REFERER});      wiki::referer::add ($form{mypage}, $ENV{HTTP_REFERER});
# Line 212  sub do_edit { Line 164  sub do_edit {
164    
165  sub do_adminedit {  sub do_adminedit {
166      my ($page) = &unarmor_name(&armor_name($form{mypage}));      my ($page) = &unarmor_name(&armor_name($form{mypage}));
167      &print_header($page, -noindex => 1);      &print_header($page, -noindex => 1, -expires => time+60);
168      if (not &is_editable($page)) {      if (not &is_editable($page)) {
169          &print_message(&Resource('Error:ThisPageIsUneditable'));          &print_message(&Resource('Error:ThisPageIsUneditable'));
170      } else {      } else {
# Line 222  sub do_adminedit { Line 174  sub do_adminedit {
174      &print_footer($page);      &print_footer($page);
175  }  }
176    
 sub do_adminchangepasswordform {  
     &print_header('AdminChangePassword', -noindex => 1);  
     &print_passwordform;  
     &print_footer('AdminChangePassword');  
 }  
   
177  sub do_adminchangepassword {  sub do_adminchangepassword {
178      if ($form{mynewpassword} ne $form{mynewpassword2}) {      if ($form{mynewpassword} ne $form{mynewpassword2}) {
179          &print_error(&Resource('Error:PasswordMismatch'));          &print_error(&Resource('Error:PasswordMismatch'));
180      }      }
181      my ($validpassword_crypt) = &get_info($AdminSpecialPage, 'AdminPassword');      my ($validpassword_crypt) = &get_info($PageName{AdminSpecialPage}, 'AdminPassword');
182      if ($validpassword_crypt) {      if ($validpassword_crypt) {
183          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  
184              &print_error(&Resource('Error:PasswordIsIncorrect'));              &print_error(&Resource('Error:PasswordIsIncorrect'));
185          }          }
186      }      }
# Line 248  sub do_adminchangepassword { Line 189  sub do_adminchangepassword {
189      my $salt1 = $token[(time | $$) % scalar(@token)];      my $salt1 = $token[(time | $$) % scalar(@token)];
190      my $salt2 = $token[($sec + $min*60 + $hour*60*60) % scalar(@token)];      my $salt2 = $token[($sec + $min*60 + $hour*60*60) % scalar(@token)];
191      my $crypted = crypt($form{mynewpassword}, "$salt1$salt2");      my $crypted = crypt($form{mynewpassword}, "$salt1$salt2");
192      &set_info($AdminSpecialPage, 'AdminPassword', $crypted);      &set_info($PageName{AdminSpecialPage}, 'AdminPassword', $crypted);
193    
194      &print_header('CompletedSuccessfully', -noindex => 1);      &print_header('CompletedSuccessfully', -noindex => 1);
195      &print_message(&Resource('Error:PasswordIsChanged'));      &print_message(&Resource('Error:PasswordIsChanged'));
196      &print_footer('CompletedSuccessfully');      &print_footer('CompletedSuccessfully');
197  }  }
198    
199    sub valid_password ($) {
200        my ($validpassword_crypt) = &get_info($PageName{AdminSpecialPage}, 'AdminPassword');
201        return crypt (shift, $validpassword_crypt) eq $validpassword_crypt ? 1 : 0;
202    }
203    
204  sub do_index {  sub do_index {
205    wiki::referer::add ($form{mypage}, $ENV{HTTP_REFERER});    wiki::referer::add ($form{mypage}, $ENV{HTTP_REFERER});
206    wiki::useragent::add ($ENV{HTTP_USER_AGENT});    wiki::useragent::add ($ENV{HTTP_USER_AGENT});
207      &print_header($IndexPage);      &print_header($PageName{IndexPage});
208      print qq(<ul>);      print qq(<ul>);
209      foreach my $page (sort keys %database) {      foreach my $page (sort keys %database) {
210          if (&is_editable($page)) {          if (&is_editable($page)) {
# Line 275  sub do_index { Line 221  sub do_index {
221      if ($rl) {      if ($rl) {
222          print qq(<div @{[&id_and_name('wikipage-referer')]}><h2>@{[&Resource('Referers',escape=>1)]}</h2>\n$rl</div>\n);          print qq(<div @{[&id_and_name('wikipage-referer')]}><h2>@{[&Resource('Referers',escape=>1)]}</h2>\n$rl</div>\n);
223      }      }
224      &print_footer($IndexPage);      &print_footer($PageName{IndexPage});
225  }  }
226    
227  sub do_write {  sub do_write {
# Line 305  sub do_write { Line 251  sub do_write {
251    
252      if ($form{mymsg}) {      if ($form{mymsg}) {
253          $database{$form{mypage}} = $form{mymsg};          $database{$form{mypage}} = $form{mymsg};
         #&send_mail_to_admin($form{mypage}, "Modify");  
254          if ($form{mytouch}) {          if ($form{mytouch}) {
255              &set_info($form{mypage}, $info_LastModified, time);              &set_info($form{mypage}, $info_LastModified, time);
256              &update_recent_changes;              &update_recent_changes;
# Line 323  sub do_write { Line 268  sub do_write {
268          &print_content(&Resource('Error:ContinueReading')." @{[&armor_name($form{mypage})]}");          &print_content(&Resource('Error:ContinueReading')." @{[&armor_name($form{mypage})]}");
269          &print_footer('CompletedSuccessfully');          &print_footer('CompletedSuccessfully');
270      } else {      } else {
         #&send_mail_to_admin($form{mypage}, "Delete");  
271          delete $database{$form{mypage}};          delete $database{$form{mypage}};
272          delete $infobase{$form{mypage}};          delete $infobase{$form{mypage}};
273          if ($form{mytouch}) {          if ($form{mytouch}) {
# Line 335  sub do_write { Line 279  sub do_write {
279      }      }
280  }  }
281    
 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);  
 }  
   
282  sub get_search_result ($;%) {  sub get_search_result ($;%) {
283    my $word = lc shift;    my $word = lc shift;
284    my %option = @_;    my %option = @_;
# Line 372  sub get_search_result ($;%) { Line 302  sub get_search_result ($;%) {
302    wantarray? ($r, scalar @r): $r;    wantarray? ($r, scalar @r): $r;
303  }  }
304    
 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);  
 }  
   
305  sub do_random_jump {  sub do_random_jump {
306    my @list = keys %database;    my @list = keys %database;
307    my $name = &encode ($list[rand @list]);    my $name = &encode ($list[rand @list]);
# Line 396  sub do_random_jump { Line 313  sub do_random_jump {
313    
314  sub print_error {  sub print_error {
315      my ($msg) = @_;      my ($msg) = @_;
316      &print_header($ErrorPage, -noindex => 1);      &print_header($PageName{ErrorPage}, -noindex => 1);
317      print qq(<p><strong class="error">$msg</strong></p>);      print qq(<p><strong class="error">$msg</strong></p>);
318      &print_footer($ErrorPage);      &print_footer($PageName{ErrorPage});
319      exit(0);      exit(0);
320  }  }
321    
# Line 421  sub print_header ($;%) { Line 338  sub print_header ($;%) {
338        }        }
339      }      }
340      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};
341        if ($option{-expires}) {
342          print qq{Expires: @{[scalar gmtime $option{-expires}]}\n};
343        }
344      if ($UA =~ m#Mozilla/2#) {      if ($UA =~ m#Mozilla/2#) {
345          my $ct = qq{text/html; charset=@{[&get_charset_name($kanjicode,compatible=>1)]}};          my $ct = qq{text/html; charset=@{[&get_charset_name($kanjicode,compatible=>1)]}};
346          print qq{Content-Type: $ct\n};          print qq{Content-Type: $ct\n};
# Line 431  sub print_header ($;%) { Line 351  sub print_header ($;%) {
351          print qq{Content-Type: text/html; charset=@{[&get_charset_name($kanjicode)]}\n};          print qq{Content-Type: text/html; charset=@{[&get_charset_name($kanjicode)]}\n};
352      }      }
353      push @head, qq(<title>@{[&escape($page)]}</title>);      push @head, qq(<title>@{[&escape($page)]}</title>);
354      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)#) {
355        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))]}");
356        }
357      push @head, q(<meta name="ROBOTS" content="NOINDEX">) if $option{-noindex};      push @head, q(<meta name="ROBOTS" content="NOINDEX">) if $option{-noindex};
358      my ($Links, $links) = &make_navigate_links ($page);      my ($Links, $links) = &make_navigate_links ($page);
359      #print $Links;      ## Link: fields      #print $Links;      ## Link: fields
# Line 479  sub print_navigate_links (@) { Line 400  sub print_navigate_links (@) {
400      ]}      ]}
401      <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> |
402      <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> |
403      <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> |
404      <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> |
405      <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> |
406      <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> |
407      <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> |
408      <a href="$url_cgi?RecentChanges" class="wiki" title="@{[&Resource('GoToRecentChangesLong',escape=>1)]}">@{[&Resource('GoToRecentChanges',escape=>1)]}</a>      <a href="$url_cgi?RecentChanges" class="wiki" title="@{[&Resource('GoToRecentChangesLong',escape=>1)]}">@{[&Resource('GoToRecentChanges',escape=>1)]}</a>
409  </div>  </div>
# Line 496  sub make_navigate_links ($) { Line 417  sub make_navigate_links ($) {
417      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);
418      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')};
419      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')};
420      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')};
421      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')};
422      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')};
423      push @link, {rel=>'News', href=>"$url_cgi?RecentChanges", class=>"wiki", title=>&Resource('GoToRecentChangesLink')};      push @link, {rel=>'News', href=>"$url_cgi?RecentChanges", class=>"wiki", title=>&Resource('GoToRecentChangesLink')};
424      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'};
425      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')};
426      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')};
427      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')};
428      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')};
# Line 759  sub make_wikilink ($%) { Line 680  sub make_wikilink ($%) {
680        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>);
681      }      }
682    } else {    } else {
683      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>);
684    }    }
685  }  }
686    
# Line 817  sub make_custom_form ($$$$) { Line 738  sub make_custom_form ($$$$) {
738              $option = &unescape ($option);              $option = &unescape ($option);
739              $option =~ s/\\(.)/$1/g;              $option =~ s/\\(.)/$1/g;
740              $fmt{form_option}->replace ($option, $param);              $fmt{form_option}->replace ($option, $param);
741              $definition .= ' %submit;' if $definition !~ /%submit/ && !$param->{output}->{nosubmit};              $param->{output}->{form} = 1 unless defined $param->{output}->{form};
742                $definition .= ' %submit;' if $definition !~ /%submit/ && !$param->{output}->{nosubmit} && $param->{output}->{form};
743              my $target_page = $param->{output}->{page} || $form{mypage};              my $target_page = $param->{output}->{page} || $form{mypage};
744              $param->{form_disabled} = 1 if $fixedpage{$target_page};              $param->{form_disabled} = 1 if $FixedPage{$target_page};
745              my $target_form = $param->{output}->{id};              my $target_form = $param->{output}->{id};
746              my $r = <<EOH;              my $r = '';
747                $r = <<EOH if $param->{output}->{form};
748  <form method="post" action="$url_cgi" id="wikiform-$FormIndex" class="wikiform">  <form method="post" action="$url_cgi" id="wikiform-$FormIndex" class="wikiform">
749    <input type="hidden" name="mycmd" value="@{[$param->{form_disabled}?'read':'wikiform']}">    <input type="hidden" name="mycmd" value="@{[$param->{form_disabled}?'read':'wikiform']}">
750    <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 754  sub make_custom_form ($$$$) {
754  EOH  EOH
755              $r .= qq(<a name="wikiform-$FormIndex"></a>) if $UA =~ m#Mozilla/[12]\.#;              $r .= qq(<a name="wikiform-$FormIndex"></a>) if $UA =~ m#Mozilla/[12]\.#;
756              $r .= $fmt{form_input}->replace ($definition, $param);              $r .= $fmt{form_input}->replace ($definition, $param);
757              $r .= <<EOH;              $r .= "</form>\n" if $param->{output}->{form};
 </form>  
 EOH  
758              $r;              $r;
759         } else {  ## No input-interface WikiForm         } else {  ## No input-interface WikiForm
760             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 776  sub init_form {
776        read STDIN, $query, $main::ENV{CONTENT_LENGTH};        read STDIN, $query, $main::ENV{CONTENT_LENGTH};
777      }      }
778      $query .= ($query ? ';' : '') . $main::ENV{QUERY_STRING};      $query .= ($query ? ';' : '') . $main::ENV{QUERY_STRING};
779      if ($main::ENV{QUERY_STRING} && $main::ENV{QUERY_STRING} !~ /[&;=]/) {      if ($main::ENV{REQUEST_METHOD} ne 'POST' && $main::ENV{QUERY_STRING} && $main::ENV{QUERY_STRING} !~ /[&;=]/) {
780        my $query = &decode($main::ENV{QUERY_STRING});        my $query = &decode($main::ENV{QUERY_STRING});
781        $query = &code_convert(\$query, $kanjicode);        $query = &code_convert(\$query, $kanjicode);
782        if ($page_command{$query}) {        if ($page_command{$query}) {
# Line 872  sub init_form { Line 793  sub init_form {
793            $form{$n} = $v;            $form{$n} = $v;
794          }          }
795        }        }
796          unless (defined $form{mypage}) {
797            $form{mypage} = $form{epage};
798            $form{mypage} =~ s/([0-9A-F]{2})/ord hex $1/g;
799          }
800        if ($page_command{$form{mypage}} && $form{mycmd} eq 'read') {        if ($page_command{$form{mypage}} && $form{mycmd} eq 'read') {
801          $form{mypage} = &code_convert(\$form{mypage}, $kanjicode);          $form{mypage} = &code_convert(\$form{mypage}, $kanjicode);
802          $form{mycmd} = $page_command{$form{mypage}};          $form{mycmd} = $page_command{$form{mypage}};
# Line 918  sub update_recent_changes { Line 843  sub update_recent_changes {
843      }      }
844      splice @updates, (&Resource ('RecentChanges:Max') || 50) + 1;      splice @updates, (&Resource ('RecentChanges:Max') || 50) + 1;
845      $database{RecentChanges} = "#?SuikaWiki/0.9\n" . join("\n", @updates);      $database{RecentChanges} = "#?SuikaWiki/0.9\n" . join("\n", @updates);
846      if ($file_touch) {      if ($PathTo{TouchFile}) {
847          open(FILE, "> $file_touch");          open(FILE, "> ".$PathTo{TouchFile});
848          print FILE localtime() . "\n";          print FILE localtime() . "\n";
849          close(FILE);          close(FILE);
850      }      }
# Line 947  sub get_subjectline { Line 872  sub get_subjectline {
872    
873  sub open_db {  sub open_db {
874      if ($modifier_dbtype eq 'dbmopen') {      if ($modifier_dbtype eq 'dbmopen') {
875          dbmopen(%database, $dataname, 0666) or &print_error("(dbmopen) $dataname");          dbmopen(%database, $PathTo{WikiDataBase}, 0666) or &print_error("(dbmopen) $PathTo{WikiDataBase}");
876          dbmopen(%infobase, $infoname, 0666) or &print_error("(dbmopen) $infoname");          dbmopen(%infobase, $PathTo{WikiInfoBase}, 0666) or &print_error("(dbmopen) $PathTo{WikiInfoBase}");
877      } elsif ($modifier_dbtype eq 'AnyDBM_File') {      } elsif ($modifier_dbtype eq 'AnyDBM_File') {
878          eval q{use AnyDBM_File};          eval q{use AnyDBM_File};
879          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}");
880          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}");
881      } else {      } else {
882          eval q{use Yuki::YukiWikiDB};          eval q{use Yuki::YukiWikiDB};
883          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}");
884          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}");
885      }      }
886  }  }
887    
# Line 975  sub close_db { Line 900  sub close_db {
900    
901  sub open_diff {  sub open_diff {
902      if ($modifier_dbtype eq 'dbmopen') {      if ($modifier_dbtype eq 'dbmopen') {
903          dbmopen(%diffbase, $diffname, 0666) or &print_error("(dbmopen) $diffname");          dbmopen(%diffbase, $PathTo{WikiDiffBase}, 0666) or &print_error("(dbmopen) $PathTo{WikiDiffBase}");
904      } elsif ($modifier_dbtype eq 'AnyDBM_File') {      } elsif ($modifier_dbtype eq 'AnyDBM_File') {
905          tie(%diffbase, "AnyDBM_File", $diffname, O_RDWR|O_CREAT, 0666) or &print_error("(tie AnyDBM_File) $diffname");          tie(%diffbase, "AnyDBM_File", $PathTo{WikiDiffBase}, O_RDWR|O_CREAT, 0666) or &print_error("(tie AnyDBM_File) $PathTo{WikiDiffBase}");
906      } else {      } else {
907          tie(%diffbase, "Yuki::YukiWikiDB", $diffname) or &print_error("(tie Yuki::YukiWikiDB) $diffname");          tie(%diffbase, "Yuki::YukiWikiDB", $PathTo{WikiDiffBase}) or &print_error("(tie Yuki::YukiWikiDB) $PathTo{WikiDiffBase}");
908      }      }
909  }  }
910    
# Line 993  sub close_diff { Line 918  sub close_diff {
918      }      }
919  }  }
920    
 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  
 }  
   
921  sub print_editform {  sub print_editform {
922      my ($mymsg, $lastmodified, %mode) = @_;      my ($mymsg, $lastmodified, %mode) = @_;
923      my $frozen = &is_frozen($form{mypage});      my $frozen = &is_frozen($form{mypage});
# Line 1028  sub print_editform { Line 942  sub print_editform {
942      $magic = $1 if $mymsg =~ m/^([^\x0A\x0D]+)/s;      $magic = $1 if $mymsg =~ m/^([^\x0A\x0D]+)/s;
943    
944      my $edit = $mode{admin} ? 'adminedit' : 'edit';      my $edit = $mode{admin} ? 'adminedit' : 'edit';
     my $escapedmypage = &escape($form{mypage});  
     my $escapedmypassword = &escape($form{mypassword});  
945      my $selected = 'read';      my $selected = 'read';
946      if ($form{after_edit_cmd}) {      if ($form{after_edit_cmd}) {
947          $selected = $form{after_edit_cmd};          $selected = $form{after_edit_cmd};
# Line 1047  EOH Line 959  EOH
959  <form action="$url_cgi" method="post">  <form action="$url_cgi" method="post">
960  <h2>@{[&Resource('Edit:Title',escape=>1)]}</h2>  <h2>@{[&Resource('Edit:Title',escape=>1)]}</h2>
961      @{[ $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>) ]}
962      @{[ $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;
963                 $mymsg =~ s/(?:-+\s)?\[([0-9]+)\]/$n = $1 if $1 > $n; $&/mge;                 $mymsg =~ s/(?:-+\s)?\[([0-9]+)\]/$n = $1 if $1 > $n; $&/mge;
964                 ++$n}]}]<br>                 ++$n}]}]<br>
965      <input type="hidden" name="myLastModified" value="$lastmodified">      <input type="hidden" name="myLastModified" value="$lastmodified">
966      <input type="hidden" name="mypage" value="$escapedmypage">      <input type="hidden" name="mypage" value="@{[&escape($form{mypage})]}">
967      <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>
968  @{[  @{[
969      $mode{admin} ?      $mode{admin} ?
# Line 1063  EOH Line 975  EOH
975  @{[  @{[
976      $mode{conflict} ? "" :      $mode{conflict} ? "" :
977      qq(      qq(
978          <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>
979          <input type="submit" name="mypreview_$edit" value="@{[&Resource('Edit:Preview',escape=>1)]}">          <input type="submit" name="mypreview_$edit" value="@{[&Resource('Edit:Preview',escape=>1)]}">
980          <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>
981         $afteredit         $afteredit
        <br>  
982      )      )
983  ]}  ]}
984  </form>  </form>
# Line 1080  EOD Line 991  EOD
991      }      }
992  }  }
993    
 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  
 }  
   
994  sub is_editable {  sub is_editable {
995      my ($page) = @_;      my ($page) = @_;
996      if ($fixedpage{$page} || $page =~ /\s/ || $page =~ /^\#/) {      if ($FixedPage{$page} || $page =~ /\s/ || $page =~ /^\#/) {
997          return 0;          return 0;
998      } else {      } else {
999          return 1;          return 1;
# Line 1205  sub frozen_reject { Line 1104  sub frozen_reject {
1104      }      }
1105  }  }
1106    
 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;  
     }  
 }  
   
1107  sub is_frozen {  sub is_frozen {
1108      my ($page) = @_;      my ($page) = @_;
1109      if (&get_info($page, $info_IsFrozen)) {      if (&get_info($page, $info_IsFrozen)) {
# Line 1408  sub code_convert { Line 1297  sub code_convert {
1297      #&Jcode::convert($contentref, $code);       # for Jcode.pm      #&Jcode::convert($contentref, $code);       # for Jcode.pm
1298  #    &jcode::convert($contentref, $code);       # for jcode.pl  #    &jcode::convert($contentref, $code);       # for jcode.pl
1299      #&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::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';
1300      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;      $$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;
1301      return $$contentref;      return $$contentref;
1302  }  }
1303    
# Line 1499  sub is_exist_page { Line 1388  sub is_exist_page {
1388  sub __get_database ($) { $database{ $_[0] } }  sub __get_database ($) { $database{ $_[0] } }
1389  sub __set_database ($$) { $database{ $_[0] } = $_[1] }  sub __set_database ($$) { $database{ $_[0] } = $_[1] }
1390    
 sub do_wikiplugininfo {  
     &print_header (q(WikiPluginInfo));  
     print text_to_html (&SuikaWiki::Plugin::make_info_page);  
     &print_footer (q(WikiPluginInfo));  
 }  
   
1391  sub do_map {  sub do_map {
1392      my $page = $form{mypage};      my $page = $form{mypage};
1393      &print_header ($page);      &print_header ($page);
# Line 1618  sub __decode ($) { Line 1501  sub __decode ($) {
1501  }  }
1502    
1503  package wiki::useragent;  package wiki::useragent;
1504    our $UseLog;
1505    
1506  sub add ($) {  sub add ($) {
1507    my $s = shift;    my $s = shift;
1508    return unless length $s;    return unless length $s;
1509      return unless $UseLog;
1510    $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;
1511    my %ua;    my %ua;
1512    for (split /\n/, &main::__get_database('WikiUserAgentList')) {    for (split /\n/, &main::__get_database($main::PageName{UserAgentList})) {
1513      if (/^-\[(\d+)\] (.+)$/) {      if (/^-\[(\d+)\] (.+)$/) {
1514        my ($t, $n) = ($1, $2);        my ($t, $n) = ($1, $2);
1515        $n =~ tr/\x0A\x0D//d;        $n =~ tr/\x0A\x0D//d;
# Line 1636  sub add ($) { Line 1521  sub add ($) {
1521    for (sort {$ua{$a} <=> $ua{$b}} keys %ua) {    for (sort {$ua{$a} <=> $ua{$b}} keys %ua) {
1522      $s .= sprintf qq(-[%d] %s\n), $ua{$_}, $_;      $s .= sprintf qq(-[%d] %s\n), $ua{$_}, $_;
1523    }    }
1524    &main::__set_database ('WikiUserAgentList' => $s);    &main::__set_database ($main::PageName{UserAgentList} => $s);
1525  }  }
1526    
1527  package wiki::suikawikiconst;  package wiki::suikawikiconst;
# Line 1665  sub unescape ($$) { main::unescape ($_[1 Line 1550  sub unescape ($$) { main::unescape ($_[1
1550  sub encode ($$) { main::encode ($_[1]) }  sub encode ($$) { main::encode ($_[1]) }
1551  sub decode ($$) { main::decode ($_[1]) }  sub decode ($$) { main::decode ($_[1]) }
1552  sub __get_datetime ($) { main::get_now () }  sub __get_datetime ($) { main::get_now () }
1553    sub resource ($$;%) { shift; &main::Resource (@_) }
1554    sub uri ($$) { $main::uri{$_[1]} }
1555    
1556  sub regist ($@) {  sub regist ($@) {
1557      my $pack = shift;      my $pack = shift;
# Line 1683  sub import_plugins () { Line 1570  sub import_plugins () {
1570      }      }
1571  }  }
1572    
 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;  
 }  
   
1573  &import_plugins ();  &import_plugins ();
1574    
1575  package wiki::conneg;  package wiki::conneg;
Legend:
Removed from v.1.41  
changed lines
  Added in v.1.45
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24