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 |
|
$cgi->{decoder}->{'#default'} = sub { |
16 |
=head1 DESCRIPTION |
return Encode::decode ('euc-jp-sw', $_[1]); |
17 |
|
}; |
18 |
This is a boot script for SuikaWiki HTTP CGI Script Driver (SWHCS). |
|
19 |
Actual driving of WikiEngine is coded in C<lib/suikawiki.pl>. |
my $page = $ENV{QUERY_STRING}; |
20 |
Options such as WikiDB directories can be specified in C<wikidata/suikawiki.ph>. |
if ($page =~ /[&;]/) { |
21 |
|
$page = $cgi->get_parameter ('mypage') // ''; |
22 |
This file is part of SuikaWiki. |
} else { |
23 |
|
$page = Encode::decode ('euc-jp-sw', percent_decode_byte ($page)); |
24 |
=head1 SYNOPSIS |
} |
25 |
|
|
26 |
$ telnet www.example.net 80<Enter> |
my $url = get_page_url ($page); |
27 |
GET /path/to/wiki/cgi/script?WikiName HTTP/1.1<Enter> |
|
28 |
Host: www.example.net<Enter> |
print qq[Status: 301 Moved |
29 |
<Enter> |
Location: $url |
30 |
|
Content-Type: text/html; charset=utf-8 |
31 |
Future version of SuikaWiki will accept "Accept: text/plain" HTTP |
|
32 |
request header field. |
<!DOCTYPE HTML> |
33 |
|
<html lang=en> |
34 |
=head1 SEE ALSO |
<title>301 Moved</title> |
35 |
|
<h1>Moved</h1> |
36 |
<http://suika.fam.cx/~wakaba/-temp/wiki/wiki?SuikaWiki>, |
<p>See <a href="@{[htescape ($url)]}">other page</a>.]; |
37 |
<http://suika.fam.cx/~wakaba/-temp/wiki/wiki?SWHCS>, |
exit; |
38 |
C<lib/suikawiki.pl>, |
|
39 |
C<wikidata/suikawiki-config.ph> |
sub get_page_url ($) { |
40 |
|
my $wiki_name = shift; |
41 |
=head1 LICENSE |
$wiki_name = percent_encode ($wiki_name); |
42 |
|
$wiki_name =~ s/%2F/+/g; |
43 |
Copyright 2002-2004 Wakaba <w@suika.fam.cx>. All rights reserved. |
$wiki_name = $sw4_url . 'n/' . $wiki_name; |
44 |
|
return $wiki_name; |
45 |
This program is free software; you can redistribute it and/or |
} # get_page_url |
46 |
modify it under the same terms as Perl itself. |
|
47 |
|
sub percent_encode ($) { |
48 |
=cut |
my $s = Encode::encode ('utf8', $_[0]); |
49 |
|
$s =~ s/([^A-Za-z0-9_~-])/sprintf '%%%02X', ord $1/ges; |
50 |
1; # $Date$ |
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 |