Parent Directory
| 
Revision Log
++ ChangeLog 11 Dec 2008 03:20:10 -0000 2008-12-11 Wakaba <wakaba@suika.fam.cx> * error-description-source.en.xml: Added descriptions for errors from Regexp::Parser and Regexp::Parser::JavaScript modules. * cc.cgi: Added support for JavaScript regular expressions. ++ html/WebHACC/Language/ChangeLog 11 Dec 2008 03:18:54 -0000 2008-12-11 Wakaba <wakaba@suika.fam.cx> * RegExpJS.pm: New module. ++ html/WebHACC/ChangeLog 11 Dec 2008 03:22:42 -0000 2008-12-11 Wakaba <wakaba@suika.fam.cx> * Output.pm (generate_input_section): Added support for JavaScript regular expressions. 2008-12-10 Wakaba <wakaba@suika.fam.cx> * Result.pm: Added support for |valueref| parameter of an error. |pos_end| should point the (intercharacter) position where the highlighted substring ends, not the character before the position, otherwise empty substring cannot be represented well.
| 1 | wakaba | 1.67 | #!/usr/bin/perl |
| 2 | # -d:DProf | ||
| 3 | wakaba | 1.1 | use strict; |
| 4 | |||
| 5 | use lib qw[/home/httpd/html/www/markup/html/whatpm | ||
| 6 | wakaba | 1.69 | /home/wakaba/work/manakai2/lib |
| 7 | /home/httpd/html/regexp/lib | ||
| 8 | ]; | ||
| 9 | wakaba | 1.1 | use CGI::Carp qw[fatalsToBrowser]; |
| 10 | |||
| 11 | wakaba | 1.53 | require WebHACC::Input; |
| 12 | wakaba | 1.2 | |
| 13 | wakaba | 1.35 | { |
| 14 | wakaba | 1.58 | require Message::CGI::HTTP; |
| 15 | wakaba | 1.16 | my $http = Message::CGI::HTTP->new; |
| 16 | wakaba | 1.1 | |
| 17 | wakaba | 1.58 | require WebHACC::Output; |
| 18 | my $out = WebHACC::Output->new; | ||
| 19 | $out->handle (*STDOUT); | ||
| 20 | $out->set_utf8; | ||
| 21 | |||
| 22 | wakaba | 1.16 | if ($http->get_meta_variable ('PATH_INFO') ne '/') { |
| 23 | wakaba | 1.58 | $out->http_error (404); |
| 24 | wakaba | 1.8 | exit; |
| 25 | } | ||
| 26 | wakaba | 1.59 | |
| 27 | ## TODO: We need real conneg support... | ||
| 28 | my $primary_language = 'en'; | ||
| 29 | if ($ENV{HTTP_ACCEPT_LANGUAGE} =~ /ja/) { | ||
| 30 | $primary_language = 'ja'; | ||
| 31 | } | ||
| 32 | $out->load_text_catalog ($primary_language); | ||
| 33 | wakaba | 1.53 | |
| 34 | $out->set_flush; | ||
| 35 | wakaba | 1.58 | $out->http_header; |
| 36 | $out->html_header; | ||
| 37 | $out->unset_flush; | ||
| 38 | wakaba | 1.55 | |
| 39 | wakaba | 1.61 | $out->generate_input_section ($http); |
| 40 | |||
| 41 | my $u = $http->get_parameter ('uri'); | ||
| 42 | my $s = $http->get_parameter ('s'); | ||
| 43 | if ((not defined $u or not length $u) and | ||
| 44 | (not defined $s or not length $s)) { | ||
| 45 | exit; | ||
| 46 | } | ||
| 47 | |||
| 48 | wakaba | 1.58 | require WebHACC::Result; |
| 49 | wakaba | 1.55 | my $result = WebHACC::Result->new; |
| 50 | wakaba | 1.60 | $result->output ($out); |
| 51 | wakaba | 1.14 | |
| 52 | wakaba | 1.60 | require WebHACC::Input; |
| 53 | my $input = WebHACC::Input->get_document ($http => $result => $out); | ||
| 54 | wakaba | 1.54 | |
| 55 | wakaba | 1.55 | check_and_print ($input => $result => $out); |
| 56 | |||
| 57 | wakaba | 1.53 | $out->nav_list; |
| 58 | wakaba | 1.16 | |
| 59 | wakaba | 1.53 | exit; |
| 60 | wakaba | 1.35 | } |
| 61 | wakaba | 1.1 | |
| 62 | wakaba | 1.53 | sub check_and_print ($$$) { |
| 63 | my ($input, $result, $out) = @_; | ||
| 64 | my $original_input = $out->input; | ||
| 65 | $out->input ($input); | ||
| 66 | wakaba | 1.31 | |
| 67 | wakaba | 1.55 | $input->generate_info_section ($result); |
| 68 | |||
| 69 | wakaba | 1.54 | $input->generate_transfer_sections ($result); |
| 70 | wakaba | 1.31 | |
| 71 | wakaba | 1.55 | unless (defined $input->{s}) { |
| 72 | wakaba | 1.62 | ## NOTE: This is an error of the implementation. |
| 73 | $result->layer_uncertain ('transfer'); | ||
| 74 | $result->generate_result_section; | ||
| 75 | wakaba | 1.63 | |