| 1 |
wakaba |
1.60 |
#!/usr/bin/perl |
| 2 |
wakaba |
1.16 |
use strict; |
| 3 |
wakaba |
1.60 |
use lib qw[/home/httpd/html/www/markup/html/whatpm |
| 4 |
|
|
/home/wakaba/work/manakai2/lib |
| 5 |
|
|
/home/httpd/html/swe/lib/]; |
| 6 |
|
|
|
| 7 |
|
|
use CGI::Carp qw[fatalsToBrowser]; |
| 8 |
|
|
require Message::CGI::Carp; |
| 9 |
|
|
|
| 10 |
|
|
my $sw4_url = q<http://suika.fam.cx/~wakaba/wiki/sw/>; |
| 11 |
|
|
|
| 12 |
|
|
require Message::CGI::HTTP; |
| 13 |
|
|
require Encode::EUCJPSW; |
| 14 |
|
|
my $cgi = Message::CGI::HTTP->new; |
| 15 |
|
|
|
| 16 |
|
|
my $page = $ENV{QUERY_STRING}; |
| 17 |
wakaba |
1.62 |
$page =~ s/^ru=[^&;]+[&;]//; |
| 18 |
wakaba |
1.60 |
if ($page =~ /[&;]/) { |
| 19 |
|
|
$page = $cgi->get_parameter ('mypage') // ''; |
| 20 |
wakaba |
1.61 |
|
| 21 |
|
|
my $charset = $cgi->get_parameter ('_charset_') // 'euc-jp-sw'; |
| 22 |
|
|
$charset = 'euc-jp-sw' unless $charset eq 'utf-8'; |
| 23 |
|
|
$page = Encode::decode ($charset, $page); |
| 24 |
wakaba |
1.60 |
} else { |
| 25 |
|
|
$page = Encode::decode ('euc-jp-sw', percent_decode_byte ($page)); |
| 26 |
|
|
} |
| 27 |
|
|
|
| 28 |
|
|
my $url = get_page_url ($page); |
| 29 |
|
|
|
| 30 |
|
|
print qq[Status: 301 Moved |
| 31 |
|
|
Location: $url |
| 32 |
|
|
Content-Type: text/html; charset=utf-8 |
| 33 |
|
|
|
| 34 |
|
|
<!DOCTYPE HTML> |
| 35 |
|
|
<html lang=en> |
| 36 |
|
|
<title>301 Moved</title> |
| 37 |
|
|
<h1>Moved</h1> |
| 38 |
|
|
<p>See <a href="@{[htescape ($url)]}">other page</a>.]; |
| 39 |
|
|
exit; |
| 40 |
|
|
|
| 41 |
|
|
sub get_page_url ($) { |
| 42 |
|
|
my $wiki_name = shift; |
| 43 |
|
|
$wiki_name = percent_encode ($wiki_name); |
| 44 |
|
|
$wiki_name =~ s/%2F/+/g; |
| 45 |
|
|
$wiki_name = $sw4_url . 'n/' . $wiki_name; |
| 46 |
|
|
return $wiki_name; |
| 47 |
|
|
} # get_page_url |
| 48 |
|
|
|
| 49 |
|
|
sub percent_encode ($) { |
| 50 |
|
|
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 |
Parent Directory
| 
Revision Log