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