#!/usr/bin/perl
#!/usr/bin/perl

## 高崎RADA シソーラス検索対応版
## 2003.06

## DBIモジュールを使用
use DBI;
## DB設定
$db_user = 'rada';
$db_name = 'radadb';
$db_passwd = 'rada';

$SCRIPT_NAME = '';
## cgiwrap のために「次の xx 件」が表示できないときに、
## CGI の絶対パスを設定して下さい。
## 例えば、http://www.xxx.yyy/zzz/namazu.cgi だったら
##  $SCRIPT_NAME = '/zzz/namazu.cgi';
## のように

# pnamazu-2002.11.16
# Namazu Search (perl 版) by furukawa@tcp-ip.or.jp

{
    my($tmp) = $0;

    $tmp = "./$tmp" if -e $tmp && $tmp !~ /[\/\\]/;
    while ($tmp =~ /^(.*[\/\\])/){
        unshift(@INC, $1);
        last if !-l $tmp;
        $tmp = $1 . $tmp if ($tmp = readlink($tmp)) !~ /^\//;
    }
}

$Debug = 1 if -e "debug";

sub config{
    $Pnamazu = '2002.11.16';
    $Author = 'furukawa@tcp-ip.or.jp';

    #-------------------------- 'configuration' --------------------------
    # namazu.conf に無いパラメータの設定、および perl 版特有の設定
    
    # v1.1 以前のバージョンで、インデクス作成と、検索で使うマシンが違う場合、
    # 整数の設定を変更する必要がある可能性があるので、確認すること。
    # ここでは、mknmz を実行したマシンでの整数のタイプに合わせる
    
    # big endian, 32bit             -> 'N'
    # big endian, 16bit             -> 'n'
    # little endian, 32bit          -> 'V'
    # little endian, 16bit          -> 'v'
    # 上記に関係なく mknmz と同じ   -> 'I'
    # v1.2 以上のバージョンのインデックスを普通に使うときには、
    # 何も入れないほうがよい
    
    $IntType = '';
    
    # データベースを gzip で圧縮した場合の、zcat の設定
    #   データベースファイルのうち、次の 5 つの拡張子のものは、
    #   gzip による圧縮ファイルを使用できる。
    #       非圧縮時    圧縮時
    #       .h          .h.gz  または .hz
    #       .ii         .ii.gz または .iiz
    #       .i          .i.gz  または .iz
    #       .fi         .fi.gz または .fiz
    #       .f          .f.gz  または .fz
    #   5 つ全部ではなく、一部だけを圧縮して置くことも可能
    #   圧縮ファイルが無ければ、自動的に非圧縮ファイルを読む
    
    $Zcat = '/usr/local/bin/gzip -dc';
    #$Zcat = '';                     # 圧縮無し
    #$Zcat = '/usr/local/bin/zcat';
    
    # zcat を使う場合に、サーバへの負担を軽減するため、priority を下げる
    $ZcatPri = 10;
    
    # 設定の初期値 (コマンドラインオプション、環境変数 QUERY_STRING により変更可能)
    $Max = 10;
    $Whence = 0;
    $DbName = 'NMZ';
    $Format = 'long';
    $Sort = "score";
    
    # $NamazuDir = "/usr/local/namazu";
    
    # Zcat を使うときには、ScriptFileName をきちんと設定しておくことが望ましい
    $ScriptFileName = '';
    
    # namazu.conf の指定
    $NamazuConf = '';
    
    
    # renice の指定、重い処理になったときに、サーバに負担がかかるのを防ぐ
    # ため、一定時間が経過したら、priority を下げる。CGI のときだけ有効
    
    # renice が実行されるまでの時間と実行後の priority の設定。時間が
    # 正の数でないと、機能は実行されない。priority が負だと、時間経過
    # したところで終了
    $ReniceTime = 120;
    $RenicePri = -1;
    
    # cmdline 時の argv の順番の指定 'new' にすると、'key string' [index dir]
    # の順、'old' にすると、[index dir] 'key string' の順
    $CmdLineArg = 'new';
    
    # database の別名リスト。
    %DbAlias = ();
    
    # 有効な database 名のリスト。
    # このリストが空でない場合、リストにあるもの以外は使えなくなる。
    @DbEnable = ();
    
    # 応答の text の検索式の初期値として、
    # 1 ... 入力をそのまま返す
    # 0 ... わかち書きなどの処理後の文字列を使う
    # (この変数は、namazurc でも設定可能です)
    $RespTextOrig = 0;
    
    # 文書の存在するディレクトリにもリンクする
    $SplitLink = 0;
    
    # 簡易キャッシュのトータルサイズ
    # 一度ファイルを作ってから、サイズ超過したら消す、という順序の処理を
    # しているので、一時的には、この値を超えることがある。
    $CacheSizeLimit = 4096;
    
    # namazu バイナリの path
    # これを指定しておくと、単純な検索のときには、こちらを呼ぶ
    # …ようにする予定だが、未実装。
    $NamazuPath = '';
    
    # 要約を、NMZ.f から読むのではなく、元ファイルを読んで、その場で作る
    # (この変数は、namazurc でも設定可能です)
    $MakeSummary = 0;
    
    # 元ファイルを読んで、単語の含まれる行を表示する
    # 'default' とすると、grep=off としない限り表示
    # 'option' とすると、grep=on としたときに限り表示
    # その他の場合は、常に表示しない
    # (この変数は、namazurc でも設定可能です)
    $MakeGrep = 'option';
    
    # grep 機能を使うときに、「grep 出力 -> 通常の要約」の順にする
    # (従来は「要約->grep」だった)
    $GrepFirst = 1;
    
    # *.hnf を grep する際に、GRP を見つけたときの扱い。
    # 1 にすると、以降の行は見ない。
    $HnsGrepGrp = 1;
    
    # 検索時の制限値。
    # MaxHit      … 語検索時の文書ヒット数の最大値
    # MaxFieldHit … フィールド検索、タイムスタンプ検索時の文書ヒット数最大値
    # MaxMatch    … 正規表現検索時の、単語マッチ数最大値
    $MaxHit = 5000;
    $MaxFieldHit = 10000;
    $MaxMatch = 1000;
    
    # 携帯電話モード
    # 'always' にすると、常に有効
    # 'auto' にすると、自動判別
    # それ以外にすると、常に無効
    $PhoneEnable = 'auto';
    
    # 携帯電話モードのときに、カタカナを x0201 (いわゆる半角カナ)
    # に変換するか (1: 変換する, 0: 変換しない)
    $PhoneX0201 = 0;
    
    
    # ヒットしなかったひらがな語を、演算対象とするかどうかの設定
    # 'on' にすると、常に演算対象とする。
    # 'wakati' にすると、分かち書き中のみ演算対象とする
    # 'off' にすると、演算対象としない。(perl 版旧来の動作)
    $HWMode = 'wakati';
    
    # カタカナフレーズモード
    # 例えば「ア・イ」を内部的に
    # 「アイ or { ア ・ イ } or { ア イ }」
    # として扱う。
    $KPMode = 1;
    
    # submit の値に、この文字列が入っていたら、Location ヘッダを
    # 返す (大文字/小文字区別なし)
    $Jump = 'jump';
    
    # Title の書き換えフォーマット
    # ${title} ... 元々のタイトル
    # ${key}   ... 検索式
    $TitleFormat = 'RADA: ${key} / ${title}';
    
    #---------------------- End of 'configuration' -----------------------

    $ScriptFileName = $ENV{'SCRIPT_FILENAME'} if !$ScriptFileName;
    $ScriptFileName = $0 if !$ScriptFileName && $0 ne '-';
    ($ScriptDir = $ScriptFileName) =~ s/[\\\/].*?$// if $ScriptFileName && !$ScriptDir;

    if ($SCRIPT_NAME eq ''){
        if (($SCRIPT_NAME = $ENV{'SCRIPT_NAME'}) =~ /cgiwrap/i){
            if (length $ENV{'REQUEST_URI'}){
                ($SCRIPT_NAME = $ENV{'REQUEST_URI'}) =~ s/\?.*$//;
            }
            $Warn_Scriptname = 1 if $SCRIPT_NAME =~ /cgiwrap/i;
        }
    }
    &debug_log("config: SCRIPT_NAME=$SCRIPT_NAME");
}


#--------------------- 'load namazu.conf' Module ---------------------
sub read_conf{
    my $filename = shift;
    local(*FH);
    return unless open(FH, $filename);
    $NamazuConfFile = $filename;

    &debug_log("RcFile=$filename");

    my $logging;
    while(<FH>){
        next if /^[\# ]/;
        next if /^\s*$/;
        chomp;
        &debug_log("Rc: $_");
        $DEFAULT_DIR      = $2 if /^(INDEX|DEFAULT_DIR)\s+(\S+)/i;
        $TEMPLATE         = $1 if /^Template\s+(\S+)/i;
        $BASE_URL         = $1 if /^BASE_URL\s+(\S+)/i;
        if (/^REPLACE\t+([^\t]+)\t+([^\t]+)/i){
            $ReplaceTo{"\L$1"} = $2;
            push(@ReplaceFrom, $1);
            $URL_REPLACE_FROM = $1;
            $URL_REPLACE_TO = $2;
        }elsif (/^\s*Replace\s+\"((\\.|[^\\])+)\"\s+\"((\\.|[^\\])+)\"/i){ #"
            &entry_replace($1, $3);
        }elsif (/^\s*Replace\s+(\S+)\s+(\S+)/i){
            &entry_replace($1, $2);
        }
        $URL_REPLACE_FROM = $1 if /^URL_REPLACE_FROM\s+(\S+)/i;
        $URL_REPLACE_TO   = $1 if /^URL_REPLACE_TO\s+(\S+)/i;
        $WAKATI           = $2 if /^(wakachi|wakati)\s+(\S+)/i;
        $logging          = $1 if /^LOGGING\s+(\S+)/i;
        $CnfLang          = $2 if /^LANG(UAGE)?\s+(\S+)/i;
        $SCORING          = $1 if /^SCORING\s+(\S+)/i;
        $RespTextOrig     = $1 if /^RespTextOrig\s+(\S+)/i;
        $MakeSummary      = $1 if /^MakeSummary\s+(\S+)/i;
        $MakeGrep         = $1 if /^MakeGrep\s+(\S+)/i;
        $DiaryDir         = $1 if /^DiaryDir\s+(\S+)/i;
        $TinyMknmz        = $1 if /^TinyMknmz\s+(\S+)/i;
        $Debug            = 1  if /^Debug/i;
        $TitleFormat      = $1 if /^TitleFormat\s+(\S.*)$/i;
        $PhoneX0201       = $1 if /^PhoneX0201\s+(\S.*)$/i;
        if (/^EmphasisTags\s+\"(.+)\"\s+\"(.+)\"\s*$/i){ #"
            ($EmTagS, $EmTagE) = ($1, $2);
            $EmTagS =~ s/\\(.)/$1/g;
            $EmTagE =~ s/\\(.)/$1/g;
        }
    }
    close(FH);

    $LOGGING = ($logging =~ /^off/)? 0: 1 if $logging ne '';
    $TFIDF = ($SCORING =~ /tfidf/i);
}

sub load_namazu_conf{
    my($env, $conf, $tmp);

    &in_hns;
    my @conf = ('/usr/local/namazu/conf', '/usr/local/share/namazu/conf',
                '/usr/local/namazu/lib', '/usr/local/etc/namazu',
                '/usr/local/share/etc/namazu', @INC, '.');
    push(@conf, $1), push(@conf, $2) if $0 =~ /^((.*)\/public_html)/;
    push(@conf, $NamazuDir) if $NamazuDir;
    push(@conf, $NamazuConf) if $NamazuConf;
    push(@conf, $ENV{'NAMAZUCONF'}) if $ENV{'NAMAZUCONF'};
    push(@conf, $ENV{'NAMAZUCONFPATH'}) if $ENV{'NAMAZUCONFPATH'};
    push(@conf, $ENV{'HOME'}) if $ENV{'HOME'};
    push(@conf, $ENV{'PWD'}) if $ENV{'PWD'};
    push(@conf, $DiaryConf) if -d $DiaryConf;
    push(@conf, $BaseDir) if $BaseDir;
    push(@conf, $NamazuConfFile) if $NamazuConfFile;

    my (@files) = ("namazu.conf", "namazurc", ".namazurc", ".pnamazurc");

    for $tmp (&pnmz_find(\@conf, \@files)){
        &read_conf($tmp);
    }

    $ReplaceFrom = join('|', map {quotemeta($_)} sort {length $b <=> length $a} @ReplaceFrom);

    if ($Debug > 0){
        if (%ReplaceTo){
            my $key;
            for $key (sort keys %ReplaceTo){
                &debug_log("ReplaceTo: $key => $ReplaceTo{$key}");
            }
        }
        if (@ReplacePattern){
            my $key;
            for $key (@ReplacePattern){
                &debug_log("ReplacePattern: $key => $ReplacePattern{$key}");
            }
        }
        &debug_log("EmStart: $EmTagS");
        &debug_log("EmEnd: $EmTagE");
    }else{
        $Debug = -1;
    }
}

sub entry_replace{
    my ($src, $dst) = @_;
    local($_);
    eval {s/$src/$dst/i};
    unless ($@){
        unshift(@ReplacePattern, $src);
        $ReplacePattern{$src} = $dst;
        $URL_REPLACE_FROM = $src;
        $URL_REPLACE_TO = $dst;
    }
}

sub replace{
    my $src = $_[0];
    return unless $Replace;
    if (%ReplaceTo){
        &debug_log("replace: $src => $_[0]"), return if $_[0] =~ s/($ReplaceFrom)/$ReplaceTo{"\L$1"}/io;
    }
    my $pat;
    for $pat (@ReplacePattern){
        &debug_log("replace: $src => $_[0]"), return if $_[0] =~ s/$pat/$ReplacePattern{$pat}/i;
    }
}

sub in_hns{
    if (-d "./lib/HNS" && -r "config.ph"){
        local(*FH);
        if (open(FH, "config.ph")){
            while (defined(my $str = <FH>)){
                eval("$str") if $str =~ /^\s*\$(DiaryDir)\s*\=/;
            }
            close(FH);
            &debug_log("hns: $DiaryDir");
            if (-d $DiaryDir){
                $DiaryNamazu = "$DiaryDir/namazu2";
                $DiaryNamazu = "$DiaryDir/namazu" unless -d $DiaryNamazu;
                $DiaryConf = "$DiaryNamazu/etc";
                $DiaryTemplate = "$DiaryNamazu/template";
                $DiaryIndex = "$DiaryNamazu/index";
            }
        }
    }
}


sub pnmz_find{
    my ($pres, $files) = @_;
    my ($pre, @ret);
    for $pre (@$pres){
        push(@ret, $pre), next if -f $pre;
        $pre .= '/' if -d $pre and substr($pre, -1) ne '/';
        my $file;
        for $file (@$files){
            my $path = "$dir$file";
            push(@ret, $path) if -r $path;
        }
    }
    @ret;
}

#----------------- End of 'load namazu.conf' Module ------------------


#----------------------- 'command line' Module -----------------------
$CmdLineEna = 1;
sub usage(){
    my $usage = << "TOPOFUSAGE";
  Search Program of Namazu Perl Command-line Version 0.3 by tmu\@ikegami.co.jp
  Original Search Program of Namazu Version 1.1.2.3 - 1.3.0.8
  Copyright (C) 1997-1999 Satoru Takabayashi All rights reserved.
  Original pnamazu-$Pnamazu
  Namazu Search (perl 版) by $Author

TOPOFUSAGE

    $usage .= '  usage: namazu.pl [-nwsvhcaoCHFRUL] ';

    if ($CmdLineArg eq 'old'){
        $usage .= '[index dir(s)] "key string"';
    }else{
        $usage .= '"key string" [index dir(s)]';
    }

    $usage .= << "ENDOFUSAGE";

     -n num, --max=num      : 一度に表示する件数
     -w num, --whence=num   : 表示するリストの先頭番号
     -s, --short            : 短いフォーマットで出力
     -S, --list             : もっと短いフォーマット (リスト表示) で出力
     -v                     : usage を表示する (この表示)
     -q, --quiet            : 検索結果以外のメッセージを表示しない
     -f, --config=FILE      : namazu.conf を指定する
     -h, --html             : HTML で出力する
     -l, --late             : 新しい順にソートする
     -e, --early            : 古い順に疑似的にソートする
     -a, --all              : 検索結果をすべて表示する
     -o, --output=FILE      : 指定したファイルに検索結果を出力する
     -r, --no-references    : 参考ヒット数を表示しない
     -C, --show-config      : コンフィギュレーション内容を表示する
     -H, --page             : 先の検索結果へのリンクを表示する (ほぼ無意味)
     -F, --form             : <FORM> ... </FORM> の部分を強制的に表示する
     -R, --no-replace       : URL の置き換えを行わない
     -U, --no-decode-uri    : plain text で出力する時に URL encode の復元を行わない
     -L lang                : メッセージの言語を設定する ja または en
     --opmode=OPMODE        : inside/forward/or
     --kp=off               : カタカナフレーズモードを off にする
ENDOFUSAGE

    if ($MakeGrep eq 'option'){
        $usage .= "     --grep=on              : grep 機能を有効とする\n";
    }elsif ($MakeGrep eq 'default'){
        $usage .= "     --grep=off             : grep 機能を無効とする\n";
    }

    &load_namazu_conf;
    &lang($CnfLang, $CmdLang);

    &message($usage);
    exit;
}

sub show_configuration(){
    my $language = &get_language;
    &prn(<< "ENDOFPRINTCONF");
namazu configurations

configuration file: $NamazuConfFile
  * DEFAULT_DIR      : $DEFAULT_DIR
  * BASE_URL         : $BASE_URL
  * URL_REPLACE_FROM : $URL_REPLACE_FROM
  * URL_REPLACE_TO   : $URL_REPLACE_TO
  * LOGGING          : $LOGGING
  * LANGUAGE         : $language
  * SCORING          : $SCORING
ENDOFPRINTCONF
exit;
}

sub command_line_opt{
    local($_);
    my $sort;
    my $method;
    my $order;
    while (@ARGV && $ARGV[0] =~ s/^-//){
        $_ = shift(@ARGV);
        if (s/^-//){
            $Format = $Result = 'short', next if $_ eq 'short';
            $Format = 'veryshort', next if $_ eq 'list';
            $Max = $_, next if s/^max\=//;
            $Whence = $_, next if s/^whence\=//;
            $Result = $_, next if s/^result\=//;
            $sort = 'later', undef $method, next if $_ eq 'late';
            $sort = 'earlier', undef $method, next if $_ eq 'early';
            $method = $_, undef $sort, next if s/^sort\=//;
            $order = $_, next if /^(ascending|descending)$/;
            $GrepMode = $_, next if s/^grep\=//;
            $| = $Debug = 1, next if $_ eq 'debug';

            if (s/^output\=//){
                close(STDOUT);
                open(STDOUT, ">$_") || die;
                next;
            }
            if (s/^opmode\=//){
                $OpMode = $_;
                next;
            }
            if (s/^kp\=//){
                $KPMode = ($_ ne 'off');
                next;
            }
            if (s/^config\=//){
                $NamazuConfFile = $_;
                &load_namazu_conf;
                next;
            }
            if ($_ eq 'show-config'){
                &load_namazu_conf;
                &lang($CnfLang, $CmdLang);
                &show_configuration;
                next;
            }
            $Reference = 'off' if $_ eq 'no-references';
            $DecodeURL = 0 if $_ eq 'no-decode-uri';
            $Replace = 0 if $_ eq 'no-replace';
            $PrintForm = 1 if $_ eq 'form';
            $PageIndex = 1 if $_ eq 'page';
            $PlainConv = 0 if $_ eq 'html';
            $Max = 0, $Whence = 0 if $_ eq 'all';
            $Quiet = 1 if $_ eq 'quiet';
            $CountOnly = 1, $Quiet = 1 if $_ eq 'count';

            &usage if $_ eq 'help' || $_ eq 'version';
            next;
        }
        while (s/^(.)//){
            if ($1 eq 'n'){
                $_ = shift(@ARGV) if /^$/;
                $Max = $_;
                last;
            }
            if ($1 eq 'w'){
                $_ = shift(@ARGV) if /^$/;
                $Whence = $_;
                last;
            }
            if ($1 eq 's'){$Format = $Result = 'short';}
            if ($1 eq 'S'){$Format = 'veryshort';}
            if ($1 eq 'h'){$PlainConv = 0;}
            if ($1 eq 'H'){$PageIndex = 1;}
            if ($1 eq 'F'){$PrintForm = 1;}
            if ($1 eq 'a'){$Max = 0; $Whence = 0;}
            if ($1 eq 'l'){$sort = 'later', undef $method}
            if ($1 eq 'e'){$sort = 'earlier', undef $method}
            if ($1 eq 'R'){$Replace = 0;}
            if ($1 eq 'U'){$DecodeURL = 0;}
            if ($1 eq 'r'){$Reference = 'off';}
            if ($1 eq 'L'){
                $_ = shift(@ARGV) if /^$/;
                $CmdLang = $_;
                last;
            }
            if ($1 eq 'C'){&load_namazu_conf;
                           &lang($CnfLang, $CmdLang);
                           &show_configuration;}
            if ($1 eq 'f'){
                $_ = shift(@ARGV) if /^$/;
                $NamazuConfFile = $_;
                &load_namazu_conf;
                last;
            }
            if ($1 eq 'v'){&usage;}
            if ($1 eq 'o'){close(STDOUT);
                           $_ = shift(@ARGV) if /^$/;
                           open(STDOUT, ">$_") || die;
                           last;}
            if ($1 eq 'd'){$| = $Debug = 1;}
            if ($1 eq '-'){unshift(@ARGV, $_), last;}
            if ($1 eq 'q'){$Quiet = 1;}
            if ($1 eq 'c'){$Quiet = 1;$CountOnly = 1;}
        }
    }

    if ($sort){
        $Sort = $sort;
    }elsif ($method){
        $order = 'descending' unless $order;
        $Sort = "field:$method:$order";
        $SortField = $method;
    }

    if ($#ARGV > 0){
        my @db;
        if ($CmdLineArg eq 'new'){
            push(@db, pop(@ARGV)) while @ARGV > 1;
        }elsif ($CmdLineArg eq 'old'){
            push(@db, shift(@ARGV)) while @ARGV > 1;
        }elsif (-d $ARGV[$#ARGV]){
            push(@db, pop(@ARGV)) while @ARGV > 1 && -d $ARGV[$#ARGV];
        }else{
            push(@db, shift(@ARGV)) while @ARGV > 1 && -d $ARGV[0];
        }
        @DbList = @db;
    }elsif ($#ARGV < 0){
        &usage;
    }
    $ARGV = join(' ', @ARGV);
}
#-------------------- End of 'command line' Module -------------------



#-------------------------- 'iocode' Module --------------------------
my $output_ja_code;
my $input_ja_code;
my $LANGUAGE;
my $default_input_ja_code = '';
my $last_input_ja_code = '';
my $doc_input_ja_code = '';

sub set_output_ja_code{
    my $cs = shift;
    if ($cs =~ /euc/i){
        $output_ja_code = 'EUC-JP';
    }elsif ($cs =~ /shift|sj/i){
        $output_ja_code = 'Shift_JIS';
    }else{
        $output_ja_code = 'ISO-2022-JP';
    }
}

sub get_output_ja_code{
    return $output_ja_code;
}

sub get_input_ja_code{
    return $input_ja_code;
}

sub get_last_input_ja_code{
    return $input_ja_code;
}

sub set_doc_input_ja_code{
    $doc_input_ja_code = shift;
}

sub set_default_input_ja_code{
    $default_input_ja_code = shift;
}

sub get_language{
    return $LANGUAGE;
}

sub lang_set{
    my $key = shift;
    return unless defined $key && length $key;

    if ($key =~ /ja|jp|jis|sj/i){
        $LANGUAGE = 'ja';
        &set_output_ja_code($key);
    }else{
        $LANGUAGE = 'en';
    }
    $key = shift if @_;

    if ($key =~ /ja|jp|jis|sj/i){
        $input_ja_code = ($key =~ /sj|shift/i)? 'Shift_JIS': 'EUC-JP';
    }
}

sub lang{
    my ($x, $y) = @_;
    $LANGUAGE = 'ja';
    $input_ja_code = 'EUC-JP';
    $output_ja_code = 'EUC-JP';
    $input_ja_code = $output_ja_code = 'Shift_JIS' if $^O =~ /win|os2|dos|hp/i;

    if (defined $ENV{'GATEWAY_INTERFACE'}){
        $output_ja_code = 'ISO-2022-JP';
        $input_ja_code = 'EUC-JP';
        if (defined $ENV{'HTTP_ACCEPT_LANGUAGE'}
            && length $ENV{'HTTP_ACCEPT_LANGUAGE'}
            && $ENV{'HTTP_ACCEPT_LANGUAGE'} !~ /^ja/i){
            $LANGUAGE = 'en';
        }
    }

    my $key;
    &lang_set($x) if defined $x && $x ne '';
    &lang_set($ENV{'LANG'});
    &lang_set($ENV{'LC_MESSAGES'}, $ENV{'LC_CTYPE'});
    &lang_set($ENV{'LC_ALL'});
    &lang_set($ENV{'LANGUAGE'});
    &lang_set($y) if defined $y && $y ne '';
    return $output_ja_code;
}

sub euc_to_euc{
    my $ptr = shift;
    my $str = (ref($ptr) eq 'SCALAR')? $$ptr: $ptr;
    my $para = ref($_[0]) eq 'HASH'? shift: '';
    my $euc = '';
    my $stat = 0x017;

    my $x0208alpha_to_ascii = 0;
    my $x0201kana_to_x0208 = 0;
    my $summary = 0;

    if (ref($para) eq 'HASH'){
        $x0208alpha_to_ascii = $para->{'a2a'} if defined $para->{'a2a'};
        $x0201kana_to_x0208 = $para->{'k2e'} if defined $para->{'k2e'};
        $summary = $para->{'summary'} if defined $para->{'summary'};
    }
    while (@_){
        my $tmp = shift;
        $x0208alpha_to_ascii = 1 if $tmp eq 'a2a';
        $x0201kana_to_x0208 = 1 if $tmp eq 'k2e';
        $summary = 1 if $tmp eq 'akk';
    }

    while (length $str){
        if ($str =~ s/^([\x00-\x7f]|(\x8e[\xa1-\xdf])+|[\xa1-\xfe][\xa1-\xfe])//){
            my $c1 = ord $1;
            if ($c1 < 0x80){
                $euc .= $1;
            }elsif ($c1 == 0x8e){
                my $str = $1;
                $str = &x0201kana_to_x0208($str) if $x0201kana_to_x0208;
                $euc .= $str;
                $stat &= ~1;
            }else{
                my $c = $1;
                if ($c =~ /^[\xa9-\xaf\xf5-\xfe]/){
                    $stat &= ~2;
                    $stat &= ~4 if $c =~ /^[\xaf\xf6\xf7\xfd-\xfe]/;
                }else{
                    $stat |= 8;
                    $c = &x0208alpha_to_ascii($c) if $x0208alpha_to_ascii;
                }
                $euc .= $c unless $summary
                    && $c =~ /^[\xa8-\xaf\xf5-\xfe]/;
            }
        }else{
            substr($str, 0, 1) = '';
            $stat = 0;
        }
    }
    $para->{'stat'} = $stat if ref($para) eq 'HASH';
    $$ptr = $euc, return $stat if ref($ptr) eq 'SCALAR';
    return $euc;
}

sub shiftjis_to_euc{
    my $ptr = shift;
    my $str = (ref($ptr) eq 'SCALAR')? $$ptr: $ptr;
    my $para = ref($_[0]) eq 'HASH'? shift: '';
    my $euc = '';
    my $stat = 0x017;

    my $x0208alpha_to_ascii = 0;
    my $x0201kana_to_x0208 = 0;
    my $summary = 0;

    if (ref($para) eq 'HASH'){
        $x0208alpha_to_ascii = $para->{'a2a'} if defined $para->{'a2a'};
        $x0201kana_to_x0208 = $para->{'k2e'} if defined $para->{'k2e'};
        $summary = $para->{'akk'} if defined $para->{'akk'};
    }
    while (@_){
        my $tmp = shift;
        $x0208alpha_to_ascii = 1 if $tmp eq 'a2a';
        $x0201kana_to_x0208 = 1 if $tmp eq 'k2e';
        $summary = 1 if $tmp eq 'akk';
    }

    while (length $str){
        if ($str =~ s/^([\x00-\x7f]+|[\xa1-\xdf]+|[\x81-\x9f\xe0-\xef][\x40-\x7e\x80-\xfc])//
            ){
            my $c1 = ord $1;
            if ($c1 < 0x80){
                $euc .= $1;
            }elsif (0xa1 <= $c1 && $c1 <= 0xdf){
                my $str = $1;
                $str =~ s/(.)/\x8e$1/g;
                $str = &x0201kana_to_x0208($str) if $x0201kana_to_x0208;
                $euc .= $str;
                $stat &= ~1;
            }else{
                my $c2 = ord substr($1, 1);
                $c1 += ($c1 - 0x60) & 0x7f;
                if ($c2 < 0x9f){
                    $c1--;
                    $c2 += ($c2 < 0x7f) + 0x60;
                }else{
                    $c2 += 2;
                }
                my $c = chr($c1) . chr($c2);
                if ($c =~ /^[\xa9-\xaf\xf5-\xfe]/){
                    $stat &= ~2;
                    $stat &= ~4 if $c =~ /^[\xaf\xf6\xf7\xfd-\xfe]/;
                }else{
                    $stat |= 8;
                    $c = &x0208alpha_to_ascii($c) if $x0208alpha_to_ascii;
                }
                $euc .= $c unless $summary
                    && $c =~ /^\xa1[^\xbc]|[\xa2\xa8-\xaf]/;
            }
        }else{
            $str =~ s/^.//;
            $stat = 0;
        }
    }
    $para->{'stat'} = $stat if ref($para) eq 'HASH';
    $$ptr = $euc, return $stat if ref($ptr) eq 'SCALAR';
    return $euc;
}

sub x0201kana_to_x0208{
    my $str = shift;
    $str =~ s/\x8e([\xb3\xb6-\xc4\xca-\xce]\x8e\xde|[\xca-\xce]\x8e\xdf|.)/{
        my $s = (3 == length $1)? (ord(substr($1, 2)) - 0xde + 1): 0;
        my $hi = ord $1;
        my $lo = (0xA3, 0xD6, 0xD7, 0xA2, 0xA6, 0xF2, 0xA1, 0xA3,
                  0xA5, 0xA7, 0xA9, 0xE3, 0xE5, 0xE7, 0xC3, 0xBC,
                  0xA2, 0xA4, 0xA6, 0xA8, 0xAA, 0xAB, 0xAD, 0xAF,
                  0xB1, 0xB3, 0xB5, 0xB7, 0xB9, 0xBB, 0xBD, 0xBF,
                  0xC1, 0xC4, 0xC6, 0xC8, 0xCA, 0xCB, 0xCC, 0xCD,
                  0xCE, 0xCF, 0xD2, 0xD5, 0xD8, 0xDB, 0xDE, 0xDF,
                  0xE0, 0xE1, 0xE2, 0xE4, 0xE6, 0xE8, 0xE9, 0xEA,
                  0xEB, 0xEC, 0xED, 0xEF, 0xF3, 0xAB, 0xAC
                  )[$hi - 0xa1];
        $hi = (0xa6 <= $hi && $hi != 0xb0 && $hi <= 0xdd)? 0xa5: 0xa1;
        $lo = ($hi == 0xb3 && $s)? 0xdd: ($lo + $s);
        chr($hi) . chr($lo);
    }/ge;
    $str;
}

sub x0208_to_x0201kana{
    my $str = shift;
    $str =~ s/([\x80-\xfe].|[\x00-\x7f]+)/{
        my $ret = $1;
        my $hi = ord $ret;
        my ($c, @tbl);
        if ($hi == 0xa1){
            @tbl = ("", "\xA4", "\xA1", "", "", "\xA5", "", 
                    "", "", "", "\xDE", "\xDF", "", "", "", 
                    "", "", "", "", "", "", "", "", 
                    "", "", "", "", "\xB0", "", "", "", 
                    "", "", "", "", "", "", "", "", 
                    "", "", "", "", "", "", "", "", 
                    "", "", "", "", "", "", "\xA2", "\xA3");
        }elsif ($hi == 0xa5){
            @tbl = ("\xA7", "\xB1", "\xA8", "\xB2", "\xA9", "\xB3", "\xAA", 
                    "\xB4", "\xAB", "\xB5", "\xB6", "\xB6\xDE", "\xB7", "\xB7\xDE", "\xB8", 
                    "\xB8\xDE", "\xB9", "\xB9\xDE", "\xBA", "\xBA\xDE", "\xBB", "\xBB\xDE", "\xBC", 
                    "\xBC\xDE", "\xBD", "\xBD\xDE", "\xBE", "\xBE\xDE", "\xBF", "\xBF\xDE", "\xC0", 
                    "\xC0\xDE", "\xC1", "\xC1\xDE", "\xAF", "\xC2", "\xC2\xDE", "\xC3", "\xC3\xDE", 
                    "\xC4", "\xC4\xDE", "\xC5", "\xC6", "\xC7", "\xC8", "\xC9", "\xCA", 
                    "\xCA\xDE", "\xCA\xDF", "\xCB", "\xCB\xDE", "\xCB\xDF", "\xCC", "\xCC\xDE", "\xCC\xDF", 
                    "\xCD", "\xCD\xDE", "\xCD\xDF", "\xCE", "\xCE\xDE", "\xCE\xDF", "\xCF", "\xD0", 
                    "\xD1", "\xD2", "\xD3", "\xAC", "\xD4", "\xAD", "\xD5", "\xAE", 
                    "\xD6", "\xD7", "\xD8", "\xD9", "\xDA", "\xDB", "", "\xDC", 
                    "", "", "\xA6", "\xDD", "\xB3\xDE");
        }
        if (defined($c = $tbl[ord(substr($ret, 1)) - 0xa1]) && $c){
            $c =~ s\/(.)\/\x8e$1\/g;
            $ret = $c;
        }
        $ret;
    }/ge;
    $str;
}

sub x0208alpha_to_ascii{
    my $str = shift;
    my $ret = '';
    while ($str =~ s/^([\x00-\x7f]|[\x8e\xa1-\xfe][\xa1-\xfe])//s){
        my $tmp = my $c = $1;
        if ($c =~ s/^([\xa1\xa3])//){
            if ($1 eq "\xa1"){
                $ret .= $c, next if $c =~ tr/\xa1\xa4\xa5\xa7\xa8\xa9\xaa\xae\xb0\xb2\xbf\xc3\xc7\xc9\xca\xcb\xce\xcf\xd0\xd1\xdc\xdd\xe1\xe3\xe4\xf0\xf3\xf4\xf5\xf6\xf7/ ,.:;?!\`^_\/|\'\"()[]{}+\-=<>$%#&*@/; #"'`
            }elsif ($1 eq "\xa3"){
                $ret .= $c, next if $c =~ tr/\xc1-\xda\xe1-\xfa\xb0-\xb9/A-Za-z0-9/;
            }
        }
        $ret .= $tmp;
    }
    return $ret;
}


sub iocode::base64w{
    my $str = shift;

    $str =~ tr/A-Za-z0-9\+\/\=/\x00-\x3f/d;

    my $ord1 = ord(substr($str, 1));
    my $ret = chr((ord($str) << 2 | $ord1 >> 4) & 0xff);

    if (2 < length $str){
        my $ord2 = ord(substr($str, 2));
        $ret .= chr(($ord1 << 4 | $ord2 >> 2) & 0xff);
        if (3 < length $str){
            $ret .= chr(($ord2 << 6 | ord(substr($str, 3))) & 0xff);
        }
    }
    return $ret;
}

sub iocode::base64{
    my $str = shift;
    my($ret);

    $ret .= &iocode::base64w($1) while $str =~ s/^(....)//;
    $ret;
}

sub iocode::quoted{
    my $str = shift;
    my $ret;
    while ($str !~ /^$/){
        $ret .= ' ', next if $str =~ s/^_//;
        $ret .= chr(hex($1)), next if $str =~ s/^=([a-zA-Z0-9]{2})//;
        $ret .= $1 if $str =~ s/^(.)//;
    }
    $ret;
}

sub esc2euc{
    my ($c1, $c2, $str) = @_;
    if ($c1 eq "\$"){
        $str =~ tr/\x21-\x7e/\xa1-\xfe/;
    }elsif ($c2 eq 'I'){
        $str =~ s/(.)/"\x8e" . chr(0x80|ord $1)/ge;
    }
    return $str;
}

sub mime_decode{
    my $ptr = shift;
    my $isref = (ref $ptr);
    my $str = $isref? $$ptr: $ptr;
    my $stat = '';
    if ($str =~ s/=\?ISO-2022-JP\?B\?(([a-zA-Z0-9\+\/\=]{4})+?)\?=/&iocode::base64($1)/ieg){
        $stat = 'ISO-2022-JP';
    }elsif ($str =~ s/=\?ISO-2022-JP\?Q\?((=[0-9a-fA-F][0-9a-fA-F]|[_\x21-\x3c\x3e\x40-\x7e])+)\?=/&iocode::quoted($1)/ieg){
        $stat = 'Shift_JIS';
    }
    $$ptr = $str, return $stat if $isref;
    return $str;
}

sub jis_to_euc{
    my $ptr = shift;
    my $isref = (ref $ptr);
    my $str = $isref? $$ptr: $ptr;
    my $stat = ($str =~ s/\e([\$\(])(.)([\x21-\x7e]*)/&esc2euc($1, $2, $3)/ge);
    $$ptr = $str, return $stat if $isref;
    return $str;
}

sub code_reset{
    $default_input_ja_code = '';
    $last_input_ja_code = '';
    $doc_input_ja_code = '';
}
sub toEuc{
    my $str = shift;
    my %para = ('k2e' => 1);
    my $opt;
    for $opt (@_){
        if (ref $opt eq 'HASH'){
            my $key;
            for $key (%$opt){
                $para{$key} = $opt->{$key};
            }
        }else{
            $para{$opt} = 1;
        }
    }

    my $flag = ($str =~ s/=\?ISO-2022-JP\?B\?(([a-zA-Z0-9\+\/\=]{4})+?)\?=/&iocode::base64($1)/ieg or $str =~ s/=\?ISO-2022-JP\?Q\?((=[0-9a-fA-F][0-9a-fA-F]|[_\x21-\x3c\x3e\x40-\x7e])+)\?=/&iocode::quoted($1)/ieg);
    $flag = 1 if $str =~ s/\e([\$\(])(.)([\x21-\x7e]*)/&esc2euc($1, $2, $3)/ge;
    if ($flag){
        my $euc = $str;
        return $euc if &euc_to_euc(\$euc, \%para) || !&shiftjis_to_euc(\$str, \%para);
        return $str;
    }

    my $sj = $str;
    my $sj_stat = undef;
    my $euc_stat = undef;

    if ($para{'doc'}){
        if ($doc_input_ja_code eq 'Shift_JIS'){
            $sj_stat = &shiftjis_to_euc(\$sj, \%para);
            return $sj if $sj_stat;
            $doc_input_ja_code = '';
        }elsif ($doc_input_ja_code eq 'EUC-JP'){
            $euc_stat = &euc_to_euc(\$str, \%para);
            return $str if $euc_stat;
            $doc_input_ja_code = '';
        }
    }
    $euc_stat = &euc_to_euc(\$str, \%para) unless defined $euc_stat;
    $sj_stat = &shiftjis_to_euc(\$sj, \%para) unless defined $sj_stat;

    if ($para{'k'}){
        $euc_stat |= 0x9;
        $sj_stat |= 0x9;
    }

    if ($sj_stat < $euc_stat){
        $doc_input_ja_code = 'EUC-JP' unless $sj_stat;
        $last_input_ja_code = 'EUC-JP';
        return $str;
    }
    if ($sj_stat > $euc_stat){
        $doc_input_ja_code = 'Shift_JIS' unless $euc_stat;
        $last_input_ja_code = 'Shift_JIS';
        return $sj;
    }
    return $sj if $default_input_ja_code eq 'Shift_JIS';
    return $str if $default_input_ja_code eq 'EUC-JP';

    return $sj if $last_input_ja_code eq 'Shift_JIS';
    return $str if $last_input_ja_code eq 'EUC-JP';
    return $sj if &get_output_ja_code eq 'Shift_JIS';
    return $str if &get_output_ja_code eq 'EUC-JP';
    return $sj if $input_ja_code eq 'Shift_JIS';
    return $str;
}

sub iocode::tosjis{
    my($c1, $c2) = unpack('CC', shift);
    return pack('C', $c2) if $c1 == 0x8e;
    $c2 -= ($c1 & 1)? (0x60 + ($c2 < 0xe0)): 2;
    $c1 = ($c1 + 0x61) >> 1;
    $c1 += 0x40 if $c1 >= 0xa0;
    pack('CC', $c1, $c2);
}

sub euc_to_shiftjis{
    my $ptr = shift;
    my $isref = (ref $ptr);
    my $str = $isref? $$ptr: $ptr;
    my $stat = ($str =~ s/([\x80-\xff].)/&iocode::tosjis($1)/ge);
    $$ptr = $str, return $stat if $isref;
    return $str;
}

sub output_code{
    my $str = shift;
    if ($output_ja_code eq 'ISO-2022-JP'){
        $str =~ s/([\x80-\xff]+)/\e\$B$1\e\(B/g;
        $str =~ tr/\x80-\xff/\x00-\x7f/;
    }elsif ($output_ja_code eq 'Shift_JIS'){
        $str = &euc_to_shiftjis($str);
    }
    return $str;
}

&code_reset;
&lang;
#----------------------- End of 'iocode' Module ----------------------


#-------------------------- 'output' Module --------------------------
sub meta_http_equiv{
    my ($he, $content) = @_;
    $he =~ tr/A-Z/a-z/ if $Xht;
    &output("<meta http-equiv=\"$he\" content=\"$content\"$Xht>\n");
}

sub lang_exp{
    my $code = &get_output_ja_code;
    &meta_http_equiv("Content-Type", "text/html; charset=$code");
    &output("<!-- \xf3\xfe -->\n");
}

sub output{
    # データの出力に使う。入力は ISO-2022-JP または EUC-JP だと仮定。
    my(@list) = @_;
    my($tmp, $str);
    my $ojcode = &get_output_ja_code;
    foreach $str (@list){
        $str = &html2plain($str) if $PlainConv;
        $str = &x0208_to_x0201kana($str) if $Phone && $PhoneX0201;
        $str = &output_code($str);
        &prn($str);
    }
}

sub message{
    # スクリプト中の文字列の出力に使う。
    &output(&toEuc(shift)) while @_;
}


my $prn_buf = '';
sub prn_proc{
    $prn_buf .= join('', @_);
    if (defined(&print)){
        while ((my $index = index($prn_buf, "\n")) >= 0){
            local $_ = substr($prn_buf, 0, $index + 1);
            &print($_);
            substr($prn_buf, 0, $index + 1) = '';
        }
    }else{
        print $prn_buf;
        $prn_buf = '';
    }
}

sub prn{
    if ($Lucky){
        $prn_buf .= join('', @_);
    }else{
        &prn_proc(@_);
    }
}

sub prn_flash{
    if ($LuckyURI){
        &prn_proc() if $Debug > 0;
        $prn_buf = "Location: $LuckyURI\n\n";
    }
    &prn_proc();
    if (defined(&print)){
        &print($prn_buf) if length $prn_buf;
        &print(undef);
    }
}

#---------------------- End of 'output' Module -----------------------


#------------------------ 'plain text' Module ------------------------

%html2plain = ('&gt;' => '>',
               '&lt;' => '<',
               '&quot;' => "\"",
               '&amp;' => '&',
               );
$html2plain = join('|', (sort {length $b <=> length $a} keys %html2plain));

sub html2plain{
    my $str = shift;
    my($tmp);

    while ($str =~ s/^(.*?)(\<|\e\$[\@B]|[\x80-\xff])/$2/s){
        $tmp .= $1;
        next if $str =~ s/\<\!\-\- .*? \-\-\>//s;
        $tmp .= "\n", next if $str =~ s/^<br( \/)?\>\n?//i;
        next if $str =~ s/^\<.*?\>//;
        $tmp .= $1, next if $str =~ s/^([\x80-\xff].?|\e\$[\@B].*?\e\([BJ])//;
        $tmp .= $1 if $str =~ s/^.//;
    }
    $str = $tmp . $str;

    $str =~ s/($html2plain)/$html2plain{$1}/g;
    $str;
}

sub decode_url{
    my $str = shift;
    $str =~ s/\+/ /g;
    $str =~ s/%(..)/chr(hex($1))/ge;
    $str;
}
#-------------------- End of 'plain text' Module ---------------------

my @caller = caller;
&premain;


#----------------------- 'integer type' Module -----------------------
sub set_inttype{
    if (!$IntType){
        $IntType = 'V' if -e "$DbPath.le" && ! -e "$DbPath.be";
        $IntType = 'N' if -e "$DbPath.be" && ! -e "$DbPath.le";
        $IntType = 'w' unless -e "$DbPath.h";
    }
    $IntType = 'I' if !$IntType;
    if ($IntType eq 'w'){
        $IntNType = 'N';
        $PackWSub = (pack('w', 128) ne "\x81\x00");
    }else{
        $IntNType = $IntType;
        $PackWSub = 0;
    }
    $IntPackFF = pack($IntNType, -1);
    $IntSize = length($IntPackFF);
    $IntFF = unpack($IntNType, $IntPackFF);
    my $tmp;
    foreach $tmp (keys(%DbSize)){
        $DbNdx{$tmp} = $DbSize{$tmp} / $IntSize;
    }
    $DbIntSize{$DbPath} = $IntSize;
    $DbIntType{$DbPath} = $IntType;
    $DbIntNType{$DbPath} = $IntNType;
    &debug_log("int: $IntType, $IntNType");
}
#-------------------- End of 'integer type' Module -------------------


#----------------------- 'word search' Module ------------------------
sub ssub{
    local($totalhit, $x, *score, $key, $pat, $flag) = @_;
    my($buf);
    my($str) = $buf = &readindexindex($x);
    $buf =~ s/([\xa1-\xfe].)/\xff$1/g if $flag;
    if ($buf =~ /$pat/i){
        my($net, $hit) = &readindexscore($x, *score, $str);
        $$totalhit += $hit;
        $SubHit{$key}{$net}{$str} = 1;
        return 1;
    }
    return 0;
}

sub binsearch{
    # Keyword を検索する。
    local($origkey, *score) = @_;
    my($x, $l, $r, $p, $buf, $hit, $totalhit, $pat);
    my($key) = $origkey;
    my($regsearch, $forward, $backward, $nativecmp);

    if ($TSEARCH && ($key =~ /^\+\[.*\]$/)){
        return &tsearch($origkey, *score, $key);
    }

    if ($FIELD && ($fieldsearch = ($key =~ /^\+[^\:\s]+\:/))){
        return &field_search($origkey, *score, $key);
    }
    
    if (!($regsearch = ($key =~ s/^\/(.*)\/$/$1/))){
        $forward = ($key =~ s/(.)\*$/$1/);
        $backward = ($key =~ s/^\*(.)/$1/);
    }

    if ($regsearch){
        return &reg_search($origkey, *score, $key) if $REG;
        push(@DbErrors, "(Cannot use regular expressions)");
        return ($origkey, '', 0);
    }

    if ($backward){
        if ($BW){
            if ($key =~ /^([\xa1-\xfe][\xa1-\xfe])+$/){
                $Mb = &bwopen('MB', 'm') if $Mb < 0;
                return &bwsearch($origkey, *score, $key, $forward, 'MB') if $Mb;
            }
            if ($key =~ /^[\x21-\x7e]$/ && $REG){
                return &reg_search($origkey, *score, $forward? $key: "$key\$");
            }
            if ($key =~ /^[\x21-\x7e]{2,}$/){
                $Sb = &bwopen('SB', 's') if $Sb < 0;
                return &bwsearch($origkey, *score, $key, $forward, 'SB') if $Sb;
            }
            return &w_bw($origkey, *score, $key, $forward);
        }
        push(@DbErrors, "(Cannot use inside/suffix matching");
        return ($origkey, '', 0);
    }

    my $esc = ($key =~ s/^\\(.)/$1/)? "\\": '';
    if ($forward){
        $pat = "^" . &quote_meta($key);
    }

    $p = $l = 0;
    $r = $DbNdx{'INDEXINDEX'} - 1;
    $nativecmp = ('a' lt 'あ');
    if ($IntType ne 'w' && $DbSize{'HASH'}){
        $x = ord($key) << 8;
        if ($key =~ /^.(.)/){
            $x |= ord($1);
            $r = &indexpointer(*HASH, 1 + $x) - 1;
        }elsif ($forward){
            $r = &indexpointer(*HASH, 0x100 + $x) - 1;
        }else{
            $r = &indexpointer(*HASH, 1 + $x) - 1;
        }
        $p = $l = &indexpointer(*HASH, $x);
        $nativecmp = 1;
    }

    if ($l <= $r){
        my $wordcnt = 0;
        while ($l <= $r){
            $x = int(($l + $r + 1) / 2);
            $buf = &readindexindex($x);
            if ($forward){
                if (index($buf, $key) == 0 &&
                    &ssub(\$totalhit, ($p = $x), *score, $origkey, $pat)){
                    while (&ssub(\$totalhit, --$x, *score, $origkey, $pat)){
                        %score = () if $MaxHit && $totalhit >= $MaxHit;
                        undef %{$SubHit{$origkey}} if $MaxMatch && ++$wordcnt >= $MaxMatch;
                    }
                    $x = $p;
                    while (&ssub(\$totalhit, ++$x, *score, $origkey, $pat)){
                        %score = () if $MaxHit && $totalhit >= $MaxHit;
                        undef %{$SubHit{$origkey}} if $MaxMatch && ++$wordcnt >= $MaxMatch;
                    }
                    if ($MaxHit && $totalhit >= $MaxHit){
                        $totalhit = 0;
                        %score = ('TooMany' => $Text{'hit'});
                    }elsif ($MaxMatch && $wordcnt >= $MaxMatch){
                        $totalhit = 0;
                        %score = ('TooMany' => $Text{'match'});
                    }
                    return ($origkey, '', $totalhit);
                }
            }elsif ($key eq $buf){
                $hit = &readindexscore($x, *score, $key);
                $hit = 0, %score = ('TooMany' => $Text{'hit'}) if $MaxHit && $hit >= $MaxHit;
                return ("$esc$key", '', $hit);
            }

            if (&unsignedcmp($key, $buf, $nativecmp) < 0){
                $r = $x - 1;
            }else{
                $l = $x + 1;
            }
        }

        if ($key =~ /^([\xa1-\xfe][\xa1-\xfe])[\xa1-\xfe]*$/){
            # kakasi を呼ばないので、複合語の検索のため
            # 最長一致で keyword と index を比較し、
            my $pre = $1;
            while ($x >= $p){
                $buf = &readindexindex($x);
                last if &unsignedcmp($buf, $pre, $nativecmp) < 0;
                if ($key =~ /^$buf/){
                    # keyword の残りは次の語として親ルーチンに返す
                    $origkey =~ s/^$buf//;
                    return ($buf, $origkey, &readindexscore($x, *score, $buf));
                }
                --$x;
            }
        }
    }
    return ($1, $origkey, 0) if $origkey =~ s/^(\xa5[\xa1-\xf3](\xa5[\a1-\xf3]|\xa1\xbc)*\*?)//;
    return ($1, $origkey, 0) if $origkey =~ s/^(\xa4[\xa1-\xf3](\xa4[\a1-\xf3]|\xa1\xbc)*\*?)//;
    return ($origkey, '', 0);
}

sub unsignedcmp {
    return ($_[0] cmp $_[1]) if $_[2];
    my ($str1, $str2) = @_;
    my ($ord1, $ord2);

    while (($ord1 = ord($str1)) == ($ord2 = ord($str2))) {
        last if ! $ord1;
        $str1 =~ s/^.//;
        $str2 =~ s/^.//;
    }
    $ord1 <=> $ord2;
}

sub wsearch{
    local($word) = @_;
    local(%score);
    my($hashp, $match, $name, $hit, @word, $sword, $wflag, $hflag);

    if ($word =~ /^[\xa1-\xfe]+$/
        and !($TinyMknmz && $word =~ /^[\xb0-\xfe]/)
        ){
        if ($OpMode eq 'inside'){
            $word = "*$word*";
            $RespTextOrig = 1;
        }elsif ($OpMode eq 'forward'){
            $word = "$word*";
            $RespTextOrig = 1;
        }
    }

    $wflag = ($HWMode ne 'on');
    $hflag = ($HWMode eq 'off'
              or $HWMode eq 'wakati'
              && $word =~ /^\*?\xa4[\xa1-\xf3](\xa4[\a1-\xf3]|\xa1\xbc)*\*?$/);

    while ($word ne ''){
        %score = ();
        ($match, $word, $hit) = &binsearch($word, *score);
        $wflag = 0 if length $word and $HWMode eq 'wakati';

        if (!$hit && ($hflag || $wflag)
            && $match =~ /^\*?\xa4[\xa1-\xf3](\xa4[\a1-\xf3]|\xa1\xbc)*\*?$/){
            $score{'Disable'} = 1;
        }

        $Hit{$match} = $score{'TooMany'}? $score{'TooMany'}: ($hit + 0);
        push(@Words, $match);

        if ($SubHit{$match}){
            my $key;
            for $key (keys %{$SubHit{$match}}){
                my $subword;
                for $subword (keys %{$SubHit{$match}->{$key}}){
                    push(@SWord, $sword . $subword);
                }
            }
            $sword = '';
        }elsif ($match !~ /^[\/\+]/){
            if ($word eq ''){
                push(@SWord, $sword . $match);
            }else{
                $sword .= $match;
            }
        }

        $hashp = &makehash;
        %$hashp = %score;
        push(@ScorePtr, $hashp);
        # ちょっと分かりにくいが、この @ScorePtr というリストは
        # sub operate の中で参照している。
        # それまで順番が変わらないことが前堤になっているので、
        # 改造の際は注意すること

        push(@word, $match);
    }
    if ($CACHE){
        &cache_write_list if $CacheChange;
        &cache_close;
    }
    return '{ ' . join(' ', @word) . ' }' if $#word > 0;
    join(' ', @word);
}

sub searchwords{
    my(@list) = @_;
    my($op) = '(and|or|not|\&\&|\&\&\&|[&|!.\-])';
    my($tmp, @tmp, @p, $p, $q);
    my $dq = "\"";
    my %pair = ("(" => ")", "{" => "}", $dq => $dq);

    foreach $tmp (@list){
        $SubQueryWords = scalar(@Words) if $tmp =~ /^\&\&\&$/;
        $tmp = &wsearch($tmp) unless $tmp =~ /^(and|or|not|\&\&|\&\&\&|[\-(){}&|!.\"])$/; #"
    }

    for $tmp (@list){
        if ($tmp =~ /^[\(\{]/ || ($tmp eq $dq && !$q)){
            unshift(@p, $tmp);
            $q = 1, $tmp = '{' if $tmp eq $dq;
            push(@tmp, $tmp);
        }elsif ($tmp =~ /^[\}\)]/ || ($tmp eq $dq && $q)){
            while (@p){
                $p = $pair{shift(@p)};
                if ($p eq $dq){
                    $q = 0;
                    push(@tmp, '}');
                }else{
                    push(@tmp, $p);
                }
                last if $tmp eq $p;
            }
        }else{
            push(@tmp, $tmp);
        }
    }
    while (@p){
        $p = $pair{shift(@p)};
        $p = '}' if $p eq $dq;
        push(@tmp, $p);
    }

    $tmp = ' ' . join(' ', &reducep(@tmp)) . ' ';
    while (
           # 演算子の連続は、後ろが有効
           $tmp =~ s/ $op $op / $2 /
           # 最後が演算子ならば削除
           || $tmp =~ s/ $op $/ /
           # 右カッコの直前が演算子ならば削除
           || $tmp =~ s/ $op ([\}\)]) / $1 /
           # 先頭の演算子は削除
           || $tmp =~ s/^ $op / /
           # 左カッコの直後が演算子ならば削除
           || $tmp =~ s/ ([\(\{]) $op / $1 /
           ){;}
    $tmp =~ s/^\s+//;
    $tmp =~ s/\s+$//;
    $tmp =~ s/\s+/ /g;
    $tmp;
}

sub reducep{
    local(@tmp) = @_;
    if ($tmp[0] eq '(' and $tmp[$#tmp] eq ')'){
        my($ndx, $cnt) = (0, 0);
        for ($ndx = 1; $ndx < $#tmp; $ndx++){
            if ($tmp[$ndx] eq '('){
                ++$cnt;
            }elsif ($tmp[$ndx] eq ')'){
                last if --$cnt < 0;
            }
        }
        pop(@tmp), shift(@tmp) if !$cnt;
    }
    @tmp;
}

#--------------------- End of 'word search' Module -------------------


#---------------------- 'hash operation' Module ----------------------
$hashop::HashName = 'hash0';

sub makehash{
    ++$hashop::HashName;
    %$hashop::HashName = ();
    return \%$hashop::HashName;
}

sub op_score{
    my($x, $y, $or) = @_;
    return $y unless $x;
    return $x unless $y;
    return $y if $x == -1;
    return $x if $y == -1;
    return $x if ($x <=> $y) == $or;
    $y;
}

sub opDefault{
    my ($x, $y, $p, $r) = @_;
    if ($p && $DbSize{'PHRASE'}){
        &opPhrase($x, $y, $KPMode && $r && grep {$_ eq "\xa1\xa6 \xa1\xa6\n"} values %{$y->{'phrase'}});
    }elsif ($OpMode eq 'or' and !$p){
        &opOr($x, $y);
    }else{
        &opAnd($x, $y);
    }
}

sub opAnd{
    my ($x, $y) = @_;
    return if $y->{'Disable'} || $y->{'TooMany'};
    %$x = %$y, return if $x->{'Disable'} || $x->{'TooMany'};

    $x->{'field_l'} = 1 if $y->{'field_l'};
    $x->{'field_r'} = 1 if $y->{'field_r'};

    delete $x->{'phrase'} if my $f = ($x->{'field_l'} && $x->{'field_r'});
    my $key;
    my @key = keys %$x;

    for $key (@key){
        next if $key =~ /phrase|field_/;
        my $vx = $x->{$key};
        if (my $vy = $y->{$key}){
            $x->{$key} = &op_score($vx, $vy);
            $x->{'phrase'}{$key} .= $y->{'phrase'}{$key} unless $f;
        }else{
            delete $x->{$key};
            delete $x->{'phrase'}{$key};
        }
    }
}

sub opPhrase{
    my ($x, $y, $orop) = @_;

    return if $y->{'Disable'} || $y->{'TooMany'};
    %$x = %$y, return if $x->{'Disable'} || $x->{'TooMany'};

    delete $x->{'phrase'} if my $f = ($x->{'field_l'} && $y->{'field_r'});
    my($key, $px, $py);
    my @key = keys %$x;
    for $key (@key){
        next if $key =~ /phrase|field_/;
        my $vx = $x->{$key};

        my $score = 0;
        my $phrase = $orop? $x->{'phrase'}{$key}: '';
        if (my $vy = $y->{$key}){
            $score = &op_score($vx, $vy);

            if ($x->{'field_r'} || $y->{'field_l'}){
                delete $x->{'phrase'}{$key} if $x->{'field_l'};
                $x->{'phrase'}{$key} .= $y->{'phrase'}{$key} unless $y->{'field_r'};
                $x->{$key} = $score;
                next;
            }
            for $px (split("\n", $x->{'phrase'}{$key})){
                my ($px1, $px2) = split(' ', $px);
                for $py (split("\n", $y->{'phrase'}{$key})){
                    my ($py1, $py2) = split(' ', $py);

                    my $s = $px2 . $py1;
                    &PhraseList($s) if !$Phrase{$s};
                    $phrase .= "$px1 $py2\n", next if $Phrase{$s}{$key};
                    if ($TinyMknmz){
                        # tiny_mknmz では文字種の違うフレーズは登録
                        # されていないので、無条件ヒットとする
                        my $ox = ord $px2;
                        $ox = (0xb0 <= $ox) + (0xa1 <= $ox);
                        my $oy = ord $py1;
                        $oy = (0xb0 <= $oy) + (0xa1 <= $oy);
                        $phrase .= "$px1 $py2\n" if $ox != $oy;
                    }
                }
            }
            if ($phrase){
                $x->{$key} = $score;
                $x->{'phrase'}{$key} = $phrase unless $f;
            }
        }
        unless ($phrase){
            delete $x->{$key};
            delete $x->{'phrase'}{$key};
        }
    }
    delete $x->{'field_r'};
    $x->{'field_r'} = 1 if $y->{'field_r'};
}

sub opNot{
    my ($x, $y) = @_;
    return if $x->{'Disable'} || $x->{'TooMany'};

    my $key;
    my @key = keys %$x;
    for $key (@key){
        next if $key =~ /phrase|field_/;
        if ($y->{$key}){
            delete $x->{$key};
            delete $x->{'phrase'}{$key};
        }
    }
}

sub opOr{
    my ($x, $y) = @_;

    return if $y->{'Disable'} || $y->{'TooMany'};
    %$x = %$y, return if $x->{'Disable'} || $x->{'TooMany'};

    $x->{'field_l'} = 1 if $y->{'field_l'};
    $x->{'field_r'} = 1 if $y->{'field_r'};

    delete $x->{'phrase'} if my $f = ($x->{'field_l'} && $x->{'field_r'});
    my $key;
    my @key = keys %$y;
    for $key (@key){
        next if $key =~ /phrase|field_/;

        $x->{$key} = &op_score($x->{$key}, $y->{$key}, 1);
        $x->{'phrase'}{$key} .= $y->{'phrase'}{$key} unless $f;
    }
}

sub opMinus{
    my ($x, $y) = @_;
    return if $x->{'Disable'} || $x->{'TooMany'};

    my $key;
    my @key = keys %$x;
    for $key (@key){
        next if $key =~ /phrase|field_/;

        my $phrase = '';
        if ($y->{$key}){
            my $w;
            my @y = split("\n", $y->{'phrase'}{$key});
            for $w (split("\n", $x->{'phrase'}{$key})){
                $phrase .= "$w\n" unless grep {$_ eq $w} @y;
            }
            if ($phrase){
                $x->{'phrase'}{$key} = $phrase;
            }else{
                delete $x->{$key};
                delete $x->{'phrase'}{$key};
            }
        }
    }
}
#------------------ End of 'hash operation' Module -------------------


#------------------------ 'operation' Module -------------------------
my @calc_oplist;
&calc_ini;
sub calc_ini{
    @calc_oplist = ({   ""    => \&opDefault, "&"   => \&opAnd,
                        "and" => \&opAnd,     "!"   => \&opNot,
                        "not" => \&opNot,     "-"   => \&opMinus, },
                    {   "|"   => \&opOr,      "or"  => \&opOr, },
                    {   "&&"  => \&opAnd,     "&&&" => \&opAnd, },);
    my @op = ('(', ')', '{', '}', '"');
    my $ptr;
    for $ptr (@calc_oplist){
        my $op;
        for $op (keys %$ptr){
            push(@op, quotemeta($op)) if length $op;
        }
    }
    $OpPattern = '^(' . join('|', @op) . ')$';
}

sub calc_sub{
    my $p = shift;
    my $lvl = shift;
    my $a = shift;
    my @olist = ();

    while (@_){
        my $op = '';
        my $b = shift;
        $op = $b, $b = shift unless ref $b;
        if (defined($lvl->{$op})){
            &{$lvl->{$op}}($a, $b, $p, (@_ && ref $_[0]));
        }else{
            push(@olist, $a);
            push(@olist, $op);
            $a = $b;
        }
    }
    push(@olist, $a);
    @olist;
}

sub calcp{
    # 括弧の中身を計算する。
    # ここには、括弧のないリストが渡される
    my($p, @list) = @_;
    my($a, $b);

    for $lvl (@calc_oplist){
        @list = &calc_sub(($p eq '{'), $lvl, @list);
    }
    return $list[0];
}

sub operate_proc{
    my($p, $calc, @list) = @_;
    my($l, $r);
    my($lp, $rp) = $p? ('[\{\(]', '[\}\)]'): ('[\(]', '[\)]');

    for (;;){
        my @x = ();
        my @y = ();
        my $tmp;

        while (@list){
            last if ($tmp = shift @list) =~ /^$rp$/;
            push(@x, $tmp);
            $tmp = '';
        }
        return &$calc('(', @x) unless $tmp;

        while (@x){
            last if ($tmp = pop @x) =~ /^$lp$/;
            unshift(@y, $tmp);
        }
        @list = (@x, &$calc($tmp, @y), @list);
    }
}

sub operate{
    my(@arg) = @_;
    my($arg, @list);

    foreach $arg (@arg){
        if ($arg =~ /^(not|\!)$/){
            push(@list, 'not');
        }elsif ($arg =~ /^(\-)$/){
            push(@list, '-');
        }elsif ($arg =~ /^(or|\|)$/){
            push(@list, 'or');
        }elsif ($arg =~ /^(and|\&)$/){
            push(@list, 'and');
        }elsif ($arg =~ /^(\&\&|\&\&\&)$/){
            push(@list, '&&');
        }elsif ($arg =~ /^[\(\)\{\}]$/){
            push(@list, $arg);
        }else{
            push(@list, shift(@ScorePtr));
        }
    }
    &operate_proc(1, \&calcp, @list);
}
#--------------------- End of 'operation' Module ---------------------


#-------------------------- 'input' Module ---------------------------
sub input::pWakachi{
    my $str = shift;
    # 1byte - 2byte を分ける
    $str =~ s/([\x21-\x7f])([\x80-\xff])/$1 $2/g;
    # 2byte - 1byte を分ける
    $str =~ s/([\x80-\xff])([\x21-\x7f])/$1 $2/g;
    return $str;
}

sub string_normalize{
    my $pat;
    my $str = &toEuc(shift, 'a2a');
    $str =~ s/^\s+//;
    while ($str !~ /^$/){
        $pat .= "$1 ", next if $str =~ s/^([\{\(\"])\s*//; #"

        if ($str =~ s/^((\+[^\s\:]+\:)?([\/\"]))//){ #"
            my $tmp = $1;
            my $ch = $3;
            $tmp =~ tr/A-Z/a-z/;
            $pat .= $tmp;

            $str =~ s/^((\\.|[^$ch])*)//;
            $tmp = "$1$ch";
            $str =~ s/^$ch\s*//;
            $tmp =~ s/\s/\xa0/g;
                                       
            $pat .= "$tmp ";
            next;
        }

        $pat .= "$1 ", next if $str =~ s/^(\+[^\s\:]+\:\S+)\s*//;

        if ($str =~ s/^(\S+)\s*//){
            my($tmp) = $1;
            my $p = ($tmp =~ s/([\"\}\)])$//)? " $1": ''; #"
            my $f = ($tmp =~ s/(\*)$//)? $1: '';
            my $b = ($tmp =~ s/^(\*)//)? $1: '';

            $tmp =~ s/([\x21-\x7f])([\x80-\xff])/$1 $2/g;
            $tmp =~ s/([\x80-\xff])([\x21-\x7f])/$1 $2/g;
            $tmp =~ tr/A-Z/a-z/;
            $pat .= "$b$tmp$f$p ";
        }
    }
    $pat =~ s/\s+/ /g;
    $pat =~ s/^\s+//;
    $pat =~ s/\s+$//;
    $pat;
}
#----------------------- End of 'input' Module -----------------------


#---------------------------- 'db' Module ----------------------------
sub opentfile{
    my($str, $filename) = @_;
    my $path;
    my($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime);
    my $language = &get_language;

    if (!$language || $language =~ /ja|jp|jis/i){
        $path = "$filename.en" unless -r ($path = "$filename.ja");
    }elsif (! -r ($path = "$filename.$language")){
        $path = $filename . '-e';
    }
    -r $path || -r ($path = $filename) || chop($path);

    if (-r $path){
        ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime)
            = stat($path) if open($str, $path);
    }
    $DbSize{$str} = $size;
    $DbTime{$str} = $mtime;
    &debug_log("opentfile: $path, $size") if $mtime;
    $mtime;
}

sub db::openzfile{
    local(*fH, $filename) = @_;
    if (-r $filename){
        if ($ZcatPri){
            $ZCatPri = 0;
            eval{setpriority(0, 0, $IniPri + $ZcatPri)};
        }
        return open(fH, "$Zcat $filename |");
    }
    return 0;
}

sub opentext{
    my ($str, $filename) = @_;
    return (!$Cgi && $Zcat && $filename =~ /\.gz$/i)? &db::openzfile($str, $filename): open($str, $filename);
}

sub openbfile{
    local($str, $filename, $flag) = @_;
    local(*fH) = $str;
    my($tmp) = $/;
    my($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime);

    if (open(fH, $filename)){
        binmode(fH);
        ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime) = stat(fH);
        $DbSize{$str} = $size;
        $DbTime{$str} = $mtime;
        $DbNdx{$str} = $size / $IntSize if $IntSize;
        &debug_log("openbfile: $filename, $size") if $mtime;
        return $mtime;
    }

    if ($Zcat){
        my($fname);
        if (&db::openzfile(*fH, ($fname = "$filename.gz"))
            || &db::openzfile(*fH, ($fname = "$filename"."z"))){

            binmode(fH);
            undef $/;
            $fH = <fH>;
            $/ = $tmp;
            close(fH);
            if (!$?){
                ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime)
                    = stat($fname);
                $DbTime{$str} = $mtime;
                $DbSize{$str} = $size = length($fH);
                $DbNdx{$str} = $size / $IntSize if $IntSize;
                &debug_log("openzfile: $filename, $size");
                return $mtime;
            }
            $fH = '';
        }
    }
    push(@DbErrors, "(Cannot open $filename)") if $flag;
    return 0;
}

sub openfiles{
    &debug_log("openfiles: " . join(",", @_));
    my $fh = shift;
    my $ext = shift;
    local(*FH);
    my $db = '';
    my @db = ();
    my @dirlist = ('');
    for $db (@_){
        next unless defined $db;
        push(@db, $db);
        push(@dirlist, $db) if -d $db;
        push(@db, $1) if $db =~ /^\+(.+)$/;
    }
    push(@db, '') if $ext ne 'i' or !defined($_[0]);

    push(@dirlist, $BaseDir) if $BaseDir;
    push(@dirlist, $TEMPLATE) if $ext eq '';
    push(@dirlist, $DEFAULT_DIR);

    push(@dirlist, "$DiaryIndex") if -d $DiaryIndex;
    push(@dirlist, "$DiaryTemplate") if -d $DiaryTemplate;
    push(@dirlist, "$ENV{'HOME'}/Namazu") if $ENV{'HOME'};
    push(@dirlist, "$ENV{'HOME'}/Namazu/$1") if $ENV{'PWD'} =~ /^\Q$ENV{'HOME'}\E\/(Mail.*)$/;

    push(@dirlist, "/usr/local/share/namazu/index/");
    push(@dirlist, "/usr/local/var/namazu/index/");
    push(@dirlist, "/usr/local/namazu/index/");
    push(@dirlist, "/usr/var/namazu/index/");

    my $dir;
    my $dbname;

    for $dir (@dirlist){
        $dir .= '/' if $dir =~ /[^\/]$/;
        for $db (@db){
            $dbname = (length $db)? "$dir$db/$DbName": "$dir$DbName";
            &debug_log("try: $dbname");
            if ($ext){
                if ($fh? &opentfile($fh, "$dbname.$ext"):
                    -r "$dbname.$ext"){
                    my $dbdir = $dbname;
                    $dbdir =~ s/\/[^\/]+$//;
                    $Db2IdxDir{$dbname} = $dbdir;
                    $Db2IdxName{$dbname} = $db;
                    return $dbname;
                }
            }elsif ($Phone && &opentfile(*FH, "$dbname.phone")
                    or &opentfile(*FH, "$dbname.head")){
                my $line;
                $ExistMeta = 0;
                $Headname = $dbname;
                while (defined($line = <FH>)){
                    $line = toEuc($line);
                    if (defined $ENV{'GATEWAY_INTERFACE'}){
                        if ($line =~ /^<\!DOCTYPE .* XHTML/){
                            $Xht = ' /';
                        }
                        if ($line =~ /^<\?xml .*encoding=\"([^\"]+)/
                            || $line =~
                            /\<meta.*content-type.*charset=([^\"]+)/i
                            ){
                            my $cs = $1;
                            &set_output_ja_code($cs);
                            &debug_log("meta: " . &get_output_ja_code);
                            $ExistMeta = 1;
                        }
                        if ($line =~ /\<\/head\>/i
                            && &get_language eq 'ja'
                            && !$ExistMeta){
                            &debug_log("ins_meta: " . &get_output_ja_code);
                        }
                        if ($line =~ /(\<\!-- (FILE|KEY) --\>)\s*(.*?)\s*\1/){
                            my $str = $2;
                            $DbHead{$str}{$db} = $3;
                            my @key = keys %{$DbHead{$str}};
                            if (1 < @key){
                                my $tmp = "\(";
                                my $key;
                                for $key (sort @key){
                                    $tmp .= "$key=$DbHead{$str}{$key} / ";
                                }
                                $tmp =~ s/ \/ $/\)/;
                                s/(\<\!-- $str --\>).*?\1/$1 $tmp $1/;
                            }
                        }
                    }
                    push(@HEAD, $line);
                }
                close(FH);
                @FOOT = <FH>, close(FH) if &opentfile(*FH, "$dbname.foot");
                return $dbname;
            }
        }
    }
    undef;
}

sub opendb{
    # DB ファイルを開く
    my($dbname) = @_;
    my(@tmp);
    my($sec,$min,$hour,$mday,$mon,$year,$wday);

    $dbname = $DbPath if !$dbname;

    if ((-r "$dbname.access") && &openbfile(*ACCESS, "$dbname.access")){
        my($ret, $str, $op, $val);
        while (defined($str = <ACCESS>)){
            if (($op, $val) = ($str =~ /^\s*(deny|allow)\s+(\S+)/)){
                $val =~ tr/A-Z/a-z/;
                $ret = $op, next if $val eq 'all';
                if ($val =~ /[a-z]$/){
                    my $pat = quotemeta($val) . '$'; #'
                    $ret = $op if $ENV{'REMOTE_HOST'} =~ /$pat/;
                }elsif ($val =~ /^\d/){
                    my $pat = '^' . quotemeta($val);
                    $ret = $op if $ENV{'REMOTE_ADDR'} =~ /$pat/;
                }
            }
        }
        if ($ret eq 'deny'){
            push(@DbErrors,
                 "(You don\'t have a permission to access the index)");
            return;
        }
    }

    if (-e "$dbname.lock"){
        &puthtmlheader;
        if (&opentfile(*MSG, "$dbname.msg")){
            &prn($_) while <MSG>;
        }else{
            &prn("(now be in system maintenance)\n");
        }
        exit;
    }
    $DbVer2{$dbname} = $DbVer2 = &openbfile('WORDINDEX', "$dbname.wi");
    if ($DbVer2){
        &debug_log("Db: Ver2");
        return 0 unless &openbfile('WORD', "$dbname.w", 1);
    }else{
        &debug_log("Db: Ver1");
        $HashTime = &openbfile('HASH', "$dbname.h");
        &openbfile('WORD', "$dbname.w");
    }
    return 0 unless &openbfile('INDEX', "$dbname.i", 1);

    my $ht = &openbfile('INDEXINDEX', "$dbname.ii", 1);
    return 0 unless $ht;
    $HashTime = $ht unless $HashTime;

    ($sec,$min,$hour,$mday,$mon,$year,$wday) = gmtime($HashTime);
    $LastModified
        = sprintf("%s, %02d %s %04d %02d:%02d:%02d GMT",
                  ('Sun', 'Mon', 'Tue',
                   'Wed', 'Thu', 'Fri', 'Sat')[$wday], $mday,
                  ('Jan', 'Feb', 'Mar', 'Apl', 'May', 'Jun',
                   'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec')[$mon],
                  $year + 1900, $hour, $min, $sec);
    &openbfile('PHRASE', "$dbname.p");
    &openbfile('PHRASEINDEX', "$dbname.pi");

    &openbfile('TIM', "$dbname.t");
    if ($SortField){
        if ($Sort =~ /^\+?fstat:/){
            &openbfile('SORT', "$dbname.fstat.$SortField");
        }elsif (&openbfile('SORTINDEX', "$dbname.field.$SortField.i")){
            &openbfile('SORT', "$dbname.field.$SortField");
        }
    }

    if ($SUMMARY and $MakeSummary || $MakeGrep){
        &openbfile("RLIST_____$DbPath", "$dbname.r");
        &openbfile("RLISTINDEX$DbPath", "$dbname.ri");
        if ($DbTime{"RLIST_____$DbPath"} > $DbTime{"RLISTINDEX$DbPath"}){
            &openbfile("RLIST_____$DbPath", "$dbname.field.uri");
            &openbfile("RLISTINDEX$DbPath", "$dbname.field.uri.i");
        }
    }
    if (!$DbVer2){
        return 0 unless &openbfile("FLIST_____$DbPath", "$dbname.f", 1);
        return 0 unless &openbfile("FLISTINDEX$DbPath", "$dbname.fi", 1);
    }
    return 1;
}

sub closefile{
    local($str) = @_;
    local(*fH) = $str;
    close(fH);
    undef $fH;
    delete $DbNdx{$str};
    delete $DbSize{$str};
    delete $DbTime{$str};
}

sub closedb{
    my($dbname) = @_;
    undef $HashTime;
    &closefile('HASH');
    &closefile('INDEX');
    &closefile('INDEXINDEX');

    &closefile('TIM');

    &closefile('PHRASE');
    &closefile('PHRASEINDEX');

    &closefile('SORTINDEX');
    &closefile('SORT');

    &closefile('WORDINDEX');
    &closefile('WORD');

    &bwclose;
    &phrase_init;

    undef %db::cache_rii_off;
    undef %db::cache_rii_buf;

    undef @SWord;
    undef @Words;
    undef %Hit;
    undef %SubHit;
    undef @ScorePtr;
    undef @DbErrors;
}

sub dbsize{
    local(*fH) = @_;
    my($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size);

    return length($fH) if $fH;
    ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size) = stat(fH);
    $size;
}

sub readdb{
    local(*fH, $offset, $size) = @_;
    my($buf, $len);

    if ($fH){
        return ($offset, '') if $offset >= length($fH);
        $buf = substr($fH, $offset, $size);
    }else{
        seek(fH, $offset, 0);
        return ($offset, '') if eof(fH);
        read(fH, $buf, $size);
    }
    $offset += $size;
    ($offset, $buf);
}

sub getsdb{
    local(*fH) = shift;
    my $offset = shift;
    my($buf, $len);

    if ($fH){
        while ($offset < length($fH)){
            $c = substr($fH, $offset++, 1);
            last if $c =~ /^$/;
            $buf .= $c;
        }
    }else{
        seek(fH, $offset, 0);

        $buf = <fH>;
        $offset += length($buf);
        chomp($buf);
    }
    ($offset, $buf);
}

sub indexpointer{
    # file 中の N 番目の整数値を返す
    local(*fH, $n) = @_;

    $n *= $IntSize;
    my $val = &readi(*fH, $n);
    $val;
}

sub readindexindex{
    # NMZ.ii の N 番目の語を NMZ.i から読んで返す
    my($x) = @_;
    my($offset, $buf);
    return ($offset, $db::cache_rii_buf{$x}) if ($offset = $db::cache_rii_off{$x});

    if ($DbVer2){
        ($offset, $buf) = &getsdb(*WORD, &indexpointer(*WORDINDEX, $x));
    }else{
        ($offset, $buf) = &getsdb(*INDEX, &indexpointer(*INDEXINDEX, $x));
    }
    $db::cache_rii_off{$x} = $offset; $db::cache_rii_buf{$x} = $buf;
    ($offset, $buf);
}

sub readindexscore{
    # NMZ.i から score を読み取る。ヒット数を返す
    local($n, *score, $str) = @_;
    my($fscore, $fno, $ndx, $hit, $net, $ret);

    ($ndx, $str) = &readindexindex($n);
    $ndx = &indexpointer(*INDEXINDEX, $n) if $DbVer2;
    ($ndx, $hit) = &readw(*INDEX, $ndx);
    $hit *= $IntSize if $IntType ne 'w';
    $buf = &readdb(*INDEX, $ndx, $hit);

    my @tmp = &unpackw($buf);

    my $idf = undef;
    if ($TFIDF && $DbNdx{'TIM'}){
        $idf = log($DbNdx{'TIM'} / (scalar(@tmp)/2)) / log(2);
    }

    my $tmp;
    $fno = 0;
    while (defined($tmp = shift @tmp) && defined($fscore = shift @tmp)){
        $fscore = int($fscore * $idf) + 1 if defined $idf;

        if ($DbVer2){
            $fno += $tmp;
        }else{
            $fno = $tmp;
        }
        if (&TimEnable($fno)){
            $score{'phrase'}{$fno} .= "$str $str\n";
            $net++;
            $ret++ if !$score{$fno};
            $score{$fno} = $fscore if $fscore > $score{$fno};
        }
    }
    # 純粋なヒット数、重複を除いたヒット数を返す
    ($net, $ret);
}

sub lastSize{
    my($fh, $x, $db) = @_;
    my($fhi) = $fh . 'INDEX';
    $fhi = $db if $db;
    ($x < $DbNdx{$fhi})? &indexpointer($fhi, $x): $DbSize{$fh};
}

sub lastNdx{
    my($fh, $x, $db) = @_;
    my($fhi) = $fh . 'INDEX';
    $fhi = $db if $db;
    ($x < $DbNdx{$fhi})? &indexpointer($fhi, $x): $DbNdx{$fh};
}

sub TimEnable{
    my $fileno = shift;
    my $p = $fileno;
    $p .= "#$DbPath";
    unless (defined($Tim{$p})){
        if ($fileno < $DbNdx{'TIM'}){
            $Tim{$p} = &indexpointer('TIM', $fileno);
        }else{
            $Tim{$p} = $fileno;
        }
    }
    if ($SortField){
        if ($Sort =~ /^\+?fstat:/){
            $SElem{$p} = &indexpointer('SORT', $fileno);
        }else{
            $SElem{$p} = 
                &getsdb('SORT', &indexpointer('SORTINDEX', $fileno));
        }
    }
    $Tim{$p} != $IntFF;
}

sub unpackw{
    my $x = shift;
    if ($PackWSub){
        my $ret = 0;
        my @ret = ();
        while ($x =~ s/^(.)//s){
            $ret <<= 7;
            $ret |= 0x7f & ord($1);
            push(@ret, $ret), $ret = 0 unless ord($1) & 0x80;
        }
        @ret;
    }else{
        unpack("$IntType*", $x);
    }
}

sub readw{
    local(*fH, $offset) = @_;
    return &readi(@_) if $IntType ne 'w';

    my ($ret, $c);
    if ($fH){
        while ($offset < length($fH)){
            $c = ord(substr($fH, $offset++, 1));
            $ret = ($ret << 7) | ($c & 0x7f);
            last unless $c & 0x80;
        }
    }else{
        seek(fH, $offset, 0);
        while (read(fH, $c, 1)){
            $offset++;
            $c = ord($c);
            $ret = ($ret << 7) | ($c & 0x7f);
            last unless $c & 0x80;
        }
    }
    ($offset, $ret);
}

sub readi{
    my ($offset, $ret) = &readdb($_[0], $_[1], $IntSize);
    $ret = ($ret eq '')? undef: unpack($IntNType, $ret);
    ($offset, $ret);
}

#------------------------- End of 'db' Module ------------------------


#--------------------- 'backward search' Module ----------------------
$BW = 1;

sub bwopen{
    my($fh, $ext) = @_;

    (&openbfile($fh, "$DbPath.$ext") >= $HashTime &&
     &openbfile($fh . 'INDEX', "$DbPath.$ext" . 'i') >= $HashTime);
}

sub bwclose{
    my($fh, $ext) = @_;
    &closefile('MB');
    &closefile('MBINDEX');
    &closefile('SB');
    &closefile('SBINDEX');
    &mb_init;
    &sb_init;
}

sub w_bw{
    local($origkey, *score, $key, $forward) = @_;
    my $pat = $key;
    my $byt = !(0x80 & ord $pat);
    my $sft = ($forward && !$byt);

    $pat =~ s/([\xa1-\xfe][\xa1-\xfe])/\xff$1/g if $sft;
    $pat =~ s/([\x00-\x7f]+)/quotemeta($1)/ge;
    $pat .= "\$" unless $forward;

    my $totalhit;

    if ($CACHE){
        &cache_init;
        $totalhit = &cache_read_word("bw $pat", *score, $origkey, $pat, $sft);
        return ($origkey, '', $totalhit) if $totalhit >= 0;
    }
    $totalhit = 0;

    my $ndx = 0;
    my $offset = 0;
    unless ($byt){
        my $l = 0;
        $ndx = $DbNdx{'INDEXINDEX'} - 1;
        while ($l < $ndx){
            my $buf = &readindexindex(my $x = ($l + $ndx) >> 1);
            if (0x80 & ord $buf){
                $ndx = $x;
            }else{
                $l = $x + 1;
            }
        }
        if ($DbVer2){
            $offset = &indexpointer('WORDINDEX', $ndx);
        }else{
            $offset = &indexpointer('INDEXINDEX', $ndx);
        }
    }

    my $direct = ($DbSize{'WORD'} && !$WORD);
    my @ndx;
    seek('WORD', $offset, 0) if $direct;
    while ($ndx < $DbNdx{'INDEXINDEX'}){
        my $str = $direct? <WORD>: &readindexindex($ndx);
        chomp $str;
        $str =~ s/([\xa1-\xfe][\xa1-\xfe])/\xff$1/g if $sft;
        last if $byt and 0x80 & ord $str;
        if ($str =~ /$pat/i){
            &ssub(\$totalhit, $ndx, *score, $origkey, $pat, $sft);
            push(@ndx, $ndx) if $CACHE;
        }
        $ndx++;
    }
    &cache_write_word("bw $pat", @ndx) if $CACHE && @ndx;
    return ($origkey, '', $totalhit);
}

sub bwsearch{
    local($origkey, *score, $key, $forward, $fh) = @_;
    local(%kdat, %ktmp);
    local(%ldat, %ltmp);
    my($str, $ini) = ($key, 1);
    my($x, $l, $r, $buf, $totalhit);
    my($bstr, $pre, $match, $h, $c1, $c2);
    my($indexsub, $fhi, $charsub);

    my($bw) = ($fh eq 'MB');

    $indexsub = \&mbindex, $charsub = \&mbchars if $fh eq 'MB';
    $indexsub = \&sbindex, $charsub = \&sbchars if $fh eq 'SB';
    $fhi = $fh . 'INDEX';

    $str =~ s/([\x00-\x7f]+)/quotemeta($1)/ge;
    $str .= "\$" if !$forward;
    $key =~ s/[^a-zA-Z0-9\x80-\xff]/_/g;

    while (($c1, $c2) = &$charsub($key)){
        $pre .= "$c1$c2";
        $x = &$indexsub($c1, $c2);
        $l = &indexpointer($fhi, $x++);

        if ($IntType ne 'w'){
            $l *= $IntSize;
            $r = &lastNdx($fh, $x) * $IntSize;
        }else{
            $r = &lastSize($fh, $x);
        }

        %ktmp = %kdat, %kdat = ();
        %ltmp = %ldat, %ldat = () if $bw;
        while ($l < $r){
            ($l, $x) = &readw($fh, $l);
            if ($ini || $ktmp{$x}){
                $kdat{$x} = 1;
                if ($bw){
                    $buf = &readindexindex($x);
                    $bw = 0, next if $ini && ($buf =~ /$str/);
                    $bstr = $pre, $ldat{$x} = 1 if $buf =~ /$pre$/;
                }
            }
        }
        $match = !$bw, $ini = 0 if $ini;
        %ldat = %ltmp if $bw && !%ldat;
        last if !%kdat;
    }

    if ($match){
        $pre = $origkey;
        $key = '';
    }elsif (%ldat){
        %kdat = %ldat;
        $str = "$bstr\$";
        ($key = $origkey) =~ s/^(\*$bstr)//;
        $pre = $1;
    }elsif ($origkey =~ s/^(\*\xa4[\xa1-\xf3](\xa4[\a1-\xf3]|\xa1\xbc)*)//){
        return ($1, $origkey, 0);
    }else{
        return ($origkey, '', 0);
    }

    my $wordcnt = 0;
    foreach $x (sort {$a <=> $b} keys(%kdat)){
        if (&ssub(\$totalhit, $x, *score, $pre, $str)){
            %score = () if $MaxHit && $totalhit >= $MaxHit;
            undef %{$SubHit{$pre}} if $MaxMatch && ++$wordcnt >= $MaxMatch;
        }
    }
    if ($MaxHit && $totalhit >= $MaxHit){
        $totalhit = 0;
        %score = ('TooMany' => $Text{'hit'});
    }elsif ($MaxMatch && $wordcnt >= $MaxMatch){
        $totalhit = 0;
        %score = ('TooMany' => $Text{'match'});
    }
    return ($pre, $key, $totalhit);
}
#------------------ End of 'backward search' Module ------------------


#-------------------- 'multi byte' search Module ---------------------
sub mb_init{
    $Mb = -1;

    $MbByteL = 0xa1;
    $MbByteR = 0xfe;

    $MbWordL = ($MbByteL * 0x100 + $MbByteL);
    $MbWordR = ($MbByteR * 0x100 + $MbByteR);

    $MbElem = $MbByteR + 1 - $MbByteL;
}
&mb_init;

sub mb_ndx{
    return ord($_[0]) - 0xa1;
}

sub mbindex{
    return &mb_ndx($_[0]) * $MbElem + &mb_ndx($_[1]);
}

sub mbchars{
    return ($_[0] =~ s/^(.)(.)//)? ($1, $2): ();
}
#----------------- End of 'multi byte' search Module -----------------


#-------------------- 'single byte' search Module --------------------
sub sb_init{
    $Sb = -1;

    $SbByteL = 0x21;
    $SbByteR = 0x7e;

    $SbWordL = ($SbByteL * 0x100 + $SbByteL);
    $SbWordR = ($SbByteR * 0x100 + $SbByteR);

    $SbOffsetA = 1;
    $SbOffsetN = $SbOffsetA + (ord('z') - ord('a') + 1);
    $SbElem = $SbOffsetN + (ord('9') - ord('0') + 1);

    $SbOffsetA -= ord('a');
    $SbOffsetN -= ord('0');
}
&sb_init;

sub sb_ndx{
    my($ord) = ord($_[0]);
    return $ord + $SbOffsetA if $_[0] =~ /^[a-z]/;
    return $ord + $SbOffsetN if $_[0] =~ /^[0-9]/;
    return 0;
}

sub sbindex{
    return &sb_ndx($_[0]) * $SbElem + &sb_ndx($_[1]);
}

sub sbchars{
    return ($_[0] =~ s/^(.)(.)/$2/)? ($1, $2) : ();
}
#---------------- End of 'single byte' search Module -----------------


#-------------------- 'regular expression' Module --------------------
$REG = 1;

sub reg_search{
    local($origkey, *score, $_) = @_;
    s/\xa0/ /g;
    local($match, $flag) = ($_, 1);
    my %opt = ('ex' => 1, 'case' => 0, 'ff' => 1);
    my $pat = &regconv(\$match, \%opt);
    my $flag = $opt{'MB'};
    my $fh = $flag? 'MB': 'SB';
    my $fhi = $fh . 'INDEX';
    my($db, $totalhit) = ("$DbPath.w", 0);
    local(*FW, $x, $_);
    $match = "/$match/";

    eval("/$pat/i");
    s/[\r\n]//g, s/ at .*//, push(@DbErrors, "$match $_"), return ($match, '', 0) if $_ = $@;

    if ($CACHE){
        &cache_init;
        $totalhit = &cache_read_word("reg $pat", *score, $match, $pat, $flag);
        return ($match, '', $totalhit) if $totalhit >= 0;
    }

    $totalhit = 0;
    my $direct = ($DbSize{'WORD'} && !$WORD);
    my $ndx = 0;
    my $wordcnt = 0;
    my @ndx;
    seek('WORD', 0, 0) if $direct;

    my $searchstr = "while (\$ndx < \$DbNdx{'INDEXINDEX'}){";
    $searchstr .= "my \$str = \$direct? <WORD>: &readindexindex(\$ndx);";
    $searchstr .= "chomp \$str;";
    $searchstr .= "\$str =~ s/([\xa1-\xfe][\xa1-\xfe])/\xff\$1/g if \$flag;";
    $searchstr .= "if (\$str =~ /$pat/i){";
    $searchstr .= " &ssub(\\\$totalhit, \$ndx, *score, \$match, \$pat, \$flag);";
    $searchstr .= "\%score = () if \$totalhit >= \$MaxHit;" if $MaxHit;
    $searchstr .= "undef %{\$SubHit{\$match}}, last if ++\$wordcnt >= \$MaxMatch;" if $MaxMatch;
    $searchstr .= "push(\@ndx, \$ndx);" if $CACHE;
    $searchstr .= "}";
    $searchstr .= "\$ndx++;";
    $searchstr .= "}";
    eval $searchstr;
    if ($MaxHit && $totalhit >= $MaxHit){
        $totalhit = 0;
        %score = ('TooMany' => 'Too many document hits. Ignored');
    }elsif ($MaxMatch && $wordcnt >= $MaxMatch){
        $totalhit = 0;
        %score = ('TooMany' => 'Too many words match. Ignored');
    }else{
        &cache_write_word("reg $pat", @ndx) if $CACHE && @ndx;
    }
    return ($match, '', $totalhit);
}
#----------------- End of 'regular expression' Module ----------------


#-------------------------- 'phrase' Module --------------------------
sub phrase_init{
    undef %Phrase;
}

sub PhraseList{
    my($s) = @_;
    my($x) = &hash($s);
    my($offset, $len);

    if (($offset = &indexpointer(*PHRASEINDEX, $x)) != $IntFF){
        ($offset, $len) = &readw(*PHRASE, $offset);
        $len *= $IntSize if $IntType ne 'w';
        my $buf = &readdb(*PHRASE, $offset, $len);
        my $x = 0;
        my $tmp;
        for $tmp (&unpackw($buf)){
            if ($DbVer2){
                $x += $tmp;
            }else{
                $x = $tmp;
            }
            $Phrase{$s}{$x} = 1;
        }
    }
    $Phrase{$s}{'enable'} = 1;
}

sub hash () {
    my ($tmp) = @_;
    my ($hash, $i);

    while ($tmp =~ m/([\xa1-\xfea-z\d])/g){
        $hash ^= $Seed[($i++) & 3][ord($1)];
    }
    $hash & 65535;
}
&init_seed;

sub init_seed () {
    @Seed = 
	(
	 [
	  3852, 26205, 51350, 2876, 47217, 47194, 55549, 43312, 
	  63689, 40984, 62703, 10954, 13108, 60460, 41680, 32277, 
	  51887, 28590, 17502, 57168, 37798, 27466, 13800, 12816, 
	  53745, 8833, 55089, 15481, 18993, 15262, 8490, 22846, 
	  41468, 59841, 25722, 23150, 41499, 15735, 926, 39653, 
	  56720, 63629, 50607, 4292, 58554, 26752, 36570, 44905, 
	  55343, 54073, 36538, 27605, 16003, 50339, 40422, 4213, 
	  59172, 29975, 19694, 12629, 45238, 28185, 35475, 21170, 
	  22491, 61198, 44320, 63991, 11398, 45247, 38108, 2583, 
	  43341, 23180, 6875, 36359, 49933, 43446, 15728, 39740, 
	  31983, 52267, 1809, 47986, 37070, 42232, 52199, 30706, 
	  6672, 6358, 43336, 51910, 34544, 13276, 7545, 57036, 
	  8939, 51866, 55491, 20338, 31577, 28064, 22921, 9383, 
	  51245, 29797, 45742, 35642, 7707, 61471, 9847, 39691, 
	  48202, 11656, 22141, 19736, 53889, 8805, 50443, 60561, 
	  15164, 28244, 46936, 49709, 41521, 54481, 41209, 50460, 
	  40812, 31165, 5262, 6853, 59230, 28184, 16237, 44940, 
	  57981, 61979, 15046, 152, 57914, 24893, 39843, 40581, 
	  36550, 61985, 60318, 24904, 5255, 45226, 19929, 20420, 
	  7934, 1329, 4593, 49456, 55811, 45803, 34381, 31087, 
	  11433, 39644, 37941, 5128, 2292, 54178, 50068, 60273, 
	  50622, 65115, 60426, 43000, 24473, 34734, 18046, 61024, 
	  31184, 12828, 20392, 36439, 58054, 40322, 56860, 453, 
	  41651, 61453, 49909, 31927, 41721, 18754, 63015, 53155, 
	  58398, 35421, 58283, 60691, 24063, 42816, 55428, 9149, 
	  42395, 50319, 52150, 1332, 19517, 4661, 62357, 50701, 
	  17489, 17213, 21605, 10008, 57535, 12929, 10462, 33651, 
	  8847, 60371, 43, 50569, 13590, 63058, 38188, 6453, 
	  32943, 30936, 1608, 57007, 8216, 57037, 621, 50611, 
	  41820, 52771, 51944, 61338, 57433, 48765, 46504, 9387, 
	  443, 2573, 19395, 57978, 15503, 29857, 26094, 24351, 
	  24693, 26137, 9385, 38284, 23659, 47573, 44738, 56602
	  ],
	 [
	  12974, 46347, 48074, 21190, 37848, 48695, 6266, 14133, 
	  35931, 58211, 9935, 27828, 41440, 56440, 37215, 41883, 
	  59014, 56610, 34326, 8982, 20932, 60420, 33333, 45626, 
	  21021, 42718, 18375, 44681, 24756, 63113, 35748, 37730, 
	  43924, 18286, 58920, 1445, 65187, 30371, 37376, 57862, 
	  40307, 65205, 33766, 31211, 36884, 10114, 24689, 27959, 
	  44441, 33671, 48892, 39326, 1469, 28982, 60348, 44188, 
	  47357, 39493, 3408, 44935, 9705, 41138, 23324, 27992, 
	  34523, 39562, 29437, 34174, 4397, 1278, 26500, 44705, 
	  947, 60267, 10380, 37832, 4846, 35070, 255, 49288, 
	  3206, 49147, 23078, 4676, 12594, 17890, 48864, 59951, 
	  57383, 52273, 39351, 1553, 27875, 62675, 29545, 62399, 
	  36701, 58983, 31038, 41099, 60262, 57539, 20268, 61210, 
	  52271, 30649, 33506, 57118, 184, 33762, 40870, 3390, 
	  17374, 63949, 8067, 29968, 16303, 56931, 24384, 8151, 
	  43668, 63736, 6008, 60875, 39251, 2872, 32040, 32699, 
	  33910, 7603, 27426, 25914, 27872, 23100, 12649, 58521, 
	  56607, 4231, 58705, 24834, 45102, 62096, 42208, 43515, 
	  4627, 6641, 59819, 61559, 31026, 2435, 39692, 29226, 
	  12141, 45700, 24565, 51392, 48573, 56606, 18556, 16947, 
	  64210, 45982, 42861, 26546, 3546, 55511, 19531, 60154, 
	  59743, 12700, 19452, 39309, 9261, 61660, 17289, 13888, 
	  2766, 11572, 9912, 33792, 14008, 49604, 63018, 26149, 
	  29769, 22048, 12006, 12806, 13118, 30562, 29754, 11792, 
	  11008, 7080, 38339, 14554, 62591, 57870, 9172, 56798, 
	  5035, 28625, 30572, 14297, 24749, 47861, 27515, 59433, 
	  38098, 61308, 7906, 22166, 58790, 34055, 51935, 15303, 
	  46061, 64742, 28421, 11087, 28960, 40214, 22095, 36041, 
	  13018, 36650, 33096, 5352, 45823, 24359, 10388, 8912, 
	  54931, 24685, 33662, 37257, 52871, 61178, 31155, 25433, 
	  56950, 39061, 47599, 50204, 7580, 33999, 65507, 53642, 
	  33205, 28393, 64730, 62166, 3072, 21290, 32671, 16090
	  ],
	 [
	  57940, 232, 21443, 38228, 24592, 31831, 47141, 13988, 
	  56517, 15268, 43852, 10910, 16864, 3750, 2324, 55926, 
	  52529, 63507, 19813, 52501, 51613, 53019, 15359, 50807, 
	  49650, 18431, 6561, 16785, 34522, 64502, 17018, 55965, 
	  37195, 41610, 22261, 18801, 55598, 13243, 34069, 41307, 
	  57095, 44979, 58172, 60846, 47304, 48562, 46660, 34298, 
	  46533, 938, 21264, 32611, 53957, 36623, 17883, 38072, 
	  55055, 24444, 54857, 24042, 23411, 6340, 14471, 60606, 
	  47950, 36733, 13872, 38012, 49976, 47941, 13784, 41536, 
	  27385, 6421, 36846, 9154, 54984, 17971, 43452, 35982, 
	  18909, 64716, 3057, 7331, 35804, 20941, 45403, 25324, 
	  45385, 34725, 49366, 3261, 41065, 63838, 63868, 23479, 
	  35036, 12204, 61492, 19476, 60146, 9741, 61013, 21995, 
	  16163, 32324, 31149, 5612, 50295, 9066, 41594, 3669, 
	  8247, 44652, 11000, 44052, 57, 56404, 3840, 45443, 
	  25593, 53206, 48704, 1123, 51508, 47037, 24603, 21008, 
	  59241, 20559, 40485, 53851, 30301, 35963, 10311, 46465, 
	  2751, 41461, 52077, 53047, 50527, 28135, 56717, 58775, 
	  7252, 2182, 37291, 7309, 58586, 41131, 52753, 18644, 
	  28802, 35922, 19767, 14775, 17423, 44371, 35784, 11128, 
	  64931, 10734, 64980, 29696, 46697, 9756, 10626, 49449, 
	  51217, 36961, 36209, 25303, 28142, 29448, 32555, 30324, 
	  1204, 39865, 23375, 42336, 27082, 42020, 5602, 63004, 
	  61788, 20378, 14892, 40623, 56162, 26021, 40018, 1360, 
	  25466, 4179, 48058, 35222, 14805, 31971, 20903, 11973, 
	  3396, 57112, 37276, 31539, 21025, 4295, 61864, 22230, 
	  44161, 19704, 64566, 5707, 61724, 4633, 3176, 57977, 
	  25011, 18069, 33064, 15638, 44090, 7547, 16998, 4020, 
	  11727, 65056, 39242, 26532, 31492, 38506, 34888, 51723, 
	  10246, 891, 7213, 14542, 62756, 29443, 58703, 16924, 
	  28473, 64411, 13112, 33107, 2052, 5554, 58118, 20121, 
	  38618, 8220, 64212, 46166, 25219, 2696, 57893, 24740
	  ],
	 [
	  41939, 18890, 56232, 36549, 57396, 25584, 22736, 2106, 
	  26476, 29949, 16648, 23697, 59393, 9816, 40621, 22331, 
	  8691, 53734, 55438, 10743, 59288, 48021, 30865, 32371, 
	  56242, 29541, 13001, 15925, 32237, 5358, 40666, 8641, 
	  24249, 31362, 45191, 16109, 56947, 2391, 18216, 17887, 
	  32341, 34864, 41584, 26199, 44680, 16670, 48530, 53372, 
	  4868, 38432, 64115, 64156, 20918, 29445, 30992, 11624, 
	  58986, 43993, 27550, 25688, 49352, 2680, 34329, 8065, 
	  34042, 13984, 24174, 25454, 16376, 42391, 43342, 48718, 
	  11719, 19390, 9381, 56400, 36061, 57911, 44237, 40929, 
	  30808, 39550, 51726, 6725, 5006, 63351, 176, 49000, 
	  25365, 25864, 32816, 28046, 60193, 40882, 62089, 8642, 
	  65057, 22007, 25018, 41912, 65349, 8201, 53632, 19204, 
	  17582, 44496, 55265, 9957, 23197, 30659, 40765, 478, 
	  4674, 26956, 7204, 9681, 24771, 7380, 58681, 50137, 
	  33245, 25962, 12647, 27903, 1308, 9200, 36545, 829, 
	  31207, 61564, 42741, 31021, 4229, 30837, 50225, 21812, 
	  9798, 39955, 31769, 32996, 5078, 6999, 33475, 9753, 
	  33956, 40679, 19434, 58727, 48060, 12579, 43328, 15770, 
	  38541, 55975, 43673, 39849, 65176, 14683, 30848, 10711, 
	  17884, 61869, 14941, 48722, 46559, 36753, 58520, 20978, 
	  2987, 25981, 26057, 9987, 59456, 35810, 43943, 34600, 
	  55244, 37135, 17124, 2288, 14928, 32895, 40829, 5368, 
	  11032, 15143, 5008, 25715, 55822, 35856, 36427, 8171, 
	  32190, 51369, 56893, 13214, 22587, 49878, 34193, 25575, 
	  10323, 60250, 35562, 4243, 30525, 13970, 38843, 20234, 
	  51106, 55968, 22523, 498, 23327, 63352, 5866, 34360, 
	  12960, 10874, 60076, 3247, 46731, 30967, 11418, 13386, 
	  16801, 2776, 26600, 39388, 52654, 60793, 64963, 62978, 
	  55508, 34990, 1686, 20498, 48960, 40530, 40733, 34530, 
	  30962, 63256, 35029, 54290, 61073, 40895, 23115, 8497, 
	  51770, 17655, 11744, 32966, 48622, 23162, 46352, 65423
	  ]
	 );
}

#---------------------- End Of 'phrase' Module -----------------------





$FIELD = 1;
sub field_init{
    %FieldAlias = ('author' => 'from',
                   'title' => 'subject',
                   'url' => 'uri',
                   );
}
&field_init;

sub field_search{
    local($origkey, *score, $_) = @_;
    s/\xa0/ /g;
    my $key = $_;
    my($flag, $match, $pat);
    local(*FH, *FDAT, *FNDX);

    $key =~ s/^\+([^\:\s]+)\://;
    my($field) = $1;
    $field =~ tr/A-Z/a-z/;

    if ($key =~ s/^\/(.*)\/$/$1/){
        my %opt = ('ex' => 1, 'case' => 0, 'ff' => 1);
        $pat = &regconv(\$key, \%opt);
        $flag = $opt{'MB'};

        $match = "+$field:/$key/";
        $key = "/$key/";
        eval("/$pat/i");
        s/[\r\n]//g, s/ at .*//, push(@DbErrors, "$match $_"), return ($match, '', 0) if $_ = $@;
    }else{
        ($pat = $key) =~ s/^\"(.*)\"$/$1/; #"
        $pat = &quote_meta($pat);
        $match = "+$field:$key";
    }

    if ($CACHE){
        &cache_init;
        $totalhit = &cache_read_score("field $field $pat", *score);
        if ($totalhit >= 0){
            $score{'field_r'} = $score{'field_l'} = 1;
            return ($match, '', $totalhit);
        }
        $totalhit = 0;
    }

    my $alias = $field;
    my $ext;
    while (1){
        $ext = 'qfield';
        last if open(FH, "$DbPath.$ext.$alias") && open(FDAT, "$DbPath.$ext.$alias.f") && open(FNDX, "$DbPath.$ext.$alias.fi");

        $ext = 'field';
        last if open(FH, "$DbPath.$ext.$alias");

        push(@DbErrors, "$match: unknown field"), return ($match, '', 0) if !$FieldAlias{$alias};
        $alias = $FieldAlias{$alias};
    }

    my($ndx, $totalhit) = (0, 0);
    my($tmp, $str, $offset);

    my $searchstr = "while(defined(\$str = <FH>)){\n";
    $searchstr .= "&replace(\$str);\n" if $alias =~ /ur[li]/i && $Replace;
    $searchstr .= "\$str =~ s/([\\xa1-\\xfe].)/\\xff\$1/g;\n" if $flag;

    $searchstr .= "if (\$str =~ /$pat/i){\n";
    if ($ext eq 'qfield'){
        $searchstr .= "seek(FNDX, \$ndx * $IntSize, 0);\n";
        $searchstr .= "read(FNDX, \$tmp, $IntSize * 2);\n";
        $searchstr .= "(\$offset, \$tmp) = unpack('$IntNType*', \$tmp);\n";
        $searchstr .= "seek(FDAT, \$offset, 0);\n";
        $searchstr .= "read(FDAT, \$tmp, \$tmp - \$offset);\n";

        $searchstr .= "\$offset = 0;\n";
        $searchstr .= "foreach \$tmp (&unpackw(\$tmp)){";
        $searchstr .= "\$offset += \$tmp;";
        $searchstr .= "\$totalhit++, \$score{\$offset} = -1 if !\$score{\$offset} && &TimEnable(\$offset)";
        $searchstr .= "}";
    }else{
        $searchstr .= "\$totalhit++, \$score{\$ndx} = -1 if &TimEnable(\$ndx);\n";
    }
    $searchstr .= "last if \$totalhit >= \$MaxFieldHit;\n" if $MaxFieldHit;
    $searchstr .= "}";
    $searchstr .= "\$ndx++;\n";
    $searchstr .= "}";
    eval $searchstr;
    close FH;
    close FDAT;
    close FNDX;

    if ($MaxFieldHit && $totalhit >= $MaxFieldHit){
        $totalhit = 0;
        %score = ('TooMany' => $Text{'hit'});
    }else{
        &cache_write_score("field $field $pat", *score) if $CACHE;
    }

    $score{'field_r'} = $score{'field_l'} = 1;
    return ($match, '', $totalhit);
}


# regconv.pl - 1998.09.09 by furukawa@tcp-ip.or.jp -*- perl -*-

sub main::regconv{
    # 正規表現を EUC 対応に (それなりに) 変換する
    # 例えば
    #     [あ-うア] -> (?:\xff\xA4[\xA2-\xA6]|\xffア)
    #     [^亜] -> ([\xA1-\xAF\xB1-\xFE][\xa1-\xfe]|\xB0[\xA2-\xFE]|[\x00-\x7F])
    # といった具合。
    #
    # usage: $pattern = &regconv($original_pattern [, $option]);
    #
    # 返り値は、変換後のパターン
    #
    # 途中の '$' は quote されるので、パターン中に変数名を入れることは
    # できない。必要ならば変換前に処理しておくこと。
    #
    # '@', '%', '/' も quote される。
    # 
    # \数字 のパターンは、必ず 8 進数として扱われる。
    # 
    # \x(16進数) のパターンで、値が 0x80 以上のときは、
    # それを上位バイトとする文字集合に変換される。
    #
    # $original_pattern は、SCALAR または、SCALAR へのリファレンス
    #   リファレンスであった場合には、元パターンに不整合があったとき
    #   に、訂正したものを戻す
    #
    # $option は、HASH へのリファレンスとして与える
    #   HASH のキーとして、次のものが使える
    #       'pl'    2 バイト文字を括る括弧の左側に、'(' でなく '(?:' を
    #               使う。これを使わないと、元パターンのカッコの位置が
    #               変わるので、$1, $2, ... は使えなくなる
    #       'case'  文字クラスの展開する際、大文字・小文字区別する
    #       'ff'    2 バイト文字の前に \xff を挿入する。これにより、
    #               文字境界を誤認識しないようにできるが、検索対象の
    #               文字列は、前もって、
    #                   s/([\xa1-\xfe].)/\xff$1/g;
    #               といった変換をしておく必要がある。
    #       'ex'    次の拡張を有効にする
    #                   \H        ひらがな (\xa4[\xa1-\xf3])
    #                   \K        カタカナ (\xa5[\xa1-\xf6]|\xa1\xbc)
    #                   \J        漢字     ([\xb0-\xf4][\xa1-\xfe])
    #                   \X0000    2 バイト文字コード
    #
    #   また、パターンに 2 バイト文字を含む場合、'MB' というキーに 1 
    #   が戻される。

    my $ptr = shift;
    my $str = (ref($ptr) eq 'SCALAR')? $$ptr: $ptr;
    my $opt = @_? shift: '';

    my $ex = 0;
    my $ff = '';
    my $case = 0;
    my ($pl, $pr) = ("(", ")");

    if (ref($opt) eq 'HASH'){
        my $key;
        $ex = $opt->{'ex'} if defined $opt->{'ex'};
        $ff = "\\xff" if defined $opt->{'ff'};
        $case = $opt->{'case'} if defined $opt->{'case'};
        $pl = "(?:" if defined $opt->{'pl'};
    }

    my $kclass = "\\xa1-\\xff";
    my $knj = "$ff\[\\xa1-\\xfe\]\[\\xa1-\\xfe\]";

    my $eol = ($str =~ s/\$$//);
    my $plevel = 0;
    my %work = ('UL' => '', 'Q' => '', 'Ex' => $ex, 'MB' => 0);
    my $fix = '';
    my $pat = '';

    while ($str !~ /^$/){
        my $ch = &regconv::reggetc(\%work, \$str);
        ++$plevel if $ch eq '(';
        if ($ch eq ')'){
            next unless $plevel;
            --$plevel;
        }

        # '$', '@', '%', '/' は quote
        $ch = "\\$ch" if $ch =~ /^[\/\$\@\%]$/;

        $fix .= $ch;
        $pat .= "$pl$ff$ch$pr", next if $ch =~ /^[\xa1-\xfe]{2}$/;
        $pat .= "$pl\[^\\n$kclass]|$knj$pr", next if $ch eq '.';
        $pat .= "$pl\[^\\w$kclass]|$knj$pr", next if $ch eq "\\W";
        $pat .= "$pl\[^\\s$kclass]|$knj$pr", next if $ch eq "\\S";
        $pat .= "$pl\[^\\d$kclass]|$knj$pr", next if $ch eq "\\D";

        $pat .= "$pl$ff$ch\[\\xa1-\\xfe\]$pr", next if $ch =~ /^\\x[a-fA-F]./;

        if ($ex){
            $pat .= "$pl$ff\\xa4[\\xa1-\\xf3]$pr", next if $ch eq "\\H";
            $pat .= "$pl$ff\\xa5[\\xa1-\\xf6]|$ff\xa1\xbc$pr", next if $ch eq "\\K";
            $pat .= "$pl$ff\[\\xb0-\\xf4\]\[\\xa1-\\xfe\]$pr", next if $ch eq "\\J";
            if ($ch =~ s/^\\X//){
                my $code = hex $ch;
                if ($code < 0x80){
                    $pat .= sprintf("\\x%02X", $code);
                }elsif ($code < 0x100){
                    $pat .= sprintf("$pl$ff\\x%02X[\\xa1-\\xfe]$pr", $code);
                }else{
                    $code |= 0x8080;
                    my $hi = $code >> 8;
                    my $lo = $code & 0xff;
                    my $tmp = &regconv::hex4($hi, $lo);
                    $pat .= "$ff$tmp" if $tmp ne '';
                }
                next;
            }
        }
        $pat .= $ch, next if $ch ne "\[";

        my $sign;
        $fix .= $1 if $sign = ($str =~ s/^(\^)//);
        if ($str ne ''){
            my %vct = ();
            $vct{'sign'} = $sign;
            $vct{'case'} = $case;
            $vct{0} = $vct{0xa1} = $vct{'all'} = $vct{'set'} = '';
            for (my $i = 0; $i < 128; $i++){vec($vct{0}, $i, 1) = $sign};
            for (my $i = 0xa1; $i <= 0xfe; $i++){
                vec($vct{0xa1}, $i, 1) = $sign;
                vec($vct{'all'}, $i, 1) = !$sign;
                vec($vct{'set'}, $i, 1) = 1;
            }
            for (my $i = 0xa2; $i <= 0xfe; $i++){ $vct{$i} = $vct{0xa1}};

            my $flag = 0;
            for(;;){
                my $x = &regconv::reggetc(\%work, \$str);
                my $y;
                $x = "\]" if $x eq '';
                $fix .= $x;
                last if $x eq ']' && $flag; # 終了
                $flag = 1;
                if ($x =~ /\\[wWsSdDHKJ]/
                    || $work{'Q'} || $str !~ /^\-[^\]]/){

                    if ($x =~ /([\xa1-\xfe])([\xa1-\xfe])/){
                        &regconv::mvect(\%vct, ord $1, ord $2);
                    }elsif ($ex && $x =~ /\\H/){
                        for $y (0xa1..0xf3){
                            &regconv::mvect(\%vct, 0xa4, $y);
                        }
                    }elsif ($ex && $x =~ /\\K/){
                        for $y (0xa1..0xf6){
                            &regconv::mvect(\%vct, 0xa5, $y);
                        }
                        &regconv::mvect(\%vct, 0xa1, 0xbc);
                    }elsif ($ex && $x =~ /\\J/){
                        for $y (0xb0..0xf4){
                            $vct{$y} = $vct{'all'};
                        }
                    }else{
                        &regconv::svect(\%vct, $x);
                        if ($x =~ /^(\.|\\[WSD])$/){
                            for $y (0xa1..0xfe){
                                $vct{$y} = $vct{'all'};
                            }
                        }
                    }
                    next;
                }

                &regconv::reggetc(\%work, \$str); $fix .= '-';
                $y = &regconv::reggetc(\%work, \$str);
                $fix .= $y;

                if ($x =~ /^([\xa1-\xfe])([\xa1-\xfe])$/){
                    my ($x0, $x1) = (ord $1, ord $2);
                    if ($y =~ /^([\xa1-\xfe])([\xa1-\xfe])$/){
                        my ($y0, $y1) = (ord $1, ord $2);
                        if ($x0 < $y0 && $x0 > 0xa1){
                            &regconv::mvect(\%vct, $x0, $x1++) while $x1 < 0xff;
                            ++$x0; $x1 = 0xa1;
                        }
                        $vct{$x0} = $vct{'all'}, ++$x0 while $x0 < $y0;
                        if ($x0 == $y0){
                            &regconv::mvect(\%vct, $x0, $x1++) while $x1 <= $y1;
                        }
                    }
                }else{
                    &regconv::svect(\%vct, "$x-$y");
                }
            }

            my $mark = $pl;
            $flag = 0;
            for (my $x = 0xa1; $x <= 0xfe; $x++){
                next unless $vct{$x} eq $vct{'set'};
                my $y;
                for ($y = $x + 1; $y <= 0xfe; $y++){
                    last unless $vct{$y} eq $vct{'set'};
                }
                $flag = 1, $pat .= $mark . '\xff[' unless $flag;
                $pat .= &regconv::rangestr($x, $y - 1);
                $x = $y;
            }
            $pat .= '][\xa1-\xfe]', $mark = '|' if $flag;

            my $x;
            for ($x = 0xa1; $x <= 0xfe; $x++){
                next if $vct{$x} eq $vct{'set'};
                if ($vct{$x} !~ /^\x00*$/){
                    $flag = '';
                    for (my $l = 0xa1; $l <= 0xfe; $l++){
                        next unless vec($vct{$x}, $l, 1);
                        my $r;
                        for ($r = $l + 1; $r <= 0xfe; $r++){
                            last unless vec($vct{$x}, $r, 1);
                        }
                        unless ($flag){
                            $pat .= "$mark$ff";
                            $pat .= chr($x) . chr($l), last if $l == $r - 1 && $vct{$x} =~ /^\x00*/;
                            $flag = ']';
                            $pat .= sprintf("\\x%02X[", $x);
                        }
                        $pat .= &regconv::rangestr($l, $r);
                        $l = $r;
                    }
                    $pat .= $flag;
                    $mark = '|';
                }
            }

            $mark = '' if $mark eq $pl;
            if ($vct{0} !~ /^\x00*$/){
                $pat .= $mark . '[';
                for (my $l = 0; $l < 128; $l++){
                    next unless vec($vct{0}, $l, 1);
                    my $r;
                    for ($r = $l + 1; $r < 128; $r++){
                        last unless vec($vct{0}, $r, 1);
                    }
                    $pat .= &regconv::rangestr($l, $r - 1);
                    $l = $r;
                }
                $pat .= ']';
            }
            $pat .= $pr if $mark;
        }
    }
    $fix .= ')', $pat .= ')' while $plevel--;
    $fix .= "\$", $pat .= "\$" if $eol;

    $opt->{'MB'} = $work{'MB'} if ref($opt) eq 'HASH';
    $$ptr = $fix if ref($ptr) eq 'SCALAR';

    return $pat;
}

sub regconv::vrange{
    my ($pv, $ps) = @_;
    for (; $$ps < 128; ++$$ps){
        next unless vec($$pv, $$ps, 1);
        vec($$pv, $$ps, 1) = 0;
        my $tmp;
        for ($tmp = 1 + $$ps; $tmp < 128; $tmp++){
            vec($$pv, $tmp, 1) = 0 while vec($$pv, $tmp, 1);
        }
    }
    
}

sub regconv::rangechar{
    my $ch = shift;
    if (chr($ch) =~ /^\w$/){
        return chr $ch;
    }else{
        return sprintf("\\x%02X", $ch);
    }
}

sub regconv::rangestr{
    my($x, $y) = @_;
    ($x == $y)?
        &regconv::rangechar($x):
            &regconv::rangechar($x) . "-" . &regconv::rangechar($y);
}



sub regconv::svect{
    # シングルバイト文字用のベクタ処理
    my($ptr, $pat) = @_;
    my $v = !$ptr->{'sign'};
    my $i;
    if ($ptr->{'case'}){
        for $i (0..0x7f){
            vec($ptr->{0}, $i, 1) = $v if eval{chr($i) =~ /[$pat]/};
        }
    }else{
        for $i (0..0x7f){
            vec($ptr->{0}, $i, 1) = $v if eval{chr($i) =~ /[$pat]/i};
        }
    }
}

sub regconv::mvect{
    # マルチバイト文字用のベクタ処理
    my($ptr, $x, $y) = @_;
    my $v = !$ptr->{'sign'};
    vec($ptr->{$x}, $y, 1) = $v;
}

sub regconv::reggetc{
    my ($tmp, $ptr) = @_;
    while ($$ptr !~ /^$/){
        if ($$ptr =~ s/^\\([ULQE])//){
            # \U, \L, \Q, \E
            if ($1 eq 'E'){
                chop $tmp->{'mode'};
            }else{
                # \U, \L, \Q のネスト処理
                $tmp->{'mode'} .= $1;
            }
            $tmp->{'Q'} = ($tmp->{'mode'} =~ tr/Q/Q/);

            # 最後の \U, \L
            $tmp->{'UL'} = (($tmp->{'mode'} =~ /([UL])[^UL]*$/)? $1: '');
            next;
        }

        if ($$ptr =~ s/^\\([ul])//){
            # \u, \l (一文字変換) 処理
            if (&regconv::ul($ptr, $1)){
                $$ptr =~ s/^(.)//;
                return $1;
            }
        }
        &regconv::ul($ptr, $tmp->{'UL'});
        
        # 1 文字読み出し
        $tmp->{'MB'} = 1, return $1 if $$ptr =~ s/^([\xa1-\xfe]{2})//;
        return $1 if $$ptr =~ s/^(\w)//;
        return '' unless $$ptr =~ s/^(.)//;

        my $ch = $1;
        if ($tmp->{'Q'}){
            my $cnt = $tmp->{'Q'};
            $ch = quotemeta($ch) while $cnt--;
            return $ch;
        }
        return $ch if $ch ne "\\";

        # \ の処理

        &regconv::ul($ptr, $tmp->{'UL'});

        # \c. (コントロール文字の処理)
        return "\\c" . ($$ptr =~ s/^(.)//? $1: '@') if $$ptr =~ s/^c//;
    
        # \000 (8 進数の処理)
        return "\\x00" if $$ptr =~ /^[89]/;
        $tmp->{'MB'} = 1, return sprintf("\\x%02X", oct($1)) if s/^([4-7][0-7]{2})//;
        return sprintf("\\x%02X", oct($1)) if s/^([0-7]{1,3})//;

        # \x00 (16 進数) の処理
        $tmp->{'MB'} = 1, return $ch . $1 if $$ptr =~ s/^(x[89a-fA-F][\da-fA-F])//;
        return $ch . $1 if $$ptr =~ s/^(x[\da-fA-F]{1,2})//;

        if ($tmp->{'Ex'}){
            $tmp->{'MB'} = 1, return $ch . $1 if $$ptr =~ s/^(X[\da-fA-F]{3,4})// || $$ptr =~ s/^(X[89a-fA-F][\da-fA-F])//;
            return $ch . $1 if $$ptr =~ s/^(X[\da-fA-F]{0,4})//;
            $tmp->{'MB'} = 1 if $$ptr =~ /^[HKJ]/;
        }
        # その他
        return $ch . $1 if $$ptr =~ s/^([\x20-\x7e])//;
        return "\\\\";
    }
    return '';
}


sub regconv::ul{
    # 先頭の 1 文字を 大/小文字 変換
    my ($ptr, $ul) = @_;
    return $$ptr =~ s/^([A-Za-z])/\u$1/ if $ul =~ /^u/i;
    return $$ptr =~ s/^([A-Za-z])/\l$1/ if $ul =~ /^l/i;
}

sub regconv::hex4{
    my ($hi, $lo) = @_;
    return '' if $hi < 0xa1 || 0xfe < $hi || $lo < 0xa1 || 0xfe < $lo;

    if (0xa4 == $hi && $lo <= 0xf3
        or $hi == 0xa5 && $lo <= 0xf6
        or $hi == 0xa1 && $lo == 0xbc
        or $hi == 0xa6 && ($lo <= 0xb8 or 0xc1 <= $lo && $lo <= 0xd8)
        or $hi == 0xa7 && ($lo <= 0xc1 or 0xd1 <= $lo && $lo <= 0xf1)
        or 0xb0 <= $hi && $hi <= 0xce
        or $hi == 0xcf && $lo <= 0xd3
        or 0xd0 <= $hi && $hi <= 0xf3
        or $hi == 0xf4 && $lo <= 0xa4
        ){
        return chr($hi) . chr($lo);
    }
    return sprintf("\\x%02X\\x%02X", $hi, $lo);
}


$TSEARCH = 1;

sub tsearch_init{
    # gmtime との時差の計算
    my ($sec, $min, $hour, $mday, $mon) = localtime(0);
    $TDif = (($hour * 60) + $min) * 60 + $sec;
    $TDif -= 24 * 60 * 60 if $mon;

    $TMax = (~0) >> 1;
    $Today = &ymd2time(&time2ymd($^T + $TDif));
}
&tsearch_init;

sub tsearch{
    local($origkey, *score, $_) = @_;
    my $key = $_;
    my ($match, $db) = ('+[', "$DbPath.t");
    my($r0, $r1);
    my($fileno, $totalhit) = (0, 0);

    $key =~ s/^\+\[//;
    $key =~ s/\].*//;
    my ($x, $y) = split(/,/, $key);

    if ($x ne ''){
        ($r0, $r1) = &calc_time(1, $x, 0);
        ($r0, $r1) = &calc_time(0, $y, $r0) if $y ne '';
        $r1 = $TMax if ($key =~ /,/) && $y eq '';
    }elsif ($y){
        $r0 = 0;
        $r1 = &calc_time(0, $y, 0);
    }elsif ($key =~ /,/){
        $r1 = $TMax;
    }
    my $str0 = sprintf("%4d.%02d.%02d", &time2ymd($r0));
    my $str1 = sprintf("%4d.%02d.%02d", &time2ymd(&add_time(0, 0, -1, $r1)));
    $match .= $str0 if $r0;
    if ($r1 == $TMax){
        $match .= ',';
    }elsif ($str0 ne $str1){
        $match .= ",$str1";
    }
    $match .= ']';

    $r0 = &fixtdif($r0);
    $r1 = &fixtdif($r1);

    if ($CACHE){
        &cache_init;
        $totalhit = &cache_read_score("tim $match", *score);
        if ($totalhit >= 0){
            $score{'field_r'} = $score{'field_l'} = 1;
            return ($match, '', $totalhit);
        }
        $totalhit = 0;
    }

    while ($fileno < $DbNdx{'TIM'}){
        my $t = &indexpointer('TIM', $fileno);
        $totalhit++, $score{$fileno} = -1 if $r0 < $t && $t < $r1 && &TimEnable($fileno);
        last if $MaxFieldHit && $totalhit >= $MaxFieldHit;
        $fileno++;
    }
    if ($MaxFieldHit && $totalhit >= $MaxFieldHit){
        $totalhit = 0;
        %score = ('TooMany' => $Text{'hit'});
    }else{
        &cache_write_score("tim $match", *score) if $CACHE;
    }
    $score{'field_r'} = $score{'field_l'} = 1;
    return ($match, '', $totalhit);
}

sub calc_time{
    my($isx, $t, $z) = @_;
    my $sgn = ($t =~ s/^([\+\-])//)? $1: '';
    my ($y, $m, $d) = split(/\./, $t);
    my ($r0, $r1);

    $sgn = '-' if $sgn && !$z;

    if ($sgn eq '+'){
        return ($z, &add_time($y, $m, $d, $z));
    }elsif ($sgn eq '-'){
        return (&add_time(-$y, -$m, -$d, $Today), $TMax) if $isx;
        return ($z, &add_time(-$y, -$m, -$d, $Today));
    }
    my($yy, $mm, $dd) = &time2ymd($Today);
    if ($y ne ''){
        $y += 1900 if $y < 100;
        $y += 100 if $y < 1970;
        $yy = $y, $mm = 1, $dd = 1;
    }
    if ($m =~ /[a-z]/i){
        my $ndx = 12;
        --$ndx while $ndx && ('january', 'february', 'march', 'april',
                              'may', 'june','july', 'august',
                              'september', 'october', 'november',
                              'december')[$ndx - 1] !~ /^$m/i;
        $m = $ndx;
    }
    $mm = $m, $dd = 1 if $m;
    $dd = $d if $d;

    $r0 = &ymd2time($yy, $mm, $dd);

    # +[日付] を検索する場合の期間計算
    ($r1) = &add_time(!$d && !$m, !($d || !$m), $d && 1, $r0);

    if ($y || $m){
        # 一部省略時に、矛盾のないようにする
        $y = ($m && !$y);
        $m = !$m;
        if ($isx){
            ($r0, $r1) = &add_time(-$y, -$m, 0, $r0, $r1) if $Today < $r0;
        }elsif ($r1 < ($r0 = $z)){
            $r1 = &add_time($y, $m, 0, $r1);
        }
    }
    ($r0, $r1);
}

sub add_time{
    # time に ($year, $mon, $mday) を加算する
    my($dy, $dm, $dd, @t) = @_;
    my @ret;
    my $t;

    for $t (@t){
        my($y, $m, $d) = &time2ymd($t);
        $y += $dy;
        $m += $dm;
        ++$y, $m -= 12 while $m > 12 && $y <= 2038;
        --$y, $m += 12 while $m < 1 && $y >= 1970;
        push(@ret, &ymd2time($y, $m, $d) + $dd * 60 * 60 * 24);
    }
    @ret;
}

sub time2ymd{
    # time を ($year, $mon, $mday) に変換する。
    # $year は、西暦 4 ケタ、$mon は 1-12 を使う
    
    my ($sec, $min, $hour, $mday, $mon, $year) = gmtime(shift);
    ($year + (($year < 70)? 2000: 1900), ++$mon, $mday);
}

sub ymd2time{
    # ($year, $mon, $mday) を time に変換する。
    my ($year, $mon, $mday) = @_;
    my @mday = (31, 28 + !($year % 4), 31, 30, 31, 30, 31, 31, 30, 31, 30);
    $mday += $mday[$mon - 1] while --$mon > 0;

    $year -= 1970;
    # perl の時刻の範囲では、単純に、閏年は 4 年に 1 度でよい
    $mday += (365 * 4 + 1) * int($year / 4);
    $year %= 4;
    $mday += 365 * $year + ($year == 3);
    my $t = ($mday - 1) * 24 * 60 * 60;
    return 0 if $t < 0;
    return $TMax if $t > $TMax;
    $t;
}

sub fixtdif{
    my $t = shift;
    return 0 if $t <= 0;
    return $TMax if $t >= $TMax;
    $t -= $TDif;
    return 0 if $t <= 0;
    return $TMax if $t >= $TMax;
    $t;
}


$CACHE = 1;

sub cache_init{
    local(*FH);
    my $cache = "$DbPath.cache.0";
    if (!$CacheInit){
        $CacheInit = 1;
        if (-s $cache && (stat(_))[9] < $HashTime){
            if (-w $cache){
                local(*TMPFH);
                if (open(FH, $cache)){
                    my $str;
                    while (defined($str = <FH>)){
                        my ($ext, $elem) = split(/ /, $str, 2);
                        open(TMPFH, ">$DbPath.cache.$ext");
                        close TMPFH;
                    }
                    close(FH);
                }
                open(TMPFH, ">$cache");
                close TMPFH;
            }
            return if -s $cache;
        }
        if (open(FH, $cache)){
            my $str;
            while (defined($str = <FH>)){
                chomp $str;
                my ($ext, $elem) = split(/ /, $str, 2);
                my $cfile = "$DbPath.cache.$ext";

                if (-r $cfile && -s $cfile){
                    $CacheSize{$ext} = (stat(_))[7];
                    $CacheTim{$ext} = (stat(_))[9];

                    $CacheList{$elem} = $ext;
                    $CacheInvList{$ext} = $elem;
                }
            }
            close(FH);
        }
    }
}

sub cache_write_list{
    local(*FH);
    my $umask = umask 0;

    my $size = 0;
    for $ext (keys %CacheInvList){
        $size += $CacheSize{$ext};
    }

    if ($size > $CacheSizeLimit){
        &debug_log("Cache size over");
        for $ext (sort {($CacheTim{$a} <=> $CacheTim{$b})
                            || ($CacheSize{$b} <=> $CacheSize{$a})
                            } keys %CacheInvList){
            my $file = "$DbPath.cache.$ext";
            next unless -w $file;
            local(*TMPFH);
            next unless open(TMPFH, ">$file");
            close TMPFH;
            $size -= $CacheSize{$ext};
            delete $CacheInvList{$ext};
            &debug_log("Cache remove: $file");
            last if $size <= $CacheSizeLimit;
        }
    }

    if (open(FH, ">$DbPath.cache.0")){
        for $ext (keys %CacheInvList){
            print FH "$ext $CacheInvList{$ext}\n";
        }
        close(FH);
        &debug_log("Cache write list: $ext");
    }
    umask $umask;
}

sub cache_close{
    undef %CacheInvList;
    undef %CacheSize;
    undef %CacheTim;
    undef %CacheList;
    undef %CacheInvList;
    $CacheInit = 0;
    $CacheChange = 0;
}

sub cache_read_proc{
    local($field, *score, $fptr, @para) = @_;
    my $ext = $CacheList{$field};
    if ($ext){
        my $file = "$DbPath.cache.$ext";
        local(*FH);
        if (&openbfile(FH, $file)){
            my($buf, $hit, $ndx);
            read(FH, $buf, $CacheSize{$ext});
            close(FH);
            unless (utime $^T, $^T, $file){
                &debug_log("Cache utime failed: $file");
                if (open(FH, ">$file")){
                    print FH $buf;
                    close(FH);
                    &debug_log("Cache rewrite: $file");
                }
            }
            $CacheTim{$ext} = $^T;

            for $ndx (&unpackw($buf)){
                &$fptr(\$hit, $ndx, *score, @para);
            }
            &debug_log("Cache read: $file");
            return $hit;
        }else{
            delete $CacheList{$field};
            delete $CacheInvList{$ext};
            $CacheChange = 1;
        }
    }
    return -1;
}

sub cache_read_word{
    local($field, *score, @para) = @_;
    return &cache_read_proc($field, *score, \&ssub, @para);
}

sub cache_read_sub{
    local($phit, $ndx, *score) = @_;
    $score{$ndx} = -1, ++$$phit if &TimEnable($ndx);
}

sub cache_read_score{
    local($field, *score) = @_;
    return &cache_read_proc($field, *score, \&cache_read_sub);
}

sub cache_write_proc{
    my ($field, @ndx) = @_;
    chomp $field;
    local(*FH);
    my $umask = umask 0;
    my $ext = $CacheList{$field};
    unless ($ext){
        $ext = 1;
        $ext++ while $CacheInvList{$ext};
        $CacheList{$field} = $ext;
        $CacheInvList{$ext} = $field
    }

    my $file = "$DbPath.cache.$ext";
    if (open(FH, ">$file")){
        binmode(FH);
        $CacheSize{$ext} = 0;
        for $ndx (@ndx){
            print FH pack($IntType, $ndx);
            $CacheSize{$ext} += $IntSize;
        }
        close(FH);

        utime $^T, $^T, $file;
        $CacheTim{$ext} = $^T;

        $CacheChange = 1;

        &debug_log("Cache write: $file");
    }else{
        delete $CacheList{$field};
        delete $CacheInvList{$ext};
    }
    umask $umask;
}

sub cache_write_word{
    &cache_write_proc(@_);
}

sub cache_write_score{
    local($field, *score) = @_;
    &cache_write_proc($field, sort {$a <=> $b} keys %score);
    return;
}



#-------------------------- 'summary' Module -------------------------
$SUMMARY = 1;
my ($Body3, $Body6);

sub summary_init{
    $Body3 = '^([\x21-\x7e\xa1-\xfe]{1,16}\s*(\.|,|\@|';
    $Body3 .= &toEuc('。|、|の');
    $Body3 .= ')\s*){0,2}[\x21-\x7e\xa1-\xfe]{1,16}\s*(';
    $Body3 .= &toEuc('です|と申します|ともうします|といいます');
    $Body3 .= ')(.{0,2})?$'; #'

    $Body6 = '^(Date:|Subject:|Message-ID:|From:|';
    $Body6 .= &toEuc('件名|差出人|日時)|');
    $Body6 .= 'In .*(article|message)|\<\S+\@([\w-.]\.)+\w+\>|';
    $Body6 .= '(wrote|said|writes|says).{0,3}$|';
    $Body6 .= '(返事です|reply\s*です|曰く|いわく|書きました|言いました|話で).{0,2}$'; #'
}
&summary_init;

sub summary_head{
    my $str = shift;
    my $lineno = shift;
    my $head = shift;
    my $filepath = shift;
    my $header = shift;
    my $st = shift;

    return 1 if $lineno == 1 && $str =~ /^From /;
    push(@$head, $str), return 1 if $str =~ /^\S+:/;
    if ($str =~ s/^\s//){
        return 0 unless @$head;
        $head->[$#$head] .= $str;
        return 1;
    }

    if ($str =~ /^$/){
        for $str (@$head){
            if ($str =~ /^(From|To|Cc|Newsgroup|Date)\:\s*(.*?)$/i){
                $$header .= "<strong>$1</strong>:<> "
                    . &metach(&toEuc($2, 'a2a')) . "</em><br$Xht>\n";
            }
            if ($str =~ s/^Subject:\s*//i){
                $$st = sprintf('<strong><a href="%s">%s</a></strong>',
                               $filepath, &metach(&toEuc($str, 'a2a')));
            }
        }
        return 0;
    }
    return -1;
}

sub summary_body{
    my $str = shift;
    my $body = shift;
    my $summary = shift;
    my $sizelimit = shift;

    if ($body > 0){
        ++$body;
        return $body if $str =~ /^[^\s\<]{1,10}\>|^\s*[\>\|\:]/;

        $str =~ s/^\s*\#?\s+//;
        $str =~ s/\s+$//;
        $str =~ s/\s\s+/ /g;
        if ($body <= 3){
            return $body if $str =~ /$Body3/io;
            return $body if $body <= 6 && $str =~ /$Body6/io;
        }
    }else{
        $str =~ s/\<[^\>]+\>/ /g;
    }
    $str =~ s/([\-\=\*\#])\1{2,}/$1$1/g;

    return 0 if $sizelimit <= length $$summary;
    if ($str !~ /^\s*$/){
        $$summary .= ' ' if defined($$summary) && length($summary);
        $$summary .= &metach(&euc_to_euc($str, {'summary' => 1}));
        return 0 if $sizelimit <= length $$summary;
    }
    return $body;
}


sub make_summary{
    my ($keydb, $keyno, $flag, $sizelimit) = @_;
    my ($dt, $st, $summary, $dd, $grep);
    local(*FSRC);

    my $offset = &indexpointer("RLISTINDEX$keydb", $keyno);
    my $filepath = &getsdb("RLIST_____$keydb", $offset);
    $filepath =~ s/\r*\n//;
    $filepath =~ s/\t.*$//;

    &debug_log("sum: $filepath");

    $sizelimit = 300 unless defined($sizelimit) && $sizelimit >= 0;

    my $size = (stat $filepath)[7];

    unless ($size && -r $filepath){
        if (-d $DiaryDir && $filepath =~ /\#(\d{4})(\d{4})\d*$/){
            my $diaryyear = $1;
            my $diarydate = $2;
            my $diarypath = "$DiaryDir/$diaryyear/d$diaryyear$diarydate.hnf";
            my $tmp = (stat $diarypath)[7];
            if (-r $diarypath && $tmp){
                $size = $tmp;
                $filepath = $diarypath;
                &debug_log("sum: hnf: $filepath");
            }
        }
    }

    unless ($size && -r $filepath){
        $filepath =~ s/\#.*$//;
        $size = (stat $filepath)[7];
        &debug_log("sum: $filepath");
    }

    unless ($size && &opentext(*FSRC, $filepath)){
        &replace($filepath);
        unless (defined $SRepSrc){
            $SRepSrc = $SCRIPT_NAME;
            $SRepDst = $0;
            $SRepSrc =~ s/.$// while $SRepSrc =~ /(.)$/ && $SRepDst =~ s/$1$//;
            $SRepSrc = quotemeta($SRepSrc);
            &debug_log("sum: SRepSrc: $SRepSrc");
            &debug_log("sum: SRepDst: $SRepDst");
        }
        $filepath =~ s/^http\:\/\/[^\/]+//;
        $filepath =~ s/^$SRepSrc/$SRepDst/o;
        $size = (stat $filepath)[7];
        $size = 0 unless $size && &opentext(*FSRC, $filepath);
        &debug_log("sum: replace: $filepath");
    }
    &debug_log("sum: $filepath");

    my $grpflag = ($HnsGrepGrp && $filepath =~ /\.hnf$/i);

    if ($size){
        my $head = 1;
        my $body = 0;
        my $lineno = 0;
        my $gflag = ($flag =~ /g/ && !$AlreadyGrep{$filepath} && length($Sword{$keydb}));
        my ($header, @head);
        my $buf;

        $dt = '<dt>';
        $dd = sprintf('<dd><a href="%s">%s</a> size (%d bytes)'
                      . "<br$Xht><br$Xht>\n",
                      $filepath, $filepath, $size);
        $grep = '';

        if ($gflag){
            unless (defined $GrepFunc{$keydb}){
                my $evalstr = '$GrepFunc{$keydb} = sub {';
                if ($PlainConv){
                    $evalstr .= '$_[0] =~ /' . $Sword{$keydb} . '/i;';
                }else{
                    $evalstr .= '$_[0] =~ s/(' . $Sword{$keydb} . ')/$EmTagS$1$EmTagE/gi;';
                }
                $evalstr .= '};';

                eval $evalstr;
            }
            
        }

        while (defined($str = <FSRC>)){
            last if $str =~ /\x00|^M[\x21-\x60]{60}$/;
            last if $str =~ /^Content-Type: /i && $str !~ /text|multipart/i;
            last if $grpflag && $str =~ /^GRP\s/;

            ++$lineno;
            $str =~ s/\r*\n$//;
            if ($head){
                $head = &summary_head($str, $lineno, \@head,
                                      $filepath, \$header, \$st);
                $body = 1, next unless $head;
                if ($head < 0){
                    $body = -1;
                    $head = 0;
                    for $str (@head){
                        $body = &summary_body(&toEuc($str, 'a2a'), $body, \$summary, $sizelimit);
                        last unless $body;
                    }
                }
            }
            $str = &toEuc($str, 'a2a') if $gflag || $body;
            $body = &summary_body($str, $body, \$summary, $sizelimit) if $body;
            if ($gflag){
                $buf = &metach($str);
                $buf =~ s/([\xa1-\xfe].)/\xff$1/g;

                if (&{$GrepFunc{$keydb}}($buf)){
                    $buf =~ tr/\xff//d;
                    if ($PlainConv){
                        $grep .= "$lineno: $buf\n";
                    }else{
                        $grep .= "\n<strong>$lineno: </strong>$buf<br$Xht>";
                    }
                }
            }
        }
        if (!$PlainConv){
            $summary = metach($summary);
            $summary =~ s/([\xa1-\xfe].)/\xff$1/g;
            $summary =~ s/($Sword{$keydb})/$EmTagS$1$EmTagE/gi if length $Sword{$keydb};
            $summary =~ tr/\xff//d;
        }

        $AlreadyGrep{$filepath} = 1 if $gflag;
        return $grep if $flag !~ /[fs]/;
        $summary = "<dd>$header$summary" if $flag =~ /f/;
    }
    ($dt, $st, $summary, $dd, $grep);
}

#---------------------- end of 'summary' Module ----------------------



my %format_para;
my @format_stack;
my $format_disable;

sub pagehref{
    my ($page, $akey) = @_;
    my $wh = $Max * int($page);

    push(@OriginalQuery, "whence=$wh") if !(grep {s/^whence.*/whence=$wh/} @OriginalQuery) && $wh;

    my $url = sprintf("%s?%s", $SCRIPT_NAME . $PathInfo, join('&', @OriginalQuery));
    $url = &metach($url);
    my $href = "<a href=\"$url\"";
    $href .= " accesskey=\"$akey\"" if $Phone && defined $akey;
    $href .= ">";
    return ($url, $href);
}

sub format_init{
    %format_para = (
                    'start_time' => localtime($^T) . "",
                    'current_time' => sub {localtime(time) . ""},
                    'time_to_search' => time - $^T,
                    'time_to_current' => sub {time - $^T},
                    'cgi' => $SCRIPT_NAME,
                    'pnamazu' => "pnamazu-$Pnamazu",
                    'key' => $KeyStr,
                    'quotekey' => &quote_meta($KeyStr),
                    'reference' => ($Reference !~ /^off/i),

                    'whence' => $Whence + 1,
                    'whither' => $Max? ($Whence + $Max): $Keys,
                    'hit' => $Keys,

                    'lang' => &get_language,
                    'code' => &get_output_ja_code,
                    );
    $format_para{'whither'} = $Keys if $Keys < $format_para{'whither'};
    $format_para{'page_index'} = ($format_para{'whence'} != 1
                                  || $format_para{'whither'} != $Keys);

    if ($format_para{'whence'} > 1){
        my ($url, $href) = &pagehref(($Whence - 1) / $Max);
        $format_para{'prev'} = 1;
        $format_para{'prev_url'} = $url;
        $format_para{'prev_href'} = $href;
    }
    if ($format_para{'whither'} < $Keys){
        my ($url, $href) = &pagehref(($Whence + $Max) / $Max, "\#");
        $format_para{'next'} = 1;
        $format_para{'next_url'} = $url;
        $format_para{'next_href'} = $href;
    }
}

sub format_num{
    my $page = int shift;
    my ($url, $href) = &pagehref($page);

    $format_para{'page_current'} = ($page * $Max == $Whence);

    $format_para{'page_number'} = $page + 1;
    $format_para{'page_url'} = $url;
    $format_para{'page_href'} = $href;
}

sub format_getline{
    my $x = shift;
    my $str;
    if (ref $x eq 'ARRAY'){
        $str = shift @$x;
    }else{
        $str = &toEuc($str) if defined($str = <$x>);
    }
    return $str;
}

sub format_replace{
    my $str = shift;
    $str = $format_para{$str};
    return $$str if ref $str eq 'SCALAR';
    return &$str if ref $str eq 'CODE';
    return $str;
}

sub format_string{
    my $str = shift;
    $str =~ s/\$\{([^\}]+)\}/&format_replace($1)/ge;
    return $str;
}

sub format_title{
    &format_init;
    $format_para{'title'} = shift;
    &format_string($TitleFormat);
}

sub format_check_stack{
    $format_disable = 0;
    for $str (@format_stack){
        $format_disable = 1 unless $str;
    }
}

sub format{
    my $x = shift;

    while (defined(my $str = &format_getline($x))){
        if ($str =~ /^\#if\s+(\S+)/){
            push(@format_stack, $format_para{$1});
            $format_disable = 1 unless $format_para{$1};
            next;
        }

        if ($str =~ /^\#endif/){
            &format_check_stack unless pop(@format_stack);
            next;
        }

        if ($str =~ /^\#else/ && @format_stack){
            $format_stack[$#format_stack] = !$format_stack[$#format_stack];
            &format_check_stack;
            next;
        }
        next if $format_disable;

        if ($str !~ /^\#/){
            &output(&format_string($str));
            next;
        }

        if ($str =~ s/^\#eval\s+//){
            $str = &format_string($str);
            $str = eval $str;
            &output($str);
            next;
        }

        &output($SList), &disp_error, next if $str =~ /^\#word/;
        &puthlist, &disp_error, next if $str =~ /^\#result/;

        if ($str =~ /^\#include/){
            my $file = $str;
            $file =~ s/^\#include\s+//;
            $file = &format_string($file);
            local(*FORMAT);
            if (open(FORMAT, $file)){
                &format(*FORMAT);
                close(FORMAT);
            }
            next;
        }

        if ($str =~ /^\#pageloop/){
            my @loop = ();
            while (defined($str = &format_getline($x))){
                last if $str =~ /^\#endloop/;
                push(@loop, $str);
            }
            my $wh;
            for ($wh = 0; $wh < $Keys; $wh += $Max){
                my @tmp = @loop;
                &format_num($wh / $Max);
                &format(\@tmp) while @tmp;
            }
            &disp_error;
            next;
        }

    }
}


#--------------------------- 'main' Module ---------------------------
sub cgiparamget{
    # CGI の QUERY_STRING を読む
    my ($val, $key, $tmp);

    if ($PathInfo = $ENV{'PATH_INFO'}){
        my $scr = $ENV{'SCRIPT_NAME'};
        if (substr($PathInfo, 0, length $scr) eq $scr){
            $PathInfo = substr($PathInfo, length $scr);
        }
        ($val = $PathInfo) =~ s/^\///;
        push(@DbList, $val) if length $val;
    }

    $val = $ENV{'QUERY_STRING'};
    $val = join('', <>) if !$val && $ENV{'REQUEST_METHOD'} =~ /post/i;
    $QueryLength = length $val;

    @OriginalQuery = split(/&/, $val);
    for $tmp (@OriginalQuery){
        ($key, $val) = split(/=/, $tmp);
        $val =~ s/\+/ /g;
        $val =~ s/%([\dA-Fa-f][\dA-Fa-f])/pack("C",hex($1))/eg;

        if ($key =~ /^(key|query)$/i){
            if ($Phone){
                $ARGV = &shiftjis_to_euc($val, 'a2a', 'k2e');
            }else{
                $ARGV = &toEuc($val, 'a2a');
            }
            $KeyStr = &metach($ARGV);
        }
        if ($key =~ /^sort$/i){
            $Sort = $val;
            $SortField = ($Sort =~ /^\+?(field|fstat):([^:]+)/)? $2: '';
        }
        $Max = $val if $key =~ /^max$/i;
        $Whence = $val if $key =~ /^whence$/i;
        @DbList = (@DbList, split(/,/, $val)) if $key =~ /^(idx|db)name$/i && $val !~ /^\// && $val !~ /\.\.\//;

        if ($tmp =~ /format/i){
            $Result = $Format if ($Format = $val) eq 'short';
        }
        if ($tmp =~ /result/i){
            $Format = $Result if ($Result = $val) eq 'short';
        }
        $Detail= $val if $tmp =~ /detail/i;
        $Subquery = $val if $key =~ /^subquery$/i;
        $Reference = $val if $key =~ /^references?$/i;
        $BaseDir = $val if $key =~ /^basedir$/i;
        $GrepMode = $val if $key =~ /^grep$/i;
        $CmdLang = $val if $key =~ /^lang$/i;
        $OpMode = $val if $key =~ /^opmode$/i;
        $Lucky = 1 if $key =~ /^submit$/i && $val =~ /$Jump/i;

	# 高崎RADA
	$OrgQuery = $val if $Key =~ /^orgquery$/i;
    }
    $ARGV =~ s/\s\&\&\&+\s/ \&\& /g;
    $Subquery =~ s/\s\&\&\&+\s/ \&\& /g;
    if ($Subquery){
        if (length $ARGV){
            $ARGV = "$Subquery &&& $ARGV";
        }else{
            $ARGV = "$Subquery &&&";
        }
    }
    $Max = 10, $Result = 'phone' if $Phone;
}

## 高崎RADA
## DBエラー時出力処理用
sub put_error_html {
    my $emsg = @_[0];

print <<"PUT_ERROR_HTML";
<html>
<head>
<title>error</title>
<meta http-equiv="Content-Style-Type" content="text/css">
<meta http-equiv="Content-Type" content="text/html; charset=EUC-JP">
<meta http-equiv="Pragma" content="no-cache">
</head>
<body bgcolor="#ffffff" link="#006666" vlink="#006666" alink="#3399ff">
<center>
<strong><font color="red">$emsg</font></strong>
</center>
</body>
</html>
PUT_ERROR_HTML

}

sub pre_proc{

    ## DB接続
    $db = DBI->connect("dbi:Pg:dbname=$db_name","$db_user","$db_pwd");
    if(!$db){
        die &put_error_html("データベースとの接続に失敗しました。\n");
    }

    # 高崎RADA 
    # シソーラス辞書読み込み
  
    ## オリジナルの入力条件を保存
    $OrgQuery = $ARGV;

    @tmp = split(/\s+/, $ARGV);

    my ($is_phraze, $do_conv) = (0, 0);
    $ARGV = "";
    foreach $tmp (@tmp) {
	if ($tmp eq '{') {  		#フレーズ検索の始まり
             $in_phraze = 1;
	     $do_conv   = 0;
        } elsif ($tmp eq '}') {		#フレーズ検索の終わり
	     $do_conv   = 0;
        } elsif ( $tmp =~ m%^/.*/$% ) {		#正規表現化なら
	     $do_conv   = 0;
	} elsif ( $tmp eq 'and' or $tmp eq 'or' 
               or $tmp eq '&' or $tmp eq '|') { #予約語なら
	     $do_conv   = 0;
	} elsif ( $in_phraze == 1 ) {	#フレーズ中は変換しない
	     $do_conv   = 0;
        } else {
	     $do_conv   = 1;
	}

        if ($do_conv == 1) {	#同義語変換する場合
		# 同義語が存在する単語ならば、"( a or a' )" 形式で結合
		# 同義語が存在しないならそのまま結合
		$ARGV = $ARGV . " " . &get_synonym($tmp);
	} 
        else {			#同義語変換しない場合
		$ARGV = $ARGV . " " . $tmp;
	}

	if ($tmp eq '}') {  		#フレーズ検索の終わり
             $in_phraze = 0;
        } 
    }

    $ARGV = &string_normalize($ARGV);

    ## DB切断
    $db->disconnect();
    if(!$db){
        die &put_error_html("データベースとの切断に失敗しました。\n");
    }

    &debug_log("最終的条件==> $ARGV");

    # ---------------------------------------------

    @ARGV = split(/\s+/, $ARGV);

    &opendb();
    &set_inttype;
}

## 高崎RADA
## 同義語検索
sub get_synonym {
    my $word = @_[0];
    my ($x_word, $i, $sql, $result, $count, $rets);
    my (@rec, $data);
    my $rets = "";
   
    $x_word = $word;
    $x_word =~ s/'/\\'/g;

    $sql = "SELECT a.word FROM synonym a WHERE a.id in ("
	 . "SELECT distinct b.id FROM synonym b WHERE b.word ='$x_word'"
         . ") "
         . "ORDER BY a.id, a.seq ";
    &debug_log("**** SQL ==> $sql ****");

    $result = $db->prepare($sql);
    if(!$result){
        die &put_error_html("検索に失敗しました。<br>$sql");
    }
    $result->execute();
    $count = $result->rows();
    &debug_log("**** synonym count ==> $count ****");

    if ($count > 1) {
	$rets = $rets . "( ";
        for($i=0; $i<$count; $i++){
            @rec = $result->fetchrow_array();
	    $data = @rec[0];
	    $rets = $rets . $data;
	    if ($i < ($count - 1)) {
	    	$rets = $rets . " or ";
	    }
        }
	$rets = $rets . " )";
    } else {
        $rets = $word;
    }
    $result->finish();

    ## &debug_log("**** $word ==> $rets *****");
    return $rets;
}

sub searchmain{
    local(*score);
    my($no, $key, $tmp);

    if ($TinyMknmz){
        # tiny_mknmz によるインデックス対策
        my @tmp = ();
        my $tmp;
        for $tmp (split(/\s+/, $ARGV)){
            push(@tmp, $tmp), next if $tmp =~ /^[\/\+]|$OpPattern/oi;

            if ($tmp =~ /[\xa1-\xfe]/){
                # tiny_mknmz では漢字は 1 文字づつ登録されて
                # いるので、部分一致は意味がない
                $tmp =~ s/^\*([\xb0-\xfe])/$1/;
                $tmp =~ s/([\xb0-\xfe].)\*$/$1/;
                push(@tmp, $tmp);
                next;
            }

            # tiny_mknmz では記号を含む語は登録されていないので、
            # 前もって分割しておく。
            my $fw = ($tmp =~ s/^([\\\*])([a-zA-Z\d_])/$2/)? $1: '';
            my $bw = ($tmp =~ s/^([a-zA-Z\d_])(\*)$/$1/)? $2: '';
            my @ary;

            $tmp =~ s/^[^a-zA-Z\d_]+//;
            $tmp =~ s/[^a-zA-Z\d_]+$//;

            while ($tmp =~ s/^([a-zA-Z\d_]+([\-\/\.\=\'][a-zA-Z\d_]+)*)//){
                push(@ary, $1);
                $tmp =~ s/^[^a-zA-Z\d_]+//;
            }

            $ary[0] = "$fw$ary[0]";
            $ary[$#ary] .= $bw;

            push(@tmp, '(') if @ary > 1;
            my $elem;
            for $elem (@ary){
                my @ph = split(/[\-\/\.\=\']/, $elem);
                push(@tmp, '{') if @ph > 1;
                @tmp = (@tmp, @ph);
                push(@tmp, '}') if @ph > 1;
            }
            push(@tmp, ')') if @ary > 1;
        }
        $ARGV = join(" ", @tmp);
        &debug_log("TinyMknmz: $ARGV");
    }

    # 単語をそれぞれ検索
    if ($KPMode){
        my @tmp = split(/\s+/, $ARGV);
        @ARGV = ();
        for $tmp (@tmp){
            if ($tmp =~ /^((\xa1\xbc|\xa5.)+\xa1\xa6)+(\xa1\xbc|\xa5.)+$/){
                my $opmode = 0;
                $RespTextOrig = 1;

                my @spl = ();
                push(@spl, $1) while $tmp =~ s/^((\xa1\xbc|\xa5.)+)\xa1\xa6//;
                push(@spl, $tmp);

                if ($OpMode eq 'inside' || $OpMode eq 'forward'){
                    $opmode = 1;
                    $spl[$#spl] = "$spl[$#spl]*";
                    $spl[0] = "*$spl[0]" if $tmp = ($OpMode eq 'inside')? 1: 0;

                    @ARGV = (@ARGV, '(', join('', @spl));

                    $spl[$tmp++] = "\\$spl[$tmp]" while $tmp < $#spl;
                }else{
                    @ARGV = (@ARGV, '(', join('', @spl));
                }
                @ARGV = (@ARGV, 'or', '{');

                my $dot = "\xa1\xa6";
                $dot = "\\$dot" if $opmode;
                while (@spl){
                    $tmp = shift(@spl);
                    push(@ARGV, $tmp);
                    push(@ARGV, $dot) if @spl;
                }
                push(@ARGV, '}');
                push(@ARGV, ')');
            }else{
                push(@ARGV, $tmp);
            }
        }
    }else{
        @ARGV = split(/\s+/, $ARGV);
    }
    $ARGV = &searchwords(@ARGV);
    @ARGV = split(/\s+/, $ARGV);

    # 演算処理
    %score = %{&operate(@ARGV)};
    my $dis = $score{'Disable'};
    my $too = $score{'TooMany'};
    delete $score{'Disable'};
    delete $score{'TooMany'};
    delete $score{'phrase'};
    delete $score{'field_l'};
    delete $score{'field_r'};

    $Keys = scalar(keys(%score));
    return if $dis || $too;
    for $tmp (keys(%score)){
        $key = $tmp;
        $key .= "#$DbPath";
        $Score{$key} = $score{$tmp};
    }
}

sub compare{
    my ($x, $y) = @_;
    return ($x <=> $y) if $x =~ /^\d/ && $y =~ /^\d/;
    $x cmp $y;
}

sub searchsort{
    # 検索結果のソート

    if ($Sort =~ /^(field|fstat):.+:descending/){
        @Keys = sort {&compare($SElem{$b}, $SElem{$a})
                        or $Tim{$b} <=> $Tim{$a} 
                          or $Score{$b} <=> $Score{$a}} keys(%Score);
    }elsif ($Sort =~ /^(field|fstat):.+(:ascending)?/){
        @Keys = sort {&compare($SElem{$a}, $SElem{$b})
                        or $Tim{$b} <=> $Tim{$a} 
                          or $Score{$b} <=> $Score{$a}} keys(%Score);
    }elsif ($Sort eq 'earlier' or $Sort eq 'date:early'){
        @Keys = sort {$Tim{$a} <=> $Tim{$b}
                        or $Score{$b} <=> $score{$a}} keys(%Score);
    }elsif ($Sort eq 'nosort'){
        @Keys = keys(%Score);
    }elsif ($Sort eq 'score'){
        @Keys = sort {$Score{$b} <=> $Score{$a}
                      or $Tim{$b} <=> $Tim{$a}} keys(%Score);
    }elsif ($Sort =~ /^\+(field|fstat):/){
        my $key;
        for $key (keys %Score){
            $Score{$key} = 1 if $Score{$key} < 1;
            $Score{$key} = int($Score{$key} + $SElem{$key});
            $Score{$key} = 1 unless $Score{$key};
        }
        @Keys = sort {$Score{$b} <=> $Score{$a}
                      or $Tim{$b} <=> $Tim{$a}} keys(%Score);
    }else{
        @Keys = sort {$Tim{$b} <=> $Tim{$a}
                      or $Score{$b} <=> $score{$a}} keys(%Score);
    }
    $Keys = scalar(@Keys);

    if ($Lucky){
        my ($keyno, $keydb);
        $keyno = $Keys[0], $keydb = ''
            unless ($keyno, $keydb) = split(/\#/, $Keys[0]);
        if (&openbfile('URI', "$keydb.field.uri")
            && &openbfile('URIINDEX', "$keydb.field.uri.i")){
            $LuckyURI = &getsdb('URI', &indexpointer('URIINDEX', $keyno));
            &replace($LuckyURI);
        }
    }
}

sub tag_elem{
    my ($str, $key, $val) = @_;

    if (defined $val){
        $str =~ s/($key\s*\=\s*\")([^\"]*)(\")/$1$val$3/i
            || $str =~ s/($key\s*\=\s*)(\S*)/$1$val/i
                || $str =~ s/\s*\>/ $key=\"$val\"\>/; #"
        return $str;
    }else{
        $val = $2 if $str =~ /($key\s*\=\s*\")(.*?)(\")/i || $str =~ /($key\s*\=\s*)(\S*)/i; #"
        return $val;
    }
}

sub tag_sel{
    my($str, $key, $val) = @_;
    if ($val){
        $str =~ s/\s*\/\>/ $key=\"$key\" \/\>/
            || $str =~ s/\s*\>/ $key\>/ if $str !~ /$key/i;
    }else{
        $str =~ s/$key=\"$key\"// || $str =~ s/\s*$key//i;
    }
    $str;
}


sub headcat{
    if (@_ && shift){
        # Phone mode
        &output("<html><head>\n");
        &lang_exp;
        &output("</head>\n<body>\n");
        return;
    }
    # NMZ.head の出力
    my($name, $form, $val);
    my($pre, $post);
    my($tag, $value);
    my($ptr, $select);
    my(@db) = @DbList;

    local(%paramtbl) = ('max' => \$Max,
                        'sort' => \$Sort,
                        'format' => \$Format,
                        'detail' => \$Detail,
                        'idxname' => \@DbList,
                        'dbname' => \@DbList,
                        'subquery' => \$Subquery,
                        'reference' => \$Reference,
                        'basedir' => \$BaseDir,
                        'grep' => \$GrepMode,
                        'cgi' => \$CmdLang,
                        'result' => \$Result,
                        'opmode' => \$OpMode,
                        'lang' => \$CmdLang,
                        );
    my($head_grep) = 1;
    my($head_opmode) = 1;

    my($intitle, $incomment, $line);
    foreach $line (@HEAD){
        while ($line ne ''){
            if ($incomment){
                if ($line =~ s/^(.*?\-\-\>)//){
                    &output($1);
                    $incomment = 0;
                    next;
                }else{
                    &output($line);
                    last;
                }
            }elsif ($intitle){
                if ($line =~ s/^(.*?\<\/title[^>]*>)//i){
                    $_ .= $1;
                    $intitle = 0;
                }else{
                    $_ .= $line;
                    last;
                }
            }else{
                if ($line =~ s/^(.*?)(\<(\!\-\-|title))/$1 eq ''? '': $2/ie){
                    if ($1 eq ''){
                        if ($2 eq '<!--'){
                            &output($2);
                            $incomment = 1;
                        }else{
                            $_ = $2;
                            $intitle = 1;
                        }
                        next;
                    }else{
                        $_ = $1;
                    }
                }else{
                    $_ = $line;
                    $line = '';
                }
            }
            &output($_), next if /^\s*\<\!\-\-.*\-\-\>\s*$/;
            s/\{cgi\}/$SCRIPT_NAME/g if length $SCRIPT_NAME;

            s/(\<title[^\>]*\>)(.*)(<\/title)/$1 . &format_title($2) . $3/eis;
            if (/\<(\/head|title)/i && &get_language eq 'ja' && !$ExistMeta){
                $ExistMeta = 1;
                &lang_exp;
            }
            if (/\<\/HEAD\>/i){
                &meta_http_equiv("Last-Modified", $LastModified);
                &output("<base href=\"$BASE_URL\">\n") if $BASE_URL;
            }
            &output($_), next if !$QueryLength && $PrintForm;

            $form = 1 if /\<FORM/i;
            if ($PrintForm || !$form){
                if (/^(.*)(\<\s*(option|select|input|\/select).*?\>)(.*\n?)$/i){
                    $pre = $1;
                    $post = $4;
                    $_ = $2;
                    ($tag = $3) =~ tr/A-Z/a-z/;

                    $name = &tag_elem($_, 'name');
                    $name =~ tr/A-Z/a-z/;
                    $value = &tag_elem($_, 'value');

                    if ($name =~ /^(idx|db)name/){
                        @db = grep {$_ ne $value} @db;
                    }
                    if ($tag eq 'input'){
                        my($type) = &tag_elem($_, 'type');
                        $type =~ tr/A-Z/a-z/;

                        if ($type eq 'text' and $name eq 'key' || $name eq 'query'){
                            if ($RespTextOrig){
                                $_ = &tag_elem($_, 'value', $KeyStr);
                            }else{
				# 高崎 RADA
				if ($name eq 'query') {
				    # シソーラスに展開した結果ではなく
                                    # オリジナルの入力条件をtextに設定
				    $_ = &tag_elem($_, 'value', $OrgQuery);
				} else {
                                    my $tmp = $ARGV;
                                    if ($Subquery){
                                        $tmp =~ s/^.*\s*\&\&\&\s*//;
                                        $tmp =~ s/^\(\s*(.*)\s*\)\s*$/$1/;
                                    }
                                    $tmp = &metach($tmp);
                                    my @tmp = split(/\s+/, $tmp);
                                    if (@tmp = &reducep(@tmp)){
                                        $_ = &tag_elem($_, 'value', join(' ', @tmp));
                                    }
				}
                            }
                        }elsif ($type eq 'checkbox'){
                            if ($name =~ /^(db|idx)name/i){
                                $_ = &tag_sel($_, 'checked',
                                              grep($value eq $_, @DbList));
                            }elsif ($name eq 'grep'){
                                $head_grep = 0;
                                $_ = &tag_sel($_, 'checked', $GrepMode eq 'on');
                            }
                        }
                    }elsif ($tag eq 'select'){
                        $ptr = $paramtbl{$name};
                        $select = (ref($ptr) ne 'SCALAR');
                        $head_grep = 0 if $name eq 'grep';
                        $head_opmode = 0 if $name eq 'opmode';
                    }elsif ($tag eq '/select'){
                        if (!$select && ($ptr = $$ptr) ne ''){
                            &output("<option value=\"$ptr\" selected>$ptr\n");
                        }
                    }elsif ($tag eq 'option'){
                        my($flag);
                        # sort, format, max の VALUE 設定

                        if (ref($ptr) eq 'ARRAY'){
                            $select = 1 if $flag = grep($value eq $_, @$ptr);
                            $_ = &tag_sel($_, 'selected', $flag);
                        }elsif (ref($ptr) eq 'SCALAR'){
                            $select = 1 if $flag = ($$ptr =~ /^$value$/i);
                            $_ = &tag_sel($_, 'selected', $flag);
                        }
                    }
                    $_ = "$pre$_$post";
                }
                if (/\<\/FORM\>/i){
                    if (@db){
                        my $db;
                        for $db (@db){
                            my $str = "dbname";
                            &output("<input type=\"hidden\" name=\"$str\" value=\"$db\">\n") if defined $db;
                        }
                    }
                    &output("<input type=\"hidden\" name=\"grep\" value=\"$GrepMode\">\n") if $head_grep && $GrepMode;
                    &output("<input type=\"hidden\" name=\"opmode\" value=\"$OpMode\">\n") if $head_opmode && $OpMode;

		    # 高崎RADA
                    &output("<input type=\"hidden\" name=\"orgquery\" value=\"$OrgQuery\">\n");

                }
                &output($_);
            }
            $form = 0 if /\<\/FORM\>/i;
        }
    }
    &disp_debug;
}

sub disp_error{
    if (@DbErrors){
        my $str;
        &output("Errors:\n");
        for $str (@DbErrors){
            &message("$str<BR>\n");
        }
    }
    &disp_debug;
}

sub debug_log{
    if ($Debug >= 0){
        push(@Debug, shift);
        &disp_debug if $^P;
    }
}

sub disp_debug{
    if ($Debug > 0){
        &message("Debug: " . &metach(shift(@Debug)) . "<BR>\n") while @Debug;
    }
}

sub metach{
    my $s = shift;
    $s =~ s/\&/\&amp\;/g;
    $s =~ s/\</\&lt\;/g;
    $s =~ s/\>/\&gt\;/g;
    $s =~ s/\"/\&quot\;/g; #"
    return $s;
}

sub quote_meta{
    my $s = shift;
    $s =~ s/([\x00-\x7f]+)/quotemeta($1)/ge;
    return $s;
}

sub calc_slist{
    return if $Phone or $Format eq 'veryshort' && !$Cgi;
    my($dblist) = @_;
    my($detail) = ($Detail ne 'off');
    my $ndx = -1;
    my $ss = '';
    if (@Words){
        @SWord = sort {length($b) <=> length($a)} @SWord;
        grep {$_ = &quote_meta(&metach($_));
              s/^(\w)/\\b$1/,
              s/(\w)$/$1\\b/ unless s/([\xa1-\xfe].)/\xff$1/g} @SWord;
        if (!$Quiet){
            $ss .= "<strong>" . &metach("$dblist: $Keys") . "</strong>: " if $dblist;
            my $word;
            for $word (@Words){
                next if ++$ndx < $SubQueryWords;
                my $tmpw = substr($word, ord($word) == ord("\\"));

                if ($SubHit{$word} && $detail){
                    $ss .= &metach(" [ $tmpw: $Hit{$word} \(");
                    $ss .= "<ul>\n";

                    my @Keys = sort {$b <=> $a} keys %{$SubHit{$word}};
                    my $key;
                    foreach $key (@Keys){
                        my $tmp = join(" ", sort keys %{$SubHit{$word}->{$key}});
                        $ss .= &metach("$key= $tmp ");
                    }
                    $ss .= "\)]";
                }else{
                    $ss .= &metach(" [ $tmpw: $Hit{$word} ] ");
                }
            }
            $ss .= "\n";
        }
    }
    $SList .= $ss;
    $Sword{$DbPath} = join('|', @SWord);

    if (@DbErrors){
        $SList .= "Errors:\n";
        $SList .= &metach(shift @DbErrors) . "<BR>\n" while @DbErrors;
    }
}

sub conv_result{
    my ($keyno, $keydb, $ndx, $score, $str) = @_;
    my $dbpath = $keydb? $keydb: $DbPath;

    if ($str eq 'namazu::accesskey'){
        $ndx -= $Whence;
        $ndx = '' if $ndx > 10;
        $ndx = '0' if $ndx == 10;
        &debug_log("result: $str => $ndx");
        return $ndx;
    }
    &debug_log("result: $str => $ndx"), return $ndx if $str eq 'namazu::counter';
    &debug_log("result: $str => $score"), return $score if $str eq 'namazu::score';
    &debug_log("result: $str => $ARGV"), return $ARGV if $str eq 'namazu::query';
    &debug_log("result: $str => $Db2IdxDir{$keydb}"), return $Db2IdxDir{$keydb} if $str eq 'namazu::idxdir';
    &debug_log("result: $str => $Db2IdxName{$keydb}"), return $Db2IdxName{$keydb} if $str eq 'namazu::idxname';
    &debug_log("result: $str => $keyno"), return $keyno if $str eq 'namazu::docid';
    $str =~ s/(\:.*)$//;
    my $opt = $1;
    unless($DbSize{"RFI$str.$keydb"}){
        &openbfile("RF_$str.$keydb", "$dbpath.field.$str");
        &openbfile("RFI$str.$keydb", "$dbpath.field.$str.i");
        if (!$DbSize{"RFI$str.$keydb"} && $FieldAlias{$str}){
            &openbfile("RF_$str.$keydb", "$dbpath.field.$FieldAlias{$str}");
            &openbfile("RFI$str.$keydb", "$dbpath.field.$FieldAlias{$str}.i");
        }
    }
    my $buf;
    if ($DbSize{"RFI$str.$keydb"}){
        $buf = &getsdb("RF_$str.$keydb", &indexpointer("RFI$str.$keydb", $keyno));
        chomp $buf;
        if ($str eq 'summary'){
            &debug_log("result: $str");
        }else{
            &debug_log("result: $str => $buf");
        }
    }

    if ($buf !~ /^(([\xa1-\xfe]{2}|[\s\x20-\x7e])*)$/){
        $buf =~ tr/\xa0/\xa1/;
        $buf =~ s/^(([\xa1-\xfe]{2}|[\s\x20-\x7e])*)[\xa1-\xfe]$/$1/;
        &debug_log("warning(nkf1.9): $buf");
    }

    if ($str eq 'uri'){
        &replace($buf);
        $buf = metach($buf);
    }elsif ($str eq 'summary'){
        my $sizelimit = -1;
        if ($opt =~ /::size=(\d+)/){
            $buf = substr($buf, 0, $sizelimit = $1);
            $buf =~ /^(([\xa1-\xfe][\xa1-\xfe]|[^\xa1-\xfe])*)/;
            $buf = $1;
        }
        if (!$PlainConv){
            $buf = metach($buf);
            $buf =~ s/([\xa1-\xfe].)/\xff$1/g;
            $buf =~ s/($Sword{$keydb})/$EmTagS$1$EmTagE/gi if length $Sword{$keydb};
            $buf =~ tr/\xff//d;
        }
        if ($SUMMARY && $DbSize{"RLISTINDEX$keydb"}){
            my ($dt, $st, $summary, $dd, $grep);

            if ($buf eq ''){
                ($dt, $st, $summary, $dd, $grep)
                    = &make_summary($keydb, $keyno, "s$MakeGrep", $sizelimit);
                $buf = $summary;
            }elsif ($MakeGrep){
                $grep = &make_summary($keydb, $keyno, 'g');
            }
            if (length $grep){
                if ($GrepFirst){
                    $buf = "$grep$buf<br$Xht>\n";
                }else{
                    $buf .= "<br$Xht>\n$grep";
                }
            }
        }
    }else{
        $buf = metach($buf) unless $opt =~ /::noescape/;
        if ($str eq 'title' and !$PlainConv){
            $buf =~ s/([\xa1-\xfe].)/\xff$1/g;
            $buf =~ s/($Sword{$keydb})/$EmTagS$1$EmTagE/gi if length $Sword{$keydb};
            $buf =~ tr/\xff//d;
        }
    }
    $buf;
}

sub puthlist{
    if ($CountOnly){
        &prn($Keys . "\n");
        exit;
    }

    # 検索結果出力
    if ($Keys){
        &output("<dl>\n") if $Cgi || $Format ne 'veryshort' and !$Quiet;

        foreach $key (@Keys){
            last if ($Whence + $Max) <= $Ndx && $Max;

            my($offset, $next, $summary, $dt, $st, $dd, $grep);
            $keyno = $key, $keydb = ''
                unless ($keyno, $keydb) = split(/\#/, $key);
            ++$Ndx;

            $IntType = $DbIntType{$keydb};
            $IntNType = $DbIntNType{$keydb};
            $IntSize = $DbIntSize{$keydb};
            $DbVer2 = $DbVer2{$keydb};

            if($Whence < $Ndx){
                &disp_debug;
                &debug_log("list: t => " . localtime($Tim{$key}));
                unless (defined $DbSize{"RESULT$keydb"}){
                    my $dbpath = $keydb? $keydb: $DbPath;
                    my @result = ("", ".normal");
                    my $result;
                    unshift(@result, ".$Result") if length $Result;
                    for $result (@result){
                        last if &opentfile("RESULT$keydb",
                                              "$dbpath.result$result");
                        last if &opentfile("RESULT$keydb",
                                              "$Headname.result$result");
                    }
                }
                if ($DbSize{"RESULT$keydb"} && $DbVer2){
                    unless ($Cgi || $Format ne 'veryshort'){
                        &output(&conv_result($keyno, $keydb, $Ndx, $Score{$key}, "uri") . "\n");
                        next;
                    }

                    my $line;
                    &output("\n");
                    while (($offset, $line) = &getsdb("RESULT$keydb", $offset)){
                        last unless length $line;
                        $line = &toEuc($line);
                        $line =~ s/\$\{(.*?)\}/&conv_result($keyno, $keydb, $Ndx, $Score{$key}, $1)/ge;
                        &output($line . "\n");
                    }
                    &output("\n");
                    next;
                }
                if ($DbSize{"FLISTINDEX$keydb"}){
                    $offset = &indexpointer("FLISTINDEX$keydb", $keyno);
                    $next = &lastSize("FLIST_____$keydb",
                                      $keyno + 1, "FLISTINDEX$keydb");

                    ($dt, $st, $summary, $dd) =
                        split(/\n/,
                              &readdb("FLIST_____$keydb",
                                      $offset, $next - $offset),
                              4);
                    if ($SUMMARY && $MakeGrep && $DbSize{"RLISTINDEX$keydb"}){
                        $grep = &make_summary($keydb, $keyno, 'g');
                    }
                }elsif ($SUMMARY
                        and $MakeSummary || $MakeGrep
                        and $DbSize{"RLISTINDEX$keydb"}){
                    ($dt, $st, $summary, $dd, $grep) = &make_summary($keydb, $keyno, "f$MakeGrep");
                }
                &replace($st);
                &replace($dd);
                if ($Format ne 'veryshort'){
                    &output("$dt$Ndx. $st (score: $Score{$key})\n");
                }
                if ($Format eq 'long'){
                    if (!$PlainConv){
                        $summary =~ s/\e\$.(.*?)\e\(./{my $tmp = $1;
                                                       $tmp =~ tr\/\x21-\x7e\/\xa1-\xfe\/;
                                                       $tmp}/ge;
                        $summary =~ s/([\xa1-\xfe].)/\xff$1/g;
                        $summary =~ s/($Sword{$keydb})/$EmTagS$1$EmTagE/gio if length $Sword{$keydb};
                        $summary =~ tr/\xff//d;
                    }
                    &output("$summary<br$Xht>\n$grep\n");
                }
                if ($DecodeURL){
                    $dd =~ s/(\<a href=\")(.*?)(\")/$1.&decode_url($2).$3/ei; #"
                }elsif ($SplitLink){
                    $dd =~ s/\<a href=\"(.*?)\"[^<]+<\/A>/&splitlink($1)/ei; #"
                }
                $dd =~ s/\n+/\n/g, $dd =~ s/ size \(\d.*$//g if $Format eq 'veryshort';
                &output($dd);
            }
        }
        &disp_debug;
        &output("</dl>\n") if $Cgi || $Format ne 'veryshort';
    }elsif (!$Phone){
        if (&opentfile(*FH, "$DbPath.tips") || &openfiles(*FH, 'tips')){
            &message(<FH>);
            close(FH);
        }
    }
}

sub splitlink{
    local($_) = @_;
    my($pre, $path, $ret);
    my(@elem, @link);

    if (s/^([a-zA-Z]+\:\/\/[^\/]*)//){
        $pre = $1;
    }

    @elem = split(/\//, $_);
    $elem[0] .= $pre;

    while (defined($_ = shift(@elem))){
        $_ .= '/' if scalar(@elem);
        $path .= $_;
        $ret .= "<a href=\"$path\">$_</a>";
    }
    $ret;
}

sub putpagelink{
    my($num, $str, $akey) = @_;
    my $href = &pagehref($num/$Max, $akey);
    &output($href. "[$str]</a>");
}

sub putpageindex{
    if ($Max){
        my($PAGE_MAX, $num, $i) = (0, 0, 0);

        if ($Warn_Scriptname){
            &output($Text{'cgiwrap'});
            return;
        }

        &output("<strong>Page:</strong>\n") if $Keys && !$Phone;

        if ($Keys > $Whence){
            if ($Max && ($Whence >= $Max) && !$Phone){
                &putpagelink($Whence - $Max, "prev");
            }
            while ((!$PAGE_MAX || $i < $PAGE_MAX) && $num < $Keys){
                $i++;
                if (!$Phone){
                    if ($num == $Whence){
                        &output("<strong>[$i]</strong>");
                    }else{
                        &putpagelink($num, $i);
                    }
                }
                $num += $Max;
                &output("\n");
            }
            if ($Whence + $Max  < $Keys){
                &putpagelink($Whence + $Max, "next", "\#");
            }
        }
    }
}

sub puthtmlheader{
    $| = 1;
    if ($Cgi && !$PutHead){
        $PutHead = 1;
        &prn("Last-Modified: $LastModified\n") if $LastModified;
        &prn("Content-Type: text/html");
        &prn("; charset=" . &get_output_ja_code) if &get_language eq 'ja';
        &prn("\n\n");
    }
    open(STDERR, ">&STDOUT") if $Debug > 0;
    &disp_debug;
}

sub slog{
    my($rhost);
    local(*SLOG);
    $rhost = ($ENV{'REMOTE_HOST'} || $ENV{'REMOTE_ADDR'});
    if (open(SLOG, ">>$DbPath.slog")){
        my($sec,$min,$hour,$mday,$mon,$year,$wday) = localtime(time);
        printf SLOG ("%s\t%d\t%s\t%s %s %2d %02d:%02d:%02d %4d\n", 
                     $ARGV, $Keys, $rhost,
                     ('Sun', 'Mon', 'Tue', 'Wed', 'Thu', 'Fri', 'Sat')[$wday],
                     ('Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun',
                      'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec')[$mon],
                     $mday, $hour, $min, $sec, 1900+$year);
        close(SLOG);
    }
}

sub premain{
    if ($Debug >= 0){
        &debug_log("\$0: $0");
        &debug_log("EXECUTABLE_NAME: $^X") if defined $^X;
        &debug_log("OSNAME: $^O");
        &debug_log("PERL_VERSION: $]");
        &debug_log("pnamazu-2002.11.16");
        &debug_log("caller:" . join(", ", @caller));
        eval "use Cwd;";
        my $cwd = eval{&getcwd} unless $@;
        &debug_log("Cwd: $cwd") unless $@;
        my $key;
        for $key (@ARGV){
            &debug_log("ARGV: $key");
        }
        for $key (sort keys %ENV){
            &debug_log("Env: $key=$ENV{$key}");
        }
    }

    $Cgi = ($ENV{'GATEWAY_INTERFACE'} || !$CmdLineEna);
    $Xht = '';
    $Replace = $LOGGING = 1;
    $PageIndex = $PrintForm = $Cgi;
    $PlainConv = $DecodeURL = !$Cgi;
    $EmTagS = '<strong class="keyword">';
    $EmTagE = '</strong>';

    &config;

    if ($Cgi){
        if ($PhoneEnable eq 'always'
            or $PhoneEnable eq 'auto'
            && ($ENV{'HTTP_USER_AGENT'} =~ /docomo/i
                || $ENV{'HTTP_ACCEPT'} =~ /hdml/i
                || $ENV{'HTTP_X_JPHONE_MSNAME'})){
            $Phone = 1;
        }
        &load_namazu_conf;
        &cgiparamget;
    }else{
        &command_line_opt;
        &load_namazu_conf;
    }
    &lang($CnfLang, $CmdLang);
    &set_output_ja_code('Shift_JIS') if $Phone;
    &debug_log(sprintf("%s, %s, %s", &get_language,
                       &get_output_ja_code, &get_input_ja_code,));

    if ($MakeGrep eq 'default'){
        $MakeGrep = ($GrepMode eq 'off')? '': 'g';
    }elsif ($MakeGrep eq 'option'){
        $MakeGrep = ($GrepMode eq 'on')? 'g': '';
    }else{
        $MakeGrep = '';
    }
}

sub main{
    my $language = &get_language;

    %Text = ('results' => 'Results',
             'word' => 'Word count',
             'total' => 'Total',
             'doc' => 'documents match your query.',
             'cgiwrap' => 'Please set SCRIPT_NAME',
            );
    if ($language =~ /ja|jp|jis/i){
        my $key;
        $Text{'results'} = '検索結果';
        $Text{'word'} = '参考ヒット数';
        $Text{'total'} = '検索式にマッチする';
        $Text{'doc'} = '個の項目が見つかりました。';
        $Text{'cgiwrap'} = 'SCRIPT_NAME を設定してください';
        for $key (keys %Text){
            $Text{$key} = &toEuc($Text{$key});
        }
    }
    $Text{'hit'} = 'Too many documents hit.  Ignored';
    $Text{'match'} = 'Too many words match.  Ignored';

    $IniPri = eval{getpriority(0, 0)};
    $SIG{'ALRM'} = \&alrm, eval{alarm $ReniceTime} if $Cgi && $ReniceTime > 0 && $RenicePri && !$^P;

    $DEFAULT_DIR .= '/' if $DEFAULT_DIR && $DEFAULT_DIR !~ /\/$/;

    if (@DbEnable){
        my(@tmp);
        for $tmp (@DbList){
            push(@tmp, $tmp) if grep {$tmp eq $_} @DbEnable;
        }
        @DbList = @tmp;
    }

    push(@DbList, undef) unless @DbList;
    $DbPath = &openfiles('', '') if @DbList > 1;
    $DbPath = &openfiles('', '', @DbList) unless $DbPath;

    &puthtmlheader;

    &disp_error;
    if (($OrigARGV = $ARGV) =~ /\S/){
        my $origIntType = $IntType;
        for $dblist (@DbList){
            $ARGV = $OrigARGV;
            $IntType = $origIntType;
            $DbList = &db_alias($dblist);
            $DbPath = &openfiles('', 'i', $DbList);
            &pre_proc;
            &searchmain;
            &slog if $LOGGING;
            &calc_slist($dblist);

            &disp_error;
            &closedb($DbPath);

            $RespARGV = $ARGV unless length $RespARGV;
            $RespTextOrig = 1 if $RespARGV ne $ARGV;
        }
        $ARGV = $OrigARGV if $RespTextOrig;
        $SList = "<ul>\n$SList\n</ul>\n" if $SList =~ /^\<li\>/;
        &searchsort;
        &headcat($Phone && $Keys) if !$PlainConv;

        &disp_error;

        local(*FORMAT);
        if ($LuckyURI){
        }elsif ($Cgi and !$Phone
                and (&openfiles(*FORMAT, 'format')
                     || &openfiles(*FORMAT, 'format', @DbList))){
            &format_init;
            &format(*FORMAT);
            close FORMAT;
        }else{
            my($a, $b) = ($Whence + 1, $Whence + $Max);
            $b = $Keys if ($b > $Keys || !$Max);

            if ($Cgi || $Format ne 'veryshort' and !$Quiet){
                if ($Phone){
                    if ($Keys){
                        &output("<p>Results $a - $b of $Keys</p>\n");
                    }else{
                        &output("<p>Not found.</p>\n");
                    }
                }else{
                    if ($Reference !~ /^off$/i){
                        &output("<h2>$Text{'results'}:</h2>\n");
                        &output("<p></p>\n");
			&output("$Text{'word'}: &nbsp\n");
                        &output($SList);
                    }
                    &output("<p><strong>$Text{'total'} <!-- HIT -->$Keys<!-- HIT --> $Text{'doc'}</strong></p>\n");
                }
            }
            &puthlist;

            &output("<p>") if $PageIndex;
            if ($Keys && !$Phone && $Format ne 'veryshort' && !$Quiet){
                &output("<strong>Current List: $a - $b</strong><br$Xht>\n");
            }
            &putpageindex, &output("</p>") if $PageIndex;
        }
    }elsif (!$PlainConv){
        &headcat(0);
        if (!$Phone and 
            &opentfile(*FH, "$DbPath.body") || &openfiles(*FH, 'body')){
            &message(<FH>);
            close(FH);
        }
    }
    # NMZ.foot の出力
    if (!$PlainConv && !$LuckyURI){
        if ($Phone){
            &output("</body></html>\n");
        }elsif (@FOOT){
            &message(@FOOT);
        }
    }

    &disp_debug;
}

sub alrm{
    &prn("<br$Xht>\n<hr>\nProcessing time exceeds a limit.\n"), exit if $RenicePri < 0;
    eval {setpriority(0, 0, $IniPri + $RenicePri);};
}

sub db_alias{
    my $db = shift;
    return undef unless defined $db;
    return $DbAlias{$db} if defined $DbAlias{$db};
    return $db;
}

&main;
&prn_flash;
1;
#----------------------- End of 'main' Module ------------------------