/[suikacvs]/markup/html/html5/spec-ja/find.cgi
Suika

Diff of /markup/html/html5/spec-ja/find.cgi

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

revision 1.1 by wakaba, Sun Jul 20 07:45:21 2008 UTC revision 1.3 by wakaba, Sun Jul 20 11:17:24 2008 UTC
# Line 1  Line 1 
1  #!/usr/bin/perl  #!/usr/bin/perl
2  use strict;  use strict;
3    use utf8;
4    use CGI::Carp qw/fatalsToBrowser/;
5    
6  BEGIN { require 'common.pl' }  BEGIN { require 'common.pl' }
7    
8  require Encode;  require Encode;
9    
10  my $max_result = 30;  my $max_result = 100;
11    
12  sub decode_url ($) {  sub decode_url ($) {
13    my $s = shift;    my $s = shift;
# Line 29  for (split /[&;]/, $ENV{QUERY_STRING} || Line 31  for (split /[&;]/, $ENV{QUERY_STRING} ||
31    $param->{decode_url ($name)} = decode_url ($value);    $param->{decode_url ($name)} = decode_url ($value);
32  }  }
33    
 my $pattern = quotemeta normalize $param->{word};  
34  my $eword = htescape $param->{word};  my $eword = htescape $param->{word};
35    
36    my $pattern = quotemeta normalize $param->{word};
37    unless ($param->{cs}) {
38      $pattern =~ s/([A-Za-z])/'[' . uc ($1) . lc ($1) . ']'/ge;
39    }
40    my $suffix_pattern = {
41      ku => qr/(?>[かこきいっくけ])/,
42      su => qr/(?>[さそしすせ])/,
43      tsu => qr/(?>[たとちっつて])/,
44      nu => qr/(?>[なのにんぬね])/,
45      mu => qr/(?>[まもみんむめ])/,
46      ru => qr/(?>[らろりっるれ])/,
47      u => qr/(?>[わおいっうえ])/,
48      gu => qr/(?>[がごぎいぐげ])/,
49      bu => qr/(?>[ばぼびんぶべ])/,
50      ichidan => qr/(?>[るれろよ])?/,
51      kuru => qr/(?>[るれい])?/,
52      suru => qr/(?>す[るれ]|しろ?|せよ?|さ)?/,
53      i => qr/(?>か[ろっ]|く|い|けれ|う)?/, ## BUG: ありがたい -> ありがとう
54      da => qr/(?>だ[ろっ]?|で|に|なら?)?/,
55      dasuru => qr/(?>だ[ろっ]?|で|に|なら?|す[るれ]|しろ?|せよ?|さ)?/,
56    }->{$param->{suffix}} || qr//;
57    $pattern =~ s/$suffix_pattern$//;
58    $pattern .= $suffix_pattern;
59    $pattern = '\b' . $pattern . '\b' if $param->{aw};
60    
61  print qq[Content-Type: text/html ; charset=utf-8  print qq[Content-Type: text/html ; charset=utf-8
62    
63  <!DOCTYPE HTML>  <!DOCTYPE HTML>
# Line 40  print qq[Content-Type: text/html ; chars Line 66  print qq[Content-Type: text/html ; chars
66  <title>Search result for "$eword"</title>  <title>Search result for "$eword"</title>
67  <link rel=stylesheet href="/www/style/html/xhtml">  <link rel=stylesheet href="/www/style/html/xhtml">
68  <style>  <style>
69    td {
70      vertical-align: top;
71    }
72  mark {  mark {
73    background-color: yellow;    background-color: yellow;
74  }  }
# Line 64  mark { Line 93  mark {
93    text-decoration: none;    text-decoration: none;
94    border-style: none;    border-style: none;
95  }  }
96    input[type=text] {
97      width: 60%;
98    }
99  </style>  </style>
100  </head>  </head>
101  <body>  <body>
102  <h1>Search result for "$eword"</h1>];  <h1>Search result for "$eword"</h1>];
103    
104  my $has_match;  print_input_form ();
 for_each_data_file (sub ($) {  
   my $data_file_name = shift;  
   load_data_file ($data_file_name, my $exact_data = {}, my $pattern_data = {});  
   $pattern_data = unescape_patterns ($pattern_data);  
   $has_match |= print_matches ($data_file_name, $exact_data, $pattern_data);  
 });  
105    
106  unless ($has_match) {  unless ('' =~ /$pattern/) {
107    print q[<p>No match found.];    print q[<article>];
108      my $has_match;
109      for_each_data_file (sub ($) {
110        my $data_file_name = shift;
111        load_data_file ($data_file_name, my $exact_data = {}, my $pattern_data = {});
112        $pattern_data = unescape_patterns ($pattern_data);
113        $has_match |= print_matches ($data_file_name, $exact_data, $pattern_data);
114      });
115      
116      unless ($has_match) {
117        print q[<p>No match found.</article>];
118      } else {
119        print q[</article>];
120        print_input_form ();
121      }
122  }  }
123    
124  sub unescape_patterns ($) {  sub unescape_patterns ($) {
# Line 154  sub get_match_text ($$) { Line 194  sub get_match_text ($$) {
194    
195    return $r;    return $r;
196  } # get_match_text  } # get_match_text
197    
198    sub print_input_form () {
199      print qq[<section><form action=find accept-charset=utf-8 method=get>];
200      print qq[<p><input type=text name=word value="@{[htescape $param->{word}]}">];
201      print qq[<select name=suffix>];
202      for (qw/none ku su tsu nu mu ru u gu bu ichidan suru kuru i da dasuru/) {
203        print qq[<option value="@{[htescape $_]}"];
204        print qq[ selected] if $param->{suffix} eq $_;
205        print qq[>];
206        print htescape ({
207          none => 'No suffix',
208          ku => 'Ka-gyou Godan (-ku)',
209          su => 'Sa-gyou Godan (-su)',
210          tsu => 'Ta-gyou Godan (-tsu)',
211          nu => 'Na-gyou Godan (-nu)',
212          mu => 'Ma-gyou Godan (-mu)',
213          ru => 'Ra-gyou Godan (-ru)',
214          u => 'Wa/a-gyou Godan (-u)',
215          gu => 'Ga-gyou Godan (-gu)',
216          bu => 'Ba-gyou Godan (-bu)',
217          ichidan => 'Ichidan (-iru, -eru)',
218          suru => 'Sahen (-suru)',
219          kuru => 'Kahen (kuru)',
220          i => 'Keiyoushi (-i)',
221          da => 'Keiyou-doushi (-da)',
222          dasuru => 'Kei-dou-sahen (-da, -suru)',
223        }->{$_} || $_);
224      }
225      print qq[</select>];
226      print qq[<input type=submit value=Submit>];
227      print qq[<p><label><input type=checkbox name=cs @{[$param->{cs} ? 'checked' : '']}> Case-sensitive</label>
228          <label><input type=checkbox name=aw @{[$param->{aw} ? 'checked' : '']}> As word(s)</label>];
229      print qq[</form></section>];
230    } # print_input_form
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.3
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24