Parent Directory
| 
Revision Log
Find script revised for new data format
| 1 | wakaba | 1.1 | #!/usr/bin/perl |
| 2 | use strict; | ||
| 3 | wakaba | 1.3 | use utf8; |
| 4 | use CGI::Carp qw/fatalsToBrowser/; | ||
| 5 | wakaba | 1.1 | |
| 6 | BEGIN { require 'common.pl' } | ||
| 7 | |||
| 8 | require Encode; | ||
| 9 | |||
| 10 | wakaba | 1.3 | my $max_result = 100; |
| 11 | wakaba | 1.1 | |
| 12 | sub decode_url ($) { | ||
| 13 | my $s = shift; | ||
| 14 | $s =~ tr/+/ /; | ||
| 15 | $s =~ s/%([0-9A-Fa-f]{2})/pack 'C', hex $1/ge; | ||
| 16 | return Encode::decode ('utf-8', $s); | ||
| 17 | } # decode_url | ||
| 18 | |||
| 19 | wakaba | 1.7 | sub encode_url ($) { |
| 20 | my $s = Encode::encode ('utf-8', shift); | ||
| 21 | $s =~ s/([^0-9A-Za-z_~.-])/sprintf '%%%02X', ord $1/g; | ||
| 22 | return $s; | ||
| 23 | } # encode_url | ||
| 24 | |||
| 25 | wakaba | 1.1 | sub htescape ($) { |
| 26 | my $s = shift; | ||
| 27 | $s =~ s/&/&/g; | ||
| 28 | $s =~ s/</</g; | ||
| 29 | $s =~ s/>/>/g; | ||
| 30 | $s =~ s/"/"/g; | ||
| 31 | return $s; | ||
| 32 | } # htescape | ||
| 33 | |||
| 34 | my $param = {}; | ||
| 35 | for (split /[&;]/, $ENV{QUERY_STRING} || '') { | ||
| 36 | my ($name, $value) = split /=/, $_, 2; | ||
| 37 | $param->{decode_url ($name)} = decode_url ($value); | ||
| 38 | } | ||
| 39 | |||
| 40 | wakaba | 1.7 | my $suffix_patterns = { |
| 41 | wakaba | 1.3 | 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 |