/[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.43 by w, Wed Jan 1 01:29:04 2003 UTC revision 1.47 by w, Fri Jan 3 03:27:30 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    our $VERSION = do{my @r=(q$Revision$=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};
11    
12  require 'wikidata/suikawiki-config.ph';  require 'wikidata/suikawiki-config.ph';
 use Yuki::DiffText qw(difftext);  
13  use Fcntl;  use Fcntl;
14  ##############################  ##############################
15  my %fmt;        ## formatter objects  my %fmt;        ## formatter objects
# Line 18  my %embed_command = ( Line 18  my %embed_command = (
18          form    => qr/\[\[\#form(?:\(([A-Za-z0-9-]+)\))?:'((?:[^'\\]|\\.)*)':'((?:[^'\\]|\\.)*)'(?::'((?:[^'\\]|\\.)*)')?\]\]/,          form    => qr/\[\[\#form(?:\(([A-Za-z0-9-]+)\))?:'((?:[^'\\]|\\.)*)':'((?:[^'\\]|\\.)*)'(?::'((?:[^'\\]|\\.)*)')?\]\]/,
19  );  );
20  our ($modifier_dbtype,$url_cgi,%uri,%PathTo,$use_exists);  our ($modifier_dbtype,$url_cgi,%uri,%PathTo,$use_exists);
21  our (%PageName,$kanjicode,$lang,%fixedpage);  our (%PageName,$kanjicode,$lang,%FixedPage);
22    
23  ##############################  ##############################
 my $info_LastModified = 'LastModified';  
 my $info_IsFrozen = 'IsFrozen';  
 ##############################  
24  my %form;  my %form;
25  my %database;  our %database;
26  my %infobase;  our $database = bless {}, 'wiki::dummy';
 my %diffbase;  
27  my %interwiki;  my %interwiki;
28  ##############################  ##############################
29  my %page_command = (  my %page_command = (
     $PageName{IndexPage} => 'index',  
30      $PageName{RssPage} => 'rss',      $PageName{RssPage} => 'rss',
     AdminChangePassword => 'adminchangepasswordform',  
31  );  );
32  my %command_do = (  my %command_do = (
33      read => \&do_read,      read => \&do_read,
34      TEXT_CSS => \&do_output_css,      TEXT_CSS => \&do_output_css,
35      edit => \&do_edit,      edit => \&do_edit,
36      adminedit => \&do_adminedit,      adminedit => \&do_adminedit,
     adminchangepasswordform => \&do_adminchangepasswordform,  
37      adminchangepassword => \&do_adminchangepassword,      adminchangepassword => \&do_adminchangepassword,
38      write => \&do_write,      write => \&do_write,
     index => \&do_index,  
39      searchform => \&do_searchform,      searchform => \&do_searchform,
40      comment => \&do_comment,      comment => \&do_comment,
41      RandomJump  => \&do_random_jump,      RandomJump  => \&do_random_jump,
# Line 70  sub main { Line 62  sub main {
62    
63  sub do_read {  sub do_read {
64    my $content = $database{$form{mypage}};    my $content = $database{$form{mypage}};
65    #print "content-type:text/plain;charset=euc-jp\n\n".gmtime."Get Lastmodified\n";    my $lm = $database->mtime ($form{mypage});
   my $lm = &get_info($form{mypage}, $info_LastModified);  
66    wiki::referer::add ($form{mypage}, $ENV{HTTP_REFERER});    wiki::referer::add ($form{mypage}, $ENV{HTTP_REFERER});
67    wiki::useragent::add ($ENV{HTTP_USER_AGENT});    wiki::useragent::add ($ENV{HTTP_USER_AGENT});
   #print gmtime."Search...\n";  
68    my ($r, $c) = get_search_result ($form{mypage});    my ($r, $c) = get_search_result ($form{mypage});
69    my $rl = wiki::referer::list_html ($form{mypage});    my $rl = wiki::referer::list_html ($form{mypage});
70    my @toc;    my @toc;
# Line 87  sub do_read { Line 77  sub do_read {
77      ## - "/*" WSP* 'W3C-CSS/' ("1.0" / "2.0") "*/" CRLF      ## - "/*" WSP* 'W3C-CSS/' ("1.0" / "2.0") "*/" CRLF
78      $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;
79      if ($cf =~ m!^(?:\#\?)?SuikaWiki/0.9(?:$|\s)!) {      if ($cf =~ m!^(?:\#\?)?SuikaWiki/0.9(?:$|\s)!) {
80      #print gmtime."Header...\n";        my $expires = time;
81        &print_header ($form{mypage}, -last_modified => $lm, -expires => time + 120,        if ($cf =~ /interactive="yes"/) {
82            $lm = $expires;
83          } else {
84            $expires += 120;
85          }
86          &print_header ($form{mypage}, -last_modified => $lm, -expires => $expires,
87          -content_format => $cf, -noindex => ($cf =~ /obsoleted="yes"/ ? 1 : 0));          -content_format => $cf, -noindex => ($cf =~ /obsoleted="yes"/ ? 1 : 0));
         #print "\n". gmtime."Body...\n";  
88        &print_content ($content, content_format => $cf, last_modified => $lm,        &print_content ($content, content_format => $cf, last_modified => $lm,
89          -toc => \@toc);          -toc => \@toc);
90        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}};
91      } else {      } else {
92        &print_header($form{mypage}, -expires => time + 120, -last_modified => $lm);        &print_header($form{mypage}, -expires => time + 120, -last_modified => $lm);
93        print "<pre>@{[&escape($content)]}</pre>";        print "<pre>@{[&escape($content)]}</pre>";
# Line 115  sub do_output_css { Line 109  sub do_output_css {
109    wiki::useragent::add ($ENV{HTTP_USER_AGENT});    wiki::useragent::add ($ENV{HTTP_USER_AGENT});
110    my $content = $database{$form{mypage}};    my $content = $database{$form{mypage}};
111    if ($content =~ m#^\s*/\*\s*W3C-CSS#) {    if ($content =~ m#^\s*/\*\s*W3C-CSS#) {
112      my $lm = gmtime &get_info($form{mypage}, $info_LastModified);      my $lm = gmtime $database->mtime ($form{mypage});
113      print "Content-Type: text/css; charset=@{[&get_charset_name($kanjicode)]}\n";      print "Content-Type: text/css; charset=@{[&get_charset_name($kanjicode)]}\n";
114      print "Last-Modified: $lm\n";      print "Last-Modified: $lm\n";
115      print "Expires: @{[scalar gmtime time+3600]}\n";    ## TODO: don't use asctime      print "Expires: @{[scalar gmtime time+3600]}\n";    ## TODO: don't use asctime
# Line 141  sub id_and_name ($) { Line 135  sub id_and_name ($) {
135  sub do_edit {  sub do_edit {
136      my ($page) = &unarmor_name(&armor_name($form{mypage}));      my ($page) = &unarmor_name(&armor_name($form{mypage}));
137      if (not &is_editable($page)) {      if (not &is_editable($page)) {
138          &print_header($page, -noindex => 1);          &print_header($page, -noindex => 1, -expires => time+60);
139          &print_message(&Resource('Error:ThisPageIsUneditable'));          &print_message(&Resource('Error:ThisPageIsUneditable'));
140      } elsif (&is_frozen($page)) {      } elsif (&is_frozen($page)) {
141          &print_header($page, -noindex => 1);          &print_header($page, -noindex => 1, -expires => time+60);
142          &print_message(&Resource('Error:ThisPageIsUneditable'));          &print_message(&Resource('Error:ThisPageIsUneditable'));
143      } else {      } else {
144          &print_header($page, -noindex => 1, -expires => time+60);          &print_header($page, -noindex => 1, -expires => time+60);
145          &print_editform($database{$page}, &get_info($page, $info_LastModified), admin=>0);          &print_editform($database{$page}, $database->mtime ($page), admin=>0);
146      }      }
147      wiki::referer::add ($form{mypage}, $ENV{HTTP_REFERER});      wiki::referer::add ($form{mypage}, $ENV{HTTP_REFERER});
148      wiki::useragent::add ($ENV{HTTP_USER_AGENT});      wiki::useragent::add ($ENV{HTTP_USER_AGENT});
# Line 166  sub do_edit { Line 160  sub do_edit {
160    
161  sub do_adminedit {  sub do_adminedit {
162      my ($page) = &unarmor_name(&armor_name($form{mypage}));      my ($page) = &unarmor_name(&armor_name($form{mypage}));
163      &print_header($page, -noindex => 1);      &print_header($page, -noindex => 1, -expires => time+60);
164      if (not &is_editable($page)) {      if (not &is_editable($page)) {
165          &print_message(&Resource('Error:ThisPageIsUneditable'));          &print_message(&Resource('Error:ThisPageIsUneditable'));
166      } else {      } else {
167          &print_message(&Resource('Error:PasswordIsNotSpecified'));          &print_message(&Resource('Error:PasswordIsNotSpecified'));
168          &print_editform($database{$page}, &get_info($page, $info_LastModified), admin=>1);          &print_editform($database{$page}, $database->mtime ($page), admin=>1);
169      }      }
170      &print_footer($page);      &print_footer($page);
171  }  }
172    
 sub do_adminchangepasswordform {  
     &print_header('AdminChangePassword', -noindex => 1);  
     &print_passwordform;  
     &print_footer('AdminChangePassword');  
 }  
   
173  sub do_adminchangepassword {  sub do_adminchangepassword {
174      if ($form{mynewpassword} ne $form{mynewpassword2}) {      if ($form{mynewpassword} ne $form{mynewpassword2}) {
175          &print_error(&Resource('Error:PasswordMismatch'));          &print_error(&Resource('Error:PasswordMismatch'));
176      }      }
177      my ($validpassword_crypt) = &get_info($PageName{AdminSpecialPage}, 'AdminPassword');      my ($validpassword_crypt) = $database->meta (AdminPassword => $PageName{AdminSpecialPage});
178      if ($validpassword_crypt) {      if ($validpassword_crypt) {
179          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  
180              &print_error(&Resource('Error:PasswordIsIncorrect'));              &print_error(&Resource('Error:PasswordIsIncorrect'));
181          }          }
182      }      }
# Line 202  sub do_adminchangepassword { Line 185  sub do_adminchangepassword {
185      my $salt1 = $token[(time | $$) % scalar(@token)];      my $salt1 = $token[(time | $$) % scalar(@token)];
186      my $salt2 = $token[($sec + $min*60 + $hour*60*60) % scalar(@token)];      my $salt2 = $token[($sec + $min*60 + $hour*60*60) % scalar(@token)];
187      my $crypted = crypt($form{mynewpassword}, "$salt1$salt2");      my $crypted = crypt($form{mynewpassword}, "$salt1$salt2");
188      &set_info($PageName{AdminSpecialPage}, 'AdminPassword', $crypted);      $database->meta (AdminPassword => $PageName{AdminSpecialPage} => $crypted);
189    
190      &print_header('CompletedSuccessfully', -noindex => 1);      &print_header('CompletedSuccessfully', -noindex => 1);
191      &print_message(&Resource('Error:PasswordIsChanged'));      &print_message(&Resource('Error:PasswordIsChanged'));
192      &print_footer('CompletedSuccessfully');      &print_footer('CompletedSuccessfully');
193  }  }
194    
195  sub do_index {  sub valid_password ($) {
196    wiki::referer::add ($form{mypage}, $ENV{HTTP_REFERER});      my ($validpassword_crypt) = $database->meta (AdminPassword => $PageName{AdminSpecialPage});
197    wiki::useragent::add ($ENV{HTTP_USER_AGENT});      return crypt (shift, $validpassword_crypt) eq $validpassword_crypt ? 1 : 0;
     &print_header($PageName{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($PageName{IndexPage});  
198  }  }
199    
200  sub do_write {  sub do_write {
# Line 248  sub do_write { Line 213  sub do_write {
213          return;          return;
214      }      }
215    
     # 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;  
     }  
   
216      if ($form{mymsg}) {      if ($form{mymsg}) {
217          $database{$form{mypage}} = $form{mymsg};          if ($form{mytouch} || !ref $database) {
218          #&send_mail_to_admin($form{mypage}, "Modify");            $database{$form{mypage}} = $form{mymsg};
219          if ($form{mytouch}) {          } else {
220              &set_info($form{mypage}, $info_LastModified, time);            $database->STORE ($form{mypage} => $form{mymsg}, -touch => 0);
             &update_recent_changes;  
221          }          }
222          &set_info($form{mypage}, $info_IsFrozen, 0 + $form{myfrozen});          $database->meta (IsFrozen => $form{mypage} => 0 + $form{myfrozen});
223          my $fragment = '';          my $fragment = '';
224          $fragment .= qq(;after_edit_cmd=@{[&encode($form{after_edit_cmd})]}) if $form{after_edit_cmd};          $fragment .= qq(;after_edit_cmd=@{[&encode($form{after_edit_cmd})]}) if $form{after_edit_cmd};
225          if ($form{__comment_anchor_index}) {          if ($form{__comment_anchor_index}) {
# Line 277  sub do_write { Line 232  sub do_write {
232          &print_content(&Resource('Error:ContinueReading')." @{[&armor_name($form{mypage})]}");          &print_content(&Resource('Error:ContinueReading')." @{[&armor_name($form{mypage})]}");
233          &print_footer('CompletedSuccessfully');          &print_footer('CompletedSuccessfully');
234      } else {      } else {
         #&send_mail_to_admin($form{mypage}, "Delete");  
235          delete $database{$form{mypage}};          delete $database{$form{mypage}};
         delete $infobase{$form{mypage}};  
         if ($form{mytouch}) {  
             &update_recent_changes;  
         }  
236          &print_header($form{mypage}, -noindex => 1);          &print_header($form{mypage}, -noindex => 1);
237          &print_message(&Resource('Error:PageIsDeletedSuccessfully'));          &print_message(&Resource('Error:PageIsDeletedSuccessfully'));
238          &print_footer($form{mypage});          &print_footer($form{mypage});
# Line 362  sub print_header ($;%) { Line 312  sub print_header ($;%) {
312      }      }
313      push @head, qq(<title>@{[&escape($page)]}</title>);      push @head, qq(<title>@{[&escape($page)]}</title>);
314      if ($UA !~ m#Mozilla/[1-4]\.# || $UA =~ m#MSIE (?:[4-9]\.|\d\d)#) {      if ($UA !~ m#Mozilla/[1-4]\.# || $UA =~ m#MSIE (?:[4-9]\.|\d\d)#) {
315        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))]}");        push @head, qq(<link rel="stylesheet" type="text/css").
316                      qq( href="@{[&escape($uri{wiki}.'?mycmd=TEXT_CSS;mypage='.&encode($PageName{DefaultStyleForHTML}).';x-lm='.$database->mtime ($PageName{DefaultStyleForHTML}))]}");
317      }      }
318      push @head, q(<meta name="ROBOTS" content="NOINDEX">) if $option{-noindex};      push @head, q(<meta name="ROBOTS" content="NOINDEX">) if $option{-noindex};
319      my ($Links, $links) = &make_navigate_links ($page);      my ($Links, $links) = &make_navigate_links ($page);
# Line 415  sub print_navigate_links (@) { Line 366  sub print_navigate_links (@) {
366      <a href="$url_cgi?$PageName{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> |
367      <a href="$url_cgi?$PageName{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> |
368      <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> |
369      <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>
370  </div>  </div>
371  EOH  EOH
372  }  }
# Line 430  sub make_navigate_links ($) { Line 381  sub make_navigate_links ($) {
381      push @link, {rel=>'index', href=>"$url_cgi?$PageName{IndexPage}", class=>'wiki', title=>&Resource('GoToIndexPageLink')};      push @link, {rel=>'index', href=>"$url_cgi?$PageName{IndexPage}", class=>'wiki', title=>&Resource('GoToIndexPageLink')};
382      push @link, {rel=>'home', href=>"$url_cgi?$PageName{FrontPage}", class=>'wiki', title=>&Resource('GoToHomePageLink')};      push @link, {rel=>'home', href=>"$url_cgi?$PageName{FrontPage}", class=>'wiki', title=>&Resource('GoToHomePageLink')};
383      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')};
384      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')};
385      push @link, {rel=>'News', href=>"$url_cgi?$PageName{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'};
386      push @link, {rel=>'search', href=>"$url_cgi?$PageName{SearchPage}", class=>'wiki', title=>&Resource('GoToSearchPageLink')};      push @link, {rel=>'search', href=>"$url_cgi?$PageName{SearchPage}", class=>'wiki', title=>&Resource('GoToSearchPageLink')};
387      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')};
# Line 439  sub make_navigate_links ($) { Line 390  sub make_navigate_links ($) {
390      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')};
391      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')};
392      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};
393      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;
394      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'};
395      my ($Links, $links) = ('', '');      my ($Links, $links) = ('', '');
396      for my $e (@link) {      for my $e (@link) {
# Line 656  sub inline ($;%) { Line 607  sub inline ($;%) {
607      $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;
608      $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;
609      $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;  
610      $line =~ s|'''([^']+)'''|<strong>$1</strong>|g;      $line =~ s|'''([^']+)'''|<strong>$1</strong>|g;
611      $line =~ s|''([^']+)''|<em>$1</em>|g;      $line =~ s|''([^']+)''|<em>$1</em>|g;
612      $line =~ s{      $line =~ s{
# Line 667  sub inline ($;%) { Line 617  sub inline ($;%) {
617      }{      }{
618        my ($l, $page,$anchor, $anum, $uri) = ($1, $3,$4, 0+$5, $6);        my ($l, $page,$anchor, $anum, $uri) = ($1, $3,$4, 0+$5, $6);
619        if ($l) {        if ($l) {
620          return &embedded_to_html($1);          &embedded_to_html($1);
621        } elsif (defined $page) {        } elsif (defined $page) {
622          &make_wikilink ($page, anchor => 0+$anchor);          &make_wikilink ($page, anchor => 0+$anchor);
623        } elsif ($anum) {        } elsif ($anum) {
# Line 741  sub make_custom_form ($$$$) { Line 691  sub make_custom_form ($$$$) {
691          $FormIndex++;          $FormIndex++;
692          if (length $definition) {          if (length $definition) {
693              my $param = bless {}, 'SuikaWiki::Plugin';              my $param = bless {}, 'SuikaWiki::Plugin';
694              my $lastmodified = &get_info($form{mypage}, $info_LastModified);              my $lastmodified = $database->mtime ($form{mypage});
695              &load_formatter (qw/form_input form_option/);              &load_formatter (qw/form_input form_option/);
696              $definition = &unescape ($definition);              $definition = &unescape ($definition);
697              $definition =~ s/\\(.)/$1/g;              $definition =~ s/\\(.)/$1/g;
# Line 751  sub make_custom_form ($$$$) { Line 701  sub make_custom_form ($$$$) {
701              $param->{output}->{form} = 1 unless defined $param->{output}->{form};              $param->{output}->{form} = 1 unless defined $param->{output}->{form};
702              $definition .= ' %submit;' if $definition !~ /%submit/ && !$param->{output}->{nosubmit} && $param->{output}->{form};              $definition .= ' %submit;' if $definition !~ /%submit/ && !$param->{output}->{nosubmit} && $param->{output}->{form};
703              my $target_page = $param->{output}->{page} || $form{mypage};              my $target_page = $param->{output}->{page} || $form{mypage};
704              $param->{form_disabled} = 1 if $fixedpage{$target_page};              $param->{form_disabled} = 1 if $FixedPage{$target_page};
705              my $target_form = $param->{output}->{id};              my $target_form = $param->{output}->{id};
706              my $r = '';              my $r = '';
707              $r = <<EOH if $param->{output}->{form};              $r = <<EOH if $param->{output}->{form};
# Line 836  sub init_form { Line 786  sub init_form {
786      $form{myname} = &code_convert(\$form{myname}, $kanjicode);      $form{myname} = &code_convert(\$form{myname}, $kanjicode);
787  }  }
788    
 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 ($PathTo{TouchFile}) {  
         open(FILE, "> ".$PathTo{TouchFile});  
         print FILE localtime() . "\n";  
         close(FILE);  
     }  
 }  
   
789  {my %SubjectLine;  {my %SubjectLine;
790  sub get_subjectline {  sub get_subjectline {
791      my ($page, %option) = @_;      my ($page, %option) = @_;
# Line 883  sub get_subjectline { Line 809  sub get_subjectline {
809  sub open_db {  sub open_db {
810      if ($modifier_dbtype eq 'dbmopen') {      if ($modifier_dbtype eq 'dbmopen') {
811          dbmopen(%database, $PathTo{WikiDataBase}, 0666) or &print_error("(dbmopen) $PathTo{WikiDataBase}");          dbmopen(%database, $PathTo{WikiDataBase}, 0666) or &print_error("(dbmopen) $PathTo{WikiDataBase}");
         dbmopen(%infobase, $PathTo{WikiInfoBase}, 0666) or &print_error("(dbmopen) $PathTo{WikiInfoBase}");  
812      } elsif ($modifier_dbtype eq 'AnyDBM_File') {      } elsif ($modifier_dbtype eq 'AnyDBM_File') {
813          eval q{use AnyDBM_File};          eval q{use AnyDBM_File};
814          tie(%database, "AnyDBM_File", $PathTo{WikiDataBase}, O_RDWR|O_CREAT, 0666) or &print_error("(tie AnyDBM_File) $PathTo{WikiDataBase}");          tie(%database, "AnyDBM_File", $PathTo{WikiDataBase}, O_RDWR|O_CREAT, 0666) or &print_error("(tie AnyDBM_File) $PathTo{WikiDataBase}");
815          tie(%infobase, "AnyDBM_File", $PathTo{WikiInfoBase}, O_RDWR|O_CREAT, 0666) or &print_error("(tie AnyDBM_File) $PathTo{WikiInfoBase}");      } elsif ($modifier_dbtype eq 'Yuki::YukiWikiDB') {
     } else {  
816          eval q{use Yuki::YukiWikiDB};          eval q{use Yuki::YukiWikiDB};
817          tie(%database, "Yuki::YukiWikiDB", $PathTo{WikiDataBase}) or &print_error("(tie Yuki::YukiWikiDB) $PathTo{WikiDataBase}");          tie(%database, "Yuki::YukiWikiDB", $PathTo{WikiDataBase}) or &print_error("(tie Yuki::YukiWikiDB) $PathTo{WikiDataBase}");
818          tie(%infobase, "Yuki::YukiWikiDB", $PathTo{WikiInfoBase}) or &print_error("(tie Yuki::YukiWikiDB) $PathTo{WikiInfoBase}");      } else {    ## Yuki::YukiWikiDB || Yuki::YukiWikiDBMeta
819            eval qq{use $modifier_dbtype};
820            $database = tie(%database, $modifier_dbtype => $PathTo{WikiDataBase}, -lock => 2, -backup => $wiki::diff::UseDiff) or &print_error("(tie $modifier_dbtype) $PathTo{WikiDataBase}");
821      }      }
822  }  }
823    
824  sub close_db {  sub close_db {
825      if ($modifier_dbtype eq 'dbmopen') {      if ($modifier_dbtype eq 'dbmopen') {
826          dbmclose(%database);          dbmclose(%database);
         dbmclose(%infobase);  
     } elsif ($modifier_dbtype eq 'AnyDBM_File') {  
         untie(%database);  
         untie(%infobase);  
827      } else {      } else {
828          untie(%database);          untie(%database);
         untie(%infobase);  
     }  
 }  
   
 sub open_diff {  
     if ($modifier_dbtype eq 'dbmopen') {  
         dbmopen(%diffbase, $PathTo{WikiDiffBase}, 0666) or &print_error("(dbmopen) $PathTo{WikiDiffBase}");  
     } elsif ($modifier_dbtype eq 'AnyDBM_File') {  
         tie(%diffbase, "AnyDBM_File", $PathTo{WikiDiffBase}, O_RDWR|O_CREAT, 0666) or &print_error("(tie AnyDBM_File) $PathTo{WikiDiffBase}");  
     } else {  
         tie(%diffbase, "Yuki::YukiWikiDB", $PathTo{WikiDiffBase}) or &print_error("(tie Yuki::YukiWikiDB) $PathTo{WikiDiffBase}");  
     }  
 }  
   
 sub close_diff {  
     if ($modifier_dbtype eq 'dbmopen') {  
         dbmclose(%diffbase);  
     } elsif ($modifier_dbtype eq 'AnyDBM_File') {  
         untie(%diffbase);  
     } else {  
         untie(%diffbase);  
829      }      }
830  }  }
831    
# Line 952  sub print_editform { Line 853  sub print_editform {
853      $magic = $1 if $mymsg =~ m/^([^\x0A\x0D]+)/s;      $magic = $1 if $mymsg =~ m/^([^\x0A\x0D]+)/s;
854    
855      my $edit = $mode{admin} ? 'adminedit' : 'edit';      my $edit = $mode{admin} ? 'adminedit' : 'edit';
     my $escapedmypage = &escape($form{mypage});  
     my $escapedmypassword = &escape($form{mypassword});  
856      my $selected = 'read';      my $selected = 'read';
857      if ($form{after_edit_cmd}) {      if ($form{after_edit_cmd}) {
858          $selected = $form{after_edit_cmd};          $selected = $form{after_edit_cmd};
# Line 971  EOH Line 870  EOH
870  <form action="$url_cgi" method="post">  <form action="$url_cgi" method="post">
871  <h2>@{[&Resource('Edit:Title',escape=>1)]}</h2>  <h2>@{[&Resource('Edit:Title',escape=>1)]}</h2>
872      @{[ $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>) ]}
873      @{[ $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;
874                 $mymsg =~ s/(?:-+\s)?\[([0-9]+)\]/$n = $1 if $1 > $n; $&/mge;                 $mymsg =~ s/(?:-+\s)?\[([0-9]+)\]/$n = $1 if $1 > $n; $&/mge;
875                 ++$n}]}]<br>                 ++$n}]}]<br>
876      <input type="hidden" name="myLastModified" value="$lastmodified">      <input type="hidden" name="myLastModified" value="$lastmodified">
877      <input type="hidden" name="mypage" value="$escapedmypage">      <input type="hidden" name="mypage" value="@{[&escape($form{mypage})]}">
878      <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>
879  @{[  @{[
880      $mode{admin} ?      $mode{admin} ?
# Line 987  EOH Line 886  EOH
886  @{[  @{[
887      $mode{conflict} ? "" :      $mode{conflict} ? "" :
888      qq(      qq(
889          <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>
890          <input type="submit" name="mypreview_$edit" value="@{[&Resource('Edit:Preview',escape=>1)]}">          <input type="submit" name="mypreview_$edit" value="@{[&Resource('Edit:Preview',escape=>1)]}">
891          <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>
892         $afteredit         $afteredit
        <br>  
893      )      )
894  ]}  ]}
895  </form>  </form>
# Line 1004  EOD Line 902  EOD
902      }      }
903  }  }
904    
 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  
 }  
   
905  sub is_editable {  sub is_editable {
906      my ($page) = @_;      my ($page) = @_;
907      if ($fixedpage{$page} || $page =~ /\s/ || $page =~ /^\#/) {      if ($FixedPage{$page} || $page =~ /\s/ || $page =~ /^\#/) {
908          return 0;          return 0;
909      } else {      } else {
910          return 1;          return 1;
# Line 1064  sub encode { Line 950  sub encode {
950    
951  sub conflict {  sub conflict {
952      my ($page, $rawmsg) = @_;      my ($page, $rawmsg) = @_;
953      if ($form{myLastModified} eq &get_info($page, $info_LastModified)) {      if ($form{myLastModified} eq $database->mtime ($page)) {
954          return 0;          return 0;
955      }      }
956      &print_header($page, -noindex => 1);      &print_header($page, -noindex => 1);
# Line 1096  sub init_InterWikiName { Line 982  sub init_InterWikiName {
982    $interwiki{'[[]]'} = 1;       ## dummy    $interwiki{'[[]]'} = 1;       ## dummy
983  }  }
984    
   
 sub get_info {  
     my ($page, $key) = @_;  
     my %info = map { split(/=/, $_, 2) } split(/\n/, $infobase{$page});  
     return $info{$key};  
 }  
   
 sub set_info {  
     my ($page, $key, $value) = @_;  
     my %info = map { split(/=/, $_, 2) } split(/\n/, $infobase{$page});  
     $info{$key} = $value;  
     my $s = '';  
     for (keys %info) {  
         $s .= "$_=$info{$_}\n";  
     }  
     $infobase{$page} = $s;  
 }  
   
985  sub frozen_reject {  sub frozen_reject {
986      my ($isfrozen) = &get_info($form{mypage}, $info_IsFrozen);      my ($isfrozen) = $database->meta (IsFrozen => $form{mypage});
987      my ($willbefrozen) = $form{myfrozen};      my ($willbefrozen) = $form{myfrozen};
988      if (not $isfrozen and not $willbefrozen) {      if (not $isfrozen and not $willbefrozen) {
989          # You need no check.          # You need no check.
# Line 1129  sub frozen_reject { Line 997  sub frozen_reject {
997      }      }
998  }  }
999    
1000  sub valid_password {  sub is_frozen ($) { $database->meta (IsFrozen => $_[0]) ? 1 : 0 }
     my ($givenpassword) = @_;  
     my ($validpassword_crypt) = &get_info($PageName{AdminSpecialPage}, 'AdminPassword');  
     if (crypt($givenpassword, $validpassword_crypt) eq $validpassword_crypt) {  
         return 1;  
     } else {  
         return 0;  
     }  
 }  
   
 sub is_frozen {  
     my ($page) = @_;  
     if (&get_info($page, $info_IsFrozen)) {  
         return 1;  
     } else {  
         return 0;  
     }  
 }  
1001    
1002  sub do_comment {  sub do_comment {
1003      my ($content) = $database{$form{mypage}};      my ($content) = $database{$form{mypage}};
# Line 1201  sub embedded_to_html { Line 1052  sub embedded_to_html {
1052      my ($embedded) = @_;      my ($embedded) = @_;
1053      if ($embedded eq '[[#comment]]' or $embedded eq '[[#rcomment]]') {      if ($embedded eq '[[#comment]]' or $embedded eq '[[#rcomment]]') {
1054        unless ($main::_EMBEDED) {        unless ($main::_EMBEDED) {
1055          my $lastmodified = &get_info($form{mypage}, $info_LastModified);          my $lastmodified = $database->mtime ($form{mypage});
1056          return <<"EOD";          return <<"EOD";
1057  <form action="$url_cgi" method="post" id="x-comment-@{[++$CommentIndex]}" class="comment"><p>  <form action="$url_cgi" method="post" id="x-comment-@{[++$CommentIndex]}" class="comment"><p>
1058      <input type="hidden" name="mycmd" value="comment">      <input type="hidden" name="mycmd" value="comment">
# Line 1329  sub code_convert { Line 1180  sub code_convert {
1180      $code = 'euc' if $code =~ /euc/;      $code = 'euc' if $code =~ /euc/;
1181      $code = 'sjis' if $code =~ /shift/;      $code = 'sjis' if $code =~ /shift/;
1182      $code = 'utf8' if $code =~ /utf/;      $code = 'utf8' if $code =~ /utf/;
     #&Jcode::convert($contentref, $code);       # for Jcode.pm  
 #    &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';  
1183      $$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;      $$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;
1184      return $$contentref;      return $$contentref;
1185  }  }
1186    
1187  sub do_diff {  sub do_diff {
     if (not &is_editable($form{mypage})) {  
         &do_read;  
         return;  
     }  
     &open_diff;  
1188      my $title = $form{mypage};      my $title = $form{mypage};
1189      &print_header($title, -noindex => 1);      &print_header($title, -noindex => 1);
1190      $_ = &escape($diffbase{$form{mypage}});      print qq(<h2>@{[&Resource('Diff:Title',escape=>1)]}</h2>);
     &close_diff;  
     print qq(<h3>@{[&Resource('Diff:Title',escape=>1)]}</h3>);  
1191      print qq(<p>@{[&Resource('Diff:Notice',escape=>1)]}</p>);      print qq(<p>@{[&Resource('Diff:Notice',escape=>1)]}</p>);
1192      print qq(<pre class="diff">);      print qq(<pre class="diff">);
1193      foreach (split(/\n/, $_)) {      for (split(/\n/, &escape ($database->traverse_diff ($form{mypage})))) {
1194          if (/^\+(.*)/) {          if (/^\+(.*)/) {
1195              print qq(<ins class="added">$1</ins>\n);              print qq(<ins class="added">$1</ins>\n);
1196          } elsif (/^\-(.*)/) {          } elsif (/^\-(.*)/) {
# Line 1393  sub do_rss { Line 1234  sub do_rss {
1234              title       => &escape($title),              title       => &escape($title),
1235              link        => $myuri . '?' . &encode($title),              link        => $myuri . '?' . &encode($title),
1236              description => &escape(&get_subjectline($title,delimiter=>'')),              description => &escape(&get_subjectline($title,delimiter=>'')),
1237              'dc:date'   => &get_info ($title, $info_LastModified),              'dc:date'   => $database->mtime ($title),
1238            );            );
1239            $count++;            $count++;
1240          }          }
# Line 1421  sub is_exist_page { Line 1262  sub is_exist_page {
1262  }  }
1263    
1264  sub __get_database ($) { $database{ $_[0] } }  sub __get_database ($) { $database{ $_[0] } }
 sub __set_database ($$) { $database{ $_[0] } = $_[1] }  
1265    
1266  sub do_map {  sub do_map {
1267      my $page = $form{mypage};      my $page = $form{mypage};
# Line 1475  sub add ($$) { Line 1315  sub add ($$) {
1315    $list{ $uri }++;    $list{ $uri }++;
1316    set ($page, \%list);    set ($page, \%list);
1317  }  }
1318  sub get ($) {  sub get ($) { split /"/, $main::database->meta (Referer => $_[0]) }
   my $page = shift;  
   split /"/, main::get_info ($page, 'Referer');  
 }  
1319  sub set ($%) {  sub set ($%) {
1320    my $page = shift;    my $page = shift;
1321    my $list = shift;    my $list = shift;
1322    main::set_info ($page, Referer => join '"', %$list);    $main::database->meta (Referer => $page => join '"', %$list);
1323  }  }
1324    
1325  sub get_dont_record () {  sub get_dont_record () {
# Line 1536  sub __decode ($) { Line 1373  sub __decode ($) {
1373  }  }
1374    
1375  package wiki::useragent;  package wiki::useragent;
1376    our $UseLog;
1377    
1378  sub add ($) {  sub add ($) {
1379    my $s = shift;    my $s = shift;
1380    return unless length $s;    return unless length $s;
1381      return unless $UseLog;
1382    $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;
1383    my %ua;    my %ua;
1384    for (split /\n/, &main::__get_database('WikiUserAgentList')) {    for (split /\n/, &main::__get_database($main::PageName{UserAgentList})) {
1385      if (/^-\[(\d+)\] (.+)$/) {      if (/^-\[(\d+)\] (.+)$/) {
1386        my ($t, $n) = ($1, $2);        my ($t, $n) = ($1, $2);
1387        $n =~ tr/\x0A\x0D//d;        $n =~ tr/\x0A\x0D//d;
# Line 1554  sub add ($) { Line 1393  sub add ($) {
1393    for (sort {$ua{$a} <=> $ua{$b}} keys %ua) {    for (sort {$ua{$a} <=> $ua{$b}} keys %ua) {
1394      $s .= sprintf qq(-[%d] %s\n), $ua{$_}, $_;      $s .= sprintf qq(-[%d] %s\n), $ua{$_}, $_;
1395    }    }
1396    &main::__set_database ('WikiUserAgentList' => $s);    $main::database->STORE ($main::PageName{UserAgentList} => $s, -touch => 0);
1397  }  }
1398    
1399  package wiki::suikawikiconst;  package wiki::suikawikiconst;
# Line 1574  sub to_hash ($;$) { Line 1413  sub to_hash ($;$) {
1413    $h;    $h;
1414  }  }
1415    
1416    package wiki::dummy;
1417    sub mtime (@) {undef}
1418    sub meta (@) {undef}
1419    sub Yuki::YukiWikiDB2::meta (@) {undef}
1420    
1421  package SuikaWiki::Plugin;  package SuikaWiki::Plugin;
1422    our $plugin_directory;  # defined in top of this file.    our $plugin_directory;  # defined in top of this file.
1423    our %List;    our %List;
# Line 1701  exit 0; Line 1545  exit 0;
1545  __END__  __END__
1546  =head1 NAME  =head1 NAME
1547    
1548  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.  
1549    
1550  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).  
1551    
1552  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/>
1553    
1554  =head1 AUTHOR  Makio Tsukamoto <http://digit.que.ne.jp/>
1555    
1556  Hiroshi Yuki <hyuki@hyuki.com> http://www.hyuki.com/yukiwiki/  Wakaba <w@suika.fam.cx>
1557    
1558  =head1 LICENSE  =head1 LICENSE
1559    
1560  Copyright (C) 2000-2002 by Hiroshi Yuki.  Copyright (C) 2000-2003 AUTHORS
1561    
1562  This program is free software; you can redistribute it and/or  This program is free software; you can redistribute it and/or
1563  modify it under the same terms as Perl itself.  modify it under the same terms as Perl itself.
Legend:
Removed from v.1.43  
changed lines
  Added in v.1.47
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24