#!/usr/local/bin/perl
#日本語コード変換ライブラリ
#ダウンロード先↓
#ftp://ftp.iij.ad.jp/pub/IIJ/dist/utashiro/perl/
require './jcode.pl';
#フォームデコード用ライブラリ
#ダウンロード先↓
#http://www.bio.cam.ac.uk/cgi-lib/
require './cgi-lib.pl';
#指定したディレクトリ内のテキストファイルの内容を読み目的の語を持つファイルにリンクを張ります。
#ファイラ系のf-basicを流用してテキストデータを読み込んでいます。
#大した対策はしていないので、正規表現とか使えてしまいます。
$title = 'Dir(Dear) サーチ';
#リストするディレクトリ
$dir = "./";
#当スクリプト
$script_file = 's-basic.cgi';
#リンクを張るファイルのリスト
@entrylist;
#cgi-lib.plの関数。これを呼び出すとフォームの内容が%inに格納される
&ReadParse;
#フォームから検索文字を所得
$s_text = $in{'searchtext'};
$s_text =~ s//>/g;
$s_title = $s_text;
#EUCに変換
&jcode'convert(*s_text,'euc');
#指定したディレクトリを開く
opendir(DIR,$dir) || &error("ディレクトリ【$dir】にアクセスできません。");
while ( $entry = readdir DIR ) {
#拡張子「txt」を持つファイルだけリストに追加する
if($entry =~ /\.txt/){
push @entrylist,"$dir$entry";
}
}
closedir(DIR) ;
print "Content-type: text/html\n\n";
print <<"EOF";
$title
$title
EOF
if($in{'mode'} eq "search"){
print "文字列\"$s_title\"の検索結果
\n";
#リストを表示する
if(@entrylist){
foreach $listentry (@entrylist) {
@lines = ();
#テキストファイルのオープン
if (open(READTXT,$listentry)) {
print "
$listentryを開きました
\n";
@lines = ;
}else{
print "
$listentryは開けません
\n";
}
close(READTXT);
$foundline = 0;
if(@lines){
$linecount = 0;
foreach $textline (@lines) {
#
$textline =~ s//>/g;
$textline =~ s/\t//g;
#検索するときはeucに変換
#Shift JISの特定の文字は検索などでは文字コードの問題からエラーを起こすので
#文字コードを最初からEUCに統一するなどの対策をとればgrepなどの関数が便利
&jcode'convert(*textline,'euc');
$linecount++;
if($textline =~ /$s_text/){
$foundline = 1;
#表示するときはまたS-jisに変換
&jcode'convert(*textline,'sjis');
print "発見 : ファイル:$listentry 行数:$linecount
";
print "$textline
\n";
}else{
#print ":残念
\n";
}
}
}
if($foundline == 0){
print "指定語は含まれていません";
}
}
}else{
print "指定したディレクトリにテキストファイルは見当たりません";
}
print "
";
print "再検索";
}else{
print "検索フォーム
\n";
print "
\n";
print "";
}
print "";
exit;
###########################################################
#エラー表示
sub error {
#ローカル変数の設定
#@_は引数の配列
local (@msg) = @_;
local ($i);
print "Content-type: text/html\n\n";
print <<"EOF";
$_[0]
$_[0]
EOF
print "\n";
foreach $i (1 .. $#msg) { print "- $msg[$i]\n"; }
print "
\n";
print "\n";
exit;
}