| 1 |
#!/usr/bin/perl -d:DProf |
#!/usr/bin/perl |
|
BEGIN { $0 = ''.$0 } |
|
| 2 |
use strict; |
use strict; |
| 3 |
use lib qw(lib); |
use lib qw[/home/httpd/html/www/markup/html/whatpm |
| 4 |
use CGI::Carp qw(fatalsToBrowser); |
/home/wakaba/work/manakai2/lib |
| 5 |
require 'suikawiki.pl'; |
/home/httpd/html/swe/lib/]; |
| 6 |
|
|
| 7 |
=head1 NAME |
use CGI::Carp qw[fatalsToBrowser]; |
| 8 |
|
require Message::CGI::Carp; |
| 9 |
wiki.cgi - SuikaWiki: Yet yet another WikiEngine - HTTP CGI Script Driver |
|
| 10 |
|
my $sw4_url = q<http://suika.fam.cx/~wakaba/wiki/sw/>; |
| 11 |
=head1 DESCRIPTION |
|
| 12 |
|
require Message::CGI::HTTP; |
| 13 |
This is a boot script for SuikaWiki HTTP CGI Script Driver (SWHCS). |
require Encode::EUCJPSW; |
| 14 |
Actual driving of WikiEngine is coded in C<lib/suikawiki.pl>. |
my $cgi = Message::CGI::HTTP->new; |
| 15 |
Options such as WikiDB directories can be specified in C<wikidata/suikawiki.ph>. |
$cgi->{decoder}->{'#default'} = sub { |
| 16 |
|
return Encode::decode ('euc-jp-sw', $_[1]); |
| 17 |
This file is part of SuikaWiki. |
}; |
| 18 |
|
|
| 19 |
=head1 SYNOPSIS |
my $page = $ENV{QUERY_STRING}; |
| 20 |
|
if ($page =~ /[&;]/) { |
| 21 |
$ telnet www.example.net 80<Enter> |
$page = $cgi->get_parameter ('mypage') // ''; |
| 22 |
GET /path/to/wiki/cgi/script?WikiName HTTP/1.1<Enter> |
} else { |
| 23 |
Host: www.example.net<Enter> |
$page = Encode::decode ('euc-jp-sw', percent_decode_byte ($page)); |
| 24 |
<Enter> |
} |
| 25 |
|
|
| 26 |
Future version of SuikaWiki will accept "Accept: text/plain" HTTP |
my $url = get_page_url ($page); |
| 27 |
request header field. |
|
| 28 |
|
print qq[Status: 301 Moved |
| 29 |
=head1 SEE ALSO |
Location: $url |
| 30 |
|
Content-Type: text/html; charset=utf-8 |
| 31 |
<http://suika.fam.cx/~wakaba/-temp/wiki/wiki?SuikaWiki>, |
|
| 32 |
<http://suika.fam.cx/~wakaba/-temp/wiki/wiki?SWHCS>, |
<!DOCTYPE HTML> |
| 33 |
C<lib/suikawiki.pl>, |
<html lang=en> |
| 34 |
C<wikidata/suikawiki-config.ph> |
<title>301 Moved</title> |
| 35 |
|
<h1>Moved</h1> |
| 36 |
=head1 LICENSE |
<p>See <a href="@{[htescape ($url)]}">other page</a>.]; |
| 37 |
|
exit; |
| 38 |
Copyright 2002-2004 Wakaba <w@suika.fam.cx>. All rights reserved. |
|
| 39 |
|
sub get_page_url ($) { |
| 40 |
This program is free software; you can redistribute it and/or |
my $wiki_name = shift; |
| 41 |
modify it under the same terms as Perl itself. |
$wiki_name = percent_encode ($wiki_name); |
| 42 |
|
$wiki_name =~ s/%2F/+/g; |
| 43 |
=cut |
$wiki_name = $sw4_url . 'n/' . $wiki_name; |
| 44 |
|
return $wiki_name; |
| 45 |
1; # $Date$ |
} # get_page_url |
| 46 |
|
|
| 47 |
|
sub percent_encode ($) { |
| 48 |
|
my $s = Encode::encode ('utf8', $_[0]); |
| 49 |
|
$s =~ s/([^A-Za-z0-9_~-])/sprintf '%%%02X', ord $1/ges; |
| 50 |
|
return $s; |
| 51 |
|
} # percent_encode |
| 52 |
|
|
| 53 |
|
sub percent_decode ($) { # input should be a byte string. |
| 54 |
|
my $s = shift; |
| 55 |
|
$s =~ s/%([0-9A-Fa-f]{2})/pack 'C', hex $1/ge; |
| 56 |
|
return Encode::decode ('utf-8', $s); # non-UTF-8 octet converted to \xHH |
| 57 |
|
} # percent_decode |
| 58 |
|
|
| 59 |
|
sub percent_decode_byte ($) { # input should be a byte string. |
| 60 |
|
my $s = shift; |
| 61 |
|
$s =~ s/%([0-9A-Fa-f]{2})/pack 'C', hex $1/ge; |
| 62 |
|
return $s; |
| 63 |
|
} # percent_decode_byte |
| 64 |
|
|
| 65 |
|
sub htescape ($) { |
| 66 |
|
my $s = shift; |
| 67 |
|
$s =~ s/&/&/g; |
| 68 |
|
$s =~ s/</</g; |
| 69 |
|
$s =~ s/"/"/g; |
| 70 |
|
return $s; |
| 71 |
|
} # htescape |
Parent Directory
| 
Revision Log
| 
Patch