suikawiki/script/wiki.cgi

#!/usr/bin/perl
use strict;
use lib qw[/home/httpd/html/www/markup/html/whatpm
           /home/wakaba/work/manakai2/lib
           /home/httpd/html/swe/lib/];

use CGI::Carp qw[fatalsToBrowser];
require Message::CGI::Carp;

my $sw4_url = q<http://suika.fam.cx/~wakaba/wiki/sw/>;

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

<!DOCTYPE HTML>
<html lang=en>
<title>301 Moved</title>
<h1>Moved</h1>
<p>See <a href="@{[htescape ($url)]}">other page</a>.];
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 ($) { # input should be a byte string.
  my $s = shift;
  $s =~ s/%([0-9A-Fa-f]{2})/pack 'C', hex $1/ge;
  return Encode::decode ('utf-8', $s); # non-UTF-8 octet converted to \xHH
} # percent_decode

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/&/&amp;/g;
  $s =~ s/</&lt;/g;
  $s =~ s/"/&quot;/g;
  return $s;
} # htescape
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