#!/usr/bin/perl
use strict;
use warnings;
use Path::Class;
use lib file (__FILE__)->dir->parent->parent->subdir ('pbin', 'accounts', 'modules', 'manakai', 'lib')->stringify;
my $sw4_url = q;
require Message::CGI::HTTP;
require Encode::EUCJPSW;
my $cgi = Message::CGI::HTTP->new;
my $page = $ENV{QUERY_STRING};
$page =~ s/^ru=[^&;]+[&;]//;
if ($page =~ /[&;]/) {
$page = $cgi->get_parameter ('mypage') // '';
my $charset = $cgi->get_parameter ('_charset_') // 'euc-jp-sw';
$charset = 'euc-jp-sw' unless $charset eq 'utf-8';
$page = Encode::decode ($charset, $page);
} else {
$page = Encode::decode ('euc-jp-sw', percent_decode_byte ($page));
}
my $url = get_page_url ($page);
print qq[Status: 301 Moved
Location: $url
Content-Type: text/html; charset=utf-8
301 Moved
Moved
See other page.];
exit;
sub get_page_url ($) {
my $wiki_name = shift;
$wiki_name = percent_encode ($wiki_name);
$wiki_name =~ s/%2F/+/g;
$wiki_name = $sw4_url . 'n/' . $wiki_name;
return $wiki_name;
} # get_page_url
sub percent_encode ($) {
my $s = Encode::encode ('utf8', $_[0]);
$s =~ s/([^A-Za-z0-9_~-])/sprintf '%%%02X', ord $1/ges;
return $s;
} # percent_encode
sub percent_decode_byte ($) { # input should be a byte string.
my $s = shift;
$s =~ s/%([0-9A-Fa-f]{2})/pack 'C', hex $1/ge;
return $s;
} # percent_decode_byte
sub htescape ($) {
my $s = shift;
$s =~ s/&/&/g;
$s =~ s/
let s = document.createElement ('script');
s.src = '/common.js';
if (!location.pathname.match (/^\/c\//)) {
s.setAttribute ('data-ads', '');
}
document.body.appendChild (s);