/[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.23 by wakaba, Fri Jan 16 08:01:05 2004 UTC revision 1.24 by wakaba, Sun Feb 1 12:25:26 2004 UTC
# Line 1  Line 1 
1  =head1 NAME  =head1 NAME
2    
3  suikawiki.pl - SuikaWiki Driver for HTTP CGI Script  suikawiki.pl - SuikaWiki Driver as HTTP CGI Script (SWHCS)
4    
5    =head1 DESCRIPTION
6    
7    This script is a WikiDriver for SuikaWiki, working as HTTP CGI script.
8    With this script, SuikaWiki WikiEngine can be controled via remote WWW
9    user agents.
10    
11    This file is part of SuikaWiki.
12    
13  =cut  =cut
14    
 use strict;  
 package main;  
 our $WIKI;  
15  package wiki::driver::http;  package wiki::driver::http;
16  ## -- Version of WikiDriver --  use strict;
17  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};
18  $WIKI->{implementation_version} = 'hcs'.$VERSION;  
19      ## These lines should be removed after utf8 support
20      BEGIN {
21        $Message::Util::Formatter::Base::Token = qr/[\w._+\x80-\xFF-]+/;
22        require Message::Util::Formatter::Base;
23      }
24    
25    ## -- Constructing a new instance of the WikiEngine --
26    
27      require SuikaWiki::Implementation;
28      our $WIKI = SuikaWiki::Implementation->new;
29    
30    ## -- Registering Version of the WikiDriver --
31    
32      $WIKI->{driver_name} = 'SWHCS';
33      $WIKI->{driver_version} = $VERSION;
34      $WIKI->{driver_uri_reference}
35           = q<http://suika.fam.cx/~wakaba/-temp/wiki/wiki?SWHCS>;
36            
37  ## -- Dying Message as HTTP Response --  ## -- Preparing Dying Message as HTTP Response --
38    
39    require SuikaWiki::Output::CGICarp;    require SuikaWiki::Output::CGICarp;
40    $SuikaWiki::Output::CGICarp::CUSTOM_REASON_TEXT    $SuikaWiki::Output::CGICarp::CUSTOM_REASON_TEXT = 'Internal WikiEngine Error';
       = 'Internal WikiEngine Error';  
41    CGI::Carp::set_message (sub {    CGI::Carp::set_message (sub {
42        my $msg = shift;      my $msg = shift; ## Already escaped
43        #$msg =~ s/&/&amp;/g;      my $wiki_name_version = sprintf '%s/%s %s/%s',
44        #$msg =~ s/</&lt;/g;                              $WIKI->{driver_name}, $WIKI->{driver_version},
45        my $wiki_name_version = $WIKI->{implementation_name} .'/'. $WIKI->version;                              $WIKI->{engine_name}, $WIKI->{engine_version};
46        my $trace = Carp::longmess ();      my $trace = Carp::longmess ();
47        for ($trace, $wiki_name_version)      for ($trace, $wiki_name_version) {
48          { s/&/&amp;/g; s/</&lt;/g;        s/&/&amp;/g; s/</&lt;/g; s/([^\x20-\x7E])/sprintf '&#x%02X;', ord $1/ge;
49            s/([^\x20-\x7E])/sprintf '&#x%02X;', ord $1/ge; };      };
50        print STDOUT <<EOH;      print <<"    EOH";
51  <!DOCTYPE html SYSTEM>        <!DOCTYPE html SYSTEM>
52  <title>500 Internal WikiEngine Error</title>        <title lang="en">500 Internal WikiEngine Error</title>
53  <h1>Internal WikiEngine Error</h1>        <h1 lang="en">Internal WikiEngine Error</h1>
54  <p>$msg</p>        <p>$msg</p>
55  <p>$trace</p>        <p>$trace</p>
56  <address>$wiki_name_version</address>        <address>$wiki_name_version</address>
57  EOH      EOH
58    });    });
59    
60  ## -- Required Modules --  ## -- Loading Configuration File --
61  use SuikaWiki::DB::Util::Error;  
62  require SuikaWiki::Plugin;    require 'wikidata/suikawiki-config.ph';
63  require SuikaWiki::Name::Space;    config ($WIKI);
64  require SuikaWiki::SrcFormat;  
65    ## -- Loading Modules --
66    
67      use SuikaWiki::DB::Util::Error;
68      require SuikaWiki::Name::Space;
69    
70  ## -- Transitional Functions --  ## -- Transitional Functions --
71    
72  # [to be obsolete] ->Message::MIME::Charset  # [to be obsolete] ->Message::MIME::Charset
73  sub main::code_convert {  sub main::code_convert {
   require Jcode;  
74    my ($contentref, $code, $srccode) = @_;    my ($contentref, $code, $srccode) = @_;
75      return $$contentref if $$contentref !~ /[^\x21-\x7E]/;
76      require Jcode;
77    $code ||= $WIKI->{config}->{charset}->{internal};    $code ||= $WIKI->{config}->{charset}->{internal};
78    for ($code, $srccode) {    for ($code, $srccode) {
79      s/[^0-9A-Za-z_.+-]+//g;      s/[^0-9A-Za-z_.+-]+//g;
# Line 68  sub main::code_convert { Line 94  sub main::code_convert {
94    return $$contentref;    return $$contentref;
95  }  }
96    
 # [to be obsolete] ->Message::Field::Date : Map  
 sub main::_rfc3339_date ($) {  
   my @time = gmtime (shift);  
   sprintf '%04d-%02d-%02dT%02d:%02d:%02d+00:00', $time[5]+1900,$time[4]+1,@time[3,2,1,0];  
 }  
   
 ## Obsolete  
 sub SuikaWiki::Plugin::get_data ($$$$;%) {  
     my ($self, $prop, $key, %opt) = @_;  
     ## TODO: common interface to WikiDB  
     ## TODO: error recovering  
     $main::WIKI->{db}->get ($prop => $key);  
 }  
   
97  ## -- Initializing WikiPlugin --      ## -- Initializing WikiPlugin --    
98    
99    $WIKI->init_plugin;     ## WikiPlugin manager    $WIKI->init_plugin;     ## WikiPlugin manager
# Line 152  sub SuikaWiki::Plugin::get_data ($$$$;%) Line 164  sub SuikaWiki::Plugin::get_data ($$$$;%)
164        -type => 'ERROR_REPORTED';        -type => 'ERROR_REPORTED';
165    };    };
166    
167  ## -- WikiDatabase Error Reporting --  ## -- Preparing for WikiDatabase Error Reports --
168  {  {
169    my $error_report = sub {    my $error_report = sub {
170      my ($wiki, $err) = @_;      my ($wiki, $err) = @_;
# Line 172  sub SuikaWiki::Plugin::get_data ($$$$;%) Line 184  sub SuikaWiki::Plugin::get_data ($$$$;%)
184        }        }
185        SuikaWiki::Plugin->module_package ('WikiDB')        SuikaWiki::Plugin->module_package ('WikiDB')
186                         ->reporting_error ($err, $wiki) if $report;                         ->reporting_error ($err, $wiki) if $report;
187        if ($err->{-def}->{level} eq 'fatal' or $err->{-def}->{level} eq 'stop') {        if ($err->{-def}->{level} eq 'fatal'
188     #      or $err->{-def}->{level} eq 'stop' ## for debug
189             ) {
190          $wiki->view_in_mode (mode => '-wdb--fatal-error');          $wiki->view_in_mode (mode => '-wdb--fatal-error');
191          throw SuikaWiki::DB::Util::Error -type => 'ERROR_REPORTED';          throw SuikaWiki::DB::Util::Error -type => 'ERROR_REPORTED';
192        }        }
# Line 193  sub SuikaWiki::Plugin::get_data ($$$$;%) Line 207  sub SuikaWiki::Plugin::get_data ($$$$;%)
207    }; # database_loaded    }; # database_loaded
208  }  }
209        
210  ## -- Misc. Error Reporting --  ## -- Preparing for Misc. Error Reports --
211    
212    if ($WIKI->{config}->{debug}->{general}) {    if ($WIKI->{config}->{debug}->{general}) {
213      $main::SIG{__WARN__} = sub {      $main::SIG{__WARN__} = sub {
# Line 205  sub SuikaWiki::Plugin::get_data ($$$$;%) Line 219  sub SuikaWiki::Plugin::get_data ($$$$;%)
219      };      };
220    }    }
221    
222  ## -- Initializing $wiki->{var} (Declaration) --  ## -- (Declaring for) Initializing $wiki->{var} --
223    
224    push @{$WIKI->{event}->{setting_initial_variables}}, sub {    push @{$WIKI->{event}->{setting_initial_variables}}, sub {
225      my $wiki = shift;      my $wiki = shift;
226        ## Database access mode
227      $wiki->{var}->{db}->{read_only}->{'#default'} = 1;      $wiki->{var}->{db}->{read_only}->{'#default'} = 1;
228            
229        ## Input parameter
230      require SuikaWiki::Input::HTTP;      require SuikaWiki::Input::HTTP;
231      $wiki->{input} = SuikaWiki::Input::HTTP->new (wiki => $wiki);      $wiki->{input} = SuikaWiki::Input::HTTP->new (wiki => $wiki);
232      $wiki->{input}->{decoder}->{'#default'} = sub {      $wiki->{input}->{decoder}->{'#default'} = sub {
# Line 219  sub SuikaWiki::Plugin::get_data ($$$$;%) Line 235  sub SuikaWiki::Plugin::get_data ($$$$;%)
235                                   lc (@{$temp_params->{_charset_}||[]}[0])                                   lc (@{$temp_params->{_charset_}||[]}[0])
236                                   || $wiki->{config}->{charset}->{uri_param});                                   || $wiki->{config}->{charset}->{uri_param});
237      };      };
238        
239        ## User agent negotiation
240      $wiki->{var}->{client}->{user_agent_name}      $wiki->{var}->{client}->{user_agent_name}
241        = $wiki->{input}->meta_variable ('HTTP_USER_AGENT');        = $wiki->{input}->meta_variable ('HTTP_USER_AGENT');
242      $wiki->{var}->{client}->{used_for_negotiate} = ['User-Agent'];      $wiki->{var}->{client}->{used_for_negotiate} = ['User-Agent'];
# Line 226  sub SuikaWiki::Plugin::get_data ($$$$;%) Line 244  sub SuikaWiki::Plugin::get_data ($$$$;%)
244      $dg->set_downgrade_flags ($wiki) if $dg;      $dg->set_downgrade_flags ($wiki) if $dg;
245            
246      ## TODO: PATH_INFO support      ## TODO: PATH_INFO support
247        
248        ## URI query parameter
249      my $page = $wiki->{input}->meta_variable ('QUERY_STRING');      my $page = $wiki->{input}->meta_variable ('QUERY_STRING');
250      if ($page && !(index ($page, '=') > -1)) {      if ($page and not (index ($page, '=') > -1)) {
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
# Line 236  sub SuikaWiki::Plugin::get_data ($$$$;%) Line 256  sub SuikaWiki::Plugin::get_data ($$$$;%)
256      } else {      } else {
257        $page = $wiki->{input}->parameter ('mypage');        $page = $wiki->{input}->parameter ('mypage');
258      }      }
259                
   
260      ## TODO: SuikaWiki 3 WikiName      ## TODO: SuikaWiki 3 WikiName
261      $page =~ tr/\x00-\x20\x7F//d;      $page =~ tr/\x00-\x20\x7F//d;
262      $page = SuikaWiki::Name::Space::normalize_name ($page);      $page = SuikaWiki::Name::Space::normalize_name ($page);
# Line 252  sub SuikaWiki::Plugin::get_data ($$$$;%) Line 271  sub SuikaWiki::Plugin::get_data ($$$$;%)
271              || $wiki->{input}->parameter ('mycmd') ## for compatibility with              || $wiki->{input}->parameter ('mycmd') ## for compatibility with
272              || 'default';                          ## YukiWiki and SuikaWiki 2              || 'default';                          ## YukiWiki and SuikaWiki 2
273      $mode =~ tr/-/_/;      $mode =~ tr/-/_/;
274      if ($mode eq 'default' || $mode =~ /[^0-9A-Za-z_]/) {      if ($mode eq 'default' or $mode =~ /[^0-9A-Za-z_]/) {
       ## BUG: this code is not strict  
275        my $cookie = $wiki->{input}->meta_variable ('HTTP_COOKIE');        my $cookie = $wiki->{input}->meta_variable ('HTTP_COOKIE');
276          ## BUG: this code is not strict
277        if ($cookie =~ /SelectedMode=([0-9A-Za-z_-]+)/) {        if ($cookie =~ /SelectedMode=([0-9A-Za-z_-]+)/) {
278          $mode = $1; $mode =~ tr/-/_/;          $mode = $1; $mode =~ tr/-/_/;
279        } else {        } else {
# Line 265  sub SuikaWiki::Plugin::get_data ($$$$;%) Line 284  sub SuikaWiki::Plugin::get_data ($$$$;%)
284      $wiki->{var}->{mode} = $mode;      $wiki->{var}->{mode} = $mode;
285    };    };
286    
287    
288    #### ---- Per-Session ----
289    
290  ## -- Initializing $wiki->{var} (Actual) --  ## -- Initializing $wiki->{var} (Actual) --
291        
292    $WIKI->init_variables;  ## Per-session variables    $WIKI->init_variables;  ## Per-session variables
# Line 277  sub SuikaWiki::Plugin::get_data ($$$$;%) Line 299  sub SuikaWiki::Plugin::get_data ($$$$;%)
299         method => $WIKI->{input}->meta_variable ('REQUEST_METHOD'));         method => $WIKI->{input}->meta_variable ('REQUEST_METHOD'));
300    } catch SuikaWiki::DB::Util::Error with {    } catch SuikaWiki::DB::Util::Error with {
301      my $err = shift;      my $err = shift;
302      $err->throw unless $err->{-type} eq 'ERROR_REPORTED';      unless ($err->{-type} eq 'ERROR_REPORTED') {
303          $WIKI->view_in_mode (mode => '-wdb--fatal-error');
304        }
305    } catch SuikaWiki::View::Implementation::error with {    } catch SuikaWiki::View::Implementation::error with {
306      my $err = shift;      my $err = shift;
307      $err->throw unless $err->{-type} eq 'ERROR_REPORTED';      $err->throw unless $err->{-type} eq 'ERROR_REPORTED';
# Line 287  sub SuikaWiki::Plugin::get_data ($$$$;%) Line 311  sub SuikaWiki::Plugin::get_data ($$$$;%)
311    };    };
312    exit;    exit;
313    
314    
315    
316  ## -- Terminating WikiEngine --  ## -- Terminating WikiEngine --
317    
318  END {  END {
319    $WIKI->exit;    $WIKI->exit;
320  }  }
321    
322    =head1 SYNOPSIS
323    
324    In your C<suikawiki.cgi>, write as:
325    
326      #!/usr/bin/perl
327      BEGIN { $0 = ''.$0 }
328      use strict;
329      use lib qw(lib);
330      use CGI::Carp qw(fatalsToBrowser);
331      require 'suikawiki.pl';
332    
333    =head1 SEE ALSO
334    
335    <http://suika.fam.cx/~wakaba/-temp/wiki/wiki?SuikaWiki>,
336    <http://suika.fam.cx/~wakaba/-temp/wiki/wiki?SWHCS>,
337    C<wiki.cgi>, C<wikidata/suikawiki-config.ph>,
338    C<SuikaWiki::Implementation>
339    
340  =head1 LICENSE  =head1 LICENSE
341    
342  Copyright 2000-2004 Wakaba <w@suika.fam.cx>, et. al  Copyright 2000-2004 Wakaba <w@suika.fam.cx>, et. al.  All rights reserved.
343    
344  This program is free software; you can redistribute it and/or  This program is free software; you can redistribute it and/or
345  modify it under the same terms as Perl itself.  modify it under the same terms as Perl itself.
Legend:
Removed from v.1.23  
changed lines
  Added in v.1.24
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24