#!/usr/bin/perl
$SCRIPT_NAME='';
## cgiwrap のために「次の xx 件」が表示できないときに、
## CGI の絶対パスを設定して下さい。
## 例えば、http://www.xxx.yyy/zzz/namazu.cgi だったら
##  $SCRIPT_NAME='/zzz/namazu.cgi';
## のように
{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';
$IntType='';$Zcat='/usr/local/bin/gzip -dc';$ZcatPri=10;$Max=10;$Whence=0;$DbName='NMZ';$Format='long';$Sort="score";$ScriptFileName='';$NamazuConf='';$ReniceTime = 120;
$RenicePri=-1;$CmdLineArg='new';%DbAlias=();@DbEnable=();$RespTextOrig=0;$SplitLink=0;$CacheSizeLimit=4096;$NamazuPath = '';
$MakeSummary=0;$MakeGrep='option';$GrepFirst=1;$HnsGrepGrp=1;$MaxHit=5000;$MaxFieldHit=10000;$MaxMatch=1000;$PhoneEnable='auto';$PhoneX0201=0;$HWMode='wakati';$KPMode=1;$Jump='jump';$TitleFormat='pNamazu: ${key} / ${title}';$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");}
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;}
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;
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{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);}}
my @caller=caller;
&premain;
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");}
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{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]*$/){my $pre=$1;while ($x >= $p){$buf=&readindexindex($x);last if &unsignedcmp($buf, $pre, $nativecmp) < 0;if ($key =~ /^$buf/){$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);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;}
$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){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};}}}}
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);}
sub input::pWakachi{my $str=shift;$str =~ s/([\x21-\x7f])([\x80-\xff])/$1 $2/g;$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;}
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{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{local(*fH, $n)=@_;$n *= $IntSize;my $val=&readi(*fH, $n);$val;}
sub readindexindex{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{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);}
$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);}
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): ();}
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) : ();}
$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);}
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 ] );}
$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);}
sub main::regconv{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;}$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])//){if ($1 eq 'E'){chop $tmp->{'mode'};}else{$tmp->{'mode'} .= $1;}$tmp->{'Q'}=($tmp->{'mode'} =~ tr/Q/Q/);$tmp->{'UL'}=(($tmp->{'mode'} =~ /([UL])[^UL]*$/)? $1: '');next;}if ($$ptr =~ s/^\\([ul])//){if (&regconv::ul($ptr, $1)){$$ptr =~ s/^(.)//;return $1;}}&regconv::ul($ptr, $tmp->{'UL'});$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'});return "\\c" . ($$ptr =~ s/^(.)//? $1: '@') if $$ptr =~ s/^c//;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})//;$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{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{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{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{my ($sec, $min, $hour, $mday, $mon, $year)=gmtime(shift);($year + (($year < 70)? 2000: 1900), ++$mon, $mday);}
sub ymd2time{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;$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=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);}
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;}}}
sub cgiparamget{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;}$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;}
sub pre_proc{$ARGV=&string_normalize($ARGV);@ARGV=split(/\s+/, $ARGV);&opendb();&set_inttype;}
sub searchmain{local(*score);my($no, $key, $tmp);if ($TinyMknmz){my @tmp=();my $tmp;for $tmp (split(/\s+/, $ARGV)){push(@tmp, $tmp), next if $tmp =~ /^[\/\+]|$OpPattern/oi;if ($tmp =~ /[\xa1-\xfe]/){$tmp =~ s/^\*([\xb0-\xfe])/$1/;$tmp =~ s/([\xb0-\xfe].)\*$/$1/;push(@tmp, $tmp);next;}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){&output("<html><head>\n");&lang_exp;&output("</head>\n<body>\n");return;}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{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);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;}&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 .= "<li><strong>" . &metach("$dblist: $Keys") . "</strong>: " if $dblist;$ss .= "<ul>\n" if $detail;my $word;for $word (@Words){next if ++$ndx < $SubQueryWords;$ss .= "<li>\n" if $detail;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 .= "<li>" . &metach("$key= $tmp ") . "</li>\n";}$ss .= "</ul>\n\)] \n";}else{$ss .= &metach(" [ $tmpw: $Hit{$word} ] ");}$ss .= "</li>\n" if $detail;}$ss .= "</ul>" if $detail;$ss .= "</li>" if $dblist;$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"}){$DbSize{"RESULT$keydb"}=0;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>\n<strong>$Text{'word'}:</strong></p>\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);}}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;