/[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.44 by w, Wed Jan 1 12:30:24 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',  
36      AdminChangePassword => 'adminchangepasswordform',      AdminChangePassword => 'adminchangepasswordform',
     WikiPluginInfo       => 'x_WikiPluginInfo',  
37  );  );
38  my %command_do = (  my %command_do = (
39      read => \&do_read,      read => \&do_read,
# Line 90  my %command_do = ( Line 45  my %command_do = (
45      write => \&do_write,      write => \&do_write,
46      index => \&do_index,      index => \&do_index,
47      searchform => \&do_searchform,      searchform => \&do_searchform,
     search => \&do_search,  
     create => \&do_create,  
     createresult => \&do_createresult,  
48      comment => \&do_comment,      comment => \&do_comment,
49      RandomJump  => \&do_random_jump,      RandomJump  => \&do_random_jump,
50      rss => \&do_rss,      rss => \&do_rss,
51      diff => \&do_diff,      diff => \&do_diff,
52      wikiform    => \&do_wikiform,      wikiform    => \&do_wikiform,
     x_WikiPluginInfo    => \&do_wikiplugininfo,  
53      map => \&do_map,      map => \&do_map,
54  );  );
55  my $UA = '';  ## User agent name  my $UA = '';  ## User agent name
# Line 112  sub main { Line 63  sub main {
63      if ($command_do{$form{mycmd}}) {      if ($command_do{$form{mycmd}}) {
64          &{$command_do{$form{mycmd}}};          &{$command_do{$form{mycmd}}};
65      } else {      } else {
66          &{$command_do{$form{read}}};          &{$command_do{read}};
67      }      }
68      &close_db;      &close_db;
69  }  }
# Line 137  sub do_read { Line 88  sub do_read {
88      $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;
89      if ($cf =~ m!^(?:\#\?)?SuikaWiki/0.9(?:$|\s)!) {      if ($cf =~ m!^(?:\#\?)?SuikaWiki/0.9(?:$|\s)!) {
90      #print gmtime."Header...\n";      #print gmtime."Header...\n";
91        &print_header ($form{mypage}, -last_modified => $lm,        &print_header ($form{mypage}, -last_modified => $lm, -expires => time + 120,
92          -content_format => $cf, -noindex => $cf =~ /obsoleted="yes"/);          -content_format => $cf, -noindex => ($cf =~ /obsoleted="yes"/ ? 1 : 0));
93          #print "\n". gmtime."Body...\n";          #print "\n". gmtime."Body...\n";
94        &print_content ($content, content_format => $cf, last_modified => $lm,        &print_content ($content, content_format => $cf, last_modified => $lm,
95          -toc => \@toc);          -toc => \@toc);
96        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}};
97      } else {      } else {
98        &print_header($form{mypage}, -last_modified => $lm);        &print_header($form{mypage}, -expires => time + 120, -last_modified => $lm);
99        print "<pre>@{[&escape($content)]}</pre>";        print "<pre>@{[&escape($content)]}</pre>";
100      }      }
101      if ($c) {      if ($c) {
# Line 167  sub do_output_css { Line 118  sub do_output_css {
118      my $lm = gmtime &get_info($form{mypage}, $info_LastModified);      my $lm = gmtime &get_info($form{mypage}, $info_LastModified);
119      print "Content-Type: text/css; charset=@{[&get_charset_name($kanjicode)]}\n";      print "Content-Type: text/css; charset=@{[&get_charset_name($kanjicode)]}\n";
120      print "Last-Modified: $lm\n";      print "Last-Modified: $lm\n";
121        print "Expires: @{[scalar gmtime time+3600]}\n";    ## TODO: don't use asctime
122      print "\n";      print "\n";
123      print $content;      print $content;
124    } else {    } else {
# Line 188  sub id_and_name ($) { Line 140  sub id_and_name ($) {
140    
141  sub do_edit {  sub do_edit {
142      my ($page) = &unarmor_name(&armor_name($form{mypage}));      my ($page) = &unarmor_name(&armor_name($form{mypage}));
     &print_header($page, -noindex => 1);  
143      if (not &is_editable($page)) {      if (not &is_editable($page)) {
144            &print_header($page, -noindex => 1);
145          &print_message(&Resource('Error:ThisPageIsUneditable'));          &print_message(&Resource('Error:ThisPageIsUneditable'));
146      } elsif (&is_frozen($page)) {      } elsif (&is_frozen($page)) {
147            &print_header($page, -noindex => 1);
148          &print_message(&Resource('Error:ThisPageIsUneditable'));          &print_message(&Resource('Error:ThisPageIsUneditable'));
149      } else {      } else {
150            &print_header($page, -noindex => 1, -expires => time+60);
151          &print_editform($database{$page}, &get_info($page, $info_LastModified), admin=>0);          &print_editform($database{$page}, &get_info($page, $info_LastModified), admin=>0);
152      }      }
153      wiki::referer::add ($form{mypage}, $ENV{HTTP_REFERER});      wiki::referer::add ($form{mypage}, $ENV{HTTP_REFERER});
# Line 232  sub do_adminchangepassword { Line 186  sub do_adminchangepassword {
186      if ($form{mynewpassword} ne $form{mynewpassword2}) {      if ($form{mynewpassword} ne $form{mynewpassword2}) {
187          &print_error(&Resource('Error:PasswordMismatch'));          &print_error(&Resource('Error:PasswordMismatch'));
188      }      }
189      my ($validpassword_crypt) = &get_info($AdminSpecialPage, 'AdminPassword');      my ($validpassword_crypt) = &get_info($PageName{AdminSpecialPage}, 'AdminPassword');
190      if ($validpassword_crypt) {      if ($validpassword_crypt) {
191          if (not &valid_password($form{myoldpassword})) {          if (not &valid_password($form{myoldpassword})) {
192  #            &send_mail_to_admin(<<"EOD", "AdminChangePassword");  #            &send_mail_to_admin(<<"EOD", "AdminChangePassword");
# Line 248  sub do_adminchangepassword { Line 202  sub do_adminchangepassword {
202      my $salt1 = $token[(time | $$) % scalar(@token)];      my $salt1 = $token[(time | $$) % scalar(@token)];
203      my $salt2 = $token[($sec + $min*60 + $hour*60*60) % scalar(@token)];      my $salt2 = $token[($sec + $min*60 + $hour*60*60) % scalar(@token)];
204      my $crypted = crypt($form{mynewpassword}, "$salt1$salt2");      my $crypted = crypt($form{mynewpassword}, "$salt1$salt2");
205      &set_info($AdminSpecialPage, 'AdminPassword', $crypted);      &set_info($PageName{AdminSpecialPage}, 'AdminPassword', $crypted);
206    
207      &print_header('CompletedSuccessfully', -noindex => 1);      &print_header('CompletedSuccessfully', -noindex => 1);
208      &print_message(&Resource('Error:PasswordIsChanged'));      &print_message(&Resource('Error:PasswordIsChanged'));
# Line 258  sub do_adminchangepassword { Line 212  sub do_adminchangepassword {
212  sub do_index {  sub do_index {
213    wiki::referer::add ($form{mypage}, $ENV{HTTP_REFERER});    wiki::referer::add ($form{mypage}, $ENV{HTTP_REFERER});
214    wiki::useragent::add ($ENV{HTTP_USER_AGENT});    wiki::useragent::add ($ENV{HTTP_USER_AGENT});
215      &print_header($IndexPage);      &print_header($PageName{IndexPage});
216      print qq(<ul>);      print qq(<ul>);
217      foreach my $page (sort keys %database) {      foreach my $page (sort keys %database) {
218          if (&is_editable($page)) {          if (&is_editable($page)) {
# Line 275  sub do_index { Line 229  sub do_index {
229      if ($rl) {      if ($rl) {
230          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);
231      }      }
232      &print_footer($IndexPage);      &print_footer($PageName{IndexPage});
233  }  }
234    
235  sub do_write {  sub do_write {
# Line 335  sub do_write { Line 289  sub do_write {
289      }      }
290  }  }
291    
 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);  
 }  
   
292  sub get_search_result ($;%) {  sub get_search_result ($;%) {
293    my $word = lc shift;    my $word = lc shift;
294    my %option = @_;    my %option = @_;
# Line 372  sub get_search_result ($;%) { Line 312  sub get_search_result ($;%) {
312    wantarray? ($r, scalar @r): $r;    wantarray? ($r, scalar @r): $r;
313  }  }
314    
 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);  
 }  
   
315  sub do_random_jump {  sub do_random_jump {
316    my @list = keys %database;    my @list = keys %database;
317    my $name = &encode ($list[rand @list]);    my $name = &encode ($list[rand @list]);
# Line 396  sub do_random_jump { Line 323  sub do_random_jump {
323    
324  sub print_error {  sub print_error {
325      my ($msg) = @_;      my ($msg) = @_;
326      &print_header($ErrorPage, -noindex => 1);      &print_header($PageName{ErrorPage}, -noindex => 1);
327      print qq(<p><strong class="error">$msg</strong></p>);      print qq(<p><strong class="error">$msg</strong></p>);
328      &print_footer($ErrorPage);      &print_footer($PageName{ErrorPage});
329      exit(0);      exit(0);
330  }  }
331    
# Line 421  sub print_header ($;%) { Line 348  sub print_header ($;%) {
348        }        }
349      }      }
350      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};
351        if ($option{-expires}) {
352          print qq{Expires: @{[scalar gmtime $option{-expires}]}\n};
353        }
354      if ($UA =~ m#Mozilla/2#) {      if ($UA =~ m#Mozilla/2#) {
355          my $ct = qq{text/html; charset=@{[&get_charset_name($kanjicode,compatible=>1)]}};          my $ct = qq{text/html; charset=@{[&get_charset_name($kanjicode,compatible=>1)]}};
356          print qq{Content-Type: $ct\n};          print qq{Content-Type: $ct\n};
# Line 431  sub print_header ($;%) { Line 361  sub print_header ($;%) {
361          print qq{Content-Type: text/html; charset=@{[&get_charset_name($kanjicode)]}\n};          print qq{Content-Type: text/html; charset=@{[&get_charset_name($kanjicode)]}\n};
362      }      }
363      push @head, qq(<title>@{[&escape($page)]}</title>);      push @head, qq(<title>@{[&escape($page)]}</title>);
364      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)#) {
365        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))]}");
366        }
367      push @head, q(<meta name="ROBOTS" content="NOINDEX">) if $option{-noindex};      push @head, q(<meta name="ROBOTS" content="NOINDEX">) if $option{-noindex};
368      my ($Links, $links) = &make_navigate_links ($page);      my ($Links, $links) = &make_navigate_links ($page);
369      #print $Links;      ## Link: fields      #print $Links;      ## Link: fields
# Line 479  sub print_navigate_links (@) { Line 410  sub print_navigate_links (@) {
410      ]}      ]}
411      <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> |
412      <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> |
413      <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> |
414      <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> |
415      <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> |
416      <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> |
417      <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> |
418      <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>
419  </div>  </div>
# Line 496  sub make_navigate_links ($) { Line 427  sub make_navigate_links ($) {
427      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);
428      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')};
429      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')};
430      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')};
431      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')};
432      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')};
433      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')};
434      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'};
435      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')};
436      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')};
437      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')};
438      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 690  sub make_wikilink ($%) {
690        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>);
691      }      }
692    } else {    } else {
693      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>);
694    }    }
695  }  }
696    
# Line 817  sub make_custom_form ($$$$) { Line 748  sub make_custom_form ($$$$) {
748              $option = &unescape ($option);              $option = &unescape ($option);
749              $option =~ s/\\(.)/$1/g;              $option =~ s/\\(.)/$1/g;
750              $fmt{form_option}->replace ($option, $param);              $fmt{form_option}->replace ($option, $param);
751              $definition .= ' %submit;' if $definition !~ /%submit/ && !$param->{output}->{nosubmit};              $param->{output}->{form} = 1 unless defined $param->{output}->{form};
752                $definition .= ' %submit;' if $definition !~ /%submit/ && !$param->{output}->{nosubmit} && $param->{output}->{form};
753              my $target_page = $param->{output}->{page} || $form{mypage};              my $target_page = $param->{output}->{page} || $form{mypage};
754              $param->{form_disabled} = 1 if $fixedpage{$target_page};              $param->{form_disabled} = 1 if $fixedpage{$target_page};
755              my $target_form = $param->{output}->{id};              my $target_form = $param->{output}->{id};
756              my $r = <<EOH;              my $r = '';
757                $r = <<EOH if $param->{output}->{form};
758  <form method="post" action="$url_cgi" id="wikiform-$FormIndex" class="wikiform">  <form method="post" action="$url_cgi" id="wikiform-$FormIndex" class="wikiform">
759    <input type="hidden" name="mycmd" value="@{[$param->{form_disabled}?'read':'wikiform']}">    <input type="hidden" name="mycmd" value="@{[$param->{form_disabled}?'read':'wikiform']}">
760    <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 764  sub make_custom_form ($$$$) {
764  EOH  EOH
765              $r .= qq(<a name="wikiform-$FormIndex"></a>) if $UA =~ m#Mozilla/[12]\.#;              $r .= qq(<a name="wikiform-$FormIndex"></a>) if $UA =~ m#Mozilla/[12]\.#;
766              $r .= $fmt{form_input}->replace ($definition, $param);              $r .= $fmt{form_input}->replace ($definition, $param);
767              $r .= <<EOH;              $r .= "</form>\n" if $param->{output}->{form};
 </form>  
 EOH  
768              $r;              $r;
769         } else {  ## No input-interface WikiForm         } else {  ## No input-interface WikiForm
770             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 786  sub init_form {
786        read STDIN, $query, $main::ENV{CONTENT_LENGTH};        read STDIN, $query, $main::ENV{CONTENT_LENGTH};
787      }      }
788      $query .= ($query ? ';' : '') . $main::ENV{QUERY_STRING};      $query .= ($query ? ';' : '') . $main::ENV{QUERY_STRING};
789      if ($main::ENV{QUERY_STRING} && $main::ENV{QUERY_STRING} !~ /[&;=]/) {      if ($main::ENV{REQUEST_METHOD} ne 'POST' && $main::ENV{QUERY_STRING} && $main::ENV{QUERY_STRING} !~ /[&;=]/) {
790        my $query = &decode($main::ENV{QUERY_STRING});        my $query = &decode($main::ENV{QUERY_STRING});
791        $query = &code_convert(\$query, $kanjicode);        $query = &code_convert(\$query, $kanjicode);
792        if ($page_command{$query}) {        if ($page_command{$query}) {
# Line 872  sub init_form { Line 803  sub init_form {
803            $form{$n} = $v;            $form{$n} = $v;
804          }          }
805        }        }
806          unless (defined $form{mypage}) {
807            $form{mypage} = $form{epage};
808            $form{mypage} =~ s/([0-9A-F]{2})/ord hex $1/g;
809          }
810        if ($page_command{$form{mypage}} && $form{mycmd} eq 'read') {        if ($page_command{$form{mypage}} && $form{mycmd} eq 'read') {
811          $form{mypage} = &code_convert(\$form{mypage}, $kanjicode);          $form{mypage} = &code_convert(\$form{mypage}, $kanjicode);
812          $form{mycmd} = $page_command{$form{mypage}};          $form{mycmd} = $page_command{$form{mypage}};
# Line 918  sub update_recent_changes { Line 853  sub update_recent_changes {
853      }      }
854      splice @updates, (&Resource ('RecentChanges:Max') || 50) + 1;      splice @updates, (&Resource ('RecentChanges:Max') || 50) + 1;
855      $database{RecentChanges} = "#?SuikaWiki/0.9\n" . join("\n", @updates);      $database{RecentChanges} = "#?SuikaWiki/0.9\n" . join("\n", @updates);
856      if ($file_touch) {      if ($PathTo{TouchFile}) {
857          open(FILE, "> $file_touch");          open(FILE, "> ".$PathTo{TouchFile});
858          print FILE localtime() . "\n";          print FILE localtime() . "\n";
859          close(FILE);          close(FILE);
860      }      }
# Line 947  sub get_subjectline { Line 882  sub get_subjectline {
882    
883  sub open_db {  sub open_db {
884      if ($modifier_dbtype eq 'dbmopen') {      if ($modifier_dbtype eq 'dbmopen') {
885          dbmopen(%database, $dataname, 0666) or &print_error("(dbmopen) $dataname");          dbmopen(%database, $PathTo{WikiDataBase}, 0666) or &print_error("(dbmopen) $PathTo{WikiDataBase}");
886          dbmopen(%infobase, $infoname, 0666) or &print_error("(dbmopen) $infoname");          dbmopen(%infobase, $PathTo{WikiInfoBase}, 0666) or &print_error("(dbmopen) $PathTo{WikiInfoBase}");
887      } elsif ($modifier_dbtype eq 'AnyDBM_File') {      } elsif ($modifier_dbtype eq 'AnyDBM_File') {
888          eval q{use AnyDBM_File};          eval q{use AnyDBM_File};
889          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}");
890          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}");
891      } else {      } else {
892          eval q{use Yuki::YukiWikiDB};          eval q{use Yuki::YukiWikiDB};
893          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}");
894          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}");
895      }      }
896  }  }
897    
# Line 975  sub close_db { Line 910  sub close_db {
910    
911  sub open_diff {  sub open_diff {
912      if ($modifier_dbtype eq 'dbmopen') {      if ($modifier_dbtype eq 'dbmopen') {
913          dbmopen(%diffbase, $diffname, 0666) or &print_error("(dbmopen) $diffname");          dbmopen(%diffbase, $PathTo{WikiDiffBase}, 0666) or &print_error("(dbmopen) $PathTo{WikiDiffBase}");
914      } elsif ($modifier_dbtype eq 'AnyDBM_File') {      } elsif ($modifier_dbtype eq 'AnyDBM_File') {
915          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}");
916      } else {      } else {
917          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}");
918      }      }
919  }  }
920    
# Line 993  sub close_diff { Line 928  sub close_diff {
928      }      }
929  }  }
930    
 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  
 }  
   
931  sub print_editform {  sub print_editform {
932      my ($mymsg, $lastmodified, %mode) = @_;      my ($mymsg, $lastmodified, %mode) = @_;
933      my $frozen = &is_frozen($form{mypage});      my $frozen = &is_frozen($form{mypage});
# Line 1207  sub frozen_reject { Line 1131  sub frozen_reject {
1131    
1132  sub valid_password {  sub valid_password {
1133      my ($givenpassword) = @_;      my ($givenpassword) = @_;
1134      my ($validpassword_crypt) = &get_info($AdminSpecialPage, 'AdminPassword');      my ($validpassword_crypt) = &get_info($PageName{AdminSpecialPage}, 'AdminPassword');
1135      if (crypt($givenpassword, $validpassword_crypt) eq $validpassword_crypt) {      if (crypt($givenpassword, $validpassword_crypt) eq $validpassword_crypt) {
1136          return 1;          return 1;
1137      } else {      } else {
# Line 1408  sub code_convert { Line 1332  sub code_convert {
1332      #&Jcode::convert($contentref, $code);       # for Jcode.pm      #&Jcode::convert($contentref, $code);       # for Jcode.pm
1333  #    &jcode::convert($contentref, $code);       # for jcode.pl  #    &jcode::convert($contentref, $code);       # for jcode.pl
1334      #&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';
1335      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;
1336      return $$contentref;      return $$contentref;
1337  }  }
1338    
# Line 1499  sub is_exist_page { Line 1423  sub is_exist_page {
1423  sub __get_database ($) { $database{ $_[0] } }  sub __get_database ($) { $database{ $_[0] } }
1424  sub __set_database ($$) { $database{ $_[0] } = $_[1] }  sub __set_database ($$) { $database{ $_[0] } = $_[1] }
1425    
 sub do_wikiplugininfo {  
     &print_header (q(WikiPluginInfo));  
     print text_to_html (&SuikaWiki::Plugin::make_info_page);  
     &print_footer (q(WikiPluginInfo));  
 }  
   
1426  sub do_map {  sub do_map {
1427      my $page = $form{mypage};      my $page = $form{mypage};
1428      &print_header ($page);      &print_header ($page);
# Line 1665  sub unescape ($$) { main::unescape ($_[1 Line 1583  sub unescape ($$) { main::unescape ($_[1
1583  sub encode ($$) { main::encode ($_[1]) }  sub encode ($$) { main::encode ($_[1]) }
1584  sub decode ($$) { main::decode ($_[1]) }  sub decode ($$) { main::decode ($_[1]) }
1585  sub __get_datetime ($) { main::get_now () }  sub __get_datetime ($) { main::get_now () }
1586    sub resource ($$;%) { shift; &main::Resource (@_) }
1587    sub uri ($$) { $main::uri{$_[1]} }
1588    
1589  sub regist ($@) {  sub regist ($@) {
1590      my $pack = shift;      my $pack = shift;
# Line 1683  sub import_plugins () { Line 1603  sub import_plugins () {
1603      }      }
1604  }  }
1605    
 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;  
 }  
   
1606  &import_plugins ();  &import_plugins ();
1607    
1608  package wiki::conneg;  package wiki::conneg;
Legend:
Removed from v.1.41  
changed lines
  Added in v.1.44
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24