/[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.13 by wakaba, Sun Oct 5 09:28:23 2003 UTC revision 1.14 by wakaba, Sun Oct 5 11:50:40 2003 UTC
# Line 1  Line 1 
 # -*- perl -*-  
1  use strict;  use strict;
2    
3  package wiki;  package wiki;
4  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};
5  package main;  package main;
6  binmode STDOUT; binmode STDIN;  binmode STDOUT; binmode STDIN;
7  use Fcntl;  
8  require SuikaWiki::Plugin;  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  );  );
12  our ($modifier_dbtype,%uri,%PathTo,%PageName,$kanjicode);  our (%uri,%PathTo,%PageName,$kanjicode);
13    
14  our %form;  our %form;
15  our %database;  our %database;
16  our $database = bless {}, 'wiki::dummy';  our $database = bless {}, 'wiki::dummy';
 my %command_do = (  
     default => \&do_view,  
     adminchangepassword => \&do_adminchangepassword,  
     write => \&do_write,  
     comment => \&do_comment,  
     RandomJump  => sub {  
       my @list = keys %main::database;  
       &main::_http_see_other (page => $list[rand @list]);  
     },  
     wikiform    => \&do_wikiform,  
 );  
17  our $UA = '';  ## User agent name  our $UA = '';  ## User agent name
18  $| = 1;  $| = 1;
19  require SuikaWiki::Name::Space;  require SuikaWiki::Name::Space;
20  my $NS_XHTML1 = 'http://www.w3.org/1999/xhtml';  my $NS_XHTML1 = 'http://www.w3.org/1999/xhtml';
21    our $WIKI;
22    
23    
 sub _wiki_exit () {  
     &close_db;  
     exit;  
 }  
24    
25  sub do_view {  sub do_view {
26    require SuikaWiki::View;    require SuikaWiki::View;
27    my $content = $main::database{$main::form{mypage}};    my $page = [split m!//!, $main::form{mypage}];
28    my $lm = SuikaWiki::Plugin->_database->mtime ($main::form{mypage});    my $content = SuikaWiki::Plugin->get_data (content => $page);
29      my $lm = SuikaWiki::Plugin->get_data (lastmodified => $page);
30    ## Determine mode    ## Determine mode
31      my $view = $form{mycmd};      my $view = $form{mycmd};
32      if (!$view || $view eq 'default' || $view =~ /[^0-9A-Za-z_]/) {      if (!$view || $view eq 'default' || $view =~ /[^0-9A-Za-z_]/) {
# Line 64  sub do_view { Line 51  sub do_view {
51    }    }
52    my $prop = $view_def->properties;    my $prop = $view_def->properties;
53    my $media = $prop->{media};    my $media = $prop->{media};
54    if ($prop->{xmedia} && $main::UA =~ /Gecko/) {        ## TODO: conneg    if (index ($prop->{xmedia}, 'Gecko') > -1) {  ## TODO: conneg
55      $media = $prop->{xmedia};      $media = $prop->{xmedia};
56      $o->{media} = $media;      $o->{media} = $media;
   } elsif ($main::UA =~ m#Mozilla/0\..+Windows#) {  
     $main::kanjicode = 'shift_jis';  
57    }    }
58        
59    if ($prop->{preprocess}) {    if ($prop->{preprocess}) {
60      _wiki_exit () unless &{$prop->{preprocess}} (o => $o);      exit unless &{$prop->{preprocess}} (o => $o);
61    }    }
62        
63    ## Output CGI/HTTP headers    ## Output CGI/HTTP headers
# Line 161  sub valid_password ($) { Line 146  sub valid_password ($) {
146    
147  # [move to SuikaWiki::Plugin::WikiEdit]  # [move to SuikaWiki::Plugin::WikiEdit]
148  sub do_write {  sub do_write {
149      my ($page_name, $new_content, $update_lm) = ($form{mypage}, $form{mymsg}, $form{mytouch});
150      my $page = [split m#//#, $page_name];
151      if (&frozen_reject()) {      if (&frozen_reject()) {
152          return;          return;
153      }      }
# Line 171  sub do_write { Line 158  sub do_write {
158          return;          return;
159      }      }
160    
161      ## Check confliction    ## Check confliction
162      if ($form{myLastModified} ne $database->mtime ($form{mypage})) {    my $lm = SuikaWiki::Plugin->get_data (lastmodified => $page);            
163        &_do_view_msg (-view => '-conflict', -page => $form{mypage});    if ($form{myLastModified} != $lm) {
164        return;      _do_view_msg (-view => '-conflict', -page => $page_name);
165      }      return;
166      }
167      if ($form{mymsg}) {                
168          if ($form{mytouch} || !ref $database) {    if (length $new_content) {
169            $database{$form{mypage}} = $form{mymsg};      SuikaWiki::Plugin->set_data (content => $page => $new_content,
170          } else {                                   -touch => 1,$form{mytouch});
           $database->STORE ($form{mypage} => $form{mymsg}, -touch => 0);  
         }  
171          $database->meta (IsFrozen => $form{mypage} => 0 + $form{myfrozen});          $database->meta (IsFrozen => $form{mypage} => 0 + $form{myfrozen});
172          my $uri = SuikaWiki::Plugin->_uri_wiki_page ($form{mypage}, mode => ($form{after_edit_cmd}||'default'), with_lm => 1, absolute => 1);          my $uri = SuikaWiki::Plugin->_uri_wiki_page ($form{mypage}, mode => ($form{after_edit_cmd}||'default'), with_lm => 1, absolute => 1);
173          $uri .= qq(;after_edit_cmd=@{[SuikaWiki::Plugin->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};
# Line 192  sub do_write { Line 177  sub do_write {
177              $uri .= qq(#wikiform-$form{__wikiform_anchor_index});              $uri .= qq(#wikiform-$form{__wikiform_anchor_index});
178          }          }
179          &_http_see_other (uri => $uri, page => $form{mypage}, alternate_view => '-wrote');          &_http_see_other (uri => $uri, page => $form{mypage}, alternate_view => '-wrote');
180      } else {    } else {
181          delete $database{$form{mypage}};            delete $database{$form{mypage}};
182          &_do_view_msg (-view => '-deleted', -page => $form{mypage});          &_do_view_msg (-view => '-deleted', -page => $form{mypage});
183      }    }
184  }  }
185    
186  sub _http_see_other (%) {  sub _http_see_other (%) {
187    my %o = @_;    my %o = @_;
188      $o{page} = join '//', @{$o{page}} if ref $o{page};
189    $o{uri} ||= SuikaWiki::Plugin->_uri_wiki_page ($o{page}, absolute => 1);    $o{uri} ||= SuikaWiki::Plugin->_uri_wiki_page ($o{page}, absolute => 1);
190    if ($o{alternate_view} && ($main::ENV{SERVER_PROTOCOL} eq 'HTTP/0.9'    if ($o{alternate_view} && ($main::ENV{SERVER_PROTOCOL} eq 'HTTP/1.0')
191                            || $main::ENV{SERVER_PROTOCOL} eq 'HTTP/1.0')     && !($main::UA =~ m#M(?:ozilla|icrosoft Internet Explorer)#)) {
    && !($main::UA =~ m#Microsoft Internet Explorer|Mozilla#)) {  
192      &_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});
193    } else {    } else {
194        my $status = q(303 See Other);        my $status = q(303 See Other);
# Line 219  Content-Language: en Line 204  Content-Language: en
204  <!DOCTYPE p SYSTEM>  <!DOCTYPE p SYSTEM>
205  <p>See &lt;<a href="$euri">$euri</a>&gt;.</p>);  <p>See &lt;<a href="$euri">$euri</a>&gt;.</p>);
206    }    }
207    _wiki_exit ();    exit;
208  }  }
209    
210  sub _compatible_options () {  sub _compatible_options () {
# Line 241  sub print_header ($;%) { Line 226  sub print_header ($;%) {
226            my $t = Time::Local::timegm_nocheck ($s, $m, $h, $d, $M, $y);            my $t = Time::Local::timegm_nocheck ($s, $m, $h, $d, $M, $y);
227            if ($option{-last_modified} <= $t) {            if ($option{-last_modified} <= $t) {
228              print "Status: 304 Not Modified\n\n";              print "Status: 304 Not Modified\n\n";
229              _wiki_exit ();              exit;
230            }            }
231        }        }
232      }      }
# Line 249  sub print_header ($;%) { Line 234  sub print_header ($;%) {
234      $option{o}->{-header}->{class}->{frozen} = 1 if &main::is_frozen ($page);      $option{o}->{-header}->{class}->{frozen} = 1 if &main::is_frozen ($page);
235      $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"/;
236      $option{o}->{-header}->{additional_html_element} ||= SuikaWiki::Markup::XML->new (type => '#fragment');      $option{o}->{-header}->{additional_html_element} ||= SuikaWiki::Markup::XML->new (type => '#fragment');
237      print "Vary: Negotiate,User-Agent,Accept-Language,Accept\n";      #print "Vary: Negotiate,User-Agent,Accept-Language,Accept\n";
238      if ($option{-goto}) {      if ($option{-goto}) {
239        if ($UA =~ m#Opera|MSIE 2\.#) {        if ($UA =~ m#Opera|MSIE 2\.#) {
240          ## 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 303  sub print_header ($;%) { Line 288  sub print_header ($;%) {
288      } else {      } else {
289      ## Modern UAs and Media types with charset parameter      ## Modern UAs and Media types with charset parameter
290        my $type = $option{-media}->{type};        my $type = $option{-media}->{type};
291        $type = 'application/xml' if ($type =~ m!^application/r(?:df|ss)\+xml$!) && ($UA =~ m#Gecko#);        $type = 'application/xml' if ($type =~ m!^application/rdf\+xml$!) && ($UA =~ m#Gecko#);
292        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};
293        ## meta element is not needed        ## meta element is not needed
294      }      }
       
     print <<"EOD";  
 Content-Style-Type: text/css  
295    
 EOD  
296  }  }
297    
298  sub get_charset_name ($;%) {  sub get_charset_name ($;%) {
# Line 404  sub init_form { Line 385  sub init_form {
385      }      }
386  }  }
387    
 # [move to SuikaWiki::WikiDB]  
 sub open_db {  
     if ($main::modifier_dbtype eq 'dbmopen') {  
         dbmopen(%main::database, $PathTo{WikiDataBase}, 0666) or die "(dbmopen) $main::PathTo{WikiDataBase}";  
     } elsif ($main::modifier_dbtype eq 'AnyDBM_File') {  
         eval q{use AnyDBM_File};  
         tie(%main::database, "AnyDBM_File", $main::PathTo{WikiDataBase}, O_RDWR|O_CREAT, 0666) or die ("(tie AnyDBM_File) $main::PathTo{WikiDataBase}");  
     } elsif ($main::modifier_dbtype eq 'Yuki::YukiWikiDB') {  
         eval q{use Yuki::YukiWikiDB};  
         tie(%main::database, "Yuki::YukiWikiDB", $main::PathTo{WikiDataBase}) or die ("(tie Yuki::YukiWikiDB) $main::PathTo{WikiDataBase}");  
     } else {    ## Yuki::YukiWikiDB || Yuki::YukiWikiDBMeta  
         eval qq{use $modifier_dbtype};  
         $database = tie (%database, $modifier_dbtype => $PathTo{WikiDataBase},  
                          -lock => 0, -backup => $wiki::diff::UseDiff,   ## TODO: new diff i/f  
                          -logfile => $main::PathTo{WikiDatabaseErrorLog})  
                     or die ("(tie $modifier_dbtype) $PathTo{WikiDataBase}");  
     }  
 }  
   
 # [move to SuikaWiki::WikiDB]  
 sub close_db {  
     if ($modifier_dbtype eq 'dbmopen') {  
         dbmclose(%database);  
     } else {  
         untie(%database);  
     }  
 }  
   
388  # [move to SuikaWiki::Plugin::WikiEdit]  # [move to SuikaWiki::Plugin::WikiEdit]
389  sub editform (@) {  sub editform (@) {
390    my %option = @_;    my %option = @_;
391      my $page = [split m!//!, $option{page}];
392    my $frozen = &is_frozen ($option{page});    my $frozen = &is_frozen ($option{page});
393    $option{content} = $database{$option{page}} unless defined $option{content};    $option{content} = SuikaWiki::Plugin->get_data (content => $page)
394    $option{content} = $database{NewPageTemplate} unless length $option{content};        unless defined $option{content};
395    $option{last_modified} = $database->mtime ($option{page}) unless defined $option{last_modified};    $option{content} = SuikaWiki::Plugin->get_data (content => $main::PageOf{NewPageTemplate})
396          unless length $option{content};
397      $option{last_modified} = SuikaWiki::Plugin->get_data (lastmodified => $page)
398          unless defined $option{last_modified};
399    my $magic = '';    my $magic = '';
400    $magic = $1 if $option{content} =~ m/^([^\x0A\x0D]+)/s;    $magic = $1 if $option{content} =~ m/^([^\x0A\x0D]+)/s;
401        
# Line 681  sub convert_format ($$$;%) { Line 638  sub convert_format ($$$;%) {
638  }  }
639    
640    
   
 # [obsolete] SuikaWiki::WikiDB  
 package wiki::dummy;  
 sub mtime (@) {undef}  
 sub meta (@) {undef}  
 sub Yuki::YukiWikiDB2::meta (@) {undef}  
   
641  package main;  package main;
642  SuikaWiki::Plugin->import_plugins ();    $WIKI->init_plugin;
643      $WIKI->{var}->{client}->{user_agent_name} = $main::ENV{HTTP_USER_AGENT};
644    $main::UA = $main::ENV{HTTP_USER_AGENT};    $main::UA = $main::ENV{HTTP_USER_AGENT};
645    &open_db;    $WIKI->{var}->{client}->{used_for_negotiate} = ['User-Agent'];
646      $WIKI->{var}->{db}->{read_only}->{'#default'} = 1;
647    
648    &init_form;    &init_form;
649    for (@{$SuikaWiki::Plugin::On{WikiDatabaseLoaded}||[]}) { &{$_} }  
650    if ($command_do{$form{mycmd}}) {    $WIKI->init_view;
651      &{$command_do{$form{mycmd}}};       # [to be obsolete]    $WIKI->{plugin}->use_type ('view-definition');
652    } else {    $WIKI->{view}->register_common_modes;
653      &{$command_do{default}};    
654      ## Mode
655      my $mode = $main::form{mycmd};
656      if (!$mode || $mode eq 'default' || $mode =~ /[^0-9A-Za-z_]/) {
657        ## BUG: this code is not strict
658        if ($main::ENV{HTTP_COOKIE} =~ /SelectedMode=([0-9A-Za-z_-]+)/) {
659          $mode = $1; $mode =~ tr/-/_/;
660        } else {
661          $mode = 'read';
662        }
663        push @{$WIKI->{var}->{client}->{used_for_negotiate}}, 'Cookie';
664    }    }
665  _wiki_exit ();    my $opt = {condition => {mode => $mode, output => 'http-cgi'}};
666      $WIKI->{var}->{mode} = $mode;
667      $WIKI->{var}->{page} = [split m!//!, $main::form{mypage}];
668      my $viewobj = $WIKI->{view}->instantiate ($mode, $opt);
669      $viewobj->main ($opt); ## TODO: or unsupported mode
670    
671    exit;
672    END {
673      $WIKI->exit;
674    }
675    
676  =head1 NAME  =head1 NAME
677    
Legend:
Removed from v.1.13  
changed lines
  Added in v.1.14
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24  
Google Analytics is used in this page; Cookies are used. 忍者AdMax is used in this page; Cookies are used. Privacy policy.