/[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.49 by w, Sat Jan 4 03:32:55 2003 UTC revision 1.50 by w, Sun Jan 12 09:15:06 2003 UTC
# Line 8  use strict; Line 8  use strict;
8  use lib qw(./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};  our $VERSION = do{my @r=(q$Revision$=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};
11    binmode STDOUT; binmode STDIN;
12  require 'wikidata/suikawiki-config.ph';  require 'wikidata/suikawiki-config.ph';
13  use Fcntl;  use Fcntl;
14  ##############################  ##############################
15  our %fmt;       ## formatter objects  our %fmt;       ## formatter objects
16  my %embed_command = (  our %embed_command = (
17          searched        => '^\[\[#searched:([^\]]+)\]\]$',          searched        => '^\[\[#searched:([^\]]+)\]\]$',
18          form    => qr/\[\[\#form(?:\(([A-Za-z0-9-]+)\))?:'((?:[^'\\]|\\.)*)':'((?:[^'\\]|\\.)*)'(?::'((?:[^'\\]|\\.)*)')?\]\]/,          form    => qr/\[\[\#form(?:\(([A-Za-z0-9-]+)\))?:'((?:[^'\\]|\\.)*)':'((?:[^'\\]|\\.)*)'(?::'((?:[^'\\]|\\.)*)')?\]\]/,
19  );  );
# Line 26  our %database; Line 26  our %database;
26  our $database = bless {}, 'wiki::dummy';  our $database = bless {}, 'wiki::dummy';
27  my %interwiki;  my %interwiki;
28  ##############################  ##############################
 my %page_command = (  
     $PageName{RssPage} => 'rss',  
 );  
29  my %command_do = (  my %command_do = (
30      read => \&do_read,      read => \&do_view,
     TEXT_CSS => \&do_output_css,  
     edit => \&do_view,  
31      adminchangepassword => \&do_adminchangepassword,      adminchangepassword => \&do_adminchangepassword,
32      write => \&do_write,      write => \&do_write,
33      searchform => \&do_searchform,      searchform => \&do_searchform,
34      comment => \&do_comment,      comment => \&do_comment,
35      RandomJump  => \&do_random_jump,      RandomJump  => \&do_random_jump,
     rss => \&do_rss,  
     diff => \&do_view,  
36      wikiform    => \&do_wikiform,      wikiform    => \&do_wikiform,
     map => \&do_view,  
37  );  );
38  my $UA = '';  ## User agent name  my $UA = '';  ## User agent name
39  $| = 1;  $| = 1;
# Line 59  sub main { Line 51  sub main {
51      &close_db;      &close_db;
52  }  }
53    
54  sub do_read {  sub do_view {
55    my $content = $database{$form{mypage}};    my $content = $database{$form{mypage}};
56    my $lm = $database->mtime ($form{mypage});    my $lm = $database->mtime ($form{mypage});
57    wiki::referer::add ($form{mypage}, $ENV{HTTP_REFERER});    wiki::referer::add ($form{mypage}, $ENV{HTTP_REFERER});
58    wiki::useragent::add ($ENV{HTTP_USER_AGENT});    wiki::useragent::add ($ENV{HTTP_USER_AGENT});
59    my @toc;    &load_formatter ('view');
60      my ($magic, $content) = &SuikaWiki::Plugin::magic_and_content (undef, $content);      my $view = $form{mycmd};
61      $magic ||= '#?SuikaWiki/0.9';      if ($view eq 'edit') {
62          $view = 'adminedit' if $form{admin};
63        } elsif ($view =~ /[^0-9A-Za-z]/) {
64          $view = 'view'
65        }
66      my ($magic, $content) = &SuikaWiki::Plugin::magic_and_content (undef, $content);
67      $magic ||= '#?SuikaWiki/0.9';
68      my $o = bless {param => \%form, page => $form{mypage}, toc => [],
69                     magic => $magic, content => $content,
70                     formatter => $fmt{view}, &_compatible_options ()}, 'SuikaWiki::Plugin';
71      if (!ref $ViewDefinition{$view} || !&{$ViewDefinition{$view}->{check}} ($o)) {
72        print "Status: 406 Unsupported Media Type\n";
73        $view = '-UnsupportedMediaType';
74      }
75      my $media = $ViewDefinition{$view}->{media};
76      if ($ViewDefinition{$view}->{xmedia} && $UA =~ /Gecko/) {
77        $media = $ViewDefinition{$view}->{xmedia};
78        $o->{media} = $media;
79      }
80      if ($magic =~ m!^\#\?SuikaWiki/0.9!) {      if ($magic =~ m!^\#\?SuikaWiki/0.9!) {
81        my $expires = time;        &print_header ($form{mypage}, -last_modified => ($magic =~ /interactive="yes"/ ? $lm : time),
82        if ($magic =~ /interactive="yes"/) {          -expires => ($magic =~ /interactive="yes"/ ? 1 : undef), o => $o,
83          $lm = $expires;          -media => $media, -magic => $magic,  content => $content);
       } else {  
         $expires += 120;  
       }  
       &print_header ($form{mypage}, -last_modified => $lm, -expires => $expires,  
         -content_format => $magic, -noindex => ($magic =~ /obsoleted="yes"/ ? 1 : 0));  
84      } else {      } else {
85        &print_header($form{mypage}, -expires => time + 120, -content_format => $magic, -last_modified => $lm);        &print_header($form{mypage}, -media => $media,
86                                       -magic => $magic, -last_modified => $lm, o => $o);
87      }      }
88      &load_formatter ('view');      print $fmt{view}->replace ($ViewDefinition{$view}->{template} => $o);
     print $fmt{view}->replace ($ViewDefinition{read} => bless {param => \%form, page => $form{mypage}, toc => \@toc, formatter => $fmt{view}, &_compatible_options ()}, 'SuikaWiki::Plugin');  
89  }  }
90    
91  sub do_output_css {  sub _do_view_msg (%) {
92    wiki::referer::add ($form{mypage}, $ENV{HTTP_REFERER});    my %option = @_;
93    wiki::useragent::add ($ENV{HTTP_USER_AGENT});    &load_formatter ('view');
94    my $content = $database{$form{mypage}};    my $o = bless {param => \%form, page => $option{-page}, toc => [], condition => \%option,
95    if ($content =~ m#^\s*/\*\s*W3C-CSS#) {                   formatter => $fmt{view}, &_compatible_options ()}, 'SuikaWiki::Plugin';
96      my $lm = gmtime $database->mtime ($form{mypage});    unless (&{$ViewDefinition{$option{-view}}->{check}} ($o)) {
     print "Content-Type: text/css; charset=@{[&get_charset_name($kanjicode)]}\n";  
     print "Last-Modified: $lm\n";  
     print "Expires: @{[scalar gmtime time+3600]}\n";    ## TODO: don't use asctime  
     print "\n";  
     print $content;  
   } else {  
97      print "Status: 406 Unsupported Media Type\n";      print "Status: 406 Unsupported Media Type\n";
98      &print_header('WikiPageIsNotCSS', -noindex => 1);      $option{-view} = '-UnsupportedMediaType';
     &load_formatter ('view');  
     print $fmt{view}->replace ($ViewDefinition{read} => bless {param => \%form, page => 'WikiPageIsNotCSS', toc => [], formatter => $fmt{view}, &_compatible_options ()}, 'SuikaWiki::Plugin');  
99    }    }
100      my $media = $ViewDefinition{$option{-view}}->{media};
101      if ($ViewDefinition{$option{-view}}->{xmedia} && $UA =~ /Gecko/) {
102        $media = $ViewDefinition{$option{-view}}->{xmedia};
103        $o->{media} = $media;
104      }
105      &print_header($option{-page}, -media => $media, o => $o, -goto => $option{-goto});
106      print $fmt{view}->replace ($ViewDefinition{$option{-view}}->{template} => $o);
107  }  }
108    
109  sub id_and_name ($) {  sub id_and_name ($) {
# Line 111  sub id_and_name ($) { Line 115  sub id_and_name ($) {
115      }      }
116  }  }
117    
 sub do_view {  
     wiki::referer::add ($form{mypage}, $ENV{HTTP_REFERER});  
     wiki::useragent::add ($ENV{HTTP_USER_AGENT});  
     &print_header($form{mypage}, -noindex => 1, -expires => time+60);  
     &load_formatter ('view');  
     my $view = $form{mycmd};  
     if ($view eq 'edit') {  
       $view = 'adminedit' if $form{admin};  
     } elsif ($view =~ /[^0-9A-Za-z]/) {  
       $view = 'view'  
     }  
     print $fmt{view}->replace ($ViewDefinition{$view} => bless {param => \%form, page => $form{mypage}, toc => [], formatter => $fmt{view}, &_compatible_options ()}, 'SuikaWiki::Plugin');  
 }  
   
118  sub do_adminchangepassword {  sub do_adminchangepassword {
119      if ($form{mynewpassword} ne $form{mynewpassword2}) {      if ($form{mynewpassword} ne $form{mynewpassword2}) {
120          &print_error(&Resource('Error:PasswordMismatch'));          &_do_view_msg (-view => '-error', -page => $form{mypage},
121                           error_message => &Resource ('Error:PasswordMismatch'));
122            return;
123      }      }
124      my ($validpassword_crypt) = $database->meta (AdminPassword => $PageName{AdminSpecialPage});      my ($validpassword_crypt) = $database->meta (AdminPassword => $PageName{AdminSpecialPage});
125      if ($validpassword_crypt) {      if ($validpassword_crypt) {
126          if (not &valid_password($form{myoldpassword})) {          if (not &valid_password($form{myoldpassword})) {
127              &print_error(&Resource('Error:PasswordIsIncorrect'));              &_do_view_msg (-view => '-error', -page => $form{mypage},
128                               error_message => &Resource ('Error:PasswordIsIncorrect'));
129                return;
130          }          }
131      }      }
132      my ($sec, $min, $hour, $day, $mon, $year, $weekday) = localtime(time);      my ($sec, $min, $hour, $day, $mon, $year, $weekday) = localtime(time);
# Line 141  sub do_adminchangepassword { Line 135  sub do_adminchangepassword {
135      my $salt2 = $token[($sec + $min*60 + $hour*60*60) % scalar(@token)];      my $salt2 = $token[($sec + $min*60 + $hour*60*60) % scalar(@token)];
136      my $crypted = crypt($form{mynewpassword}, "$salt1$salt2");      my $crypted = crypt($form{mynewpassword}, "$salt1$salt2");
137      $database->meta (AdminPassword => $PageName{AdminSpecialPage} => $crypted);      $database->meta (AdminPassword => $PageName{AdminSpecialPage} => $crypted);
138        
139      &print_header('CompletedSuccessfully', -noindex => 1);      &_do_view_msg (-view => '-wrote', -page => $form{mypage});
     &print_message(&Resource('Error:PasswordIsChanged'));  
140  }  }
141    
142  sub valid_password ($) {  sub valid_password ($) {
# Line 157  sub do_write { Line 150  sub do_write {
150      }      }
151    
152      if (not &is_editable($form{mypage})) {      if (not &is_editable($form{mypage})) {
153          &print_header($form{mypage}, -noindex => 1);          &_do_view_msg (-view => '-error', -page => $form{mypage},
154          &print_message(&Resource('Error:ThisPageIsUneditable'));                         error_message => &Resource ('Error:ThisPageIsUneditable'));
155          return;          return;
156      }      }
157    
158      ## Check confliction      ## Check confliction
159      if ($form{myLastModified} ne $database->mtime ($form{mypage})) {      if ($form{myLastModified} ne $database->mtime ($form{mypage})) {
160        &print_header($form{mypage}, -noindex => 1);        &_do_view_msg (-view => '-conflict', -page => $form{mypage});
       &load_formatter ('view');  
       print $fmt{view}->replace ($ViewDefinition{-conflict} => bless {param => \%form, page => $form{mypage}, toc => [], formatter => $fmt{view}, &_compatible_options ()}, 'SuikaWiki::Plugin');  
161        return;        return;
162      }      }
163    
# Line 184  sub do_write { Line 175  sub do_write {
175          } elsif ($form{__wikiform_anchor_index}) {          } elsif ($form{__wikiform_anchor_index}) {
176              $fragment .= qq(#wikiform-$form{__wikiform_anchor_index});              $fragment .= qq(#wikiform-$form{__wikiform_anchor_index});
177          }          }
178          &print_header($form{mypage}, -noindex => 1, -goto => $url_cgi.'?mycmd='.&encode($form{after_edit_cmd}||'read').';mypage='.&encode($form{mypage}).qq(;x-param=@{[time.[0..9]->[rand 10]]}$fragment));          &_do_view_msg (-view => '-wrote', -page => $form{mypage}, -goto => $url_cgi.'?mycmd='.&encode($form{after_edit_cmd}||'read').';mypage='.&encode($form{mypage}).qq(;x-param=@{[time.[0..9]->[rand 10]]}$fragment));
         &load_formatter ('view');  
         print $fmt{view}->replace ($ViewDefinition{-wrote} => bless {param => \%form, page => $form{mypage}, formatter => $fmt{view}, &_compatible_options ()}, 'SuikaWiki::Plugin');  
179      } else {      } else {
180          delete $database{$form{mypage}};          delete $database{$form{mypage}};
181          &print_header($form{mypage}, -noindex => 1);          &_do_view_msg (-view => '-deleted', -page => $form{mypage});
         &load_formatter ('view');  
         print $fmt{view}->replace ($ViewDefinition{-deleted} => bless {param => \%form, page => $form{mypage}, formatter => $fmt{view}, &_compatible_options ()}, 'SuikaWiki::Plugin');  
182      }      }
183  }  }
184    
# Line 225  sub get_search_result ($;%) { Line 212  sub get_search_result ($;%) {
212  sub do_random_jump {  sub do_random_jump {
213    my @list = keys %database;    my @list = keys %database;
214    my $name = &encode ($list[rand @list]);    my $name = &encode ($list[rand @list]);
215    my $scheme = 'http';    print "Location: $uri{wiki}?$name\n";
   $scheme = lc $1 if $main::ENV{SERVER_PROTOCOL} =~ m#([A-Za-z0-9+.%-]+)#;  
   print "Location: $scheme://$main::ENV{SERVER_NAME}:$main::ENV{SERVER_PORT}$url_cgi?$name\n";  
216    print "\n";    print "\n";
217  }  }
218    
 sub print_error {  
     my ($msg) = @_;  
     &print_header($PageName{ErrorPage}, -noindex => 1);  
     print qq(<p><strong class="error">$msg</strong></p>);  
     exit(0);  
 }  
   
219  sub print_header ($;%) {  sub print_header ($;%) {
220      my ($page, %option) = @_;      my ($page, %option) = @_;
221      my @head;      my @head;
222      $option{body_class} = &is_frozen($page) ? 'frozen' : 'normal';      $option{o}->{-header}->{class} = &is_frozen($page) ? 'frozen' : '';
223      $option{body_class} .= " wiki-page-obsoleted" if $option{-content_format} =~ /obsoleted="yes"/;      $option{o}->{-header}->{class} .= " wiki-page-obsoleted" if $option{-magic} =~ /obsoleted="yes"/;
224      if ($option{-goto}) {      if ($option{-goto}) {
225        if ($UA =~ m#Opera|MSIE 2\.#) {        if ($UA =~ m#Opera|MSIE 2\.#) {
226            ## WARNING: This code may output unsafe HTML document if            ## WARNING: This code may output unsafe HTML document if
# Line 250  sub print_header ($;%) { Line 228  sub print_header ($;%) {
228            $option{-goto} =~ tr/;/&/ if $UA =~ m#Opera#;            $option{-goto} =~ tr/;/&/ if $UA =~ m#Opera#;
229            print qq{Refresh: 0; url=$option{-goto}\n};            print qq{Refresh: 0; url=$option{-goto}\n};
230            push @head, qq(<meta http-equiv="refresh" content="0; url=$option{-goto}">);            push @head, qq(<meta http-equiv="refresh" content="0; url=$option{-goto}">);
231          } elsif ($UA =~ /Gecko/) {
232              print qq{Refresh: 0; url="$option{-goto}"\n};
233              push @head, qq(<meta http-equiv="refresh" content="0; url=&quot;@{[&escape($option{-goto})]}&quot;" />);
234        } else {        } else {
235            $option{-goto} =~ tr/;/&/ if $UA =~ m#Mozilla/[1-4]\.#;            $option{-goto} =~ tr/;/&/ if $UA =~ m#Mozilla/[1-4]\.#;
236            print qq{Refresh: 0; url="$option{-goto}"\n};            print qq{Refresh: 0; url="$option{-goto}"\n};
# Line 257  sub print_header ($;%) { Line 238  sub print_header ($;%) {
238        }        }
239      }      }
240      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};
241      if ($option{-expires}) {      if ($option{-expires} != -1) {
242        print qq{Expires: @{[scalar gmtime $option{-expires}]}\n};        if (defined $option{-expires}) {  ## TODO: Don't use asctime
243            print qq{Expires: @{[scalar gmtime (time + $option{-expires})]}\n};
244          } elsif ($option{-media}->{expires} != -1) {
245            print qq{Expires: @{[scalar gmtime (time + $option{-media}->{expires})]}\n};
246          }
247      }      }
248      if ($UA =~ m#Mozilla/2#) {      if ($option{-media}->{charset} && $UA =~ m#Mozilla/2#) {
249          my $ct = qq{text/html; charset=@{[&get_charset_name($kanjicode,compatible=>1)]}};          my $ct = qq{$option{-media}->{type}; charset=@{[&get_charset_name($kanjicode,compatible=>1)]}};
250          print qq{Content-Type: $ct\n};          print qq{Content-Type: $ct\n};
251          push @head, qq{<meta http-equiv="content-type" content="$ct">};          $option{o}->{-header}->{meta_ct} = qq{<meta http-equiv="content-type" content="$ct">\n};
252      } elsif ($UA =~ m#Infomosaic#) {      } elsif (!$option{-media}->{charset} || $UA =~ m#Infomosaic#) {
253          print qq{Content-Type: text/html\n};          print qq{Content-Type: $option{-media}->{type}\n};
254      } else {      } else {
255          print qq{Content-Type: text/html; charset=@{[&get_charset_name($kanjicode)]}\n};          my $type = $option{-media}->{type};
256            $type = 'application/xml' if $type eq 'application/rss+xml';
257            print qq{Content-Type: $type; charset=@{[&get_charset_name($kanjicode)]}\n};
258      }      }
259      push @head, qq(<title>@{[&escape($page)]}</title>);      print <<"EOD";      ## TODO:
     if ($UA !~ m#Mozilla/[1-4]\.# || $UA =~ m#MSIE (?:[4-9]\.|\d\d)#) {  
       push @head, qq(<link rel="stylesheet" type="text/css").  
                   qq( href="@{[&escape($uri{wiki}.'?mycmd=TEXT_CSS;mypage='.&encode($PageName{DefaultStyleForHTML}).';x-lm='.$database->mtime ($PageName{DefaultStyleForHTML}))]}");  
     }  
     push @head, q(<meta name="ROBOTS" content="NOINDEX">) if $option{-noindex};  
     my ($Links, $links) = &make_navigate_links ($page);  
     #print $Links;      ## Link: fields  
     $links = join "\n", (@head, $links);  
     print <<"EOD";  
260  Content-Language: $lang  Content-Language: $lang
261  Content-Style-Type: text/css  Content-Style-Type: text/css
262    
 <!-- <!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN"  
 "http://www.w3.org/TR/html4/loose.dtd"> + RUBY -->  
 <html lang="$lang" class="$option{body_class}">  
 <head profile="http://suika.fam.cx/~wakaba/-temp/wiki/wiki?WikiHTMLMetaProfile">  
 $links  
 </head>  
263  EOD  EOD
264      $option{o}->{-header}->{links} = join "\n", (@head);
265  }  }
266    
267  sub get_charset_name ($;%) {  sub get_charset_name ($;%) {
# Line 303  sub get_charset_name ($;%) { Line 276  sub get_charset_name ($;%) {
276      $charset;      $charset;
277  }  }
278    
 sub _navigate_links (@) {  
   my ($page) = @_;  
   my $editable = (&is_editable($page) && !&is_frozen($page)) ? 1 : 0;  
   my $cookedpage = &encode($page);  
   <<EOH;  
     @{[ $editable  
         ? qq(<a title="@{[&Resource('EditThisPageLong',escape=>1)]}" href="$url_cgi?mycmd=edit;mypage=$cookedpage" accesskey="E" class="wiki-cmd">@{[&Resource('EditThisPage',escape=>1)]}</a> | )  
         : qq()  
     ]}  
     <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=map;mypage=$cookedpage" class="wiki-cmd" title="@{[&Resource('ShowMapOfThisPageLong',escape=>1)]}">@{[&Resource('ShowMapOfThisPage',escape=>1)]}</a> |  
     <a href="$url_cgi?$PageName{CreatePage}" class="wiki" title="@{[&Resource('GoToCreatePageLong',escape=>1)]}">@{[&Resource('GoToCreatePage',escape=>1)]}</a> |  
     <a href="$url_cgi?$PageName{IndexPage}" class="wiki" title="@{[&Resource('GoToIndexPageLong',escape=>1)]}">@{[&Resource('GoToIndexPage',escape=>1)]}</a> |  
     <a href="$url_cgi?$PageName{FrontPage}" class="wiki" title="@{[&Resource('GoToHomePageLong',escape=>1)]}">@{[&Resource('GoToHomePage',escape=>1)]}</a> |  
     <a href="$url_cgi?$PageName{SearchPage}" class="wiki" title="@{[&Resource('GoToSearchPageLong',escape=>1)]}">@{[&Resource('GoToSearchPage',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> |  
     <a href="$url_cgi?$PageName{RecentChanges}" class="wiki" title="@{[&Resource('GoToRecentChangesLong',escape=>1)]}">@{[&Resource('GoToRecentChanges',escape=>1)]}</a>  
 EOH  
 }  
   
 sub make_navigate_links ($) {  
     my $page = shift;  
     my @link;  
     push @link, {rel=>'edit', href=>"$url_cgi?mycmd=edit;mypage=@{[&encode($page)]}", class=>"wiki-command", title=>&Resource('EditThisPageLink')} if &is_editable ($page) && !&is_frozen ($page);  
     push @link, {rel=>'edit', href=>"$url_cgi?mycmd=edit;admin=1;mypage=@{[&encode($page)]}", class=>"wiki-command", title=>&Resource('AdminEditThisPageLink')} if &is_editable ($page) || &is_frozen ($page);  
     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=>'myself', href=>"$url_cgi?@{[&encode($page)]}", class=>'wiki', title=>&Resource('GoToMyselfLink')};  
     push @link, {rel=>'index', href=>"$url_cgi?$PageName{IndexPage}", class=>'wiki', title=>&Resource('GoToIndexPageLink')};  
     push @link, {rel=>'home', href=>"$url_cgi?$PageName{FrontPage}", class=>'wiki', title=>&Resource('GoToHomePageLink')};  
     push @link, {rel=>'News', href=>"$url_cgi?WikiNews", class=>'wiki', title=>&Resource('GoToWikiNewsLink')};  
     push @link, {rel=>'News', href=>"$url_cgi?$PageName{RecentChanges}", class=>"wiki", title=>&Resource('GoToRecentChangesLink')};  
     push @link, {rel=>'News', href=>"$url_cgi?$PageName{RssPage}", class=>"wiki", title=>&Resource('GoToRssPageLink'), type=>'application/xml'};  
     push @link, {rel=>'search', href=>"$url_cgi?$PageName{SearchPage}", class=>'wiki', title=>&Resource('GoToSearchPageLink')};  
     push @link, {rel=>'help', href=>"$url_cgi?WikiHelp", class=>'wiki', title=>&Resource('GoToWikiHelpLink')};  
     push @link, {rel=>'copyright', href=>"$url_cgi?WikiPageLicense", class=>'wiki', title=>&Resource('GoToWikiPageLicenseLink')};  
     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%3Fmycmd=edit;mypage='+encodeURIComponent(WikiName)%7D), class=>'wiki-cmd', title=>&Resource('JumpToEditLink')};  
     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=>'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=>"$url_cgi?mycmd=diff;mypage=@{[&encode($page)]}", title=>&Resource('ViewDiffOfThisPageLink'), class=>'wiki-command'} if $wiki::diff::UseDiff;  
     push @link, {rel=>'contents', href=>"$url_cgi?mycmd=map;mypage=@{[&encode($page)]}", title=>&Resource('ShowMapOfThisPageLink'), class=>'wiki-command'};  
     my ($Links, $links) = ('', '');  
     for my $e (@link) {  
         $links .= qq(<link);  
         $Links .= qq(Link: <$e->{href}>);  
         for my $attr (qw/rel rev href title class type hreflang charset/) {  
             $links .= qq( $attr="@{[&escape($e->{$attr})]}") if $e->{$attr};  
         }  
         for my $attr (qw/rel rev title/) {  
             $Links .= qq(; $attr="@{[do{$e->{$attr} =~ s/([\\\"])/\\$1/g; $e->{$attr}}]}") if $e->{$attr};  
         }  
         $links .= qq(>\n);  
         $Links .= qq(\n);  
     }  
     wantarray ? ($Links, $links) : $Links;  
 }  
   
279  sub escape {  sub escape {
280      my $s = shift;      my $s = shift;
281      $s =~ s|\x0D\x0A|\x0A|g;      $s =~ s|\x0D\x0A|\x0A|g;
# Line 383  sub unescape { Line 299  sub unescape {
299  sub convert_format ($$$;%) {  sub convert_format ($$$;%) {
300    my ($content, $d => $t, %option) = @_;    my ($content, $d => $t, %option) = @_;
301    &load_formatter ('format');    &load_formatter ('format');
302    my $f = $fmt{format}->{$d.'_to_'.$t};    my $f = SuikaWiki::Plugin->format_converter ($d => $t);
303    if (ref $f) {    if (ref $f) {
304      $option{content} = $content;      $option{content} = $content;
305        $option{from} = $d;
306        $option{to} = $t;
307      &$f ({}, bless (\%option, 'SuikaWiki::Plugin'));      &$f ({}, bless (\%option, 'SuikaWiki::Plugin'));
308    } elsif ($t =~ /HTML|xml/) {    } elsif ($t =~ /HTML|xml/) {
309      length $content ? '<pre>'.&escape($content).'</pre>' : '';      length $content ? '<pre>'.&escape($content).'</pre>' : '';
# Line 629  sub make_custom_form ($$$$) { Line 547  sub make_custom_form ($$$$) {
547              $fmt{form_option}->replace ($option, $param);              $fmt{form_option}->replace ($option, $param);
548              $param->{output}->{form} = 1 unless defined $param->{output}->{form};              $param->{output}->{form} = 1 unless defined $param->{output}->{form};
549              $definition .= ' %submit;' if $definition !~ /%submit/ && !$param->{output}->{nosubmit} && $param->{output}->{form};              $definition .= ' %submit;' if $definition !~ /%submit/ && !$param->{output}->{nosubmit} && $param->{output}->{form};
550              my $target_page = $param->{output}->{page} || $form{mypage};              $param->{output}->{page} ||= $form{mypage};
551              $param->{form_disabled} = 1 if $database->meta (IsFrozen => $form{mypage});              $param->{form_disabled} = 1 if $database->meta (IsFrozen => $form{mypage});
552              my $target_form = $param->{output}->{id};              my $target_form = $param->{output}->{id};
553              my $r = '';              my $r = '';
554              $r = <<EOH if $param->{output}->{form};              $r = <<EOH if $param->{output}->{form};
555  <form method="post" action="$url_cgi" id="wikiform-$FormIndex" class="wikiform">  <form method="post" action="$url_cgi" id="wikiform-$FormIndex" class="wikiform">
556    <input type="hidden" name="mycmd" value="@{[$param->{form_disabled}?'read':'wikiform']}">    <input type="hidden" name="mycmd" value="@{[$param->{form_disabled}?'read':'wikiform']}" />
557    <input type="hidden" name="mypage" value="@{[&escape($target_page)]}">    <input type="hidden" name="mypage" value="@{[&escape($param->{output}->{page})]}" />
558    <input type="hidden" name="myLastModified" value="$lastmodified">    <input type="hidden" name="myLastModified" value="$lastmodified" />
559    <input type="hidden" name="mytouch" value="on">    <input type="hidden" name="mytouch" value="on" />
560    <input type="hidden" name="@{[$target_form? qq(wikiform_targetform" value="@{[&escape($target_form)]}) : qq(wikiform_index" value="$FormIndex)]}">    <input type="hidden" name="@{[$target_form? qq(wikiform_targetform" value="@{[&escape($target_form)]}) : qq(wikiform_index" value="$FormIndex)]}" />
561  EOH  EOH
562              $r .= qq(<a name="wikiform-$FormIndex"></a>) if $UA =~ m#Mozilla/[12]\.#;              $r .= qq(<a name="wikiform-$FormIndex"></a>) if $UA =~ m#Mozilla/[12]\.#;
563              $r .= $fmt{form_input}->replace ($definition, $param);              $r .= $fmt{form_input}->replace ($definition, $param);
# Line 653  EOH Line 571  EOH
571      }      }
572  }}  }}
573    
 sub print_message {  
     my ($msg) = @_;  
     print qq(<p><strong>@{[&escape($msg)]}</strong></p>);  
 }  
   
574  sub init_form {  sub init_form {
575      ## TODO: Support multipart/form-data      ## TODO: Support multipart/form-data
576      my $query = '';      my $query = '';
# Line 668  sub init_form { Line 581  sub init_form {
581      if ($main::ENV{REQUEST_METHOD} ne 'POST' && $main::ENV{QUERY_STRING} && $main::ENV{QUERY_STRING} !~ /[&;=]/) {      if ($main::ENV{REQUEST_METHOD} ne 'POST' && $main::ENV{QUERY_STRING} && $main::ENV{QUERY_STRING} !~ /[&;=]/) {
582        my $query = &decode($main::ENV{QUERY_STRING});        my $query = &decode($main::ENV{QUERY_STRING});
583        $query = &code_convert(\$query, $kanjicode);        $query = &code_convert(\$query, $kanjicode);
       if ($page_command{$query}) {  
         $form{mycmd} = $page_command{$query};  
         $form{mypage} = $query;  
       } else {  
584          $form{mypage} = $query;          $form{mypage} = $query;
585          $form{mycmd} = $database{$form{mypage}} ? 'read' : 'edit';          $form{mycmd} = $database{$form{mypage}} ? 'read' : 'edit';
       }  
586      } else {      } else {
587        for (split /[;&]/, $query) {        for (split /[;&]/, $query) {
588          if (my ($n, $v) = split /=/, $_, 2) {          if (my ($n, $v) = split /=/, $_, 2) {
# Line 686  sub init_form { Line 594  sub init_form {
594          $form{mypage} = $form{epage};          $form{mypage} = $form{epage};
595          $form{mypage} =~ s/([0-9A-F]{2})/ord hex $1/g;          $form{mypage} =~ s/([0-9A-F]{2})/ord hex $1/g;
596        }        }
       if ($page_command{$form{mypage}} && $form{mycmd} eq 'read') {  
         $form{mypage} = &code_convert(\$form{mypage}, $kanjicode);  
         $form{mycmd} = $page_command{$form{mypage}};  
       }  
597      }      }
598      $form{mypage} ||= 'HomePage';      $form{mypage} ||= $PageName{FrontPage};
599      $form{mypage} =~ tr/\x00-\x1F\x7F//d;      $form{mypage} =~ tr/\x00-\x1F\x7F//d;
600      $form{mycmd} ||= 'read';      $form{mycmd} ||= 'read';
601    
# Line 738  sub get_subjectline { Line 642  sub get_subjectline {
642    
643  sub open_db {  sub open_db {
644      if ($modifier_dbtype eq 'dbmopen') {      if ($modifier_dbtype eq 'dbmopen') {
645          dbmopen(%database, $PathTo{WikiDataBase}, 0666) or &print_error("(dbmopen) $PathTo{WikiDataBase}");          dbmopen(%database, $PathTo{WikiDataBase}, 0666) or die "(dbmopen) $PathTo{WikiDataBase}";
646      } elsif ($modifier_dbtype eq 'AnyDBM_File') {      } elsif ($modifier_dbtype eq 'AnyDBM_File') {
647          eval q{use AnyDBM_File};          eval q{use AnyDBM_File};
648          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 die ("(tie AnyDBM_File) $PathTo{WikiDataBase}");
649      } elsif ($modifier_dbtype eq 'Yuki::YukiWikiDB') {      } elsif ($modifier_dbtype eq 'Yuki::YukiWikiDB') {
650          eval q{use Yuki::YukiWikiDB};          eval q{use Yuki::YukiWikiDB};
651          tie(%database, "Yuki::YukiWikiDB", $PathTo{WikiDataBase}) or &print_error("(tie Yuki::YukiWikiDB) $PathTo{WikiDataBase}");          tie(%database, "Yuki::YukiWikiDB", $PathTo{WikiDataBase}) or die ("(tie Yuki::YukiWikiDB) $PathTo{WikiDataBase}");
652      } else {    ## Yuki::YukiWikiDB || Yuki::YukiWikiDBMeta      } else {    ## Yuki::YukiWikiDB || Yuki::YukiWikiDBMeta
653          eval qq{use $modifier_dbtype};          eval qq{use $modifier_dbtype};
654          $database = tie(%database, $modifier_dbtype => $PathTo{WikiDataBase}, -lock => 2, -backup => $wiki::diff::UseDiff) or &print_error("(tie $modifier_dbtype) $PathTo{WikiDataBase}");          $database = tie(%database, $modifier_dbtype => $PathTo{WikiDataBase}, -lock => 2, -backup => $wiki::diff::UseDiff) or die ("(tie $modifier_dbtype) $PathTo{WikiDataBase}");
655      }      }
656  }  }
657    
# Line 783  sub editform (@) { Line 687  sub editform (@) {
687  EOH  EOH
688    $f .= <<"EOD";    $f .= <<"EOD";
689  <form action="$uri{wiki}" method="post">  <form action="$uri{wiki}" method="post">
690      @{[ $option{conflict} ? '' : qq(<label><input type="submit" name="mypreview_write" value="@{[&Resource('Edit:Save',escape=>1)]}"><kbd>S</kbd></label>) ]}      @{[ $option{conflict} ? '' : qq(<label><input type="submit" name="mypreview_write" value="@{[&Resource('Edit:Save',escape=>1)]}" /><kbd>S</kbd></label>) ]}
691      @{[ $option{admin} ? qq(<label>@{[&Resource('Edit:Password=',escape=>1)]}<input type="password" name="mypassword" value="" size="10"></label>) : "" ]} [@{[&get_new_anchor_index($option{content})]}]<br>      @{[ $option{admin} ? qq(<label>@{[&Resource('Edit:Password=',escape=>1)]}<input type="password" name="mypassword" value="" size="10" /></label>) : "" ]} [@{[&get_new_anchor_index($option{content})]}]<br />
692      <input type="hidden" name="myLastModified" value="$option{last_modified}">      <input type="hidden" name="myLastModified" value="$option{last_modified}" />
693      <input type="hidden" name="mypage" value="@{[&escape($form{mypage})]}">      <input type="hidden" name="mypage" value="@{[&escape($form{mypage})]}" />
694      <textarea cols="@{[&Resource('Edit:Form:Cols')+0||80]}" rows="@{[&Resource('Edit:Form:Rows')+0||20]}" name="mymsg" tabindex="1">@{[&escape($option{content})]}</textarea><br>      <textarea cols="@{[&Resource('Edit:Form:Cols')+0||80]}" rows="@{[&Resource('Edit:Form:Rows')+0||20]}" name="mymsg" tabindex="1">@{[&escape($option{content})]}</textarea><br />
695  @{[  @{[
696      $option{admin} ?      $option{admin} ?
697      qq(      qq(
698      <label><input type="radio" name="myfrozen" value="1" @{[$frozen ? qq(checked="checked") : ""]}>@{[&Resource('Edit:Freeze',escape=>1)]}</label>      <label><input type="radio" name="myfrozen" value="1" @{[$frozen ? qq(checked="checked") : ""]} />@{[&Resource('Edit:Freeze',escape=>1)]}</label>
699      <label><input type="radio" name="myfrozen" value="0" @{[$frozen ? "" : qq(checked="checked")]}>@{[&Resource('Edit:DontFreeze',escape=>1)]}</label><br>)      <label><input type="radio" name="myfrozen" value="0" @{[$frozen ? "" : qq(checked="checked")]} />@{[&Resource('Edit:DontFreeze',escape=>1)]}</label><br />)
700      : ""      : ""
701  ]}  ]}
702  @{[  @{[
703      $option{conflict} ? "" :      $option{conflict} ? "" :
704      qq(      qq(
705          <label><input type="checkbox" name="mytouch" value="on" checked="checked">@{[&Resource('Edit:UpdateTimeStamp',escape=>1)]}</label><br>          <label><input type="checkbox" name="mytouch" value="on" checked="checked" />@{[&Resource('Edit:UpdateTimeStamp',escape=>1)]}</label><br />
706          <label><input type="submit" name="mypreview_write" value="@{[&Resource('Edit:Save',escape=>1)]}" accesskey="S"><kbd>S</kbd></label>          <label><input type="submit" name="mypreview_write" value="@{[&Resource('Edit:Save',escape=>1)]}" accesskey="S" /><kbd>S</kbd></label>
707         $afteredit         $afteredit
708      )      )
709  ]}  ]}
# Line 810  EOD Line 714  EOD
714    
715  sub is_editable {  sub is_editable {
716      my ($page) = @_;      my ($page) = @_;
717      $page =~ /[\x00-\x1F\x7F]/ ? 0 : 1;      $page =~ /[\x00-\x20\x7F]/ ? 0 : 1;
718  }  }
719    
720  sub decode {  sub decode {
# Line 822  sub decode { Line 726  sub decode {
726    
727  sub encode {  sub encode {
728    my $s = shift;    my $s = shift;
729    $s =~ s/([^0-9A-Za-z_-])/sprintf '%%%02X', ord $1/g;    $s =~ s/([^0-9A-Za-z_-])/sprintf '%%%02X', ord $1/ge;
730    $s;    $s;
731  }  }
732    
# Line 858  sub frozen_reject { Line 762  sub frozen_reject {
762          # You are admin.          # You are admin.
763          return 0;          return 0;
764      } else {      } else {
765          &print_error(&Resource('Error:PasswordIsIncorrect'));          &_do_view_msg (-view => '-error', -page => $form{mypage},
766          return 1;                         error_message => &Resource ('Error:PasswordIsIncorrect'));
767            exit;
768      }      }
769  }  }
770    
# Line 921  sub embedded_to_html { Line 826  sub embedded_to_html {
826          my $lastmodified = $database->mtime ($form{mypage});          my $lastmodified = $database->mtime ($form{mypage});
827          return <<"EOD";          return <<"EOD";
828  <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>
829      <input type="hidden" name="mycmd" value="comment">      <input type="hidden" name="mycmd" value="comment" />
830      <input type="hidden" name="mypage" value="$form{mypage}">      <input type="hidden" name="mypage" value="$form{mypage}" />
831      <input type="hidden" name="myLastModified" value="$lastmodified">      <input type="hidden" name="myLastModified" value="$lastmodified" />
832      <input type="hidden" name="mytouch" value="on">      <input type="hidden" name="mytouch" value="on" />
833      <input type="hidden" name="comment_index" value="$CommentIndex">      <input type="hidden" name="comment_index" value="$CommentIndex" />
834      @{[&Resource('WikiForm:WikiComment:Name=',escape=>1)]}      @{[&Resource('WikiForm:WikiComment:Name=',escape=>1)]}
835      <input type="text" name="myname" value="" size="10" class="comment-name">      <input type="text" name="myname" value="" size="10" class="comment-name" />
836      <input type="text" name="mymsg" value="" size="60" class="comment-msg">      <input type="text" name="mymsg" value="" size="60" class="comment-msg" />
837      <input type="submit" value="@{[&Resource('WikiForm:Add',escape=>1)]}" title="@{[&Resource('WikiForm:AddLong',escape=>1)]}" class="comment-submit">      <input type="submit" value="@{[&Resource('WikiForm:Add',escape=>1)]}" title="@{[&Resource('WikiForm:AddLong',escape=>1)]}" class="comment-submit" />
838  </p></form>  </p></form>
839  EOD  EOD
840       } else {       } else {
841          return <<"EOD";          return <<"EOD";
842  <del><form action="$url_cgi" method="get">  <del><form action="$url_cgi" method="get">
843      <input type="hidden" name="mycmd" value="read">      <input type="hidden" name="mycmd" value="read" />
844      <input type="hidden" name="mypage" value="$form{mypage}">      <input type="hidden" name="mypage" value="$form{mypage}" />
845      @{[&Resource('WikiForm:WikiComment:Name=',escape=>1)]}      @{[&Resource('WikiForm:WikiComment:Name=',escape=>1)]}
846      <input type="text" name="myname" value="" size="10" disabled="disabled">      <input type="text" name="myname" value="" size="10" disabled="disabled" />
847      <input type="text" name="mymsg" value="" size="60" disabled="disabled">      <input type="text" name="mymsg" value="" size="60" disabled="disabled" />
848  </form></del>  </form></del>
849  EOD  EOD
850      }      }
# Line 1050  sub code_convert { Line 955  sub code_convert {
955      return $$contentref;      return $$contentref;
956  }  }
957    
 sub do_rss {  
     eval q{use Yuki::RSS};  
     my $rss = new Yuki::RSS(  
         version => '1.0',  
         encoding => &get_charset_name ($kanjicode),  
     );  
     my $scheme = 'http';  
     $scheme = lc $1 if $main::ENV{SERVER_PROTOCOL} =~ m#([A-Za-z0-9+.%-]+)#;  
     my $myuri = "$scheme://$main::ENV{SERVER_NAME}:$main::ENV{SERVER_PORT}$url_cgi";  
     $rss->stylesheet (  
       href      => $myuri . "?mycmd=TEXT_CSS;mypage=WikiStyle:RSS",  
       type      => 'text/css',  
     );  
     $rss->channel(  
         title   => &Resource ('RSS:WikiTitle'),  
         link    => $myuri,  
         description     => &Resource ('RSS:WikiDescription'),  
         'dc:language'   => $lang,  
     );  
     my $recentchanges = $database{RecentChanges};  
     my $count = 0;  
     foreach (split(/\n/, $recentchanges)) {  
         last if ($count >= 15);  
         if (/\[\[([^]]+)\]\]/) {  
           my $title = $1;  
           $rss->add_item (  
             title       => &escape($title),  
             link        => $myuri . '?' . &encode($title),  
             description => &escape(&get_subjectline($title,delimiter=>'')),  
             'dc:date'   => $database->mtime ($title),  
           );  
           $count++;  
         }  
     }  
     # print RSS information (as XML).  
     print <<"EOD"  
 Content-type: application/xml; charset=@{[&get_charset_name ($kanjicode)]}  
   
 @{[$rss->as_string]}  
 EOD  
 }  
   
958  sub _rfc3339_date ($) {  sub _rfc3339_date ($) {
959    my @time = gmtime (shift);    my @time = gmtime (shift);
960    sprintf '%04d-%02d-%02dT%02d:%02d:%02d+00:00', $time[5]+1900,$time[4]+1,@time[3,2,1,0];    sprintf '%04d-%02d-%02dT%02d:%02d:%02d+00:00', $time[5]+1900,$time[4]+1,@time[3,2,1,0];
# Line 1236  package SuikaWiki::Plugin; Line 1099  package SuikaWiki::Plugin;
1099    our $plugin_directory;    our $plugin_directory;
1100    our %List;    our %List;
1101    our %Index;    our %Index;
1102      push @main::INC, $plugin_directory.'/../..';
1103    
1104  sub escape ($$) { main::escape ($_[1]) }  sub escape ($$) { main::escape ($_[1]) }
1105  sub unescape ($$) { main::unescape ($_[1]) }  sub unescape ($$) { main::unescape ($_[1]) }
# Line 1245  sub __get_datetime ($) { main::get_now ( Line 1109  sub __get_datetime ($) { main::get_now (
1109  sub resource ($$;%) { shift; &main::Resource (@_) }  sub resource ($$;%) { shift; &main::Resource (@_) }
1110  sub uri ($$) { $main::uri{$_[1]} }  sub uri ($$) { $main::uri{$_[1]} }
1111  sub new_index ($$) { ++$Index{$_[1]} }  sub new_index ($$) { ++$Index{$_[1]} }
1112    sub user_agent_names ($) { $main::UA }
1113  sub magic_and_content ($$) {  sub magic_and_content ($$) {
1114    my $page = $_[1];    my ($magic, $page) = ('', $_[1]);
1115    $page =~ s!^((?:\#\?|/\*|<\?)[^\x02\x0A\x0D]+)[\x02\x0A\x0D]+!!s;    $magic = $1 if $page =~ s!^((?:\#\?|/\*|<\?)[^\x02\x0A\x0D]+)[\x02\x0A\x0D]+!!s;
1116    ($1, $page);    ($magic, $page);
1117  }  }
1118  sub formatter ($$) {  sub formatter ($$) {
1119    &main::load_formatter ($_[1]);    &main::load_formatter ($_[1]);
1120    $main::fmt{$_[1]};    $main::fmt{$_[1]};
1121  }  }
1122    sub format_converter ($$$) {
1123      &main::load_formatter ('format');
1124      $main::fmt{format}->{($_[1]=~/([A-Za-z0-9]\S+)/?$1:'SuikaWiki/0.9').'_to_'.$_[2]}
1125      || $main::fmt{format}->{($_[1]=~/([A-Za-z0-9](?:(?!\/)\S)+)/?$1:'SuikaWiki').'_to_'.$_[2]};
1126    }
1127    
1128  sub regist ($@) {  sub regist ($@) {
1129      my $pack = shift;      my $pack = shift;
Legend:
Removed from v.1.49  
changed lines
  Added in v.1.50
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24