/[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.2 by wakaba, Sun Jul 20 09:15:55 2008 UTC revision 1.4 by wakaba, Thu Jul 24 13:17:11 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>
# Line 71  mark { Line 104  mark {
104    
105  print_input_form ();  print_input_form ();
106    
107  print q[<article>];  unless ('' =~ /$pattern/) {
108  my $has_match;    print q[<article>];
109  for_each_data_file (sub ($) {    my $has_match;
110    my $data_file_name = shift;    for_each_data_file (sub ($) {
111    load_data_file ($data_file_name, my $exact_data = {}, my $pattern_data = {});      my $data_file_name = shift;
112    $pattern_data = unescape_patterns ($pattern_data);      load_data_file ($data_file_name, my $exact_data = {}, my $pattern_data = {});
113    $has_match |= print_matches ($data_file_name, $exact_data, $pattern_data);      $pattern_data = unescape_patterns ($pattern_data);
114  });      $has_match |= print_matches ($data_file_name, $exact_data, $pattern_data);
115      });
116  unless ($has_match) {    
117    print q[<p>No match found.</article>];    unless ($has_match) {
118  } else {      print q[<p>No match found.</article>];
119    print q[</article>];    } else {
120    print_input_form ();      print q[</article>];
121        print_input_form ();
122      }
123  }  }
124    
125  sub unescape_patterns ($) {  sub unescape_patterns ($) {
# Line 164  sub get_match_text ($$) { Line 199  sub get_match_text ($$) {
199  sub print_input_form () {  sub print_input_form () {
200    print qq[<section><form action=find accept-charset=utf-8 method=get>];    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}]}">];    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>    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>];        <label><input type=checkbox name=aw @{[$param->{aw} ? 'checked' : '']}> As word(s)</label>];
230    print qq[</form></section>];    print qq[</form></section>];
Legend:
Removed from v.1.2  
changed lines
  Added in v.1.4
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24