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