/[pub]/suikawiki/script/lib/suikawiki.pl
Suika

Diff of /suikawiki/script/lib/suikawiki.pl

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.14 by wakaba, Sun Oct 5 11:50:40 2003 UTC revision 1.15 by wakaba, Sat Oct 18 07:08:34 2003 UTC
# Line 9  require SuikaWiki::Plugin; Line 9  require SuikaWiki::Plugin;
9  our %embed_command = (  our %embed_command = (
10          form    => qr/\[\[\#form(?:\(([A-Za-z0-9-]+)\))?:'((?:[^'\\]|\\.)*)':'((?:[^'\\]|\\.)*)'(?::'((?:[^'\\]|\\.)*)')?\]\]/,          form    => qr/\[\[\#form(?:\(([A-Za-z0-9-]+)\))?:'((?:[^'\\]|\\.)*)':'((?:[^'\\]|\\.)*)'(?::'((?:[^'\\]|\\.)*)')?\]\]/,
11  );  );
 our (%uri,%PathTo,%PageName,$kanjicode);  
   
 our %form;  
 our %database;  
12  our $database = bless {}, 'wiki::dummy';  our $database = bless {}, 'wiki::dummy';
 our $UA = '';  ## User agent name  
13  $| = 1;  $| = 1;
14  require SuikaWiki::Name::Space;  require SuikaWiki::Name::Space;
15  my $NS_XHTML1 = 'http://www.w3.org/1999/xhtml';  my $NS_XHTML1 = 'http://www.w3.org/1999/xhtml';
16  our $WIKI;  our $WIKI;
17    require Message::Markup::XML;
   
   
 sub do_view {  
   require SuikaWiki::View;  
   my $page = [split m!//!, $main::form{mypage}];  
   my $content = SuikaWiki::Plugin->get_data (content => $page);  
   my $lm = SuikaWiki::Plugin->get_data (lastmodified => $page);  
   ## Determine mode  
     my $view = $form{mycmd};  
     if (!$view || $view eq 'default' || $view =~ /[^0-9A-Za-z_]/) {  
       ## BUG: this code is not strict  
       if ($main::ENV{HTTP_COOKIE} =~ /SelectedMode=([0-9A-Za-z_-]+)/) {  
         $view = $1; $view =~ tr/-/_/;  
       } else {  
         $view = 'read';  
       }  
     }  
   ## Get content and its meta info  
   my ($magic, $content) = SuikaWiki::Plugin->magic_and_content ($content);  
   $magic ||= '#?SuikaWiki/0.9';  
   my $o = bless {param => \%main::form, page => $main::form{mypage}, toc => [],  
                  magic => $magic, content => $content,  
                  &main::_compatible_options ()}, 'SuikaWiki::Plugin';  
   my $view_def = SuikaWiki::View->definition ($view);  
   if (!$view_def->check ($o)) {  
     print "Status: 406 Unsupported Media Type\n";  
     $view = '-UnsupportedMediaType';  
     $view_def = SuikaWiki::View->definition ($view);  
   }  
   my $prop = $view_def->properties;  
   my $media = $prop->{media};  
   if (index ($prop->{xmedia}, 'Gecko') > -1) {  ## TODO: conneg  
     $media = $prop->{xmedia};  
     $o->{media} = $media;  
   }  
     
   if ($prop->{preprocess}) {  
     exit unless &{$prop->{preprocess}} (o => $o);  
   }  
     
   ## Output CGI/HTTP headers  
     if ($magic =~ m!^\#\?SuikaWiki/0.9!) {  
       &main::print_header ($main::form{mypage},  
         -last_modified => ($magic =~ /interactive="yes"/ ? time : $lm),  
         -expires => ($magic =~ /interactive="yes"/ ? 1 : undef), o => $o,  
         -media => $media, -view => $view_def, -magic => $magic,  content => $content);  
     } else {  
       &main::print_header($main::form{mypage}, -media => $media, -view => $view_def,  
                                    -magic => $magic, -last_modified => $lm, o => $o);  
     }  
   ## Output HTTP message body  
   my $fmt = SuikaWiki::Plugin->formatter ('view');  
   my $s = $fmt->replace ($view_def->as_string => $o, {formatter => $fmt});  
   if ($main::kanjicode eq 'euc') {  
     #require Compress::Zlib;  
     #print scalar Compress::Zlib::memGzip (''.$s);  
     print $s;  
   } else {  
     $s .= '';  
     print &main::code_convert (\$s => $main::kanjicode);  
   }  
 }  
18    
19  sub _do_view_msg (%) {  sub _do_view_msg (%) {
20    require SuikaWiki::View;    require SuikaWiki::View;
21    my %option = @_;    my %option = @_;
22    my $o = $option{-o} || bless {param => \%form, page => $option{-page},    my $o = $option{-o} || bless {param => \%main::form, page => $option{-page},
23                                  &_compatible_options ()}, 'SuikaWiki::Plugin';                                  &_compatible_options ()}, 'SuikaWiki::Plugin';
24    $o->{toc} = [];    $o->{toc} = [];
25    $o->{condition} = \%option;   ## This parameter really used??    $o->{condition} = \%option;   ## This parameter really used??
# Line 98  sub _do_view_msg (%) { Line 31  sub _do_view_msg (%) {
31    }    }
32    my $prop = $view_def->properties;    my $prop = $view_def->properties;
33    my $media = $prop->{media};    my $media = $prop->{media};
34    if ($prop->{xmedia} && $UA =~ /Gecko/) {    if ($prop->{xmedia} && $main::UA =~ /Gecko/) {
35      $media = $prop->{xmedia};      $media = $prop->{xmedia};
36      $o->{media} = $media;      $o->{media} = $media;
37    }    }
38    &print_header($option{-page}, -media => $media, -view => $view_def, o => $o, -goto => $option{-goto});    &print_header($option{-page}, -media => $media, -view => $view_def, o => $o, -goto => $option{-goto});
39      print "\n";
40    ## Output HTTP message body    ## Output HTTP message body
41    my $fmt = SuikaWiki::Plugin->formatter ('view');    my $fmt = SuikaWiki::Plugin->formatter ('view');
42    my $s = $fmt->replace ($view_def->as_string => $o, {formatter => $fmt});    my $s = $fmt->replace ($view_def->as_string => $o, {formatter => $fmt});
43    if ($main::kanjicode eq 'euc') {    print $s;
     print $s;  
   } else {  
     print &main::code_convert (\$s => $main::kanjicode);  
   }  
44  }  }
45    
46    =pod
47    
48  # [move to SuikaWiki::Plugin::WikiAdmin]  # [move to SuikaWiki::Plugin::WikiAdmin]
49  sub do_adminchangepassword {  sub do_adminchangepassword {
50      if ($form{mynewpassword} ne $form{mynewpassword2}) {      if ($main::form{mynewpassword} ne $main::form{mynewpassword2}) {
51          &_do_view_msg (-view => '-error', -page => $form{mypage},          &_do_view_msg (-view => '-error', -page => $main::form{mypage},
52                         error_message => &Resource ('Error:PasswordMismatch'));                         error_message => &Resource ('Error:PasswordMismatch'));
53          return;          return;
54      }      }
55      my ($validpassword_crypt) = $database->meta (AdminPassword => $PageName{AdminSpecialPage});      my ($validpassword_crypt) = $main::database->meta (AdminPassword => $PageName{AdminSpecialPage});
56      if ($validpassword_crypt) {      if ($validpassword_crypt) {
57          if (not &valid_password($form{myoldpassword})) {          if (not &valid_password($main::form{myoldpassword})) {
58              &_do_view_msg (-view => '-error', -page => $form{mypage},              &_do_view_msg (-view => '-error', -page => $main::form{mypage},
59                             error_message => &Resource ('Error:PasswordIsIncorrect'));                             error_message => &Resource ('Error:PasswordIsIncorrect'));
60              return;              return;
61          }          }
# Line 132  sub do_adminchangepassword { Line 64  sub do_adminchangepassword {
64      my (@token) = ('0'..'9', 'A'..'Z', 'a'..'z');      my (@token) = ('0'..'9', 'A'..'Z', 'a'..'z');
65      my $salt1 = $token[(time | $$) % scalar(@token)];      my $salt1 = $token[(time | $$) % scalar(@token)];
66      my $salt2 = $token[($sec + $min*60 + $hour*60*60) % scalar(@token)];      my $salt2 = $token[($sec + $min*60 + $hour*60*60) % scalar(@token)];
67      my $crypted = crypt($form{mynewpassword}, "$salt1$salt2");      my $crypted = crypt($main::form{mynewpassword}, "$salt1$salt2");
68      $database->meta (AdminPassword => $PageName{AdminSpecialPage} => $crypted);      $main::database->meta (AdminPassword => $main::PageName{AdminSpecialPage} => $crypted);
69            
70      &_do_view_msg (-view => '-wrote', -page => $form{mypage});      &_do_view_msg (-view => '-wrote', -page => $main::form{mypage});
71  }  }
72    
73    =cut
74    
75  # [move to SuikaWiki::WikiDB]  # [move to SuikaWiki::WikiDB]
76  sub valid_password ($) {  sub valid_password ($) {
77      my ($validpassword_crypt) = $database->meta (AdminPassword => $PageName{AdminSpecialPage});    return 0;
78      return crypt (shift, $validpassword_crypt) eq $validpassword_crypt ? 1 : 0;  #    my ($validpassword_crypt) = $main::database->meta (AdminPassword => $PageName{AdminSpecialPage});
79  }  #    return crypt (shift, $validpassword_crypt) eq $validpassword_crypt ? 1 : 0;
   
 # [move to SuikaWiki::Plugin::WikiEdit]  
 sub do_write {  
   my ($page_name, $new_content, $update_lm) = ($form{mypage}, $form{mymsg}, $form{mytouch});  
   my $page = [split m#//#, $page_name];  
     if (&frozen_reject()) {  
         return;  
     }  
   
     if (not &is_editable($form{mypage})) {  
         &_do_view_msg (-view => '-error', -page => $form{mypage},  
                        error_message => &Resource ('Error:ThisPageIsUneditable'));  
         return;  
     }  
   
   ## Check confliction  
   my $lm = SuikaWiki::Plugin->get_data (lastmodified => $page);              
   if ($form{myLastModified} != $lm) {  
     _do_view_msg (-view => '-conflict', -page => $page_name);  
     return;  
   }  
                 
   if (length $new_content) {  
     SuikaWiki::Plugin->set_data (content => $page => $new_content,  
                                  -touch => 1,$form{mytouch});  
         $database->meta (IsFrozen => $form{mypage} => 0 + $form{myfrozen});  
         my $uri = SuikaWiki::Plugin->_uri_wiki_page ($form{mypage}, mode => ($form{after_edit_cmd}||'default'), with_lm => 1, absolute => 1);  
         $uri .= qq(;after_edit_cmd=@{[SuikaWiki::Plugin->encode($form{after_edit_cmd})]}) if $form{after_edit_cmd};  
         if ($form{__comment_anchor_index}) {  
             $uri .= qq(#anchor-$form{__comment_anchor_index});  
         } elsif ($form{__wikiform_anchor_index}) {  
             $uri .= qq(#wikiform-$form{__wikiform_anchor_index});  
         }  
         &_http_see_other (uri => $uri, page => $form{mypage}, alternate_view => '-wrote');  
   } else {  
           delete $database{$form{mypage}};  
         &_do_view_msg (-view => '-deleted', -page => $form{mypage});  
   }  
80  }  }
81    
82    ## [obsolete] BugTrack, RandomJump
83  sub _http_see_other (%) {  sub _http_see_other (%) {
84    my %o = @_;    my %o = @_;
85    $o{page} = join '//', @{$o{page}} if ref $o{page};    $o{page} = join '//', @{$o{page}} if ref $o{page};
# Line 191  sub _http_see_other (%) { Line 88  sub _http_see_other (%) {
88     && !($main::UA =~ m#M(?:ozilla|icrosoft Internet Explorer)#)) {     && !($main::UA =~ m#M(?:ozilla|icrosoft Internet Explorer)#)) {
89      &_do_view_msg (-view => $o{alternate_view}, -page => $o{page}, -goto => $o{uri}, -o => $o{o});      &_do_view_msg (-view => $o{alternate_view}, -page => $o{page}, -goto => $o{uri}, -o => $o{o});
90    } else {    } else {
91        my $status = q(303 See Other);      require SuikaWiki::Output::HTTP;
92        if ($main::UA =~ m!Mozilla/[0-4]\.|Microsoft Internet Explorer!) {      my $output = SuikaWiki::Output::HTTP->new (wiki => $WIKI);
93            $status = q(302 See Other);      $output->set_redirect (uri => $o{uri}, status_code => 303);
94        }      $output->output (output => 'http-cgi');
     my $euri = SuikaWiki::Plugin->escape ($o{uri});  
     print qq(Status: $status  
 Location: $o{uri}  
 Content-Type: text/html  
 Content-Language: en  
   
 <!DOCTYPE p SYSTEM>  
 <p>See &lt;<a href="$euri">$euri</a>&gt;.</p>);  
95    }    }
96    exit;    exit;
97  }  }
98    
99    # temp
100    sub is_editable { 1 }
101    
102  sub _compatible_options () {  sub _compatible_options () {
103    (use_anchor_name => ($main::UA =~ m#Mozilla/[1-4]\.|Microsoft Internet Explorer# ? 1 : 0));    (use_anchor_name => ($main::UA =~ m#Mozilla/[1-4]\.|Microsoft Internet Explorer# ? 1 : 0));
104  }  }
# Line 230  sub print_header ($;%) { Line 122  sub print_header ($;%) {
122            }            }
123        }        }
124      }      }
125      my $UA = SuikaWiki::Plugin->user_agent_names;      #my $UA = SuikaWiki::Plugin->user_agent_names;
126      $option{o}->{-header}->{class}->{frozen} = 1 if &main::is_frozen ($page);      $option{o}->{-header}->{class}->{frozen} = 1 if &main::is_frozen ($page);
127      $option{o}->{-header}->{class}->{'wiki-page-obsoleted'} = 1 if $option{-magic} =~ /obsoleted="yes"/;      $option{o}->{-header}->{class}->{'wiki-page-obsoleted'} = 1 if $option{-magic} =~ /obsoleted="yes"/;
128      $option{o}->{-header}->{additional_html_element} ||= SuikaWiki::Markup::XML->new (type => '#fragment');      $option{o}->{-header}->{additional_html_element} ||= SuikaWiki::Markup::XML->new (type => '#fragment');
129      #print "Vary: Negotiate,User-Agent,Accept-Language,Accept\n";      #print "Vary: Negotiate,User-Agent,Accept-Language,Accept\n";
130      if ($option{-goto}) {      if ($option{-goto}) {
131        if ($UA =~ m#Opera|MSIE 2\.#) {        if ($main::UA =~ m#Opera|MSIE 2\.#) {
132          ## WARNING: This code may output unsafe HTML document if $option{-goto} is unclean.          ## WARNING: This code may output unsafe HTML document if $option{-goto} is unclean.
133          $option{-goto} =~ tr/;/&/ if $UA =~ m#Opera#;          $option{-goto} =~ tr/;/&/ if $main::UA =~ m#Opera#;
134          print qq{Refresh: 0; url=$option{-goto}\n};          print qq{Refresh: 0; url=$option{-goto}\n};
135          for ($option{o}->{-header}->{additional_html_element}->append_new_node          for ($option{o}->{-header}->{additional_html_element}->append_new_node
136                  (namespace_uri => $NS_XHTML1, local_name => 'meta')) {                  (namespace_uri => $NS_XHTML1, local_name => 'meta')) {
# Line 247  sub print_header ($;%) { Line 139  sub print_header ($;%) {
139            $_->option (use_EmptyElemTag => 1);            $_->option (use_EmptyElemTag => 1);
140          }          }
141        } else {        } else {
142          $option{-goto} =~ tr/;/&/ if $UA =~ m#Mozilla/[1-4]\.#;          $option{-goto} =~ tr/;/&/ if $main::UA =~ m#Mozilla/[1-4]\.#;
143          print qq{Refresh: 0; url="$option{-goto}"\n};          print qq{Refresh: 0; url="$option{-goto}"\n};
144          for ($option{o}->{-header}->{additional_html_element}->append_new_node          for ($option{o}->{-header}->{additional_html_element}->append_new_node
145                  (namespace_uri => $NS_XHTML1, local_name => 'meta')) {                  (namespace_uri => $NS_XHTML1, local_name => 'meta')) {
# Line 266  sub print_header ($;%) { Line 158  sub print_header ($;%) {
158          print qq{Expires: @{[scalar gmtime (time + $option{-media}->{expires})]}\n};          print qq{Expires: @{[scalar gmtime (time + $option{-media}->{expires})]}\n};
159        }        }
160      }      }
161      if ($option{-media}->{charset} && $UA =~ m#Mozilla/[12]\.#) {      if ($option{-media}->{charset} && $main::UA =~ m#Mozilla/[12]\.#) {
162      ## UAs don't support official charset names but do non-official names      ## UAs don't support official charset names but do non-official names
163        my $ct = qq{$option{-media}->{type}; charset=@{[ &main::get_charset_name ($main::kanjicode, compatible => 1) ]}};        my $ct = qq{$option{-media}->{type}; charset=@{[ &main::get_charset_name ($main::kanjicode, compatible => 1) ]}};
164        print qq{Content-Type: $ct\n};        print qq{Content-Type: $ct\n};
# Line 275  sub print_header ($;%) { Line 167  sub print_header ($;%) {
167          $_->set_attribute ('http-equiv' => 'content-type');          $_->set_attribute ('http-equiv' => 'content-type');
168          $_->set_attribute (content => $ct);          $_->set_attribute (content => $ct);
169        }        }
170      } elsif (!$option{-media}->{charset} || $UA =~ m#Infomosaic|Mozilla/0\.#) {      } elsif (!$option{-media}->{charset} || $main::UA =~ m#Infomosaic|Mozilla/0\.#) {
171      ## Media types or UAs don't support charset parameter in HTTP header      ## Media types or UAs don't support charset parameter in HTTP header
172        print qq{Content-Type: $option{-media}->{type}\n};        print qq{Content-Type: $option{-media}->{type}\n};
173        if ($option{-media}->{charset}) {        if ($option{-media}->{charset}) {
# Line 288  sub print_header ($;%) { Line 180  sub print_header ($;%) {
180      } else {      } else {
181      ## Modern UAs and Media types with charset parameter      ## Modern UAs and Media types with charset parameter
182        my $type = $option{-media}->{type};        my $type = $option{-media}->{type};
183        $type = 'application/xml' if ($type =~ m!^application/rdf\+xml$!) && ($UA =~ m#Gecko#);        $type = 'application/xml' if ($type =~ m!^application/rdf\+xml$!) && ($main::UA =~ m#Gecko#);
184        print qq{Content-Type: $type; charset=@{[&main::get_charset_name ($main::kanjicode)]}\n};        print qq{Content-Type: $type; charset=@{[&main::get_charset_name ($main::kanjicode)]}\n};
185        ## meta element is not needed        ## meta element is not needed
186      }      }
# Line 307  sub get_charset_name ($;%) { Line 199  sub get_charset_name ($;%) {
199      $charset;      $charset;
200  }  }
201    
 =pod  
   
 sub _decode_argv () {  
   my $QS = $main::ENV{QUERY_STRING};  
   if ($main::ENV{PATH_INFO}) {  
   die;  
   # new format: not implemented yet  
   } else {  
     my %argv;  
     if ($QS =~ /[&;=]/) {       ## ?FOO=foo;BAR=bar;BAZ=baz  
       for (split /[;&]/, $QS) {  
         if (my ($n, $v) = split /=/, $_, 2) {  
           for ($n, $v) {tr/+/ /; s/%([0-9A-Fa-f][0-9A-Fa-f])/pack 'HH', $1/ge};  
           $argv{$n} = $v;  
         }  
       }  
     } else {    ## ?FOO-BAR  
       $argv{page} = $QS;  
       $argv{page} =~ tr/+/ /;  
       $argv{page} =~ s/%([0-9A-Fa-f][0-9A-Fa-f])/pack 'HH', $1/ge;  
     }  
     my $ie = $argv{ie}; ## Input coding system  
     for ([qw/mypage page/], [qw/mycmd mode/]) {  
       $argv{$_->[1]} ||= $argv{$_->[0]};  
       delete $argv{$_->[0]};  
     }  
     for (keys %argv) {  
       $argv{$_} = main::code_convert ($argv{$_}, $main::kanjicode, $ie);  
     }  
     for ([qw/mypage page/], [qw/mycmd mode/]) {  
       $argv{$_->[0]} = $argv{$_->[1]};  
     }  
   }  
 }  
   
 =cut  
   
 sub init_form {  
     ## TODO: Support multipart/form-data  
     my $query = '';  
     if (uc $main::ENV{REQUEST_METHOD} eq 'POST') {  
       if ($main::ENV{CONTENT_TYPE}=~ m!^application/(?:x-www|sgml)-form-urlencoded(?:$|\s*;)!) {  
         read STDIN, $query, $main::ENV{CONTENT_LENGTH};  
       } else {  
         $main::form{mycmd} = '___unsupported_media_type___';  
         $main::form{mypage} = $main::PageName{FrontPage};  
         return;  
       }  
     }  
     $query .= ($query ? ';' : '') . $main::ENV{QUERY_STRING};  
     if ($main::ENV{REQUEST_METHOD} ne 'POST' && $main::ENV{QUERY_STRING} && $main::ENV{QUERY_STRING} !~ /[&;=]/) {  
       my $query = SuikaWiki::Plugin->decode ($main::ENV{QUERY_STRING});  
       $query = &main::code_convert (\$query, $main::kanjicode);  
         $main::form{mypage} = $query;  
         $main::form{mycmd} = 'default';  
     } else {  
       for (split /[;&]/, $query) {  
         if (my ($n, $v) = split /=/, $_, 2) {  
           for ($n, $v) {tr/+/ /; s/%([0-9A-Fa-f][0-9A-Fa-f])/pack 'C', hex $1/ge};  
           $main::form{$n} = $v;  
         }  
       }  
       unless (defined $form{mypage}) {  
         $form{mypage} = $form{epage};  
         $form{mypage} =~ s/([0-9A-F]{2})/ord hex $1/g;  
       }  
       $form{mypage} = &main::code_convert (\$form{mypage}, $kanjicode);  
     }  
     $form{mypage} =~ tr/\x00-\x20\x7F//d;  
     $form{mypage} = SuikaWiki::Name::Space::normalize_name ($form{mypage}) || $PageName{FrontPage};  
     $form{mycmd} ||= $form{mode} || 'default';  
     $form{mycmd} =~ tr/-/_/;  
   
     for ('mymsg', 'myname', grep /^(?:wikiform__|pi_)/, keys %form) {  
         $form{$_} = &main::code_convert (\$form{$_}, $kanjicode);  
     }  
 }  
   
 # [move to SuikaWiki::Plugin::WikiEdit]  
 sub editform (@) {  
   my %option = @_;  
   my $page = [split m!//!, $option{page}];  
   my $frozen = &is_frozen ($option{page});  
   $option{content} = SuikaWiki::Plugin->get_data (content => $page)  
       unless defined $option{content};  
   $option{content} = SuikaWiki::Plugin->get_data (content => $main::PageOf{NewPageTemplate})  
       unless length $option{content};  
   $option{last_modified} = SuikaWiki::Plugin->get_data (lastmodified => $page)  
       unless defined $option{last_modified};  
   my $magic = '';  
   $magic = $1 if $option{content} =~ m/^([^\x0A\x0D]+)/s;  
     
   my $selected = 'default';  
   if ($form{after_edit_cmd}) {  
     $selected = $form{after_edit_cmd};  
   } elsif ($magic =~ /Const|Config|CSS/) {  
     $selected = 'edit';  
   }  
   my $afteredit = <<EOH;  
 <select name="after_edit_cmd">  
 <option value="default" label="@{[&Resource('Edit:SaveAndDefault',escape=>1)]}"@{[$selected eq 'default' ? ' selected="selected"':'']}>@{[&Resource('Edit:SaveAndDefault',escape=>1)]}</option>  
 <option value="read" label="@{[&Resource('Edit:SaveAndView',escape=>1)]}"@{[$selected eq 'read' ? ' selected="selected"':'']}>@{[&Resource('Edit:SaveAndView',escape=>1)]}</option>  
 <option value="edit" label="@{[&Resource('Edit:SaveAndEdit',escape=>1)]}"@{[$selected eq 'edit' ? ' selected="selected"':'']}>@{[&Resource('Edit:SaveAndEdit',escape=>1)]}</option>  
 </select>  
 EOH  
   
 =pod  
   
   my $f = SuikaWiki::Markup::XML->new (namespace_uri => $NS_XHTML1, local_name => 'form');  
     $f->set_attribute (action => SuikaWiki::Plugin->uri ('wiki');  
     $f->set_attribute (method => 'post');  
     if (!$option{conflict}) {  
       for ($f->append_new_node (namespace_uri => $NS_XHTML1, local_name => 'label')) {  
         for ($_->append_new_node (namespace_uri => $NS_XHTML1, local_name => 'input')) {  
           $f->set_attribute (type => 'submit');  
           $f->set_attribute (value => SuikaWiki::Plugin->resource ('Edit:Save'));  
         }  
         #<input type=hidden name=mycmd value=write/>  
         $_->append_new_node (namespace_uri => $NS_XHTML1, local_name => 'kbd', value => 'S');  
       }  
     }  
   
 =cut  
   
   my $f = <<"EOD";  
 <form action="$uri{wiki}" method="post">  
     @{[ $option{conflict} ? '' : qq(<label><input type="submit" value="@{[SuikaWiki::Plugin->resource('Edit:Save',escape=>1)]}" /><kbd>S</kbd></label>) ]}  
     @{[ $option{admin} ? qq(<label>@{[SuikaWiki::Plugin->resource('Edit:Password=',escape=>1)]}<input type="password" name="mypassword" value="" size="10" /></label>) : "" ]} [@{[&get_new_anchor_index($option{content})]}]<br />  
     <input type="hidden" name="myLastModified" value="$option{last_modified}" />  
     <input type="hidden" name="mycmd" value="write" />  
     <input type="hidden" name="mypage" value="@{[SuikaWiki::Plugin->escape($form{mypage})]}" />  
     <textarea cols="@{[SuikaWiki::Plugin->resource('Edit:Form:Cols')+0||35]}" rows="@{[SuikaWiki::Plugin->resource('Edit:Form:Rows')+0||15]}" name="mymsg" tabindex="1"@{[$main::UA =~ m{Mozilla/[0-4]\.} ? ' wrap="virtual"':'']}>@{[SuikaWiki::Plugin->escape($option{content})]}</textarea><br />  
 @{[  
     $option{admin} ?  
     qq(  
     <label><input type="radio" name="myfrozen" value="1" @{[$frozen ? qq(checked="checked") : ""]} />@{[SuikaWiki::Plugin->resource('Edit:Freeze',escape=>1)]}</label>  
     <label><input type="radio" name="myfrozen" value="0" @{[$frozen ? "" : qq(checked="checked")]} />@{[SuikaWiki::Plugin->resource('Edit:DontFreeze',escape=>1)]}</label><br />)  
     : ""  
 ]}  
 @{[  
     $option{conflict} ? "" :  
     qq(  
         <label><input type="checkbox" name="mytouch" value="on" checked="checked" />@{[SuikaWiki::Plugin->resource('Edit:UpdateTimeStamp',escape=>1)]}</label><br />  
         <label><input type="submit" value="@{[SuikaWiki::Plugin->resource('Edit:Save',escape=>1)]}" accesskey="S" /><kbd>S</kbd></label>  
        $afteredit  
     )  
 ]}  
 </form>  
 EOD  
     $f;  
 }  
   
 # [move to SuikaWiki::WikiDB]  
 sub is_editable {  
     my ($page) = @_;  
     return 0 unless SuikaWiki::Name::Space::validate_name ($page);  
     return 0 if $page =~ /[\x00-\x20\[\]\x7F]/;  
     1;  
 }  
   
202  # [move to SuikaWiki::WikiDB]  # [move to SuikaWiki::WikiDB]
203  sub frozen_reject {  sub frozen_reject {
204      my ($isfrozen) = $database->meta (IsFrozen => $form{mypage});      my ($isfrozen) = $main::database->meta (IsFrozen => $main::form{mypage});
205      my ($willbefrozen) = $form{myfrozen};      my ($willbefrozen) = $main::form{myfrozen};
206      if (not $isfrozen and not $willbefrozen) {      if (not $isfrozen and not $willbefrozen) {
207          # You need no check.          # You need no check.
208          return 0;          return 0;
209      } elsif (valid_password($form{mypassword})) {      } elsif (valid_password($main::form{mypassword})) {
210          # You are admin.          # You are admin.
211          return 0;          return 0;
212      } else {      } else {
213          &_do_view_msg (-view => '-error', -page => $form{mypage},          &_do_view_msg (-view => '-error', -page => $main::form{mypage},
214                         error_message => SuikaWiki::Plugin->resource ('Error:PasswordIsIncorrect'));                         error_message => SuikaWiki::Plugin->resource ('Error:PasswordIsIncorrect'));
215          exit;          exit;
216      }      }
# Line 489  sub is_frozen ($) { SuikaWiki::Plugin->_ Line 221  sub is_frozen ($) { SuikaWiki::Plugin->_
221    
222  # [to be obsolete]  # [to be obsolete]
223  sub do_comment {  sub do_comment {
224      my ($content) = $database{$form{mypage}};      my ($content) = $main::database{$main::form{mypage}};
225      my $default_name;   ## this code is not strict.      my $default_name;   ## this code is not strict.
226      $default_name = $1 if $content =~ /default-name="([^"]+)"/;      $default_name = $1 if $content =~ /default-name="([^"]+)"/;
227      my @time = gmtime (time);      my @time = gmtime (time);
228      my $datestr = sprintf '[WEAK[%04d-%02d-%02d %02d:%02d:%02d +00:00]]', $time[5]+1900,$time[4]+1,@time[3,2,1,0];      my $datestr = sprintf '[WEAK[%04d-%02d-%02d %02d:%02d:%02d +00:00]]', $time[5]+1900,$time[4]+1,@time[3,2,1,0];
229      my $namestr = $form{myname} || $default_name || &Resource('WikiForm:WikiComment:DefaultName');      my $namestr = $main::form{myname} || $default_name || &Resource('WikiForm:WikiComment:DefaultName');
230      ($namestr = '', $datestr = '') if $form{myname} eq 'nodate';      ($namestr = '', $datestr = '') if $main::form{myname} eq 'nodate';
231      if ($namestr =~ /^(?:>>)?[0-9]/) {      if ($namestr =~ /^(?:>>)?[0-9]/) {
232        $namestr = qq( ''$namestr'': );        $namestr = qq( ''$namestr'': );
233      } elsif (length $namestr) {      } elsif (length $namestr) {
# Line 505  sub do_comment { Line 237  sub do_comment {
237      my $i = 1;  my $o = 0;      my $i = 1;  my $o = 0;
238      $content =~ s{(\[\[\#r?comment\]\])}{      $content =~ s{(\[\[\#r?comment\]\])}{
239        my $embed = $1;        my $embed = $1;
240        if ($i == $form{comment_index}) {        if ($i == $main::form{comment_index}) {
241          if ($embed ne '[[#rcomment]]') {          if ($embed ne '[[#rcomment]]') {
242            $embed = "- [$anchor] $datestr$namestr$form{mymsg}\n$embed";  $o = 1;            $embed = "- [$anchor] $datestr$namestr$main::form{mymsg}\n$embed";  $o = 1;
243          } else {          } else {
244            $embed .= "\n- [$anchor] $datestr$namestr$form{mymsg}";  $o = 1;            $embed .= "\n- [$anchor] $datestr$namestr$main::form{mymsg}";  $o = 1;
245          }          }
246        }        }
247        $i++; $embed;        $i++; $embed;
# Line 517  sub do_comment { Line 249  sub do_comment {
249      unless ($o) {      unless ($o) {
250        $content = "#?SuikaWiki/0.9\n\n" unless $content;        $content = "#?SuikaWiki/0.9\n\n" unless $content;
251        $content .= "\n" unless $content =~ /\n$/s;        $content .= "\n" unless $content =~ /\n$/s;
252        $content .= "- [$anchor] $datestr$namestr$form{mymsg}\n";        $content .= "- [$anchor] $datestr$namestr$main::form{mymsg}\n";
253      }      }
254      $form{__comment_anchor_index} = $anchor;      $main::form{__comment_anchor_index} = $anchor;
255      if ($form{mymsg} || $form{myname}) {      if ($main::form{mymsg} || $main::form{myname}) {
256          $form{mymsg} = $content;          $main::form{mymsg} = $content;
257          $form{mytouch} = 'on';          $main::form{mytouch} = 'on';
258          &do_write;          &do_write;
259      } else {    ## Don't write      } else {    ## Don't write
260          $form{mycmd} = 'default';          #$main::form{mycmd} = 'default';
261          &do_view;          #&do_view;
262          die "No comment specified";
263      }      }
264  }  }
265    
# Line 540  sub get_new_anchor_index ($) { Line 273  sub get_new_anchor_index ($) {
273    
274  # [move to SuikaWiki::Plugin::WikiForm]  # [move to SuikaWiki::Plugin::WikiForm]
275  sub do_wikiform {  sub do_wikiform {
276      my $content = $database{$form{mypage}};      my $content = $main::database{$main::form{mypage}};
277      my $anchor = &get_new_anchor_index ($content);      my $anchor = &get_new_anchor_index ($content);
278      my $write = 0;      my $write = 0;
279      my $i = 1;      my $i = 1;
280      $content =~ s{$embed_command{form}}{      $content =~ s{$embed_command{form}}{
281          my ($embed, $wfname, $template, $option) = ($&, $1, $3, $4);          my ($embed, $wfname, $template, $option) = ($&, $1, $3, $4);
282          if (($wfname && $wfname eq $form{wikiform_targetform})          if (($wfname && $wfname eq $main::form{wikiform_targetform})
283              || $i == $form{wikiform_index}) {              || $i == $main::form{wikiform_index}) {
284              $template =~ s/\\([\\'])/$1/g;              $template =~ s/\\([\\'])/$1/g;
285              $option =~ s/\\([\\'])/$1/g;              $option =~ s/\\([\\'])/$1/g;
286              my $param = bless {depth=>10}, 'SuikaWiki::Plugin';              my $param = bless {depth=>10}, 'SuikaWiki::Plugin';
287              $param->{page} = $form{mypage};              $param->{page} = $main::form{mypage};
288              $param->{form_index} = $i;              $param->{form_index} = $i;
289              $param->{form_name} = $wfname;              $param->{form_name} = $wfname;
290              $param->{anchor_index} = $anchor;              $param->{anchor_index} = $anchor;
291              $param->{argv} = \%form;              $param->{argv} = \%main::form;
292              $param->{default_name} = $1 if $content =~ /default-name="([^"]+)"/;              $param->{default_name} = $1 if $content =~ /default-name="([^"]+)"/;
293              $param->{default_name} ||= &Resource('WikiForm:WikiComment:DefaultName');              $param->{default_name} ||= &Resource('WikiForm:WikiComment:DefaultName');
294              SuikaWiki::Plugin->formatter ('form_option')->replace ($option, $param);              SuikaWiki::Plugin->formatter ('form_option')->replace ($option, $param);
# Line 571  sub do_wikiform { Line 304  sub do_wikiform {
304                      $embed = $t . "\n" . $embed;                      $embed = $t . "\n" . $embed;
305                  }                  }
306                  $write = 1;                  $write = 1;
307                  $form{__comment_anchor_index} = $anchor                  $main::form{__comment_anchor_index} = $anchor
308                    if $param->{anchor_index_};  ## $anchor is used!                    if $param->{anchor_index_};  ## $anchor is used!
309              }              }
310              $form{__wikiform_anchor_index} = $i;              $main::form{__wikiform_anchor_index} = $i;
311              undef $form{wikiform_targetform};  ## Make sure never to match              undef $main::form{wikiform_targetform};  ## Make sure never to match
312              undef $form{wikiform_index};       ## with WikiForm in rest of page!              undef $main::form{wikiform_index};       ## with WikiForm in rest of page!
313          }          }
314          $i++; $embed;          $i++; $embed;
315      }ge;      }ge;
# Line 586  sub do_wikiform { Line 319  sub do_wikiform {
319        #        #
320      }      }
321      if ($write) {      if ($write) {
322          $form{mymsg} = $content;          $main::form{mymsg} = $content;
323          $form{mytouch} = 'on';          $main::form{mytouch} = 'on';
324          &do_write;          &do_write;
325      } else {    ## Don't write!      } else {    ## Don't write!
326          $form{mycmd} = 'default';          #$main::form{mycmd} = 'default';
327          &do_view;          #&do_view;
328          die "No content specified";
329      }      }
330  }  }
331    
332  # [to be obsolete] ->Message::MIME::Charset  # [to be obsolete] ->Message::MIME::Charset
333  sub code_convert {  sub code_convert {
334    require Jcode;    require Jcode;
335      my ($contentref, $code, $srccode) = (shift, shift || $kanjicode, shift || undef);    my ($contentref, $code, $srccode) = @_;
336      if    ($code =~ /euc/) { $code = 'euc' }    $code ||= $WIKI->{config}->{charset}->{internal};
337      elsif ($code =~ /iso/) { $code = 'jis' }    for ($code, $srccode) {
338      elsif ($code =~ /shi/) { $code = 'sjis' }      if    ($_ eq 'euc-jp') { $_ = 'euc' }
339      elsif ($code =~ /utf/) { $code = 'utf8' }      elsif ($_ eq 'iso-2022-jp') { $_ = 'jis' }
340      $$contentref = Jcode->new ($contentref, $srccode)->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;      elsif ($_ eq 'utf-8') { $_ = 'utf8' }
341      return $$contentref;      elsif ($_ eq 'shift_jis') { $_ = 'sjis' }
342      }
343      $$contentref = Jcode->new ($contentref, $srccode)
344        ## Normalize FULLWIDTH characters and IDEOGRAPHIC SPACE
345                          ->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\xA1\xE4\xA1\xE3\xA1\xA1\xA2\xAF\xA2\xB0\xA2\xB2\xA2\xB1\xA1\xA1\xC0" => q(0-9A-Za-z&,.:;?!`^_/|()[]{}+$%#*@=>< '"~-))
346                          ->tr (qq(\x8E\xDE\x8E\xDF) => qq(\xA1\xAB\xA1\xAC))
347                          ->h2z
348                          ->$code;
349      return $$contentref;
350  }  }
351    
352  # [to be obsolete] ->Message::Field::Date  # [to be obsolete] ->Message::Field::Date
# Line 613  sub _rfc3339_date ($) { Line 355  sub _rfc3339_date ($) {
355    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];
356  }  }
357    
358  # [obsolete] ->SuikaWiki::SrcFormat  # [obsolete] ->SuikaWiki::SrcFormat : SuikaWiki09 plugin
359  sub convert_format ($$$;%) {  sub convert_format ($$$;%) {
360    my ($content, $d => $t, %option) = @_;    my ($content, $d => $t, %option) = @_;
361    my $f = SuikaWiki::Plugin->format_converter ($d => $t);    my $f = SuikaWiki::Plugin->format_converter ($d => $t);
# Line 637  sub convert_format ($$$;%) { Line 379  sub convert_format ($$$;%) {
379    }    }
380  }  }
381    
382    package wiki::transitional::uri_param;
383    require Tie::Hash;
384    our @ISA = 'Tie::Hash';
385    
386  package main;  sub TIEHASH ($@) {
387    $WIKI->init_plugin;    bless {http => $_[1]}, $_[0];
388    $WIKI->{var}->{client}->{user_agent_name} = $main::ENV{HTTP_USER_AGENT};  }
   $main::UA = $main::ENV{HTTP_USER_AGENT};  
   $WIKI->{var}->{client}->{used_for_negotiate} = ['User-Agent'];  
   $WIKI->{var}->{db}->{read_only}->{'#default'} = 1;  
389    
390    &init_form;  sub FETCH ($$) {
391      my ($self, $key) = @_;
392      exists $self->{val}->{$key} ?
393        $self->{val}->{$key}:
394        $self->{http}->parameter ($key);
395    }
396    
397    sub STORE ($$$) {
398      my ($self, $key, $val) = @_;
399      $self->{val}->{$key} = $val;
400    }
401    
402    sub DELETE ($$) {
403      my ($self, $key) = @_;
404      $self->{val}->{$key} = undef;
405    }
406    
407    sub EXISTS ($$) {
408      my ($self, $key) = @_;
409      exists $self->{val}->{$key} ?
410        1:
411        defined $self->{http}->parameter ($key);
412    }
413    
414    package main;
415      push @{$WIKI->{event}->{setting_initial_variables}}, sub {
416        my $wiki = shift;
417        $wiki->{implementation_version} = 'pl'.$VERSION;
418        
419        ## Error output
420        require SuikaWiki::Output::CGICarp;
421        $SuikaWiki::Output::CGICarp::CUSTOM_REASON_TEXT
422          = 'Internal WikiEngine Error';
423        CGI::Carp::set_message (sub {
424          my $msg = shift;
425          #$msg =~ s/&/&amp;/g;
426          #$msg =~ s/</&lt;/g;
427          my $wiki_name_version = $wiki->{implementation_name} .'/'. $wiki->version;
428          for ($wiki_name_version) { s/&/&amp;/g; s/</&lt;/g;
429                                     s/([^\x20-\x7E])/sprintf '&#x%02X;',
430                                                              ord $1/g; };
431          print STDOUT <<EOH
432    <!DOCTYPE html SYSTEM>
433    <title>500 Internal WikiEngine Error</title>
434    <h1>Internal WikiEngine Error</h1>
435    <p>$msg</p>
436    <address>$wiki_name_version</address>
437    EOH
438        });
439        
440        $wiki->{var}->{db}->{read_only}->{'#default'} = 1;
441        
442        require SuikaWiki::Input::HTTP;
443        $wiki->{input} = SuikaWiki::Input::HTTP->new;
444        $wiki->{input}->{decoder}->{'#default'} = sub {
445          my ($http, $s, $temp_params) = @_;
446          return main::code_convert (\$s, undef, # internal code
447                                     @{$temp_params->{ie}||[]}[0]
448                                     || $wiki->{config}->{charset}->{uri_param});
449        };
450        $wiki->{var}->{client}->{user_agent_name}
451          = $wiki->{input}->meta_variable ('HTTP_USER_AGENT');
452        $wiki->{var}->{client}->{used_for_negotiate} = ['User-Agent'];
453        
454        ## TODO: PATH_INFO support
455        my $page = $wiki->{input}->meta_variable ('QUERY_STRING');
456        if ($page && !(index ($page, '=') > -1)) {
457          $page =~ tr/+/ /;
458          $page =~ s/%([0-9A-Fa-f][0-9A-Fa-f])/pack 'C', hex $1/ge;
459          $page = main::code_convert
460            (\$page, undef, # internal code
461             $wiki->{config}->{charset}->{uri_query});
462        } else {
463          $page = $wiki->{input}->parameter ('mypage');
464        }
465        
466    
467        ## TODO: SuikaWiki 3 WikiName
468        $page =~ tr/\x00-\x20\x7F//d;
469        $page = SuikaWiki::Name::Space::normalize_name ($page);
470        if ($page) {
471          $wiki->{var}->{page} = [split '//', $page];
472        } else {
473          $wiki->{var}->{page} = $wiki->{config}->{page}->{Default};
474        }
475    
476        ## Mode
477        my $mode = $wiki->{input}->parameter ('mode')
478                || $wiki->{input}->parameter ('mycmd') ## for compatibility with
479                || 'default';                          ## YukiWiki and SuikaWiki 2
480        $mode =~ tr/-/_/;
481        if ($mode eq 'default' || $mode =~ /[^0-9A-Za-z_]/) {
482          ## BUG: this code is not strict
483          my $cookie = $wiki->{input}->meta_variable ('HTTP_COOKIE');
484          if ($cookie =~ /SelectedMode=([0-9A-Za-z_-]+)/) {
485            $mode = $1; $mode =~ tr/-/_/;
486          } else {
487            $mode = 'read';
488          }
489          push @{$wiki->{var}->{client}->{used_for_negotiate}}, 'Cookie';
490        }
491        $wiki->{var}->{mode} = $mode;
492        
493        ## Transitional variables
494        tie %main::form, 'wiki::transitional::uri_param', $wiki->{input};
495        $main::UA = $wiki->{var}->{client}->{user_agent_name};
496        $main::form{mypage} = join '//', @{$wiki->{var}->{page}};
497        $main::form{mycmd} = $mode;
498      };
499      
500      $WIKI->init_variables;
501      
502      $WIKI->init_plugin;
503    $WIKI->init_view;    $WIKI->init_view;
504    $WIKI->{plugin}->use_type ('view-definition');    $WIKI->{plugin}->use_type ('view-definition');
505    $WIKI->{view}->register_common_modes;    $WIKI->{view}->register_common_modes;
506        my $opt = {condition => {mode => $WIKI->{var}->{mode}, output => 'http-cgi',
507    ## Mode                             http_method => $main::ENV{REQUEST_METHOD}}};
508    my $mode = $main::form{mycmd};    my $viewobj = $WIKI->{view}->instantiate ($WIKI->{var}->{mode}, $opt);
   if (!$mode || $mode eq 'default' || $mode =~ /[^0-9A-Za-z_]/) {  
     ## BUG: this code is not strict  
     if ($main::ENV{HTTP_COOKIE} =~ /SelectedMode=([0-9A-Za-z_-]+)/) {  
       $mode = $1; $mode =~ tr/-/_/;  
     } else {  
       $mode = 'read';  
     }  
     push @{$WIKI->{var}->{client}->{used_for_negotiate}}, 'Cookie';  
   }  
   my $opt = {condition => {mode => $mode, output => 'http-cgi'}};  
   $WIKI->{var}->{mode} = $mode;  
   $WIKI->{var}->{page} = [split m!//!, $main::form{mypage}];  
   my $viewobj = $WIKI->{view}->instantiate ($mode, $opt);  
509    $viewobj->main ($opt); ## TODO: or unsupported mode    $viewobj->main ($opt); ## TODO: or unsupported mode
510    
511  exit;  exit;
Legend:
Removed from v.1.14  
changed lines
  Added in v.1.15
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24