/[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.8 by wakaba, Sat May 31 07:01:46 2003 UTC revision 1.9 by w, Thu Jul 17 23:59:12 2003 UTC
# Line 6  our $VERSION = '2.'.do{my @r=(q$Revision Line 6  our $VERSION = '2.'.do{my @r=(q$Revision
6  binmode STDOUT; binmode STDIN;  binmode STDOUT; binmode STDIN;
7  use Fcntl;  use Fcntl;
8  require SuikaWiki::Plugin;  require SuikaWiki::Plugin;
 our %fmt;       ## formatter objects  
9  our %embed_command = (  our %embed_command = (
10          form    => qr/\[\[\#form(?:\(([A-Za-z0-9-]+)\))?:'((?:[^'\\]|\\.)*)':'((?:[^'\\]|\\.)*)'(?::'((?:[^'\\]|\\.)*)')?\]\]/,          form    => qr/\[\[\#form(?:\(([A-Za-z0-9-]+)\))?:'((?:[^'\\]|\\.)*)':'((?:[^'\\]|\\.)*)'(?::'((?:[^'\\]|\\.)*)')?\]\]/,
11  );  );
12  our ($modifier_dbtype,$url_cgi,%uri,%PathTo);  our ($modifier_dbtype,%uri,%PathTo,%PageName,$kanjicode);
 our (%PageName,$kanjicode,$lang);  
13    
14  our %form;  our %form;
15  our %database;  our %database;
16  our $database = bless {}, 'wiki::dummy';  our $database = bless {}, 'wiki::dummy';
 our %interwiki;  
17  my %command_do = (  my %command_do = (
18      default => \&do_view,      default => \&do_view,
19      adminchangepassword => \&do_adminchangepassword,      adminchangepassword => \&do_adminchangepassword,
20      write => \&do_write,      write => \&do_write,
     searchform => \&do_searchform,  
21      comment => \&do_comment,      comment => \&do_comment,
22      RandomJump  => \&do_random_jump,      RandomJump  => sub {
23          my @list = keys %main::database;
24          &main::_http_see_other (page => $list[rand @list]);
25        },
26      wikiform    => \&do_wikiform,      wikiform    => \&do_wikiform,
27  );  );
28  our $UA = '';  ## User agent name  our $UA = '';  ## User agent name
29  $| = 1;  $| = 1;
30  SuikaWiki::Plugin->feature ('SuikaWiki::View');  require SuikaWiki::Name::Space;
 SuikaWiki::Plugin->feature ('SuikaWiki::Name::Space');  
 SuikaWiki::Plugin->feature ('SuikaWiki::Markup::XML');  
 SuikaWiki::Plugin->feature ('Yuki::YukiWikiCache');  
31  my $NS_XHTML1 = 'http://www.w3.org/1999/xhtml';  my $NS_XHTML1 = 'http://www.w3.org/1999/xhtml';
32    
33  sub main {  sub _wiki_exit () {
     $UA = $main::ENV{HTTP_USER_AGENT};  
     &open_db;  
     &init_form;  
     for (@{$SuikaWiki::Plugin::On{WikiDatabaseLoaded}||[]}) {  
       &{$_};  
     }  
     if ($command_do{$form{mycmd}}) {  
         &{$command_do{$form{mycmd}}};  
     } else {  
         &{$command_do{default}};  
     }  
34      &close_db;      &close_db;
35        exit;
36  }  }
37    
38  sub do_view {  sub do_view {
39      require SuikaWiki::View;
40    my $content = $main::database{$main::form{mypage}};    my $content = $main::database{$main::form{mypage}};
41    my $lm = SuikaWiki::Plugin->_database->mtime ($main::form{mypage});    my $lm = SuikaWiki::Plugin->_database->mtime ($main::form{mypage});
42      ## Determine mode
43      my $view = $form{mycmd};      my $view = $form{mycmd};
44      $view = 'default' if $view =~ /[^0-9A-Za-z_]/;      if (!$view || $view eq 'default' || $view =~ /[^0-9A-Za-z_]/) {
     if ($view eq 'default' || !$view) {  
45        ## BUG: this code is not strict        ## BUG: this code is not strict
46        if ($main::ENV{HTTP_COOKIE} =~ /SelectedMode=([0-9A-Za-z]+)/) {        if ($main::ENV{HTTP_COOKIE} =~ /SelectedMode=([0-9A-Za-z_-]+)/) {
47          $view = $1;          $view = $1; $view =~ tr/-/_/;
48        } else {        } else {
49          $view = 'read';          $view = 'read';
50        }        }
51      }      }
52      ## Get content and its meta info
53    my ($magic, $content) = SuikaWiki::Plugin->magic_and_content ($content);    my ($magic, $content) = SuikaWiki::Plugin->magic_and_content ($content);
54    $magic ||= '#?SuikaWiki/0.9';    $magic ||= '#?SuikaWiki/0.9';
55    my $o = bless {param => \%main::form, page => $main::form{mypage}, toc => [],    my $o = bless {param => \%main::form, page => $main::form{mypage}, toc => [],
56                   magic => $magic, content => $content,                   magic => $magic, content => $content,
57                   formatter => $fmt{view}, &main::_compatible_options ()}, 'SuikaWiki::Plugin';                   &main::_compatible_options ()}, 'SuikaWiki::Plugin';
58    my $view_def = SuikaWiki::View->definition ($view);    my $view_def = SuikaWiki::View->definition ($view);
59    if (!$view_def->check ($o)) {    if (!$view_def->check ($o)) {
60      print "Status: 406 Unsupported Media Type\n";      print "Status: 406 Unsupported Media Type\n";
61      $view = '-UnsupportedMediaType';      $view = '-UnsupportedMediaType';
62      $view_def = SuikaWiki::View->definition ($view);      $view_def = SuikaWiki::View->definition ($view);
63    }    }
64    my $media = $view_def->properties->{media};    my $prop = $view_def->properties;
65    if ($view_def->properties->{xmedia} && $UA =~ /Gecko/) {    my $media = $prop->{media};
66      $media = $view_def->properties->{xmedia};    if ($prop->{xmedia} && $main::UA =~ /Gecko/) {        ## TODO: conneg
67        $media = $prop->{xmedia};
68      $o->{media} = $media;      $o->{media} = $media;
69    } elsif ($main::UA =~ m#Mozilla/0\..+Windows#) {    } elsif ($main::UA =~ m#Mozilla/0\..+Windows#) {
70      $main::kanjicode = 'shift_jis';      $main::kanjicode = 'shift_jis';
71    }    }
72      
73      if ($prop->{preprocess}) {
74        _wiki_exit () unless &{$prop->{preprocess}} (o => $o);
75      }
76      
77      ## Output CGI/HTTP headers
78      if ($magic =~ m!^\#\?SuikaWiki/0.9!) {      if ($magic =~ m!^\#\?SuikaWiki/0.9!) {
79        &main::print_header ($main::form{mypage}, -last_modified => ($magic =~ /interactive="yes"/ ? time : $lm),        &main::print_header ($main::form{mypage},
80            -last_modified => ($magic =~ /interactive="yes"/ ? time : $lm),
81          -expires => ($magic =~ /interactive="yes"/ ? 1 : undef), o => $o,          -expires => ($magic =~ /interactive="yes"/ ? 1 : undef), o => $o,
82          -media => $media, -magic => $magic,  content => $content);          -media => $media, -view => $view_def, -magic => $magic,  content => $content);
83      } else {      } else {
84        &main::print_header($main::form{mypage}, -media => $media,        &main::print_header($main::form{mypage}, -media => $media, -view => $view_def,
85                                     -magic => $magic, -last_modified => $lm, o => $o);                                     -magic => $magic, -last_modified => $lm, o => $o);
86      }      }
87      ## Output HTTP message body
88    my $fmt = SuikaWiki::Plugin->formatter ('view');    my $fmt = SuikaWiki::Plugin->formatter ('view');
89    if ($main::kanjicode ne 'euc') {    my $s = $fmt->replace ($view_def->as_string => $o, {formatter => $fmt});
90      my $s = $fmt->replace ($view_def->as_string => $o, {formatter => $fmt});    if ($main::kanjicode eq 'euc') {
91      print &main::code_convert (\$s => $main::kanjicode);      #require Compress::Zlib;
92        #print scalar Compress::Zlib::memGzip (''.$s);
93        print $s;
94    } else {    } else {
95      print $fmt->replace ($view_def->as_string => $o, {formatter => $fmt});      $s .= '';
96        print &main::code_convert (\$s => $main::kanjicode);
97    }    }
98  }  }
99    
100  sub _do_view_msg (%) {  sub _do_view_msg (%) {
101      require SuikaWiki::View;
102    my %option = @_;    my %option = @_;
103    &load_formatter ('view');    my $o = $option{-o} || bless {param => \%form, page => $option{-page},
104    my $o = bless {param => \%form, page => $option{-page}, toc => [], condition => \%option,                                  &_compatible_options ()}, 'SuikaWiki::Plugin';
105                   formatter => $fmt{view}, &_compatible_options ()}, 'SuikaWiki::Plugin';    $o->{toc} = [];
106      $o->{condition} = \%option;   ## This parameter really used??
107    my $view_def = SuikaWiki::View->definition ($option{-view});    my $view_def = SuikaWiki::View->definition ($option{-view});
108    unless ($view_def->check ($o)) {    unless ($view_def->check ($o)) {
109      print "Status: 406 Unsupported Media Type\n";      print "Status: 406 Unsupported Media Type\n";
110      $option{-view} = '-UnsupportedMediaType';      $option{-view} = '-UnsupportedMediaType';
111      $view_def = SuikaWiki::View->definition ($option{-view});      $view_def = SuikaWiki::View->definition ($option{-view});
112    }    }
113    my $media = $view_def->properties->{media};    my $prop = $view_def->properties;
114    if ($view_def->properties->{xmedia} && $UA =~ /Gecko/) {    my $media = $prop->{media};
115      $media = $view_def->properties->{xmedia};    if ($prop->{xmedia} && $UA =~ /Gecko/) {
116        $media = $prop->{xmedia};
117      $o->{media} = $media;      $o->{media} = $media;
118    }    }
119    &print_header($option{-page}, -media => $media, o => $o, -goto => $option{-goto});    &print_header($option{-page}, -media => $media, -view => $view_def, o => $o, -goto => $option{-goto});
120    print $fmt{view}->replace ($view_def->as_string => $o, {formatter => $fmt{view}});    ## Output HTTP message body
121      my $fmt = SuikaWiki::Plugin->formatter ('view');
122      my $s = $fmt->replace ($view_def->as_string => $o, {formatter => $fmt});
123      if ($main::kanjicode eq 'euc') {
124        print $s;
125      } else {
126        print &main::code_convert (\$s => $main::kanjicode);
127      }
128  }  }
129    
130    # [move to SuikaWiki::Plugin::WikiAdmin]
131  sub do_adminchangepassword {  sub do_adminchangepassword {
132      if ($form{mynewpassword} ne $form{mynewpassword2}) {      if ($form{mynewpassword} ne $form{mynewpassword2}) {
133          &_do_view_msg (-view => '-error', -page => $form{mypage},          &_do_view_msg (-view => '-error', -page => $form{mypage},
# Line 141  sub do_adminchangepassword { Line 152  sub do_adminchangepassword {
152      &_do_view_msg (-view => '-wrote', -page => $form{mypage});      &_do_view_msg (-view => '-wrote', -page => $form{mypage});
153  }  }
154    
155    # [move to SuikaWiki::WikiDB]
156  sub valid_password ($) {  sub valid_password ($) {
157      my ($validpassword_crypt) = $database->meta (AdminPassword => $PageName{AdminSpecialPage});      my ($validpassword_crypt) = $database->meta (AdminPassword => $PageName{AdminSpecialPage});
158      return crypt (shift, $validpassword_crypt) eq $validpassword_crypt ? 1 : 0;      return crypt (shift, $validpassword_crypt) eq $validpassword_crypt ? 1 : 0;
159  }  }
160    
161    # [move to SuikaWiki::Plugin::WikiEdit]
162  sub do_write {  sub do_write {
163      if (&frozen_reject()) {      if (&frozen_reject()) {
164          return;          return;
# Line 170  sub do_write { Line 183  sub do_write {
183            $database->STORE ($form{mypage} => $form{mymsg}, -touch => 0);            $database->STORE ($form{mypage} => $form{mymsg}, -touch => 0);
184          }          }
185          $database->meta (IsFrozen => $form{mypage} => 0 + $form{myfrozen});          $database->meta (IsFrozen => $form{mypage} => 0 + $form{myfrozen});
186          my $fragment = '';          my $uri = SuikaWiki::Plugin->_uri_wiki_page ($form{mypage}, mode => ($form{after_edit_cmd}||'default'), with_lm => 1);
187          $fragment .= qq(;after_edit_cmd=@{[&encode($form{after_edit_cmd})]}) if $form{after_edit_cmd};          $uri .= qq(;after_edit_cmd=@{[SuikaWiki::Plugin->encode($form{after_edit_cmd})]}) if $form{after_edit_cmd};
188          if ($form{__comment_anchor_index}) {          if ($form{__comment_anchor_index}) {
189              $fragment .= qq(#anchor-$form{__comment_anchor_index});              $uri .= qq(#anchor-$form{__comment_anchor_index});
190          } elsif ($form{__wikiform_anchor_index}) {          } elsif ($form{__wikiform_anchor_index}) {
191              $fragment .= qq(#wikiform-$form{__wikiform_anchor_index});              $uri .= qq(#wikiform-$form{__wikiform_anchor_index});
192          }          }
193          &_do_view_msg (-view => '-wrote', -page => $form{mypage}, -goto => $url_cgi.'?mycmd='.&encode($form{after_edit_cmd}||'default').';mypage='.&encode($form{mypage}).qq(;x-param=@{[time.[0..9]->[rand 10]]}$fragment));          &_http_see_other (uri => $uri, page => $form{mypage}, alternate_view => '-wrote');
194      } else {      } else {
195          delete $database{$form{mypage}};          delete $database{$form{mypage}};
196          &_do_view_msg (-view => '-deleted', -page => $form{mypage});          &_do_view_msg (-view => '-deleted', -page => $form{mypage});
197      }      }
198  }  }
199    
200  sub _compatible_options () {  sub _http_see_other (%) {
201    (use_anchor_name => ($UA =~ m#Mozilla/[12]\.|Microsoft Internet Explorer# ? 1 : 0));    my %o = @_;
202      $o{uri} ||= SuikaWiki::Plugin->_uri_wiki_page ($o{page});
203      if ($o{alternate_view} && ($main::ENV{SERVER_PROTOCOL} eq 'HTTP/0.9'
204                              || $main::ENV{SERVER_PROTOCOL} eq 'HTTP/1.0')) {
205        &_do_view_msg (-view => $o{alternate_view}, -page => $o{page}, -goto => $o{uri}, -o => $o{o});
206      } else {
207        my $euri = SuikaWiki::Plugin->escape ($o{uri});
208        print qq(Status: 303 See Other
209    Location: $o{uri}
210    Content-Type: text/html
211    Content-Language: en
212    
213    <!DOCTYPE p SYSTEM>
214    <p>See &lt;<a href="$euri">$euri</a>&gt;</p>);
215      }
216      _wiki_exit ();
217  }  }
218    
219  sub do_random_jump {  sub _compatible_options () {
220    my @list = keys %main::database;    (use_anchor_name => ($main::UA =~ m#Mozilla/[12]\.|Microsoft Internet Explorer# ? 1 : 0));
   print "Location: ".SuikaWiki::Plugin->_uri_wiki_page ($list[rand @list])."\n";  
   print "\n";  
221  }  }
222    
223    
224    
225  sub print_header ($;%) {  sub print_header ($;%) {
226      my ($page, %option) = @_;      my ($page, %option) = @_;
227        if ($main::ENV{HTTP_IF_MODIFIED_SINCE} && $option{-last_modified}) {
228          ## TODO: use Message::Field::Date
229          if ($option{-view}->properties->{if}->{modified_since}
230           && $main::ENV{HTTP_IF_MODIFIED_SINCE} =~ /([0-9]{1,2})\s*([A-Za-z]{3})\s*([0-9]{2,4})\s*([0-9]{2}):([0-9]{2}):([0-9]{2})\s*[Gg][Mm][Tt]/) {
231              require Time::Local;
232              my ($d, $M, $y, $h, $m, $s) = ($1, $2, $3, $4, $5, $6);
233              $M = {jan=>0,feb=>1,mar=>2,apr=>3,may=>4,jun=>5,jul=>6,aug=>7,sep=>8,oct=>9,nov=>10,dec=>11}->{lc $M};
234              #$y += 1900 if $y < 100;      ## BUG: don't conform HTTP spec
235              my $t = Time::Local::timegm_nocheck ($s, $m, $h, $d, $M, $y);
236              if ($option{-last_modified} <= $t) {
237                print "Status: 304 Not Modified\n\n";
238                _wiki_exit ();
239              }
240          }
241        }
242      my $UA = SuikaWiki::Plugin->user_agent_names;      my $UA = SuikaWiki::Plugin->user_agent_names;
243      $option{o}->{-header}->{class}->{frozen} = 1 if &main::is_frozen ($page);      $option{o}->{-header}->{class}->{frozen} = 1 if &main::is_frozen ($page);
244      $option{o}->{-header}->{class}->{'wiki-page-obsoleted'} if $option{-magic} =~ /obsoleted="yes"/;      $option{o}->{-header}->{class}->{'wiki-page-obsoleted'} = 1 if $option{-magic} =~ /obsoleted="yes"/;
245      $option{o}->{-header}->{additional_html_element} ||= SuikaWiki::Markup::XML->new (type => '#fragment');      $option{o}->{-header}->{additional_html_element} ||= SuikaWiki::Markup::XML->new (type => '#fragment');
246        print "Vary: Negotiate,User-Agent,Accept-Language,Accept\n";
247      if ($option{-goto}) {      if ($option{-goto}) {
248        if ($UA =~ m#Opera|MSIE 2\.#) {        if ($UA =~ m#Opera|MSIE 2\.#) {
249          ## 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.
# Line 251  sub print_header ($;%) { Line 295  sub print_header ($;%) {
295      } else {      } else {
296      ## Modern UAs and Media types with charset parameter      ## Modern UAs and Media types with charset parameter
297        my $type = $option{-media}->{type};        my $type = $option{-media}->{type};
298        $type = 'application/xml' if ($type =~ m!^application/(?:rdf|rss)\+xml$!) && ($UA =~ m#Gecko#);        $type = 'application/xml' if ($type =~ m!^application/r(?:df|ss)\+xml$!) && ($UA =~ m#Gecko#);
299        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};
300        ## meta element is not needed        ## meta element is not needed
301      }      }
     #if ($main::ENV{HTTP_IF_MODIFIED_SINCE}) {  
       ## TODO: IMS support  
     #}  
302            
     ## TODO: more Vary: support  
303      print <<"EOD";      print <<"EOD";
 Vary: Negotiate,User-Agent,Accept-Language,Accept-Type  
304  Content-Style-Type: text/css  Content-Style-Type: text/css
305    
306  EOD  EOD
# Line 279  sub get_charset_name ($;%) { Line 318  sub get_charset_name ($;%) {
318      $charset;      $charset;
319  }  }
320    
321  sub escape {  =pod
     my $s = shift;  
     $s =~ s|&|&amp;|g;  
     $s =~ s|<|&lt;|g;  
     $s =~ s|>|&gt;|g;  
     $s =~ s|"|&quot;|g;  
     $s =~ s/([\x00-\x08\x0B\x0C\x0E-\x1F])/sprintf '&amp;#%d;', ord $1/ge;  
         ## XML unsafe control chars  
     return $s;  
 }  
   
 sub unescape {  
     my $s = shift;  
     $s =~ s|&lt;|<|g;  
     $s =~ s|&gt;|>|g;  
     $s =~ s|&quot;|"|g;  
     $s =~ s|&amp;|&|g;  
     return $s;  
 }  
322    
323  sub convert_format ($$$;%) {  sub _decode_argv () {
324    my ($content, $d => $t, %option) = @_;    my $QS = $main::ENV{QUERY_STRING};
325    my $f = SuikaWiki::Plugin->format_converter ($d => $t);    if ($main::ENV{PATH_INFO}) {
326    if (ref $f) {    die;
327      $option{content} = $content;    # new format: not implemented yet
     $option{from} = $d;  
     $option{to} = $t;  
     &$f ({}, bless (\%option, 'SuikaWiki::Plugin'));  
   } elsif ($option{-error_no_return}) {  
     return undef;  
   } elsif ($t =~ /HTML|xml/) {  
     if (length $content) {  
       my $r = SuikaWiki::Markup::XML->new (namespace_uri => $NS_XHTML1, local_name => 'pre');  
       return $r->append_text ($content);  
     } else {  
       return '';  
     }  
328    } else {    } else {
329      $content;      my %argv;
330        if ($QS =~ /[&;=]/) {       ## ?FOO=foo;BAR=bar;BAZ=baz
331          for (split /[;&]/, $QS) {
332            if (my ($n, $v) = split /=/, $_, 2) {
333              for ($n, $v) {tr/+/ /; s/%([0-9A-Fa-f][0-9A-Fa-f])/pack 'HH', $1/ge};
334              $argv{$n} = $v;
335            }
336          }
337        } else {    ## ?FOO-BAR
338          $argv{page} = $QS;
339          $argv{page} =~ tr/+/ /;
340          $argv{page} =~ s/%([0-9A-Fa-f][0-9A-Fa-f])/pack 'HH', $1/ge;
341        }
342        my $ie = $argv{ie}; ## Input coding system
343        for ([qw/mypage page/], [qw/mycmd mode/]) {
344          $argv{$_->[1]} ||= $argv{$_->[0]};
345          delete $argv{$_->[0]};
346        }
347        for (keys %argv) {
348          $argv{$_} = main::code_convert ($argv{$_}, $main::kanjicode, $ie);
349        }
350        for ([qw/mypage page/], [qw/mycmd mode/]) {
351          $argv{$_->[0]} = $argv{$_->[1]};
352        }
353    }    }
354  }  }
355    
356    =cut
357    
358  sub init_form {  sub init_form {
359      ## TODO: Support multipart/form-data      ## TODO: Support multipart/form-data
# Line 330  sub init_form { Line 363  sub init_form {
363         || lc ($main::ENV{CONTENT_TYPE}) eq 'application/sgml-form-urlencoded') {         || lc ($main::ENV{CONTENT_TYPE}) eq 'application/sgml-form-urlencoded') {
364          read STDIN, $query, $main::ENV{CONTENT_LENGTH};          read STDIN, $query, $main::ENV{CONTENT_LENGTH};
365        } else {        } else {
366          $form{mycmd} = '___unsupported_media_type___';          $main::form{mycmd} = '___unsupported_media_type___';
367          $form{mypage} = $PageName{FrontPage};          $main::form{mypage} = $main::PageName{FrontPage};
368          return;          return;
369        }        }
370      }      }
371      $query .= ($query ? ';' : '') . $main::ENV{QUERY_STRING};      $query .= ($query ? ';' : '') . $main::ENV{QUERY_STRING};
372      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} !~ /[&;=]/) {
373        my $query = &decode($main::ENV{QUERY_STRING});        my $query = SuikaWiki::Plugin->decode ($main::ENV{QUERY_STRING});
374        $query = &code_convert(\$query, $kanjicode);        $query = &main::code_convert (\$query, $main::kanjicode);
375          $form{mypage} = $query;          $main::form{mypage} = $query;
376          $form{mycmd} = 'default';          $main::form{mycmd} = 'default';
377      } else {      } else {
378        for (split /[;&]/, $query) {        for (split /[;&]/, $query) {
379          if (my ($n, $v) = split /=/, $_, 2) {          if (my ($n, $v) = split /=/, $_, 2) {
380            for ($n, $v) {tr/+/ /; s/%([0-9A-Fa-f][0-9A-Fa-f])/pack 'C', hex $1/ge};            for ($n, $v) {tr/+/ /; s/%([0-9A-Fa-f][0-9A-Fa-f])/pack 'C', hex $1/ge};
381            $form{$n} = $v;            $main::form{$n} = $v;
382          }          }
383        }        }
384        unless (defined $form{mypage}) {        unless (defined $form{mypage}) {
385          $form{mypage} = $form{epage};          $form{mypage} = $form{epage};
386          $form{mypage} =~ s/([0-9A-F]{2})/ord hex $1/g;          $form{mypage} =~ s/([0-9A-F]{2})/ord hex $1/g;
387        }        }
388        $form{mypage} = &code_convert (\$form{mypage}, $kanjicode);        $form{mypage} = &main::code_convert (\$form{mypage}, $kanjicode);
389      }      }
390      $form{mypage} ||= $PageName{FrontPage};      $form{mypage} =~ tr/\x00-\x20\x7F//d;
391      $form{mypage} =~ tr/\x00-\x1F\x7F//d;      $form{mypage} = SuikaWiki::Name::Space::normalize_name ($form{mypage}) || $PageName{FrontPage};
392      $form{mypage} = SuikaWiki::Name::Space::normalize_name ($form{mypage});      $form{mycmd} ||= $form{mode} || 'default';
     $form{mycmd} ||= 'default';  
393      $form{mycmd} =~ tr/-/_/;      $form{mycmd} =~ tr/-/_/;
394    
395      # mypreview_edit        -> do_edit, with preview.      for ('mymsg', 'myname', grep /^(?:wikiform__|pi_)/, keys %form) {
396      # mypreview_adminedit   -> do_adminedit, with preview.          $form{$_} = &main::code_convert (\$form{$_}, $kanjicode);
     # mypreview_write       -> do_write, without preview.  
     foreach (keys %form) {  
         if (/^mypreview_(.*)$/) {  
             $form{mycmd} = $1;  
             $form{mypreview} = 1;  
         }  
397      }      }
   
     #  
     # $form{mycmd} is frozen here.  
     #  
   
     for (grep /^(?:wikiform__|pi_)/, keys %form) {  
         $form{$_} = &code_convert (\$form{$_}, $kanjicode);  
     }  
     $form{mymsg} = &code_convert(\$form{mymsg}, $kanjicode);  
     $form{myname} = &code_convert(\$form{myname}, $kanjicode);  
398  }  }
399    
400    # [move to SuikaWiki::WikiDB]
401  sub open_db {  sub open_db {
402      if ($modifier_dbtype eq 'dbmopen') {      if ($main::modifier_dbtype eq 'dbmopen') {
403          dbmopen(%database, $PathTo{WikiDataBase}, 0666) or die "(dbmopen) $PathTo{WikiDataBase}";          dbmopen(%main::database, $PathTo{WikiDataBase}, 0666) or die "(dbmopen) $main::PathTo{WikiDataBase}";
404      } elsif ($modifier_dbtype eq 'AnyDBM_File') {      } elsif ($main::modifier_dbtype eq 'AnyDBM_File') {
405          eval q{use AnyDBM_File};          eval q{use AnyDBM_File};
406          tie(%database, "AnyDBM_File", $PathTo{WikiDataBase}, O_RDWR|O_CREAT, 0666) or die ("(tie AnyDBM_File) $PathTo{WikiDataBase}");          tie(%main::database, "AnyDBM_File", $main::PathTo{WikiDataBase}, O_RDWR|O_CREAT, 0666) or die ("(tie AnyDBM_File) $main::PathTo{WikiDataBase}");
407      } elsif ($modifier_dbtype eq 'Yuki::YukiWikiDB') {      } elsif ($main::modifier_dbtype eq 'Yuki::YukiWikiDB') {
408          eval q{use Yuki::YukiWikiDB};          eval q{use Yuki::YukiWikiDB};
409          tie(%database, "Yuki::YukiWikiDB", $PathTo{WikiDataBase}) or die ("(tie Yuki::YukiWikiDB) $PathTo{WikiDataBase}");          tie(%main::database, "Yuki::YukiWikiDB", $main::PathTo{WikiDataBase}) or die ("(tie Yuki::YukiWikiDB) $main::PathTo{WikiDataBase}");
410      } else {    ## Yuki::YukiWikiDB || Yuki::YukiWikiDBMeta      } else {    ## Yuki::YukiWikiDB || Yuki::YukiWikiDBMeta
411          eval qq{use $modifier_dbtype};          eval qq{use $modifier_dbtype};
412          $database = tie(%database, $modifier_dbtype => $PathTo{WikiDataBase}, -lock => 2, -backup => $wiki::diff::UseDiff) or die ("(tie $modifier_dbtype) $PathTo{WikiDataBase}");          $database = tie (%database, $modifier_dbtype => $PathTo{WikiDataBase},
413                             -lock => 2, -backup => $wiki::diff::UseDiff,   ## TODO: new diff i/f
414                             -logfile => $main::PathTo{WikiDatabaseErrorLog})
415                        or die ("(tie $modifier_dbtype) $PathTo{WikiDataBase}");
416      }      }
417  }  }
418    
419    # [move to SuikaWiki::WikiDB]
420  sub close_db {  sub close_db {
421      if ($modifier_dbtype eq 'dbmopen') {      if ($modifier_dbtype eq 'dbmopen') {
422          dbmclose(%database);          dbmclose(%database);
# Line 405  sub close_db { Line 425  sub close_db {
425      }      }
426  }  }
427    
428    # [move to SuikaWiki::Plugin::WikiEdit]
429  sub editform (@) {  sub editform (@) {
430    my %option = @_;    my %option = @_;
431    my $frozen = &is_frozen ($option{page});    my $frozen = &is_frozen ($option{page});
# Line 433  EOH Line 454  EOH
454    my $f = SuikaWiki::Markup::XML->new (namespace_uri => $NS_XHTML1, local_name => 'form');    my $f = SuikaWiki::Markup::XML->new (namespace_uri => $NS_XHTML1, local_name => 'form');
455      $f->set_attribute (action => SuikaWiki::Plugin->uri ('wiki');      $f->set_attribute (action => SuikaWiki::Plugin->uri ('wiki');
456      $f->set_attribute (method => 'post');      $f->set_attribute (method => 'post');
457      if (!$option{confloct}) {      if (!$option{conflict}) {
458        for ($f->append_new_node (namespace_uri => $NS_XHTML1, local_name => 'label')) {        for ($f->append_new_node (namespace_uri => $NS_XHTML1, local_name => 'label')) {
459          for ($_->append_new_node (namespace_uri => $NS_XHTML1, local_name => 'input')) {          for ($_->append_new_node (namespace_uri => $NS_XHTML1, local_name => 'input')) {
460            $f->set_attribute (type => 'submit');            $f->set_attribute (type => 'submit');
           $f->set_attribute (name => 'mypreview_write');  
461            $f->set_attribute (value => SuikaWiki::Plugin->resource ('Edit:Save'));            $f->set_attribute (value => SuikaWiki::Plugin->resource ('Edit:Save'));
462          }          }
463            #<input type=hidden name=mycmd value=write/>
464          $_->append_new_node (namespace_uri => $NS_XHTML1, local_name => 'kbd', value => 'S');          $_->append_new_node (namespace_uri => $NS_XHTML1, local_name => 'kbd', value => 'S');
465        }        }
466      }      }
# Line 448  EOH Line 469  EOH
469    
470    my $f = <<"EOD";    my $f = <<"EOD";
471  <form action="$uri{wiki}" method="post">  <form action="$uri{wiki}" method="post">
472      @{[ $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" value="@{[SuikaWiki::Plugin->resource('Edit:Save',escape=>1)]}" /><kbd>S</kbd></label>) ]}
473      @{[ $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>@{[SuikaWiki::Plugin->resource('Edit:Password=',escape=>1)]}<input type="password" name="mypassword" value="" size="10" /></label>) : "" ]} [@{[&get_new_anchor_index($option{content})]}]<br />
474      <input type="hidden" name="myLastModified" value="$option{last_modified}" />      <input type="hidden" name="myLastModified" value="$option{last_modified}" />
475      <input type="hidden" name="mypage" value="@{[&escape($form{mypage})]}" />      <input type="hidden" name="mycmd" value="write" />
476      <textarea cols="@{[&Resource('Edit:Form:Cols')+0||80]}" rows="@{[&Resource('Edit:Form:Rows')+0||20]}" name="mymsg" tabindex="1">@{[&escape($option{content})]}</textarea><br />      <input type="hidden" name="mypage" value="@{[SuikaWiki::Plugin->escape($form{mypage})]}" />
477        <textarea cols="@{[SuikaWiki::Plugin->resource('Edit:Form:Cols')+0||80]}" rows="@{[SuikaWiki::Plugin->resource('Edit:Form:Rows')+0||20]}" name="mymsg" tabindex="1">@{[SuikaWiki::Plugin->escape($option{content})]}</textarea><br />
478  @{[  @{[
479      $option{admin} ?      $option{admin} ?
480      qq(      qq(
481      <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") : ""]} />@{[SuikaWiki::Plugin->resource('Edit:Freeze',escape=>1)]}</label>
482      <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")]} />@{[SuikaWiki::Plugin->resource('Edit:DontFreeze',escape=>1)]}</label><br />)
483      : ""      : ""
484  ]}  ]}
485  @{[  @{[
486      $option{conflict} ? "" :      $option{conflict} ? "" :
487      qq(      qq(
488          <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" />@{[SuikaWiki::Plugin->resource('Edit:UpdateTimeStamp',escape=>1)]}</label><br />
489          <label><input type="submit" name="mypreview_write" value="@{[&Resource('Edit:Save',escape=>1)]}" accesskey="S" /><kbd>S</kbd></label>          <label><input type="submit" value="@{[SuikaWiki::Plugin->resource('Edit:Save',escape=>1)]}" accesskey="S" /><kbd>S</kbd></label>
490         $afteredit         $afteredit
491      )      )
492  ]}  ]}
# Line 473  EOD Line 495  EOD
495      $f;      $f;
496  }  }
497    
498    # [move to SuikaWiki::WikiDB]
499  sub is_editable {  sub is_editable {
500      my ($page) = @_;      my ($page) = @_;
501      return 0 unless SuikaWiki::Name::Space::validate_name ($page);      return 0 unless SuikaWiki::Name::Space::validate_name ($page);
# Line 480  sub is_editable { Line 503  sub is_editable {
503      1;      1;
504  }  }
505    
506  sub decode {  # [move to SuikaWiki::WikiDB]
     my ($s) = @_;  
     $s =~ tr/+/ /;  
     $s =~ s/%([A-Fa-f0-9][A-Fa-f0-9])/pack("C", hex($1))/eg;  
     return $s;  
 }  
   
 sub encode {  
   my $s = shift;  
   $s =~ s/([^0-9A-Za-z_-])/sprintf '%%%02X', ord $1/ge;  
   $s;  
 }  
   
 sub get_now {  
     my ($sec, $min, $hour, $day, $mon, $year) = localtime(time);  
     $year += 1900;  
     $mon++;  
     $mon = "0$mon" if $mon < 10;  
     $day = "0$day" if $day < 10;  
     $hour = "0$hour" if $hour < 10;  
     $min = "0$min" if $min < 10;  
     #$sec = "0$sec" if $sec < 10;  
     return "$year-$mon-$day $hour:$min";  
 }  
   
507  sub frozen_reject {  sub frozen_reject {
508      my ($isfrozen) = $database->meta (IsFrozen => $form{mypage});      my ($isfrozen) = $database->meta (IsFrozen => $form{mypage});
509      my ($willbefrozen) = $form{myfrozen};      my ($willbefrozen) = $form{myfrozen};
# Line 521  sub frozen_reject { Line 520  sub frozen_reject {
520      }      }
521  }  }
522    
523    # [move to SuikaWiki::WikiDB]
524  sub is_frozen ($) { SuikaWiki::Plugin->_database->meta (IsFrozen => $_[0]) ? 1 : 0 }  sub is_frozen ($) { SuikaWiki::Plugin->_database->meta (IsFrozen => $_[0]) ? 1 : 0 }
525    
526    # [to be obsolete]
527  sub do_comment {  sub do_comment {
528      my ($content) = $database{$form{mypage}};      my ($content) = $database{$form{mypage}};
529      my $default_name;   ## this code is not strict.      my $default_name;   ## this code is not strict.
530      $default_name = $1 if $content =~ /default-name="([^"]+)"/;      $default_name = $1 if $content =~ /default-name="([^"]+)"/;
531      my $datestr = '[WEAK['.&get_now.']]';      my @time = gmtime (time);
532        my $datestr = sprintf '[WEAK[%04d-%02d-%02d %02d:%02d:%02d +00:00]]', $time[5]+1900,$time[4]+1,@time[3,2,1,0];
533      my $namestr = $form{myname} || $default_name || &Resource('WikiForm:WikiComment:DefaultName');      my $namestr = $form{myname} || $default_name || &Resource('WikiForm:WikiComment:DefaultName');
534      ($namestr = '', $datestr = '') if $form{myname} eq 'nodate';      ($namestr = '', $datestr = '') if $form{myname} eq 'nodate';
535      if ($namestr =~ /^(?:>>)?[0-9]/) {      if ($namestr =~ /^(?:>>)?[0-9]/) {
# Line 564  sub do_comment { Line 566  sub do_comment {
566      }      }
567  }  }
568    
569    # [move to SuikaWiki::Plugin::WikiForm]
570  sub get_new_anchor_index ($) {  sub get_new_anchor_index ($) {
571      my $content = shift;      my $content = shift;
572      my $anchor = 0;      my $anchor = 0;
# Line 571  sub get_new_anchor_index ($) { Line 574  sub get_new_anchor_index ($) {
574      $anchor + 1;      $anchor + 1;
575  }  }
576    
577  sub load_formatter (@) {  # [move to SuikaWiki::Plugin::WikiForm]
     for my $t (@_) {  
         unless ($fmt{$t}) {  
             require Message::Util::Formatter;  
             $fmt{$t} = Message::Util::Formatter->new;  
             for (@{$SuikaWiki::Plugin::List{'wiki'.$t}||[]}) {  
                 $_->load_formatter ($fmt{$t}, type => 'wiki'.$t);  
             }  
             $fmt{$t}->option (return_class => 'SuikaWiki::Markup::XML');  
         }  
     }  
 }  
   
578  sub do_wikiform {  sub do_wikiform {
579      my $content = $database{$form{mypage}};      my $content = $database{$form{mypage}};
580      my $anchor = &get_new_anchor_index ($content);      my $anchor = &get_new_anchor_index ($content);
     &load_formatter (qw/form_template form_option/);  
581      my $write = 0;      my $write = 0;
582      my $i = 1;      my $i = 1;
583      $content =~ s{$embed_command{form}}{      $content =~ s{$embed_command{form}}{
# Line 604  sub do_wikiform { Line 594  sub do_wikiform {
594              $param->{argv} = \%form;              $param->{argv} = \%form;
595              $param->{default_name} = $1 if $content =~ /default-name="([^"]+)"/;              $param->{default_name} = $1 if $content =~ /default-name="([^"]+)"/;
596              $param->{default_name} ||= &Resource('WikiForm:WikiComment:DefaultName');              $param->{default_name} ||= &Resource('WikiForm:WikiComment:DefaultName');
597              $fmt{form_option}->replace ($option, $param);              SuikaWiki::Plugin->formatter ('form_option')->replace ($option, $param);
598              my $t = 1;              my $t = 1;
599              for (keys %{$param->{require}||{}}) {              for (keys %{$param->{require}||{}}) {
600                  (undef $t, last) unless length $param->{argv}->{'wikiform__'.$_};                  (undef $t, last) unless length $param->{argv}->{'wikiform__'.$_};
601              }              }
602              $t = $fmt{form_template}->replace ($template, $param) if $t;              $t = SuikaWiki::Plugin->formatter ('form_template')->replace ($template, $param) if $t;
603              if (length $t) {              if (length $t) {
604                  if ($param->{output}->{reverse}) {                  if ($param->{output}->{reverse}) {
605                      $embed .= "\n" . $t;                      $embed .= "\n" . $t;
# Line 641  sub do_wikiform { Line 631  sub do_wikiform {
631      }      }
632  }  }
633    
634    # [to be obsolete] ->Message::MIME::Charset
635  sub code_convert {  sub code_convert {
636    require Jcode;    require Jcode;
637      my ($contentref, $code) = (shift, shift || $kanjicode);      my ($contentref, $code, $srccode) = (shift, shift || $kanjicode, shift || undef);
638      if    ($code =~ /euc/) { $code = 'euc' }      if    ($code =~ /euc/) { $code = 'euc' }
639      elsif ($code =~ /iso/) { $code = 'jis' }      elsif ($code =~ /iso/) { $code = 'jis' }
640      elsif ($code =~ /shi/) { $code = 'sjis' }      elsif ($code =~ /shi/) { $code = 'sjis' }
641      elsif ($code =~ /utf/) { $code = 'utf8' }      elsif ($code =~ /utf/) { $code = 'utf8' }
642      $$contentref = Jcode->new ($contentref)->tr ("\xA3\xB0-\xA3\xB9\xA3\xC1-\xA3\xDA\xA3\xE1-\xA3\xFA\xA1\xF5\xA1\xA4\xA1\xA5\xA1\xA7\xA1\xA8\xA1\xA9\xA1\xAA\xA1\xAE\xA1\xB0\xA1\xB2\xA1\xBF\xA1\xC3\xA1\xCA\xA1\xCB\xA1\xCE\xA1\xCF\xA1\xD0\xA1\xD1\xA1\xDC\xA1\xF0\xA1\xF3\xA1\xF4\xA1\xF6\xA1\xF7\xA1\xE1\xA2\xAF\xA2\xB0\xA2\xB2\xA2\xB1\xA1\xE4\xA1\xE3\xA1\xC0\xA1\xA1" => q(0-9A-Za-z&,.:;?!`^_/|()[]{}+$%#*@='"~-><\ ))->$code;      $$contentref = Jcode->new ($contentref, $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;
643      return $$contentref;      return $$contentref;
644  }  }
645    
646    # [to be obsolete] ->Message::Field::Date
647  sub _rfc3339_date ($) {  sub _rfc3339_date ($) {
648    my @time = gmtime (shift);    my @time = gmtime (shift);
649    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];
650  }  }
651    
652    # [obsolete] ->SuikaWiki::SrcFormat
653    sub convert_format ($$$;%) {
654      my ($content, $d => $t, %option) = @_;
655      my $f = SuikaWiki::Plugin->format_converter ($d => $t);
656      if (ref $f) {
657        $option{content} = $content;
658        $option{from} = $d;
659        $option{to} = $t;
660        &$f ({}, bless (\%option, 'SuikaWiki::Plugin'));
661      } elsif ($option{-error_no_return}) {
662        return undef;
663      } elsif ($t =~ /HTML|xml/) {
664        if (length $content) {
665          my $r = SuikaWiki::Markup::XML->new (namespace_uri => $NS_XHTML1, local_name => 'pre');
666          $r->append_text ($content);
667          return $r;
668        } else {
669          return '';
670        }
671      } else {
672        $content;
673      }
674    }
675    
676    
677    
678    # [obsolete] SuikaWiki::WikiDB
679  package wiki::dummy;  package wiki::dummy;
680  sub mtime (@) {undef}  sub mtime (@) {undef}
681  sub meta (@) {undef}  sub meta (@) {undef}
682  sub Yuki::YukiWikiDB2::meta (@) {undef}  sub Yuki::YukiWikiDB2::meta (@) {undef}
683    
684  package main;  package main;
685  &SuikaWiki::Plugin::import_plugins ();  SuikaWiki::Plugin->import_plugins ();
686  &main ();    $main::UA = $main::ENV{HTTP_USER_AGENT};
687      &open_db;
688      &init_form;
689      for (@{$SuikaWiki::Plugin::On{WikiDatabaseLoaded}||[]}) { &{$_} }
690      if ($command_do{$form{mycmd}}) {
691        &{$command_do{$form{mycmd}}};       # [to be obsolete]
692      } else {
693        &{$command_do{default}};
694      }
695    _wiki_exit ();
696    
697  =head1 NAME  =head1 NAME
698    
Legend:
Removed from v.1.8  
changed lines
  Added in v.1.9
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24