/[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.17 by wakaba, Sat Oct 25 06:38:18 2003 UTC revision 1.18 by wakaba, Thu Oct 30 07:46:09 2003 UTC
# Line 1  Line 1 
1  use strict;  use strict;
   
 package wiki;  
 our $VERSION = do{my @r=(q$Revision$=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};  
2  package main;  package main;
3  binmode STDOUT; binmode STDIN;  binmode STDOUT; binmode STDIN;
4    our $WIKI;
5  require SuikaWiki::Plugin;  require SuikaWiki::Plugin;
6  our %embed_command = (  our %embed_command = ( # Map, main
7          form    => qr/\[\[\#form(?:\(([A-Za-z0-9-]+)\))?:'((?:[^'\\]|\\.)*)':'((?:[^'\\]|\\.)*)'(?::'((?:[^'\\]|\\.)*)')?\]\]/,          form    => qr/\[\[\#form(?:\(([A-Za-z0-9-]+)\))?:'((?:[^'\\]|\\.)*)':'((?:[^'\\]|\\.)*)'(?::'((?:[^'\\]|\\.)*)')?\]\]/,
8  );  );
9  our $database = bless {}, 'wiki::dummy';  our $database = bless {}, 'wiki::dummy';
 $| = 1;  
10  require SuikaWiki::Name::Space;  require SuikaWiki::Name::Space;
 my $NS_XHTML1 = 'http://www.w3.org/1999/xhtml';  
 our $WIKI;  
11  require Message::Markup::XML;  require Message::Markup::XML;
12    require SuikaWiki::SrcFormat;
 sub _do_view_msg (%) {  
   require SuikaWiki::View;  
   my %option = @_;  
   my $o = $option{-o} || bless {param => \%main::form, page => $option{-page},  
                                 }, 'SuikaWiki::Plugin';  
   $o->{toc} = [];  
   $o->{condition} = \%option;   ## This parameter really used??  
   my $view_def = SuikaWiki::View->definition ($option{-view});  
   unless ($view_def->check ($o)) {  
     print "Status: 406 Unsupported Media Type\n";  
     $option{-view} = '-UnsupportedMediaType';  
     $view_def = SuikaWiki::View->definition ($option{-view});  
   }  
   my $prop = $view_def->properties;  
   my $media = $prop->{media};  
   if ($prop->{xmedia} && $main::UA =~ /Gecko/) {  
     $media = $prop->{xmedia};  
     $o->{media} = $media;  
   }  
   &print_header($option{-page}, -media => $media, -view => $view_def, o => $o, -goto => $option{-goto});  
   print "\n";  
   ## Output HTTP message body  
   my $fmt = SuikaWiki::Plugin->formatter ('view');  
   my $s = $fmt->replace ($view_def->as_string => $o, {formatter => $fmt});  
   print $s;  
 }  
   
 # temp  
 sub valid_password ($) { 0 }  
 sub is_editable { 1 }  
   
 # [move to SuikaWiki::WikiDB]  
 sub frozen_reject {  
     my ($isfrozen) = $main::database->meta (IsFrozen => $main::form{mypage});  
     my ($willbefrozen) = $main::form{myfrozen};  
     if (not $isfrozen and not $willbefrozen) {  
         # You need no check.  
         return 0;  
     } elsif (valid_password($main::form{mypassword})) {  
         # You are admin.  
         return 0;  
     } else {  
         &_do_view_msg (-view => '-error', -page => $main::form{mypage},  
                        error_message => SuikaWiki::Plugin->resource ('Error:PasswordIsIncorrect'));  
         exit;  
     }  
 }  
   
 # [move to SuikaWiki::WikiDB]  
 sub is_frozen ($) { SuikaWiki::Plugin->_database->meta (IsFrozen => $_[0]) ? 1 : 0 }  
13    
14  # [to be obsolete]  # [to be obsolete]
15  sub do_comment {  sub do_comment {
# Line 197  sub code_convert { Line 141  sub code_convert {
141    return $$contentref;    return $$contentref;
142  }  }
143    
144  # [to be obsolete] ->Message::Field::Date  # [to be obsolete] ->Message::Field::Date : Map
145  sub _rfc3339_date ($) {  sub _rfc3339_date ($) {
146    my @time = gmtime (shift);    my @time = gmtime (shift);
147    sprintf '%04d-%02d-%02dT%02d:%02d:%02d+00:00', $time[5]+1900,$time[4]+1,@time[3,2,1,0];    sprintf '%04d-%02d-%02dT%02d:%02d:%02d+00:00', $time[5]+1900,$time[4]+1,@time[3,2,1,0];
# Line 216  sub convert_format ($$$;%) { Line 160  sub convert_format ($$$;%) {
160      return undef;      return undef;
161    } elsif ($t =~ /HTML|xml/) {    } elsif ($t =~ /HTML|xml/) {
162      if (length $content) {      if (length $content) {
163    my $NS_XHTML1 = 'http://www.w3.org/1999/xhtml';
164        my $r = SuikaWiki::Markup::XML->new (namespace_uri => $NS_XHTML1, local_name => 'pre');        my $r = SuikaWiki::Markup::XML->new (namespace_uri => $NS_XHTML1, local_name => 'pre');
165        $r->append_text ($content);        $r->append_text ($content);
166        return $r;        return $r;
# Line 260  sub EXISTS ($$) { Line 205  sub EXISTS ($$) {
205  }  }
206    
207  package main;  package main;
208    our $VERSION = do{my @r=(q$Revision$=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};
209    push @{$WIKI->{event}->{setting_initial_variables}}, sub {    push @{$WIKI->{event}->{setting_initial_variables}}, sub {
210      my $wiki = shift;      my $wiki = shift;
211      $wiki->{implementation_version} = 'sw'.$VERSION;      $wiki->{implementation_version} = 'wd'.$VERSION;
212            
213      ## Error output      ## Error output
214      require SuikaWiki::Output::CGICarp;      require SuikaWiki::Output::CGICarp;
# Line 276  package main; Line 222  package main;
222        for ($wiki_name_version) { s/&/&amp;/g; s/</&lt;/g;        for ($wiki_name_version) { s/&/&amp;/g; s/</&lt;/g;
223                                   s/([^\x20-\x7E])/sprintf '&#x%02X;',                                   s/([^\x20-\x7E])/sprintf '&#x%02X;',
224                                                            ord $1/g; };                                                            ord $1/g; };
225        print STDOUT <<EOH        print STDOUT <<EOH;
226  <!DOCTYPE html SYSTEM>  <!DOCTYPE html SYSTEM>
227  <title>500 Internal WikiEngine Error</title>  <title>500 Internal WikiEngine Error</title>
228  <h1>Internal WikiEngine Error</h1>  <h1>Internal WikiEngine Error</h1>
# Line 291  EOH Line 237  EOH
237      $wiki->{input} = SuikaWiki::Input::HTTP->new;      $wiki->{input} = SuikaWiki::Input::HTTP->new;
238      $wiki->{input}->{decoder}->{'#default'} = sub {      $wiki->{input}->{decoder}->{'#default'} = sub {
239        my ($http, $s, $temp_params) = @_;        my ($http, $s, $temp_params) = @_;
240        return main::code_convert (\$s, undef, # internal code        return main::code_convert (\$s, $wiki->{config}->{charset}->{internal},
241                                   @{$temp_params->{ie}||[]}[0]                                   lc (@{$temp_params->{_charset_}||[]}[0])
242                                   || $wiki->{config}->{charset}->{uri_param});                                   || $wiki->{config}->{charset}->{uri_param});
243      };      };
244      $wiki->{var}->{client}->{user_agent_name}      $wiki->{var}->{client}->{user_agent_name}
# Line 305  EOH Line 251  EOH
251        $page =~ tr/+/ /;        $page =~ tr/+/ /;
252        $page =~ s/%([0-9A-Fa-f][0-9A-Fa-f])/pack 'C', hex $1/ge;        $page =~ s/%([0-9A-Fa-f][0-9A-Fa-f])/pack 'C', hex $1/ge;
253        $page = main::code_convert        $page = main::code_convert
254          (\$page, undef, # internal code          (\$page, $wiki->{config}->{charset}->{internal},
255           $wiki->{config}->{charset}->{uri_query});           $wiki->{config}->{charset}->{uri_query});
256      } else {      } else {
257        $page = $wiki->{input}->parameter ('mypage');        $page = $wiki->{input}->parameter ('mypage');
# Line 345  EOH Line 291  EOH
291      $main::form{mycmd} = $mode;      $main::form{mycmd} = $mode;
292    };    };
293        
294    $WIKI->init_variables;    push @{$WIKI->{event}->{view_in_mode}}, sub {
295          my ($wiki, $opt) = @_;
296        my $arg = {condition => {mode => $opt->{mode} || '-error',
297                                 output => 'http-cgi',
298                                 http_method => $opt->{method} || 'GET'}};
299        my $viewobj = $wiki->{view}->instantiate ($opt->{mode} || '-error', $arg);
300        if (ref $viewobj) {
301          $viewobj->main ($arg);
302        } elsif ($opt->{mode} ne '-error') {
303          $wiki->view_in_mode (mode => '-error', method => 'GET');
304            ## TODO: cache control for non-GET
305        } else {
306          die "Some error happens.  Additionally, error reporting mode not defined";
307        }
308      };
309    
310    ## Initialization of various functions
311      $WIKI->init_variables;  
312    $WIKI->init_plugin;    $WIKI->init_plugin;
313    $WIKI->init_view;    $WIKI->init_view;
   $WIKI->{plugin}->use_type ('view-definition');  
314    $WIKI->{view}->register_common_modes;    $WIKI->{view}->register_common_modes;
   my $opt = {condition => {mode => $WIKI->{var}->{mode}, output => 'http-cgi',  
                            http_method => $main::ENV{REQUEST_METHOD}}};  
   my $viewobj = $WIKI->{view}->instantiate ($WIKI->{var}->{mode}, $opt);  
   $viewobj->main ($opt); ## TODO: or unsupported mode  
315    
316    ## Main  
317      $WIKI->view_in_mode
318        (mode => $WIKI->{var}->{mode},
319         method => $WIKI->{input}->meta_variable ('REQUEST_METHOD'));
320      
321  exit;  exit;
322  END {  END {
323    $WIKI->exit;    $WIKI->exit;
# Line 363  END { Line 325  END {
325    
326  =head1 NAME  =head1 NAME
327    
328  lib/suikawiki.pl --- SuikaWiki transitional library  lib/suikawiki.pl --- SuikaWiki : WikiEngine driver for HTTP CGI
   
 =head1 AUTHOR  
   
 Hiroshi Yuki <hyuki@hyuki.com> <http://www.hyuki.com/yukiwiki/> (YukiWiki)  
   
 Makio Tsukamoto <http://digit.que.ne.jp/> (WalWiki)  
   
 Wakaba <w@suika.fam.cx>  
329    
330  =head1 LICENSE  =head1 LICENSE
331    
332  Copyright AUTHORS 2000-2003  Copyright 2000-2003 Wakaba <w@suika.fam.cx>, et. al
333    
334  This program is free software; you can redistribute it and/or  This program is free software; you can redistribute it and/or
335  modify it under the same terms as Perl itself.  modify it under the same terms as Perl itself.
Legend:
Removed from v.1.17  
changed lines
  Added in v.1.18
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24