#!/usr/local/bin/perl

# Copyright (c) CGIROOM.                           http://www.cgiroom.nu
#======================================================================#
# [Ver  2.03.2s ] 簡易高機能検索専用データベース
#
# このプログラムによって起きた事にCGIROOMは責任を負いません。
# 利用契約に同意できない方のご利用は、遠慮下さい。
#
#======================================================================#
# 初期設定

	#◆ jcode.plまでのパス
require 'jcode.pl';

	#◆ データファイルまでのパス
	#    何個でも増やして設定可能！
$SEEK{'default'} = 'database.dat';

	#◆ テンプレートファイル設定
	#    何個でも増やして設定可能！
$html{'default'} = 'html.htm';
$html{'list2'}   = 'html2.htm';
$html{'list3'}   = 'html3.htm';

	#◆ １ページ標準表示件数
$print_max = 10;

	#◆ １ページ最大表示件数
$max_max = 20;

	#◆ タブ区切りファイルの場合は先頭の「#$tab」の「#」を削除
	#  「<>」区切りのデータファイルなら、そのあと\tを<>に書き変え可能
$tab = "\t";

	#◆ __LINKLIST__ で表示するページ件数
$linklist = 30;

	#◆ 最大検索件数
	#    ｘ件該当が出たら残りのデータは検索しない。
$foundmax = 500;

#======================================================================#
$DAT{"start_time"} = (times)[0] ;&set_;
print"Content-type: text/html\n\n";

if($ENV{'REQUEST_METHOD'} eq "POST"){
	read(STDIN,$QUERY,$ENV{'CONTENT_LENGTH'})
}else{
	$QUERY = $ENV{'QUERY_STRING'}
}
@QUERY=split(/&/,$QUERY);
foreach (@QUERY){
	($n,$v)=split(/=/);
	$v=~ tr/+/ /;
	$v =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
	$v =~ s/\r|\n|\t/ /g;
	$v =~ s/\s+(""|"|,)\s+/ /g;
	$v =~ s/^(""|"|,)$//g;
	next if $n eq "" || $v eq "";
	&jcode::convert(\$v,'sjis');
	if(index($n,"IDn",0) >= 0){
		$ID{$n}=$v
	}elsif(index($n,"IDv",0) >= 0){
		$n=~ /^IDv(\d+)/;
		$IDv{$1}.=" " if $IDv{$1};
		$IDv{$1}.=$v;
	}elsif(index($n,"template",0) >= 0){
		push(@template,$v) if $v =~ /^\d+\-\d+$/
	}else{
		$s=$n=~ /^join/ ?"":" ";
		$FORM{$n}.=$s if $FORM{$n};
		$FORM{$n}.=$v
	}
	&tag($v);
	$PRINT{$n}=$v;
}

if($FORM{'query'}){
	foreach ( split(/&/,$FORM{'query'})){
		($n,$v)=split(/=/);
		next if $n eq "" || $v eq "";
		if($n=~ /^IDn/){
			$ID{$n}=$v
		}elsif($n=~ /^IDv(\d+)/){
			$IDv{$1}.=" " if $IDv{$1};
			$IDv{$1}.=$v
		}else{
			$s=$n=~ /^join/ ?"":" ";
			$FORM{$n}.=$s if $FORM{$n};
			$FORM{$n}.=$v
		}
	}
}

#======================================================================#
#◆テンプレートファイルの読み込み

$FORM{'tid'} =~ s/\W//g;
$HTML = $html{$FORM{'tid'}} || $html{'default'};
open(HTML)||&error('テンプレートファイルを開けません');
read(HTML,$htmls,-s HTML);
close(HTML);
($h_html,$b_html,$f_html)=split("<!--LINE-->",$htmls,3);
&error('非対応のテンプレートファイルファイルが指定されました') unless $b_html;

#======================================================================#
#◆ テンプレート(補助型)処理

foreach(@template){
	($n,$v)=split(/\-/);
	$FORM{$ID{"IDn$n"}}.= $FORM{$ID{"IDn$n"}} ? " ".$IDv{$v} : $IDv{$v} ;
}

#======================================================================#
#◆ 表示件数処理
$print_max = $FORM{'print'} if $FORM{'print'} && $FORM{'print'} !~ /\D/;
$print_max = $max_max if $print_max > $max_max;
$print_max_dat = $print_max;
#======================================================================#
#◆ 選択(補助型)処理

while(($n,$v)=each(%ID)){
	$n =~ /IDn(\d+)/;
	$FORM{$v} .= $FORM{$v} ? " ".$IDv{$1} : $IDv{$1};
}

#======================================================================#
#◆ 結合(補助型)処理

if(index($QUERY,"join",0) >= 0){
	while(($n,$v)=each(%FORM)){
		$n=~ s/^join//;
		push(@form,"$n\t$v");
		delete $FORM{"join$n"};
	}
	foreach(@form){
		($n,$v)=split(/\t/);
		$FORM{$n} = $v if $n ne "" && $v ne "";
	}
	undef @form;
}

#======================================================================#
#◆ 選択(補助型)処理

if(index($QUERY,"select",0) >= 0){
	while(($n,$v)=each(%FORM)){
		if($n=~ s/^select// && $FORM{"$v$n"} eq ""){
			push(@form,"$v$n\t$FORM{\"value$n\"}");
			delete $FORM{"select$n"};
		}
	}
	foreach(@form){
		($n,$v)=split(/\t/);
		$FORM{$n} = $v if $n ne "" && $v ne "";
	}
	undef @form;
}

#======================================================================#
#◆ 類似文字検索機能

if($FORM{'word'} == 2){%W=(
'Ａ','(?:Ａ|ａ|A|a)','ａ','(?:Ａ|ａ|A|a)','A','(?:Ａ|ａ|A|a)','a','(?:Ａ|ａ|A|a)',
'Ｂ','(?:Ｂ|ｂ|B|b)','ｂ','(?:Ｂ|ｂ|B|b)','B','(?:Ｂ|ｂ|B|b)','b','(?:Ｂ|ｂ|B|b)',
'Ｃ','(?:Ｃ|ｃ|C|c)','ｃ','(?:Ｃ|ｃ|C|c)','C','(?:Ｃ|ｃ|C|c)','c','(?:Ｃ|ｃ|C|c)',
'Ｄ','(?:Ｄ|ｄ|D|d)','ｄ','(?:Ｄ|ｄ|D|d)','D','(?:Ｄ|ｄ|D|d)','d','(?:Ｄ|ｄ|D|d)',
'Ｅ','(?:Ｅ|ｅ|E|e)','ｅ','(?:Ｅ|ｅ|E|e)','E','(?:Ｅ|ｅ|E|e)','e','(?:Ｅ|ｅ|E|e)',
'Ｆ','(?:Ｆ|ｆ|F|f)','ｆ','(?:Ｆ|ｆ|F|f)','F','(?:Ｆ|ｆ|F|f)','f','(?:Ｆ|ｆ|F|f)',
'Ｇ','(?:Ｇ|ｇ|G|g)','ｇ','(?:Ｇ|ｇ|G|g)','G','(?:Ｇ|ｇ|G|g)','g','(?:Ｇ|ｇ|G|g)',
'Ｈ','(?:Ｈ|ｈ|H|h)','ｈ','(?:Ｈ|ｈ|H|h)','H','(?:Ｈ|ｈ|H|h)','h','(?:Ｈ|ｈ|H|h)',
'Ｉ','(?:Ｉ|ｉ|I|i)','ｉ','(?:Ｉ|ｉ|I|i)','I','(?:Ｉ|ｉ|I|i)','i','(?:Ｉ|ｉ|I|i)',
'Ｊ','(?:Ｊ|ｊ|J|j)','ｊ','(?:Ｊ|ｊ|J|j)','J','(?:Ｊ|ｊ|J|j)','j','(?:Ｊ|ｊ|J|j)',
'Ｋ','(?:Ｋ|ｋ|K|k)','ｋ','(?:Ｋ|ｋ|K|k)','K','(?:Ｋ|ｋ|K|k)','k','(?:Ｋ|ｋ|K|k)',
'Ｌ','(?:Ｌ|ｌ|L|l)','ｌ','(?:Ｌ|ｌ|L|l)','L','(?:Ｌ|ｌ|L|l)','l','(?:Ｌ|ｌ|L|l)',
'Ｍ','(?:Ｍ|ｍ|M|m)','ｍ','(?:Ｍ|ｍ|M|m)','M','(?:Ｍ|ｍ|M|m)','m','(?:Ｍ|ｍ|M|m)',
'Ｎ','(?:Ｎ|ｎ|N|n)','ｎ','(?:Ｎ|ｎ|N|n)','N','(?:Ｎ|ｎ|N|n)','n','(?:Ｎ|ｎ|N|n)',
'Ｏ','(?:Ｏ|ｏ|O|o)','ｏ','(?:Ｏ|ｏ|O|o)','O','(?:Ｏ|ｏ|O|o)','o','(?:Ｏ|ｏ|O|o)',
'Ｐ','(?:Ｐ|ｐ|P|p)','ｐ','(?:Ｐ|ｐ|P|p)','P','(?:Ｐ|ｐ|P|p)','p','(?:Ｐ|ｐ|P|p)',
'Ｑ','(?:Ｑ|ｑ|Q|q)','ｑ','(?:Ｑ|ｑ|Q|q)','Q','(?:Ｑ|ｑ|Q|q)','q','(?:Ｑ|ｑ|Q|q)',
'Ｒ','(?:Ｒ|ｒ|R|r)','ｒ','(?:Ｒ|ｒ|R|r)','R','(?:Ｒ|ｒ|R|r)','r','(?:Ｒ|ｒ|R|r)',
'Ｓ','(?:Ｓ|ｓ|S|s)','ｓ','(?:Ｓ|ｓ|S|s)','S','(?:Ｓ|ｓ|S|s)','s','(?:Ｓ|ｓ|S|s)',
'Ｔ','(?:Ｔ|ｔ|T|t)','ｔ','(?:Ｔ|ｔ|T|t)','T','(?:Ｔ|ｔ|T|t)','t','(?:Ｔ|ｔ|T|t)',
'Ｕ','(?:Ｕ|ｕ|U|u)','ｕ','(?:Ｕ|ｕ|U|u)','U','(?:Ｕ|ｕ|U|u)','u','(?:Ｕ|ｕ|U|u)',
'Ｖ','(?:Ｖ|ｖ|V|v)','ｖ','(?:Ｖ|ｖ|V|v)','V','(?:Ｖ|ｖ|V|v)','v','(?:Ｖ|ｖ|V|v)',
'Ｗ','(?:Ｗ|ｗ|W|w)','ｗ','(?:Ｗ|ｗ|W|w)','W','(?:Ｗ|ｗ|W|w)','w','(?:Ｗ|ｗ|W|w)',
'Ｘ','(?:Ｘ|ｘ|X|x)','ｘ','(?:Ｘ|ｘ|X|x)','X','(?:Ｘ|ｘ|X|x)','x','(?:Ｘ|ｘ|X|x)',
'Ｙ','(?:Ｙ|ｙ|Y|y)','ｙ','(?:Ｙ|ｙ|Y|y)','Y','(?:Ｙ|ｙ|Y|y)','y','(?:Ｙ|ｙ|Y|y)',
'Ｚ','(?:Ｚ|ｚ|Z|z)','ｚ','(?:Ｚ|ｚ|Z|z)','Z','(?:Ｚ|ｚ|Z|z)','z','(?:Ｚ|ｚ|Z|z)',
'１','(?:１|一|壱|1)','一','(?:１|一|壱|1)','壱','(?:１|一|壱|1)','1','(?:１|一|壱|1)',
'２','(?:２|二|弐|2)','二','(?:２|二|弐|2)','弐','(?:２|二|弐|2)','2','(?:２|二|弐|2)',
'３','(?:３|三|参|3)','三','(?:３|三|参|3)','参','(?:３|三|参|3)','3','(?:３|三|参|3)',
'４','(?:４|四|4)','四','(?:４|四|4)','4','(?:４|四|4)',
'５','(?:５|五|5)','五','(?:５|五|5)','5','(?:５|五|5)',
'６','(?:６|六|6)','六','(?:６|六|6)','6','(?:６|六|6)',
'７','(?:７|七|7)','七','(?:７|七|7)','7','(?:７|七|7)',
'８','(?:８|八|8)','八','(?:８|八|8)','8','(?:８|八|8)',
'９','(?:９|九|9)','九','(?:９|九|9)','9','(?:９|九|9|９)',
'０','(?:０|零|0)','零','(?:０|零|0)','0','(?:０|零|0|〇)',
'あ','(?:ぁ|あ)','ぁ','(?:あ|ぁ)','い','(?:ぃ|い)','ぃ','(?:ぃ|い)',
'う','(?:ぅ|う)','ぅ','(?:う|ぅ)','え','(?:ぇ|え)','ぇ','(?:ぇ|え)',
'お','(?:ぉ|お)','ぉ','(?:お|ぉ)','や','(?:ゃ|や)','ゃ','(?:ゃ|や)',
'ゆ','(?:ゅ|ゆ)','ゅ','(?:ゅ|ゆ)','よ','(?:ょ|よ)','ょ','(?:ょ|よ)',
'，','(?:、|，|,)','、','(?:、|，|,)',',','(?:、|，|,)',
'．','(?:．|。|\.)','。','(?:．|。|\.)','.','(?:．|。|\.)',
'＠','(?:＠|\@)','@','(?:＠|\@)',	'＃','(?:＃|\#)','#','(?:＃|\#)',
'＄','(?:＄|\$)','$','(?:＄|\$)',	'％','(?:％|\%)','%','(?:％|\%)',
'’','(?:’|\')','\'','(?:’|\')',	'（','(?:（|\()','(','(?:（|\()',
'）','(?:）|\))',')','(?:）|\))',	'；','(?:；|\;)',';','(?:；|\;)',
'：','(?:：|\:)',':','(?:：|\:)',	'＊','(?:＊|\*)','*','(?:＊|\*)',
'＝','(?:＝|\=)','=','(?:＝|\=)',	'＋','(?:＋|\+)','+','(?:＋|\+)',
'？','(?:？|\?)','?','(?:？|\?)',	'！','(?:！|\!)','!','(?:！|\!)',
'＾','(?:＾|\^)','^','(?:＾|\^)',	'｜','(?:｜|\|)','|','(?:｜|\|)',
'［','(?:［|\[)','[','(?:［|\[)',	'］','(?:］|\])',']','(?:］|\])',
'／','(?:／|\/)','/','(?:／|\/)','＼','(?:＼|\\)','\\','(?:＼|\\|￥)','￥','(?:￥|\\)',
'−','(?:−|\-|\x81\x5B)','-','(?:−|\-|\x81\x5B)',"\x81\x5B",'(?:−|\-|\x81\x5B)',
'＜','(?:＜|\&lt\;)','＞','(?:＞|\&gt;)')}
$komozi = "(?i)" unless $FORM{'word'};


#======================================================================#
#◆ 検索パラメータ整理処理

while(($n,$v)=each(%FORM)){
	$FORM{$n}=~ s/　/ /g if $n !~ /equal/;
}

$AND = $FORM{'and'} || $FORM{'AND'} || $FORM{'key'};
$OR  = $FORM{'or'}  || $FORM{'OR'};
$NOT = $FORM{'not'} || $FORM{'NOT'};
$INDEX = $FORM{'index'} || $FORM{'INDEX'};
%wild=('*','.*?','?','.');
while(($n,$v)=each(%FORM)){
	next if $n =~ /^(?:join|select)/o;
	next if $n !~ /^(?:key|not|equal|and|or|up|down|wildor|wildkeys|wildnot|wildequal|keys|index|sort|sline|eline|word|reverse)/io;
	$q .= "$v ";
	($nn,$vv)=($n,$v);
	$vv =~ s/(\W)/'%'. unpack("H*",$1)/oeg;
	$nn =~ s/(\W)/'%'. unpack("H*",$1)/oeg;
	$url .="$nn\=$vv\&";
	if($n =~ /^(?:keys|or|not|and|wildor|wildkeys|wildnot|wildequal|equal)/o){
		&word(\$v);
		@COLOR{split(/\s+/,$v)}=1;
		if(substr($n,0,1) eq "w"){
		#◆ワイルドカード
			$n=~ s/^wild//o;
			$v=~ s/\\(\*|\?)/$wild{$1}/go;
			if($n =~ s/^equal/keys/){
				if($FORM{"word"}==2){
					$v=~ s/ /(?:　|\\s)/og;
				}else{
					$v=~ s/ /\\s/og;
				}
			}
			if($n =~ /^(?:or|not)/o){
				$v =~ s/\s+/|/og;
				$v ="(" . $v .")";
			}
			$v =~ s/\s+/\$ \^/og if $n =~ /^keys/o;
			$v = '^' . $v . '$';
		}else{
		#◆その他
			if($n =~ /^equal/){
				if($FORM{"word"}==2){
					$v=~ s/ /(?:　|\s)/og;
				}
			}else{
				$v =~ s/\s+/|/g if $n =~ /^(?:or|not)/o
			}
		}
	}
	if($n =~ /^(not|equal|and|or|up|down|keys)(\d+)$/o){
	#◆ 列検索
		if($1 eq "keys" || $1 eq "and"){
			my(@value)=split(/\s+/,$v);
			$v=\@value;
		}
		my(@list)=($2 - 1,$1,$v);
		push(@form,\@list) if ($2 - 1) >= 0;
	}
}

$q =~ s/\s+$//;
&word(\$OR)  if $OR;
&word(\$NOT) if $NOT;
&word(\$AND) if $AND;
@COLOR{split(/\s+/,"$AND $OR $INDEX")}=1;
foreach(@data){
	undef $_ if /\D/
}
$OR =~ s/\s+/|/g;
$NOT=~ s/\s+/|/g;
@AND=split(/\s+/,$AND);
@INDEX=split(/\s+/,$INDEX);
$DAT{'keywords'} = $q;
&tag($DAT{'keywords'});
$c=$FORM{'count'}+0;
$DAT{"target"}= $FORM{'target'} + 0;
$DAT{"max"}= $FORM{'max'} + 0;
$sline=$FORM{'sline'} - 1 if $FORM{'sline'};
$eline=$FORM{'eline'} if $FORM{'eline'} && $FORM{'eline'} !~ /\D/;

#======================================================================#
#◆ 検索指定がなにもなければ・・・該当無しで終了
if($q !~ /\S/){
	&pro(\$h_html);
	&pro(\$f_html);
	print $h_html , $f_html;
	exit;
}

#======================================================================#
#◆ データファイル読み込み

$FORM{'did'} =~ s/\W//g;
$SEEK = $SEEK{$FORM{'did'}} || $SEEK{'default'};
open(SEEK) || &error('データファイルを開けません');binmode(SEEK);
if($sline && $sline !~ /\D/){
	while(<SEEK>){
		last if $sline <= $.
	}
}
FI: while(<SEEK>){
	last if $eline && $eline <= $.;
	foreach $key (@INDEX){
		next FI if index($_,$key,0) < 0
	}
	foreach $key (@AND){
		next FI if ! /$komozi$key/
	}
	next if $OR  && ! /$komozi$OR/o;
	next if $NOT &&   /$komozi$NOT/o;
	s/[\r\n]+//;
	if($tab){
		@data=split(/$tab/,$_);
	}elsif(index($_,'"') >= 0){
		@data=();
		@line=split(/,/,$_);
		while(@line){
			$dummy = shift @line;
			while(($dummy=~ tr/"/"/ % 2) == 1){
				last unless @line;
				$dummy .=',' . shift @line;
			}
			if(index($dummy,'"') >= 0){
				chop $dummy;
				substr($dummy,0,1)="";
				$dummy=~ s/""/"/og;
			}
			push(@data,$dummy);
		}
	}else{
		@data=split(/,/,$_)
	}
	foreach(@form){
		($keys,$n,$v)=@{$_};
		next FI if &{$dcheck{$n}};
	}
	last if $c++ >= $foundmax;
	push(@found,[$.,@data]);
}
while(<SEEK>){
	1;
}
$DAT{"found_over"}=1 if $c == $foundmax + 1;
@SORT= split(/\s+/,$FORM{'sort'});
$i=0;
foreach (@SORT[0..9]){
	next unless $_;
	my($sort,$cmd,$r);
	$sort[$i][0] = $1 if ( /(\d+)/ && $1 > 0 || next) || next;
	$sort[$i][1] = /^d/i ? 1 : 0;
	$sort[$i][2] = /s$/i ? 1 : 0;
	$i++;
}
if(@sort){
	@found = sort { &sort_s } @found;
}
sub sort_s{
	my $i;
	foreach $s(@sort){
		if($s->[2]){
			if($s->[1]){
				$i = $b->[$s->[0]] cmp $a->[$s->[0]]
			}else{
				$i = $a->[$s->[0]] cmp $b->[$s->[0]]
			}
		}else{
			if($s->[1]){
				$i = $b->[$s->[0]] <=> $a->[$s->[0]]
			}else{
				$i = $a->[$s->[0]] <=> $b->[$s->[0]]
			}
		}
		return $i if $i;
	}
	0
}

if($FORM{'reverse'}){
	@found = reverse @found;
}elsif($FORM{'random'} || $FORM{'tane'}){
	my $ip = $ENV{'REMOTE_ADDR'};
	$ip =~ s/\D//g;
	$tane = int($FORM{'tane'}) || time + $ip + $$;
	srand($tane);
	my @temp;
	push( @temp , splice(@found,rand(@found),1)) while @found;
	@found = @temp;
	$url .="tane=$tane&amp;";
}

$DAT{'max'}=$. + 0;
$FORM{'p'} =~ s/\D//g;
$start= $FORM{'p'} * $print_max;
$DAT{'target'}=@found;
$DAT{"start_count"} = $start + 1;
$DAT{"NEXT"}="${'url'}print=$print_max_dat&tid=$FORM{'tid'}&did=$FORM{'did'}&p=" . ($FORM{'p'} + 1) if $start + $print_max <= $#found;
$DAT{"BACK"}="${'url'}print=$print_max_dat&tid=$FORM{'tid'}&did=$FORM{'did'}&p=" . ($FORM{'p'} - 1) if $FORM{'p'} > 0;
$pagemax = int($DAT{'target'}  / $print_max) + ($DAT{'target'} % $print_max != 0);
$pagestart = 1;
if($pagemax > $linklist){
	if($FORM{'p'} > int($linklist / 2)){
		$pagestart = $FORM{'p'} + 1 - int($linklist  / 2);
		if($pagestart + $linklist  > $pagemax){
			$pagestart = $pagemax - $linklist + 1;
		}else{
			$pagemax = $pagestart + $linklist - 1;
		}
	}elsif($pagemax > $linklist){
		$pagemax = $linklist ;
	}
}
for($i=$pagestart ;$i <= $pagemax ;$i++){
	$s=$i - 1;
	if($FORM{'p'} eq $s){
		$DAT{"LINKLIST"} .="$i|";
	}else{
		$DAT{"LINKLIST"} .="<a href='database.cgi?${'url'}print=$print_max_dat&tid=$FORM{'tid'}&did=$FORM{'did'}&p=$s'>$i</a>|";
	}
}
chop $DAT{"LINKLIST"};
$DAT{"time"} = (times)[0] - $DAT{"start_time"};
$DAT{"end_time"} = (times)[0] ;
$DAT{'count'}= $#found + 1 if ($DAT{'count'} = $start + $print_max) > $#found + 1;
&pro(\$h_html);
print $h_html;
for($i=$start ; $i <= $start + $print_max - 1; $i++){
	@data = @{$found[$i]} ;
	last if ! @data ;
	($DAT{'no'},$DAT{'count'})=($data[0], $i + 1);
	$Btmp = $b_html;
	&pro(\$Btmp);
	print $Btmp;
	@last = @data;
}
&pro(\$f_html);
print $f_html;
exit;
#======================================================================#
#◆ 関数


sub tag{#タグ解除
	$_[0]=~ s/&/&amp;/g;
	$_[0]=~ s/</&lt;/g;
	$_[0]=~ s/>/&gt;/g;
	$_[0]=~ s/"/&quot;/g
}
sub word{#類似文字検索機能
	*word = shift ;
	$word =~ s/([^\w ])/\\$1/go && return 1 if  $FORM{'word'} < 2;
	$word =~ s/((?:[\x81-\x9F|\xE0-\xEF][\x40-\x7E|\x80-\xFC])|(?:[\x20-\x7E])|(?:[\xA0-\xDF]))/&_word($1)/oeg
}
sub _word{
	$sw=$_[0];
	return $W{$sw} if $W{$sw};
	$sw =~ s/([^\w ])/\\$1/go;
	return $sw
}
sub a{#自動リンク
	*_ = shift;
	s/(&quot;|&gt;|&lt;)/ $1 /go;
	s/<br>/\n/go;
	s/(http:\/\/[\!-;\=\?-\~]+)|([\x81-\x9F|\xE0-\xEF][\x40-\x7E|\x80-\xFC])*([\x21-\x7E]+\@[\x21-\x7E]+\.[\x21-\x7E]+)/$3 ? "$2<a href=\"mailto:$1$3\" target=_blank>$1$3<\/a>" :  "$2<a href=\"$1$3\" target=_blank>$1$3<\/a>"/eog;
	s/ (&quot;|&gt;|&lt;) /$1/go;
	s/\n/<br>/go;
}
sub encode_url{#ＵＲＬエンコード
	*_ = shift;
	s/(\W)/sprintf("%%%02X", ord($1))/eg;
}
sub color{#カラーカラーカラー
	(*_ , $color) = @_;
	unless($colors){
		$colors = join('|',%COLOR);
		1 while $colors =~ s/^\||^.$|\|$|^\\?.\||\|\\?.(\|)|\|(\|)|\|\\?.$/$1$2/o;
	}
	if($colors){
		s/\G((?:(?:[\x81-\x9F|\xE0-\xEF][\x40-\x7E|\x80-\xFC])|(?:[\x20-\x7E])|(?:[\xA0-\xDF]))*?)($colors)/$1<font color="$color">$2<\/font>/og;
	}
}
sub cut{#文字カット
	local(*cut,$cut_size)=@_;
	return $cut if $cut_size >= length($cut);
	$cut = substr($cut,0,$cut_size);
	chop $cut if $cut !~ /^(?:[\x81-\x9F|\xE0-\xEF][\x40-\x7E|\x80-\xFC]|[\x20-\x7E\xA0-\xDF])*$/;
}

sub formats{
	($n,$v)=($1,$2);
	if(index($v,":last",0) >= 0){
		$a = $last[$n]
	}elsif(index($v,":form",0) >= 0){
		$a = $PRINT{$n};
	}elsif(index($v,":env") >= 0){
		$a = $ENV{$n};
	}elsif(index($v,":cookie") >= 0){
		$a = $COOKIE{$n};
	}elsif($n =~ /\D/){
		$a = $DAT{$n};
	}else{
		$a = $data[$n];
	}
	foreach(split(/\:/,$v)){
		if($If{$_}){
			$If{$_}->(\$a);
		}elsif(/^auto\-br\((\d+)\)/o){
			my($br)=$1;
			$a =~ s/(\w{$br})/$1<br>/g;
		}elsif(/^([\*\%\/\+\-])\((\-?\d+(?:\.\d+)?)\)/o){
			$a = $If{$1}->($a,$2);
		}elsif(/^cut\((\d+)\)/o){
			&cut(\$a,$1)
		}elsif(/^color\((.+?)\)/o){
			&color(\$a,$1)
		}
	}
	$a;
}
sub pro{#テンプレート内の実行
	*html_S = shift;
	$html_S =~ s/__(.+?)((?::cut\(\d+\)|:color\(.+?\)|:last|:auto\-br\(\d+\)|:a|:encode|:form|:tagout|:cookie|:res|:env|:int|:,|:\+\+|:\-\-|:[\*\%\/\+\-]\(\-?\d+(?:\.\d+)?\))*)__/&formats/eg;
	1 while $html_S =~ s/<\!\-\-IF(\d*)=(\S+?)(?: (\S+) (.+?))?\-\->(.*?)(?:<\!\-\-ELSE\1=\2\-\->(.*?))?<\!\-\-END\1=\2\-\->/&ifs($2,$3,$4,$5,$6)/eis;
}
sub ifs{
	@d=@_;
	$d[0] =~ s/([^:]+)((?::cut\(\d+\)|:color\(.+?\)|:last|:auto\-br\(\d+\)|:a|:encode|:form|:tagout|:cookie|:res|:env|:int|:,|:\+\+|:\-\-|:[\*\%\/\+\-]\(\-?\d+(?:\.\d+)?\))*)/&formats/eg;
	if($d[1] && $IF{$d[1]}){
		return $IF{$d[1]}->($d[0],$d[2]) ? $d[3] : $d[4]
	}
	return $d[0] ? $d[3]  : $d[4];
}
sub set_{
	$IF{"<"}  = sub { return 1 if $_[0] <  $_[1] };
	$IF{">"}  = sub { return 1 if $_[0] >  $_[1] };
	$IF{"lt"} = sub { return 1 if $_[0] lt $_[1] };
	$IF{"gt"} = sub { return 1 if $_[0] gt $_[1] };
	$IF{"<="} = sub { return 1 if $_[0] <= $_[1] };
	$IF{">="} = sub { return 1 if $_[0] >= $_[1] };
	$IF{"le"} = sub { return 1 if $_[0] le $_[1] };
	$IF{"ge"} = sub { return 1 if $_[0] ge $_[1] };
	$IF{"=="} = sub { return 1 if $_[0] == $_[1] };
	$IF{"!="} = sub { return 1 if $_[0] != $_[1] };
	$IF{"eq"} = sub { return 1 if $_[0] eq $_[1] };
	$IF{"ne"} = sub { return 1 if $_[0] ne $_[1] };
	$IF{"index"} = sub { return 1 if index($_[0],$_[1],0) >= 0 };
	$If{"+"} = sub { $_[0] + $_[1] };
	$If{"-"} = sub { $_[0] - $_[1] };
	$If{"*"} = sub { $_[0] * $_[1] };
	$If{"/"} = sub { $_[1] >= 1 ? $_[0] / $_[1] : 0 };
	$If{"%"} = sub { $_[1] >= 1 ? $_[0] % $_[1] : 0 };
	$If{"a"} = \&a;
	$If{"encode"} = \&encode_url;
	$If{"tagout"} = \&tagout;
	$If{"++"} = sub { *if = shift; $if++ };
	$If{"--"} = sub { *if = shift; $if-- };
	$If{"br"} = sub { *if = shift; $if =~ s/<br>/\n/ig};
	$If{"int"}= sub { *if = shift; $if = int($if) };
	$If{"res"}= sub { *if = shift; $if =~ s/^|(<br>|\n)/$1&gt; /ig};
	$If{","}  = sub { *if = shift; 1 while $if =~ s/(.*\d)(\d\d\d)/$1,$2/;};
	$dcheck{"and"} = $dcheck{"keys"} = sub {
		foreach (@{$v}){
			return 1 if $data[$keys] !~ /$komozi$_/
		}
	};
	$dcheck{"or"} = sub {
		return 1 if $data[$keys] !~ /$komozi$v/
	};
	$dcheck{"not"}= sub {
		return 1 if $data[$keys] =~ /$komozi$v/
	};
	$dcheck{"up"} = sub {
		return 1 if $data[$keys] < $v
	};
	$dcheck{"down"}=sub {
		return 1 if $data[$keys] > $v
	};
	$dcheck{"equal"}=sub{
		return 1 if $data[$keys] !~ /^$v$/;
	};
}
sub error{
	print "<h1>$_[0]</h1><a href=http://cgiroom.nu>CCGIROOM</a>";
	exit;
}
#================================================================================#
#【 作  成 】：わん     < wake-t@mtc.biglobe.ne.jp >
#【公開場所】：CGIROOM  < http://cgiroom.nu >
#【 履  歴 】：
#  1999/07/22 Ver  0.00
#  1999/08/06 Ver  1.00
#  1999/10/13 Ver  1.20 検索機能に 以上、以下、結合、選択 を追加
#  2000/01/03 Ver  1.30 タブ区切りファイルに対応、検索機能にNOT,ORを追加
#  2000/01/12 Ver  1.31 1.30のバグを修正
#  2000/01/20 Ver  1.32 1.31のバグを修正
#  2000/02/21 Ver  1.33 1.32のバグを修正 10以上の列検索が出来なかったバグ
#  2000/05/13 Ver  1.40 高度検索機能を追加
#  2000/05/23 Ver  1.41 1.40で発生したバグ修正(非公開)
#  2000/05/29 Ver  1.42 やっとこさ公開
#  2000/06/22 Ver  1.43 equalだけで検索すると該当しないバグを修正
#  2000/10/14 Ver  1.44 ワイルドカードに対応、以上以下検索のバグを修正
#  2000/11/18 Ver  2.00 βデザインをテンプレート式に変更
#  2000/12/03 Ver  b2   ちょこっとバグ修正
#  2001/02/20 Ver  2.01 :aバグの修正 onlyone機能の向上
#  2001/03/17 Ver  2.02 １列目検索バグを修正
#  2001/08/11 Ver  2.02s ソート版更新
#  2001/09/17 Ver  2.03s query検索対応
#  2001/09/17 Ver  2.03.1s Perl 5.004で作動するように修正
#  2001/10/18 Ver  2.03.2s __count__ reverse の改ページ不備を修正
#================================================================================#