Parent Directory
|
Revision Log
++ ChangeLog 17 Aug 2008 05:05:13 -0000 2008-08-17 Wakaba <wakaba@suika.fam.cx> * cc-about.en.html: Author section added. * cc.cgi: |text/x-h2h| added. ++ html/WebHACC/Language/ChangeLog 17 Aug 2008 05:06:18 -0000 2008-08-17 Wakaba <wakaba@suika.fam.cx> * CacheManifest.pm (generate_structure_dump_section): Support for broken manifest. * H2H.pm: New module. ++ html/WebHACC/ChangeLog 17 Aug 2008 05:05:31 -0000 2008-08-17 Wakaba <wakaba@suika.fam.cx> * Output.pm: |text/x-h2h| added.
| 1 | wakaba | 1.1 | #!/usr/bin/perl |
| 2 | use strict; | ||
| 3 | |||
| 4 | use lib qw[/home/httpd/html/www/markup/html/whatpm | ||
| 5 | wakaba | 1.16 | /home/wakaba/work/manakai2/lib]; |
| 6 | wakaba | 1.1 | use CGI::Carp qw[fatalsToBrowser]; |
| 7 | |||
| 8 | wakaba | 1.53 | require WebHACC::Input; |
| 9 | wakaba | 1.2 | |
| 10 | wakaba | 1.35 | { |
| 11 | wakaba | 1.58 | require Message::CGI::HTTP; |
| 12 | wakaba | 1.16 | my $http = Message::CGI::HTTP->new; |
| 13 | wakaba | 1.1 | |
| 14 | wakaba | 1.58 | require WebHACC::Output; |
| 15 | my $out = WebHACC::Output->new; | ||
| 16 | $out->handle (*STDOUT); | ||
| 17 | $out->set_utf8; | ||
| 18 | |||
| 19 | wakaba | 1.16 | if ($http->get_meta_variable ('PATH_INFO') ne '/') { |
| 20 | wakaba | 1.58 | $out->http_error (404); |
| 21 | wakaba | 1.8 | exit; |
| 22 | } | ||
| 23 | wakaba | 1.59 | |
| 24 | ## TODO: We need real conneg support... | ||
| 25 | my $primary_language = 'en'; | ||
| 26 | if ($ENV{HTTP_ACCEPT_LANGUAGE} =~ /ja/) { | ||
| 27 | $primary_language = 'ja'; | ||
| 28 | } | ||
| 29 | $out->load_text_catalog ($primary_language); | ||
| 30 | wakaba | 1.53 | |
| 31 | $out->set_flush; | ||
| 32 | wakaba | 1.58 | $out->http_header; |
| 33 | $out->html_header; | ||
| 34 | $out->unset_flush; | ||
| 35 | wakaba | 1.55 | |
| 36 | wakaba | 1.61 | $out->generate_input_section ($http); |
| 37 | |||
| 38 | my $u = $http->get_parameter ('uri'); | ||
| 39 | my $s = $http->get_parameter ('s'); | ||
| 40 | if ((not defined $u or not length $u) and | ||
| 41 | (not defined $s or not length $s)) { | ||
| 42 | exit; | ||
| 43 | } | ||
| 44 | |||
| 45 | wakaba | 1.58 | require WebHACC::Result; |
| 46 | wakaba | 1.55 | my $result = WebHACC::Result->new; |
| 47 | wakaba | 1.60 | $result->output ($out); |
| 48 | wakaba | 1.14 | |
| 49 | wakaba | 1.60 | require WebHACC::Input; |
| 50 |