/[pub]/suikawiki/script/wiki.cgi
Suika

Diff of /suikawiki/script/wiki.cgi

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.55 by wakaba, Thu Nov 27 05:31:05 2003 UTC revision 1.61 by wakaba, Mon Nov 10 15:05:30 2008 UTC
# Line 1  Line 1 
1  #!/usr/bin/perl  #!/usr/bin/perl
 ## wiki.cgi --- This is SuikaWiki, yet another WikiEngine  
 $0 = ''.$0;  
2  use strict;  use strict;
3  use CGI::Carp qw(fatalsToBrowser);  use lib qw[/home/httpd/html/www/markup/html/whatpm
4  require 'wikidata/suikawiki-config.ph'; ## the site configuration script             /home/wakaba/work/manakai2/lib
5  require 'suikawiki.pl'; ## the main script             /home/httpd/html/swe/lib/];
6    
7  package SuikaWiki;  use CGI::Carp qw[fatalsToBrowser];
8  our $VERSION = '2.2';  require Message::CGI::Carp;
9    
10  =head1 NAME  my $sw4_url = q<http://suika.fam.cx/~wakaba/wiki/sw/>;
11    
12  wiki.cgi --- SuikaWiki: Yet yet another WikiEngine  require Message::CGI::HTTP;
13    require Encode::EUCJPSW;
14  =head1 SEE ALSO  my $cgi = Message::CGI::HTTP->new;
15    
16  <IW:SuikaWiki:SuikaWiki>  my $page = $ENV{QUERY_STRING};
17    if ($page =~ /[&;]/) {
18  =head1 LICENSE    $page = $cgi->get_parameter ('mypage') // '';
19    
20  Copyright 2002-2003 Wakaba <w@suika.fam.cx>    my $charset = $cgi->get_parameter ('_charset_') // 'euc-jp-sw';
21      $charset = 'euc-jp-sw' unless $charset eq 'utf-8';
22  This program is free software; you can redistribute it and/or    $page = Encode::decode ($charset, $page);
23  modify it under the same terms as Perl itself.  } else {
24      $page = Encode::decode ('euc-jp-sw', percent_decode_byte ($page));
25  =cut  }
26    
27  1; # $Date$  my $url = get_page_url ($page);
28    
29    print qq[Status: 301 Moved
30    Location: $url
31    Content-Type: text/html; charset=utf-8
32    
33    <!DOCTYPE HTML>
34    <html lang=en>
35    <title>301 Moved</title>
36    <h1>Moved</h1>
37    <p>See <a href="@{[htescape ($url)]}">other page</a>.];
38    exit;
39    
40    sub get_page_url ($) {
41      my $wiki_name = shift;
42      $wiki_name = percent_encode ($wiki_name);
43      $wiki_name =~ s/%2F/+/g;
44      $wiki_name = $sw4_url . 'n/' . $wiki_name;
45      return $wiki_name;
46    } # get_page_url
47    
48    sub percent_encode ($) {
49      my $s = Encode::encode ('utf8', $_[0]);
50      $s =~ s/([^A-Za-z0-9_~-])/sprintf '%%%02X', ord $1/ges;
51      return $s;
52    } # percent_encode
53    
54    sub percent_decode ($) { # input should be a byte string.
55      my $s = shift;
56      $s =~ s/%([0-9A-Fa-f]{2})/pack 'C', hex $1/ge;
57      return Encode::decode ('utf-8', $s); # non-UTF-8 octet converted to \xHH
58    } # percent_decode
59    
60    sub percent_decode_byte ($) { # input should be a byte string.
61      my $s = shift;
62      $s =~ s/%([0-9A-Fa-f]{2})/pack 'C', hex $1/ge;
63      return $s;
64    } # percent_decode_byte
65    
66    sub htescape ($) {
67      my $s = shift;
68      $s =~ s/&/&amp;/g;
69      $s =~ s/</&lt;/g;
70      $s =~ s/"/&quot;/g;
71      return $s;
72    } # htescape

Legend:
Removed from v.1.55  
changed lines
  Added in v.1.61

admin@suikawiki.org
ViewVC Help
Powered by ViewVC 1.1.24