全文検索

全文検索機能

ここでは全文検索機能の作り方を解説します。
FreeBSD-users-jp というメーリングリストのログファイルから、指定されたファイルを検索する CGI プログラムを作ります。ここでは 1メールを 1ファイルで保持しています。あまりにもファイル数が多いとサーバに余計な負荷をかけてしまいますので、ここでは [FreeBSD-users-jp 1]～[FreeBSD-users-jp 9999] までの約1万通を対象に検索します。
とりあえず 3種類のプログラムを作ってみました。機能は全く同じはずです。以下のフォームから試してみてください。検索キーワードには日本語も使えます。空白で区切ると AND 条件とみなし、入力された全てのキーワードを含むメールを抽出します。検索結果では、jp.FreeBSD.org へのリンクと、各キーワードを含む行 (複数の行が同じキーワードを含む場合は、その中の最初の行) を表示します。高負荷を避けるため、100件マッチした場合はそこで検索を打ち切ります。

search-1.cgi

search-2.cgi

search-3.cgi

3つのプログラムは機能は同じですが、速度が違います。それぞれ数回実行し、最も実行速度が短かったものを下表にまとめました。 search-1.cgi が最も遅く、search-3.cgi が最も速くなっています (X68000.q-e-d.net ではない別のマシンで実行しました。 X68000.q-e-d.net の方がスペックがよいので、より短時間で検索が終了すると思われます)。

プログラム名実行時間対 search-1.cgi 比の速度

1 search-1.cgi 4.56秒 -

2 search-2.cgi 3.55秒 1.3 倍

3 search-3.cgi 1.63秒 2.8 倍

それぞれ約1万個のファイルをオープンしている点は同じです。しかし、個々のファイル内容を検索する方法が以下のように異なります。

search-1.cgi … ファイルを 1行ごとに読み込み、それぞれの検索キーワードについて index 関数でマッチするかチェック
search-2.cgi … ファイル全体を読み込み、それぞれの検索キーワードについて index 関数でマッチするかチェック
search-3.cgi … ファイル全体を読み込み、正規表現で一度だけチェック

	プログラム名	実行時間	対 search-1.cgi 比の速度
1	search-1.cgi	4.56秒	-
2	search-2.cgi	3.55秒	1.3 倍
3	search-3.cgi	1.63秒	2.8 倍

疑似コード

疑似コードでそれぞれのアルゴリズムを書くと以下のようになります。
# search-1.cgi
@keywords = ('hoge', 'emacs');
foreach $file (@files){
 open(IN, $file);
 while (<IN>){
 foreach $keyword (@keywords){
 if ( 行中に $keyword が存在する ){
 ...
 }
 }
 }
 @keywords 全てが見付かったら、ファイル名と内容を表示
}
# search-2.cgi
@keywords = ('hoge', 'emacs');
foreach $file (@files){
 open(IN, $file);
 $buf = join('', <IN>);
 foreach $keyword (@keywords){
 if ( $buf 内に $keyword が存在する ){
 ...
 }
 }
 @keywords 全てが見付かったら、ファイル名と内容を表示
}
# search-3.cgi
@keywords = ('hoge', 'emacs');
foreach $file (@files){
 open(IN, $file);
 $buf = join('', <IN>);
 if ( $buf 内に @keywords の全要素が存在する ){
 ファイル名と内容を表示
 }
}
search-1.cgi より search-2.cgi の方がネストが浅く、さらに search-3.cgi の方がネストがもう一段浅くなっています。 search-3.cgi が速いのは当然と言えるでしょう。
アルゴリズムの面だけ見ると、 search-1.cgi の速度は「ファイル数×メール行数×キーワード数」に比例するのに対し、 search-2.cgi は「ファイル数×キーワード数」に比例、 search-3.cgi は「ファイル数」に比例することになります。
世の中にいくつか全文検索を行う CGI プログラムが配布されていますが、 search-1.cgi のようなプログラムが多く見受けられ、残念に思っています。

search-1.cgi

簡単にプログラムを説明します。まずは search-1.cgi から。

search-1.pl
 10: $|=1;
バッファリングを OFF にして、検索結果が即座にブラウザに表示されるようにします。これを行わないと、全てのファイルの検索が終了するか、 CGI プログラムがある量以上の出力結果を Web サーバに渡すまで、ブラウザに検索結果が表示されません。詳しくはバッファリングをどうぞ。
 15: foreach ( split(/&/, $ENV{QUERY_STRING}) ){
 16: my ($name, $value) = split(/=/, $_);
 17: if ( $name eq 'keyword' ){
 18: $value =~ s/%([0-9a-fA-F][0-9a-fA-F])/pack("C", hex($1))/eg;
 19: &jcode::convert(\$value, 'euc');
 20: # 前後の空白を削除
 21: my $jisx0208_space = '　';
 22: $value =~ s/^(\s|$jisx0208_space)+//;
 23: $value =~ s/(\s|$jisx0208_space)+$//;
 24: foreach my $keyword (split(/\++/, $value)){
 25: push(@keywords, $keyword);
 26: }
 27: }
 28: }
引数解析をします。検索文字列は「keyword=hoge+emacs」という形式で環境変数 QUERY_STRING に渡されます (半角空白は + に変換されることに注意)。

まず全体を pack で URL デコードします。
jcode::convert で EUC-JP に変換します。 (ここではメールファイルのエンコーディングもあらかじめ EUC-JP に変換してあります)。
フォームに「■hoge emacs」とか「hoge emacs■」などと空白を指定したときのために (■は空白のつもり)、先頭・末尾の空白文字を削除します。ここではいわゆる半角空白と全角空白両方を削除しています。
最後に + (半角空白) で split し、配列 @keywords に格納します。最終的には @keywords=('hoge', 'emacs') という形でセットされます。
 34: if ( scalar(@keywords) == 0 ){
 35: print "検索キーワードが入力されていません。\n";
 36: print "</BODY></HTML>\n";
 37: exit 1;
 38: }
検索文字列が指定されていない場合は、エラーとして終了します。 scalar(@keywords) で @keywords の要素数を取得することができます。この場合はスカラーコンテキストなので、if ( @keywords == 0 )でも構いませんが、可読性を高めるためにあえて scalar を使っています。 $#keywords だと「要素数-1」になることに注意。
 47: my $maildir = '../../freebsd-users-jp';
 48: opendir(DIR, $maildir);
 49: my @files = grep(/^[0-9]+$/, readdir(DIR));
検索対象のファイル名を取得します。grep でファイル名が数字だけからなるものを抽出しています。
 54: foreach my $filename (sort {$a <=> $b} @files){
 55: my @match_line; # マッチした行を格納するための配列
 56: my %already_found; # 発見済キーワードを登録しておくハッシュ
 57: my $all_found_flg = 0; # 全キーワードを発見したら 1 に
 58: 
 59: open(IN, "$maildir/$filename");
 60: LINELOOP:
 61: while (my $line=<IN>){
 62: chomp $line;
 63: foreach my $keyword (@keywords){
 64: # 狙いのキーワードがこのファイル内でみつかっておらず、
 65: # なおかつこの行で検索対象文字列が見付かった
 66: if ( ! defined $already_found{$keyword} &&
 67: index($line, $keyword) >= 0 ){
 68: 
 69: push(@match_line, $line);
 70: $already_found{$keyword} = 1;
 71: 
 72: # 全部のキーワードが見付かったら、もうこのファイルを調べる必要はない
 73: if ( scalar(keys %already_found) == scalar(@keywords) ){
 74: $all_found_flg = 1;
 75: last LINELOOP;
 76: }
 77: }
 78: }
 79: }
 80: close(IN);
 81: 
 82: # 全てのキーワードが見付かった
 83: if ( $all_found_flg ){
 84: print qq(<a href="$freebsd_users_jp_url/$filename">$filename</a> \n);
 85: foreach (@match_line){
 86: printf(" &nbsp; &nbsp; %s \n", escape($_));
 87: }
 88: $found_filenum++;
 89: if ( $found_filenum == $max_found_filenum ){
 90: last;
 91: }
 92: }
 93: }
全体としては先ほどの疑似コードそのままです。注意点は以下の通り。

文字列の検索は index を使用している。もしキーワードが見つからなかったら、index の戻り値は -1 となる。
発見した文字列を @match_line に格納する。
キーワードを発見するとハッシュ %already_found に登録し、同じファイル内では二度と検索しないようにしている。
全てのキーワードを発見したら、そこでそのファイルの検索を打ち切る。
指定の件数以上 (この場合は 100件以上) マッチした場合、そこでそのファイルの検索を打ち切る。
 95: print "\n";
 96: print "$found_filenum 件見つかりました。\n";
 97: if ( $found_filenum == $max_found_filenum ){
 98: print "$max_found_filenum 件見つかったので、検索を打ち切りました。";
 99: }
 100: print "\n";
 101: printf("ユーザモード CPU 消費時間: %.2f秒\n", times()-$start_time);
 102: 
 103: print "</BODY></HTML>\n";
 104: exit 0;
最後に発見したファイルの個数と実行時間を表示して終了です。 $start_time は検索開始前に
 8: my $start_time = times();
としてあらかじめセットしています。times 関数はユーザモードでの命令を実行するために消費された CPU 時間を返しますので、実際にかかった時間とは異なります。
より正確に言うと、times 関数は、リストコンテキストでは

現プロセスがユーザモードで消費した CPU 時間
現プロセスがシステムモードで消費した CPU 時間
子プロセスがユーザモードで消費した CPU 時間
子プロセスがシステムモードで消費した CPU 時間
の 4要素を返し、スカラーコンテキストでは

現プロセスがユーザモードで消費した CPU 時間
だけを返します。文字列検索などのメモリアクセスや演算などを行う際はユーザモードで実行され、 open などのファイル入出力はシステムモードで実行されます。
本当は小数点第二位程度までの時刻が取得できれば何でもよかったのですが、 time 関数は小数点以下の時刻を取得できず、わざわざ時刻計測のためだけに Time::HiRes モジュールをインストールするのもばからしかったので、今回は times 関数を使うことにしました。

search-2.cgi

search-2.cgi はファイル全体をバッファにためて、各キーワードごとに index で検索します。 search-1.cgi と異なる部分だけ説明します。
search-2.pl
 54: FILELOOP:
 55: foreach my $filename (sort {$a <=> $b} @files){
 56: my %match_line;
 57: my %already_found;
 58: 
 59: open(IN, "$maildir/$filename");
 60: my $buf = join('', map { s/\r\n/\n/; $_; } <IN>);
 61: close(IN);
 62: 
 63: foreach my $keyword (@keywords){
 64: my $pos = index($buf, $keyword);
 65: if ( $pos >= 0 ){
 66: # キーワードが見つかった。
 67: my $line_start_pos = rindex($buf, "\n", $pos)+1;
 68: my $line_end_pos = index($buf, "\n", $pos)-1;
 69: $match_line{$line_start_pos} =
 70: substr($buf, $line_start_pos, $line_end_pos-$line_start_pos+1);
 71: } else {
 72: # 見つからなかったらそこで打ち切って、次のファイルへ。
 73: next FILELOOP;
 74: }
 75: }
処理概要は以下の通りです。

<IN> を join して、$buf に格納します。
$buf に対して index でキーワードが存在するか検索します。
今回は常に AND 検索なので、キーワードが存在しなかったら、そこでそのファイルの検索を打ち切ります。
キーワードを発見したときの
 67: my $line_start_pos = rindex($buf, "\n", $pos)+1;
 68: my $line_end_pos = index($buf, "\n", $pos)-1;
 69: $match_line{$line_start_pos} =
 70: substr($buf, $line_start_pos, $line_end_pos-$line_start_pos+1);
という処理は説明が必要かもしれません。search-1.cgi では行単位で検索していたため、キーワードを見付けたらその行をそのまま表示すればよかったのですが、 search-2.cgi ではファイル全体を検索するため、どの行がマッチしたのかを調べる必要があります。 index は発見した文字列のポジション (先頭が 0) を戻り値として返すため、これを利用します。
$buf の内容が
こんにちは、68user です。emacs について質問があります。
カレントディレクトリに hoge というファイルがあるときに、
emacs を起動すると、
となっていたとします。ここで $pos = index($buf, 'hoge') とすると戻り値のポジション $pos は
こんにちは、68user です。emacs について質問があります。
カレントディレクトリに ★hoge というファイルがあるときに、
emacs を起動すると、
の「★」の場所になります。ここで抽出したいのは hoge を含む行 (太線部) です。
コンピュータにしてみれば改行コードはただの 0x0A というコードですから、以下のように表現してみるとどうやって行を抽出すればよいかがわかりやすいかもしれません。
こんにちは、68user です。emacs について質問があります。(0x0A)カレントディレクトリに ★hoge というファイルがあるときに、(0x0A)emacs を起動すると、
つまり

★より前の改行コード (0x0A) の位置
★より後の改行コード (0x0A) の位置
を検索し、その間の文字列を取得すれば、狙いの行全体を得ることができそうです。
1 を取得するには rindex($buf, "\n", $pos) として、ポジション $pos から逆方向に検索し、初めに発見した \n のポジションを取得します。実際には、改行コード自体を含まないように戻り値に +1 を加えています。
2 を取得するには index($buf, "\n", $pos) として、ポジション $pos から順方向に検索し、初めに発見した \n のポジションを取得します。実際には、改行コード自体を含まないように戻り値を -1 しています。
キーワードがファイルの先頭行にある場合、それより前に改行コードが存在しないため、 rindex は -1 を返します。しかし -1 に対して +1 を加算しているため結果は 0 になり、ちょうどファイルの先頭のポジションを指すため、うまく動作します。
一方キーワードがファイルの最終行にあり、その行末に改行コードが存在しなかった場合、 index は -1 を返し、さらに -1 するため -2 となってしまいます。もしファイル行末に改行コードが存在しないメールがあった場合は、おかしな表示になるでしょう。ただし今回はサンプルということで特に対処していません。
 69: $match_line{$line_start_pos} =
 70: substr($buf, $line_start_pos, $line_end_pos-$line_start_pos+1);
あとは 1 から 2 の文字列を substr を使って切り出します。
ここで %match_line ハッシュにしているのは、切り出した行の順序が、実際のファイル内容の順序と合わなくなるのを避けるためです。例えば
こんにちは、68user です。emacs について質問があります。
カレントディレクトリに hoge というファイルがあるときに、
emacs を起動すると、
というメールについて @keywords = ('hoge', 'emacs') というキーワードで検索すると、最初のキーワード hoge でマッチするのは 2行目の
カレントディレクトリに hoge というファイルがあるときに、
の行で、次のキーワード emacs でマッチするのは 1行目の
こんにちは、68user です。emacs について質問があります。
の行です。これをそのまま配列に突っ込んで検索結果として表示してしまうと、
カレントディレクトリに hoge というファイルがあるときに、
こんにちは、68user です。emacs について質問があります。
となってしまい、実際のメール内容とは逆になってしまいます。そこでハッシュ %match_line のキーは行頭のポジション、値は行の内容として、最終的に正しい順序に並べられるようにしています。
また、異なるキーワードが同じ行にマッチした場合でも、ハッシュを使えば同じ行が 2度表示されないという利点もあります。

検索結果表示部分は
 79: foreach my $pos ( sort {$a<=>$b} keys %match_line ){
 80: $_ = $match_line{$pos};
 81: printf(" &nbsp; &nbsp; %s \n", escape($_));
 82: }
です。%match_line のキーを数値としてソートしているので、メール文中の順序どおりに表示されることになります。

search-3.cgi

最も高速な search-3.cgi の解説です。検索結果の末尾に、以下のようなデバッグ文が表示されているのでもう気付いているかもしれません。
eval したコード:
foreach my $filename (sort {$a <=> $b} @files){
 open(IN, "$maildir/$filename");
 my $buf = join(//, <IN>);
 close(IN);

 if ( $buf =~ m/hoge/ && $buf =~ m/emacs/ ){
 matched($filename, $buf, @keywords);
 $found_filenum++;
 if ( $found_filenum == $max_found_filenum ){
 last;
 }
 }
}
高速化の鍵は eval です。eval は Perl のコードを文字列として作成し、それを実行するものです。
文字列ではなくブロックに対する eval もあります。これを使うと Java のように throw/catch な例外処理を実現できたりもしますが、ここでは触れません。

上記のデバッグ文の文字列を作成しているのが以下の部分です。
search-3.pl
 54: my @tmp_keywords = @keywords;
 55: foreach (@tmp_keywords){
 56: $_ = quotemeta($_);
 57: $_ = "\$buf =~ m/$_/";
 58: }
 59: my $regexps = join(' && ', @tmp_keywords);
 60: 
 61: my $eval_code = <<END;
 62: foreach my \$filename (sort {\$a <=> \$b} \@files){
 63: open(IN, "\$maildir/\$filename");
 64: my \$buf = join('', <IN>);
 65: close(IN);
 66: 
 67: if ( $regexps ){
 68: matched(\$filename, \$buf, \@keywords);
 69: \$found_filenum++;
 70: if ( \$found_filenum == \$max_found_filenum ){
 71: last;
 72: }
 73: }
 74: }
 75: END
以下、@keywords = ('hoge', 'emacs') と仮定して解説します。
 54: my @tmp_keywords = @keywords;
 55: foreach (@tmp_keywords){
 56: $_ = quotemeta($_);
 57: $_ = "\$buf =~ m/$_/";
 58: }
まず、@keywords を @tmp_keywords に代入します。次に foreach で @tmp_keywords を直接更新します。すると @tmp_keywords は
@tmp_keywords = (
 '$buf =~ m/hoge/',
 '$buf =~ m/emacs/',
);
となります。foreach 内で各要素を更新していることに注意してください。このためにわざわざ @keywords を使わず、別の配列 @tmp_keywords に代入したわけです。
 59: my $regexps = join(' && ', @tmp_keywords);
@tmp_keywords を && で join することで、 $regexps は
$buf =~ m/hoge/ && $buf =~ m/emacs/
という文字列になります。
 61: my $eval_code = <<END;
 62: foreach my \$filename (sort {\$a <=> \$b} \@files){
 63: open(IN, "\$maildir/\$filename");
 64: my \$buf = join('', <IN>);
 65: close(IN);
 66: 
 67: if ( $regexps ){
 68: matched(\$filename, \$buf, \@keywords);
 69: \$found_filenum++;
 70: if ( \$found_filenum == \$max_found_filenum ){
 71: last;
 72: }
 73: }
 74: }
 75: END
後は用意しておいた文字列に $regexps を埋め込むだけでデバッグ表示されていた文字列のできあがりです。 eval するコード $eval_code はあくまでただの文字列なので、
$eval_code = <<END;
...
END
で作成する場合は変数展開されないように、 \$filename・\\n などとエスケープしておく必要があります。
エスケープのやり方がよくわからない人のために、エスケープなしで同じ文字列を作成する方法を 2つあげておきます。
# 別解 1
$eval_code = join("\n", 
 ('foreach my $filename (sort {$a <=> $b} @files){',
 '...',
 ' if ( ' . $regexps . '){',
 ' matched($filename, $buf, @keywords);',
 '...',
 '}');
# 別解 2
$eval_code = <<'END';
foreach my $filename (sort {$a <=> $b} @files){
...
 if (
END
$eval_code .= $regexps;
$eval_code .= <<'END';
 ) {
 matched($filename, $buf, @keywords);
...
END
これで検索するキーワードがいくつあっても、文字列に対して
if ( $buf =~ m/hoge/ && $buf =~ m/emacs/ ){
とワンアクションで検索できるようになりました。その結果、ループの排除という非常に効果のある高速化を実現できたわけです。
後は検索結果表示ですが、全てのキーワードがマッチした場合、以下の matched サブルーチンを呼ぶようにしてあります。
 97: sub matched {
 98: my ($filename, $buf, @keywords) = @_;
 99: my %already_found;
 100: 
 101: print qq(<a href="$freebsd_users_jp_url/$filename">$filename</a> \n);
 102: 
 103: # マッチした行を表示
 104: foreach my $line (split(/\n/, $buf)){
 105: foreach my $keyword (@keywords){
 106: if ( ! defined $already_found{$keyword} &&
 107: index($line, $keyword) >= 0 ){
 108: 
 109: printf(" &nbsp; &nbsp; %s \n", escape($line));
 110: $already_found{$keyword} = 1;
 111: 
 112: # 次の行へ。
 113: last;
 114: }
 115: }
 116: }
 117: }
サブルーチン化した理由は、 eval 内に記述するとエスケープが多くて可読性が低下するからです。ただしこれは sample-1.cgi と同じく 1行ずつ調べていくやり方で、かなり遅いと思われます。しかし以下の理由により、高速化する必要ははないと考えます。

ファイル検索は約1万回実行される。
検索結果表示は最高でも 100回しか表示されない。検索キーワードによってはそれ以下かもしれない (実際、「hoge emacs」の場合は 3回)。
何度も実行される部分は重点的に高速化すべきですが、あまり実行されない部分を高速化しても、全体としての効果はそれほどあがりません。これは負荷について考えるの「実行頻度が多い処理は軽くする」と同じ考え方です。

search-3.cgi - eval の効率

search-3.cgi では以下の疑似コードの太字部分を eval していました。
@keywords = ('hoge', 'emacs');
foreach $file (@files){
 open(IN, $file);
 $buf = join('', <IN>);
 if ( $buf 内に @keywords の全要素が存在する ){
 ファイル名と内容を表示
 }
}
一方、以下のように文字列検索部分だけを eval する方法もあります。
@keywords = ('hoge', 'emacs');
foreach $file (@files){
 open(IN, $file);
 $buf = join('', <IN>);
 if ( $buf 内に @keywords の全要素が存在する ){
 ファイル名と内容を表示
 }
}
eval で実行する範囲が減り、その結果エスケープしなければいけない箇所も減るというメリットがあります。しかし、この方法はお勧めできません。
eval はかなり重い処理です。 eval すると Perl が字句解析・構文解析・エラーチェックを行います。外側の foreach は約1万回ループするわけなので、 eval も約1万回実行され、毎回字句解析・構文解析・エラーチェックが行われます。実際に試してみましたが、最も遅い search-1.cgi の 1.5倍程度遅くなってしまいました。
search-3.cgi では一度しか eval しないようにして、速度低下を最小限にしています。

search-3.cgi - eval のセキュリティ

eval は非常に恐ろしい命令です。安易に
$keyword = $ENV{QUERY_STRING};
$keyword =~ s/%([0-9a-fA-F][0-9a-fA-F])/pack("C", hex($1))/eg;
$eval_code = 'if ( $buf =~ m/$keyword/ ){ ... }';
eval $eval_code;
などとやってしまうと、もうおしまいです。 QUERY_STRING に
keyword=hoge/ ){} system("rm -rf .&"); if ( "a" =~ m/fuga
という文字列を送り込まれると、eval するコードが
if ( $buf =~ m/hoge/ ){}
system("rm -rf . &");
if ( "a" =~ m/fuga/ ){ ... }
となり、サーバのカレントディレクトリ以下の全ファイルが消去されます。
この対策として、「/」(スラッシュ) を「\/」にエスケープし、正規表現を閉じるスラッシュを無効にしてみましょう。つまり、
$eval_code =~ s|/|\\/|g; # ★追加
$eval_code = 'if ( $buf =~ m/$keyword/ ){ ... }';
eval $eval_code;
となります。この場合は
if ( $buf =~ m/hoge\/ ){} system("rm -rf . &"); if ( "a" =~ m\/fuga/ ){ ... }
と太字部分すべてが正規表現とみなされ、外部からのコードは実行されません。
実際には「)」が正規表現としてエラーとみなされ、実行時エラーとなります。
ただし、スラッシュ以外に問題となる文字がないかどうかはわかりません (わたしはないと思いますが、もしかしたら見逃しているかもしれません)。 sample-3.cgi ではより安全側に寄せるために
   54: my @tmp_keywords = @keywords;
   55: foreach (@tmp_keywords){
   56:     $_ = quotemeta($_);
   57:     $_ = "\$buf =~ m/$_/";
   58: }
と quotemeta を使うことで、正規表現とみなされる全ての文字や、 $・@ などの文字をエスケープしています。
正規表現中に (?{...}) という文字列を指定すると、「...」の部分を Perl のコードとみなして実行する機能があります (少なくとも Perl-5.005_03 では実装されています)。ということは、上のセキュリティ的に問題のあるコードの QUERY_STRING に
keyword=(?{system("rm -rf . &")})
と渡すとカレントディレクトリ以下のファイルが削除されてしまうのでは、と思うかもしれませんが、実際には
Eval-group not allowed at runtime, use re 'eval' in regex
と実行時エラーになります。これは、Perl のセキュリティチェック機能が働いているからです。
if ( m/(?{system("rm -rf . &")})/ ){
などと直接正規表現中に (?{...}) を記述した場合は rm コマンドが実行されるのですが、
$regexp = '(?{system("rm -rf . &")})';
if ( m/$regexp/ ){
と一度変数に経由した正規表現に (?{...}) が含まれていた場合は上記のエラーになります。もしこのような処理で (?{...}) を有効にしたければ、
use re 'eval';
としてください。ただし、お勧めはしません。

search-3.cgi - 正規表現の利点

eval と正規表現を組み合わせる利点として「大文字・小文字の区別をしない検索を用意に実現できる」ということがあげられます。
   55: foreach (@tmp_keywords){
   56:     $_ = quotemeta($_);
   57:     $_ = "\$buf =~ m/$_/";
   58: }
上記の部分を
foreach (@tmp_keywords){
    $_ = quotemeta($_);
    $_ = "\$buf =~ m/$_/i";  # ★ m/.../ を m/.../i に変更
}
とするだけで、eval する文字列が
if ( $buf =~ m/hoge/i && $buf =~ m/emacs/i ){
となり、大文字・小文字を区別しない検索が容易に実現できます。数回試した限りでは、実行時間は search-3.cgi の 1.15倍程度となりました。ただしマッチしたメールの数が 3個から 66 個まで増えてしまったので、実際に検索に関わる部分の時間については、それほど長くなってはいないと思われます。

全ソース

search-1.cgi・search-2.cgi・search-3.cgi のソース全文は以下の通りです。

search-1.pl

    1: #!/usr/local/bin/perl
    2: 
    3: # $Id: search-1.cgi,v 1.3 2006/02/04 07:11:40 68user Exp $
    4: 
    5: use strict;
    6: require 'jcode.pl';
    7: 
    8: my $start_time = times();
    9: 
   10: $|=1;
   11: 
   12: my @keywords;   # 検索対象となるキーワード
   13: 
   14: # 引数解析
   15: foreach ( split(/&/, $ENV{QUERY_STRING}) ){
   16:     my ($name, $value) = split(/=/, $_);
   17:     if ( $name eq 'keyword' ){
   18:         $value =~ s/%([0-9a-fA-F][0-9a-fA-F])/pack("C", hex($1))/eg;
   19:         &jcode::convert(\$value, 'euc');
   20:         # 前後の空白を削除
   21:         my $jisx0208_space = '　';
   22:         $value =~ s/^(\s|$jisx0208_space)+//;
   23:         $value =~ s/(\s|$jisx0208_space)+$//;
   24:         foreach my $keyword (split(/\++/, $value)){
   25:             push(@keywords, $keyword);
   26:         }
   27:     }
   28: }
   29: 
   30: print "Content-type: text/html; charset=EUC-JP\n\n";
   31: print qq(<HTML><BODY BGCOLOR="#EEEEEE">\n);
   32: print "<h1>全文検索その1: index 関数で各キーワードごとに各行を検索</h1>\n";
   33: 
   34: if ( scalar(@keywords) == 0 ){
   35:     print "検索キーワードが入力されていません。\n";
   36:     print "</BODY></HTML>\n";
   37:     exit 1;
   38: }
   39: 
   40: printf("<p>FreeBSD-users-jp を「%s」で検索します。</p>\n",
   41:        escape(join(' ', @keywords)));
   42: 
   43: my $freebsd_users_jp_url =
   44:     'http://home.jp.freebsd.org/cgi-bin/showmail/FreeBSD-users-jp';
   45: 
   46: # メールのファイル名を @files に格納 
   47: my $maildir = '../../freebsd-users-jp';
   48: opendir(DIR, $maildir);
   49: my @files = grep(/^[0-9]+$/, readdir(DIR));
   50: 
   51: my $found_filenum = 0;          # マッチしたファイル数
   52: my $max_found_filenum = 100;    # これ以上マッチしたら検索を打ち切る
   53: 
   54: foreach my $filename (sort {$a <=> $b} @files){
   55:     my @match_line;         # マッチした行を格納するための配列
   56:     my %already_found;      # 発見済キーワードを登録しておくハッシュ
   57:     my $all_found_flg = 0;  # 全キーワードを発見したら 1 に
   58: 
   59:     open(IN, "$maildir/$filename");
   60:   LINELOOP:
   61:     while (my $line=<IN>){
   62:         chomp $line;
   63:         foreach my $keyword (@keywords){
   64:             # 狙いのキーワードがこのファイル内でみつかっておらず、
   65:             # なおかつこの行で検索対象文字列が見付かった
   66:             if ( ! defined $already_found{$keyword} &&
   67:                  index($line, $keyword) >= 0 ){
   68: 
   69:                 push(@match_line, $line);
   70:                 $already_found{$keyword} = 1;
   71: 
   72:                 # 全部のキーワードが見付かったら、もうこのファイルを調べる必要はない
   73:                 if ( scalar(keys %already_found) == scalar(@keywords) ){
   74:                     $all_found_flg = 1;
   75:                     last LINELOOP;
   76:                 }
   77:             }
   78:         }
   79:     }
   80:     close(IN);
   81: 
   82:     # 全てのキーワードが見付かった
   83:     if ( $all_found_flg ){
   84:         print qq(<a href="$freebsd_users_jp_url/$filename">$filename</a><BR>\n);
   85:         foreach (@match_line){
   86:             printf(" &nbsp; &nbsp; %s<BR>\n", escape($_));
   87:         }
   88:         $found_filenum++;
   89:         if ( $found_filenum == $max_found_filenum ){
   90:             last;
   91:         }
   92:     }
   93: }
   94: 
   95: print "<p>\n";
   96: print "$found_filenum 件見つかりました。\n";
   97: if ( $found_filenum == $max_found_filenum ){
   98:     print "$max_found_filenum 件見つかったので、検索を打ち切りました。";
   99: }
  100: print "<p>\n";
  101: printf("ユーザモード CPU 消費時間: %.2f秒\n", times()-$start_time);
  102: 
  103: print "</BODY></HTML>\n";
  104: exit 0;
  105: 
  106: 
  107: #-----------------------------------------
  108: sub escape {
  109:     my ($str) = @_;
  110:     $str =~ s/&/&amp;/g;
  111:     $str =~ s/</&lt;/g;
  112:     $str =~ s/>/&gt;/g;
  113:     $str =~ s/ /&nbsp;/g;
  114:     return $str;
  115: }

search-2.pl

    1: #!/usr/local/bin/perl
    2: 
    3: # $Id: search-2.cgi,v 1.2 2006/02/04 07:11:40 68user Exp $
    4: 
    5: use strict;
    6: require 'jcode.pl';
    7: 
    8: my $start_time = times();
    9: 
   10: $|=1;
   11: 
   12: my @keywords;   # 検索対象となるキーワード
   13: 
   14: # 引数解析
   15: foreach ( split(/&/, $ENV{QUERY_STRING}) ){
   16:     my ($name, $value) = split(/=/, $_);
   17:     if ( $name eq 'keyword' ){
   18:         $value =~ s/%([0-9a-fA-F][0-9a-fA-F])/pack("C", hex($1))/eg;
   19:         &jcode::convert(\$value, 'euc');
   20:         # 前後の空白を削除
   21:         my $jisx0208_space = '　';
   22:         $value =~ s/^(\s|$jisx0208_space)+//;
   23:         $value =~ s/(\s|$jisx0208_space)+$//;
   24:         foreach my $keyword (split(/\++/, $value)){
   25:             push(@keywords, $keyword);
   26:         }
   27:     }
   28: }
   29: 
   30: print "Content-type: text/html; charset=EUC-JP\n\n";
   31: print qq(<HTML><BODY BGCOLOR="#EEEEEE">\n);
   32: print "<h1>全文検索その2: index 関数で各キーワードを検索</h1>\n";
   33: 
   34: if ( scalar(@keywords) == 0 ){
   35:     print "検索キーワードが入力されていません。\n";
   36:     print "</BODY></HTML>\n";
   37:     exit 1;
   38: }
   39: 
   40: printf("<p>FreeBSD-users-jp を「%s」で検索します。</p>\n",
   41:        escape(join(' ', @keywords)));
   42: 
   43: my $freebsd_users_jp_url =
   44:     'http://home.jp.freebsd.org/cgi-bin/showmail/FreeBSD-users-jp';
   45: 
   46: # メールのファイル名を @files に格納 
   47: my $maildir = '../../freebsd-users-jp';
   48: opendir(DIR, $maildir);
   49: my @files = grep(/^[0-9]+$/, readdir(DIR));
   50: 
   51: my $found_filenum = 0;          # マッチしたファイル数
   52: my $max_found_filenum = 100;    # これ以上マッチしたら検索を打ち切る
   53: 
   54: FILELOOP:
   55: foreach my $filename (sort {$a <=> $b} @files){
   56:     my %match_line;
   57:     my %already_found;
   58: 
   59:     open(IN, "$maildir/$filename");
   60:     my $buf = join('', map { s/\r\n/\n/; $_; } <IN>);
   61:     close(IN);
   62: 
   63:     foreach my $keyword  (@keywords){
   64:         my $pos = index($buf, $keyword);
   65:         if ( $pos >= 0 ){
   66:             # キーワードが見つかった。
   67:             my $line_start_pos = rindex($buf, "\n", $pos)+1;
   68:             my $line_end_pos = index($buf, "\n", $pos)-1;
   69:             $match_line{$line_start_pos} =
   70:                 substr($buf, $line_start_pos, $line_end_pos-$line_start_pos+1);
   71:         } else {
   72:             # 見つからなかったらそこで打ち切って、次のファイルへ。
   73:             next FILELOOP;
   74:         }
   75:     }
   76: 
   77:     # ここまで到達したということは、全てのキーワードが見付かったということ
   78:     print qq(<a href="$freebsd_users_jp_url/$filename">$filename</a><BR>\n);
   79:     foreach my $pos ( sort {$a<=>$b} keys %match_line ){
   80:         $_ = $match_line{$pos};
   81:         printf(" &nbsp; &nbsp; %s<br>\n", escape($_));
   82:     }
   83:     $found_filenum++;
   84:     if ( $found_filenum == $max_found_filenum ){
   85:         last;
   86:     }
   87: }
   88: 
   89: print "<p>\n";
   90: print "$found_filenum 件見付かりました。\n";
   91: if ( $found_filenum == $max_found_filenum ){
   92:     print "$max_found_filenum 件見つかったので、検索を打ち切りました。";
   93: }
   94: print "<p>\n";
   95: printf("ユーザモード CPU 消費時間: %.2f秒\n", times()-$start_time);
   96: 
   97: print "</BODY></HTML>\n";
   98: exit 0;
   99: 
  100: 
  101: #-----------------------------------------
  102: sub escape {
  103:     my ($str) = @_;
  104:     $str =~ s/&/&amp;/g;
  105:     $str =~ s/</&lt;/g;
  106:     $str =~ s/>/&gt;/g;
  107:     $str =~ s/ /&nbsp;/g;
  108:     return $str;
  109: }

search-3.pl

    1: #!/usr/local/bin/perl
    2: 
    3: # $Id: search-3.cgi,v 1.3 2006/02/04 07:11:40 68user Exp $
    4: 
    5: use strict;
    6: require 'jcode.pl';
    7: 
    8: my $start_time = times();
    9: 
   10: $|=1;
   11: 
   12: my @keywords;   # 検索対象となるキーワード
   13: 
   14: # 引数解析
   15: foreach ( split(/&/, $ENV{QUERY_STRING}) ){
   16:     my ($name, $value) = split(/=/, $_);
   17:     if ( $name eq 'keyword' ){
   18:         $value =~ s/%([0-9a-fA-F][0-9a-fA-F])/pack("C", hex($1))/eg;
   19:         &jcode::convert(\$value, 'euc');
   20:         # 前後の空白を削除
   21:         my $jisx0208_space = '　';
   22:         $value =~ s/^(\s|$jisx0208_space)+//;
   23:         $value =~ s/(\s|$jisx0208_space)+$//;
   24:         foreach my $keyword (split(/\++/, $value)){
   25:             push(@keywords, $keyword);
   26:         }
   27:     }
   28: }
   29: 
   30: print "Content-type: text/html; charset=EUC-JP\n\n";
   31: print qq(<HTML><BODY BGCOLOR="#EEEEEE">\n);
   32: print "<h1>全文検索その3: 正規表現で全キーワードを一度に検索</h1>\n";
   33: 
   34: if ( scalar(@keywords) == 0 ){
   35:     print "検索キーワードが入力されていません。\n";
   36:     print "</BODY></HTML>\n";
   37:     exit 1;
   38: }
   39: 
   40: printf("<p>FreeBSD-users-jp を「%s」で検索します。</p>\n",
   41:        escape(join(' ', @keywords)));
   42: 
   43: my $freebsd_users_jp_url =
   44:     'http://home.jp.freebsd.org/cgi-bin/showmail/FreeBSD-users-jp';
   45: 
   46: # メールのファイル名を @files に格納 
   47: my $maildir = '../../freebsd-users-jp';
   48: opendir(DIR, $maildir);
   49: my @files = grep(/^[0-9]+$/, readdir(DIR));
   50: 
   51: my $found_filenum = 0;          # マッチしたファイル数
   52: my $max_found_filenum = 100;    # これ以上マッチしたら検索を打ち切る
   53: 
   54: my @tmp_keywords = @keywords;
   55: foreach (@tmp_keywords){
   56:     $_ = quotemeta($_);
   57:     $_ = "\$buf =~ m/$_/";
   58: }
   59: my $regexps = join(' && ', @tmp_keywords);
   60: 
   61: my $eval_code = <<END;
   62: foreach my \$filename (sort {\$a <=> \$b} \@files){
   63:     open(IN, "\$maildir/\$filename");
   64:     my \$buf = join('', <IN>);
   65:     close(IN);
   66: 
   67:     if ( $regexps ){
   68:         matched(\$filename, \$buf, \@keywords);
   69:         \$found_filenum++;
   70:         if ( \$found_filenum == \$max_found_filenum ){
   71:             last;
   72:         }
   73:     }
   74: }
   75: END
   76:     ;
   77: my $eval_code_for_print = $eval_code;
   78: 
   79: eval $eval_code;
   80: print "$@";
   81: 
   82: print "<hr>eval したコード: ";
   83: printf("<BLOCKQUOTE><FONT SIZE='-1'><PRE>%s</PRE></FONT></BLOCKQUOTE>", escape($eval_code_for_print));
   84: 
   85: print "<p>\n";
   86: print "$found_filenum 件見付かりました。\n";
   87: if ( $found_filenum == $max_found_filenum ){
   88:     print "$max_found_filenum 件見つかったので、検索を打ち切りました。";
   89: }
   90: print "<p>\n";
   91: printf("ユーザモード CPU 消費時間: %.2f秒\n", times()-$start_time);
   92: 
   93: print "</BODY></HTML>\n";
   94: exit 0;
   95: 
   96: #----------------------------------------------
   97: sub matched {
   98:     my ($filename, $buf, @keywords) = @_;
   99:     my %already_found;
  100: 
  101:     print qq(<a href="$freebsd_users_jp_url/$filename">$filename</a><BR>\n);
  102: 
  103:     # マッチした行を表示
  104:     foreach my $line (split(/\n/, $buf)){
  105:         foreach my $keyword  (@keywords){
  106:             if ( ! defined $already_found{$keyword} &&
  107:                  index($line, $keyword) >= 0 ){
  108: 
  109:                 printf(" &nbsp; &nbsp; %s<br>\n", escape($line));
  110:                 $already_found{$keyword} = 1;
  111: 
  112:                 # 次の行へ。
  113:                 last;
  114:             }
  115:         }
  116:     }
  117: }
  118: 
  119: #-----------------------------------------
  120: sub escape {
  121:     my ($str) = @_;
  122:     $str =~ s/&/&amp;/g;
  123:     $str =~ s/</&lt;/g;
  124:     $str =~ s/>/&gt;/g;
  125:     $str =~ s/ /&nbsp;/g;
  126:     return $str;
  127: }

前へ << GD::Graph によるグラフ生成

CGI プログラムからのメール送信 (1) >> 次へ

TOP >> web と CGI のひみつ >> 全文検索

$Id: search-1.html,v 1.7 2006/06/07 04:47:49 68user Exp $