/[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.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    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  ##############################  ##############################
24  my $info_LastModified = 'LastModified';  my $info_LastModified = 'LastModified';
25  my $info_IsFrozen = 'IsFrozen';  my $info_IsFrozen = 'IsFrozen';
26  ##############################  ##############################
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 = (
     $PageName{IndexPage} => 'index',  
34      $PageName{RssPage} => 'rss',      $PageName{RssPage} => 'rss',
     AdminChangePassword => 'adminchangepasswordform',  
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,
44      comment => \&do_comment,      comment => \&do_comment,
45      RandomJump  => \&do_random_jump,      RandomJump  => \&do_random_jump,
# Line 93  sub do_read { Line 89  sub do_read {
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}, -expires => time + 120, -last_modified => $lm);        &print_header($form{mypage}, -expires => time + 120, -last_modified => $lm);
95        print "<pre>@{[&escape($content)]}</pre>";        print "<pre>@{[&escape($content)]}</pre>";
# Line 141  sub id_and_name ($) { Line 137  sub id_and_name ($) {
137  sub do_edit {  sub do_edit {
138      my ($page) = &unarmor_name(&armor_name($form{mypage}));      my ($page) = &unarmor_name(&armor_name($form{mypage}));
139      if (not &is_editable($page)) {      if (not &is_editable($page)) {
140          &print_header($page, -noindex => 1);          &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);          &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);          &print_header($page, -noindex => 1, -expires => time+60);
# Line 166  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 176  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'));
# Line 189  sub do_adminchangepassword { Line 179  sub do_adminchangepassword {
179      my ($validpassword_crypt) = &get_info($PageName{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 209  sub do_adminchangepassword { Line 194  sub do_adminchangepassword {
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($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});  
200  }  }
201    
202  sub do_write {  sub do_write {
# Line 248  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 277  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});
# Line 415  sub print_navigate_links (@) { Line 368  sub print_navigate_links (@) {
368      <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> |
369      <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> |
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 430  sub make_navigate_links ($) { Line 383  sub make_navigate_links ($) {
383      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')};
384      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')};
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?$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'};
388      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')};
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')};
# Line 439  sub make_navigate_links ($) { Line 392  sub make_navigate_links ($) {
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 656  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 667  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 751  sub make_custom_form ($$$$) { Line 703  sub make_custom_form ($$$$) {
703              $param->{output}->{form} = 1 unless defined $param->{output}->{form};              $param->{output}->{form} = 1 unless defined $param->{output}->{form};
704              $definition .= ' %submit;' if $definition !~ /%submit/ && !$param->{output}->{nosubmit} && $param->{output}->{form};              $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 = '';              my $r = '';
709              $r = <<EOH if $param->{output}->{form};              $r = <<EOH if $param->{output}->{form};
# Line 836  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 ($PathTo{TouchFile}) {  
         open(FILE, "> ".$PathTo{TouchFile});  
         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 888  sub open_db { Line 816  sub open_db {
816          eval q{use AnyDBM_File};          eval q{use AnyDBM_File};
817          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}");
818          tie(%infobase, "AnyDBM_File", $PathTo{WikiInfoBase}, O_RDWR|O_CREAT, 0666) or &print_error("(tie AnyDBM_File) $PathTo{WikiInfoBase}");          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", $PathTo{WikiDataBase}) or &print_error("(tie Yuki::YukiWikiDB) $PathTo{WikiDataBase}");          tie(%database, "Yuki::YukiWikiDB", $PathTo{WikiDataBase}) or &print_error("(tie Yuki::YukiWikiDB) $PathTo{WikiDataBase}");
822          tie(%infobase, "Yuki::YukiWikiDB", $PathTo{WikiInfoBase}) or &print_error("(tie Yuki::YukiWikiDB) $PathTo{WikiInfoBase}");          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 899  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, $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);  
     }  
 }  
   
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 952  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 971  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 987  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 1004  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 1129  sub frozen_reject { Line 1023  sub frozen_reject {
1023      }      }
1024  }  }
1025    
 sub valid_password {  
     my ($givenpassword) = @_;  
     my ($validpassword_crypt) = &get_info($PageName{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 1329  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/;
     #&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';  
1216      $$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;
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 1536  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 1554  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 1701  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.43  
changed lines
  Added in v.1.46
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24