Parent Directory
| 
Revision Log
++ html/WebHACC/ChangeLog 15 Sep 2008 02:54:58 -0000 2008-09-15 Wakaba <wakaba@suika.fam.cx> * Output.pm ($htescape, $htescape_value): Commented out redundant things for now.
| 1 | wakaba | 1.66 | #!/usr/bin/perl -d:DProf |
| 2 | wakaba | 1.1 | 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 | my $input = WebHACC::Input->get_document ($http => $result => $out); | ||
| 51 |