#----------------------------------------------
# Multi Talk "eXtend liblary"
# Rel.2.0.12 (c)1998-2001 ASKN (朝日薫)
# http://www.hinocatv.ne.jp/~askn/
#----------------------------------------------

=copyleft=

    This program is free software;  you can redistribute it and/or
    modify it under  the terms of  the  GNU General Public License
    as published by the Free Software Foundation; either version 2
    of the License, or (at your option) any later version.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.   See the
    GNU General Public License for more details.

                http://www.gnu.org/copyleft/gpl.txt

    本プログラムはフリー・ソフトウェアです。あなたは Free Software
    Foundation が公表した GNU 一般公有使用許諾の「バージョン２」或
    いはそれ以降の各バージョンの中から何れかを選択し、そのバージョ
    ンが定める条項に従って本プログラムを再頒布または変更することが
    できます。

    本プログラムは有用とは思いますが、頒布にあたっては、市場性及び
    特定目的適合性についての暗黙の保証を含めて、いかなる保証も行な
    いません。詳細については GNU一般公有使用許諾書をお読みください。

=cut=

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

package mtx;sub import{goto &MTX::import}
package MTX;

	$precols = 80;
	$linklen = 48;
	$linklen2 = 64;
	$linkmess = "[CLICK HERE]";
	$linkmaxlen = 256;
	$tablength = 4;

sub new{
	my $class = shift;
	my $text = shift;
	my $obj = \$text;
	bless $obj, $class;
	return $obj;
}
sub newform{
	my($class, $j) = @_;
	my @c = ($j || $CHARCODE, \%FF, \@FN, \@FD);
	my $obj = \@c;
	bless $obj, $class;
	return $obj;
}
sub newquery{
	my($class, $q, $j, $k) = @_;
	my($a, $b, $c, $f, @c, @fd, @fn, %ff, $obj, $jis, $jcode);
	$q =~ s/%01|%02|\01|\02/ /g;
	$q =~ tr/+=&/\x20\01\02/;
	&qdec(\$q);
	($jcode,$jis) = &jtype($q);
	$jcode = shift || $jcode;
	$jcode eq 'sjis' && &sjis2euc(\$q);
	$jis && &jis2euc(\$q);
	&qjis2euc(\$q);
	@fn = @fd = ('');
	for $c (split /\02\x20*/, $q){
		($a, $b) = split /\x20*\01/, $c, 2;
		push @fn, &formtrue($a);
		push @fd, $b;
		$ff{$a} = $#fd;
	}
	@c = ($j || $CHARCODE, \%ff, \@fn, \@fd);
	$obj = \@c;
	bless $obj, $class;
	return $obj;
}
sub mkquery{
	my($obj) = @_;
	my($j, $ff, $fn, $fd) = @$obj;
	my($a, $b, $c, @c);
	for $a (keys %$ff){
		next if $a eq '';
		&formtrue(\$a);
		next if ($b = $$fd[$$ff{$a}]) eq '';
		'sjis' eq $j && &euc2sjis(\$b);
		$c = &query(\$a) . "=" . &query(\$b);
		$c =~ s/%20/+/g;
		push @c, $c;
	}
	join "&", @c;
}
sub newcookie{
	my($class, $n, $j) = @_;
	my($a, $b, $c, @c, @fd, @fn, %ff, $obj);
	@fn = @fd = ('');
	for $c (split /\n\x20*/, $FC{&formtrue($n)}){
		($a, $b) = split /:/, $c, 2;
		push @fn, &formtrue($a);
		push @fd, $b;
		$ff{$a} = $#fd;
	}
	@c = ($j || $CHARCODE, \%ff, \@fn, \@fd);
	$obj = \@c;
	bless $obj, $class;
	return $obj;
}
sub mkcookie{
	my($obj, $n) = @_;
	my($j, $ff, $fn, $fd) = @$obj;
	my($a, $b, @c);
	&formtrue(\$n);
	while(($a, $b) = each %$ff){
		next if $a eq '';
		next if ($b = $$fd[$b]) eq '';
		push @c, "${a}:" . &charline($b);
	}
	$a = join "\n", @c;
	"${n}=" . &qenc2($a);
}
sub setcell{
	my($obj, $n, $b) = @_;
	my($j, $ff, $fn, $fd) = @$obj;
	&formtrue($n);
	return if $n eq '';
	'sjis' eq $j && &sjis2euc(\$b);
	if($$ff{$n} eq ''){
		push @$fn, $n;
		push @$fd, $b;
		$$ff{$n} = $#$fd;
	}else{
		$$fd[$$ff{$n}] = $b;
	}
}
sub def{
	my($obj, @d) = @_;
	my($j, $ff, $fn, $fd) = @$obj;
	my(@c, $c);
	for $c (@d){
		push @c, ($$ff{$c} ne '');
	}
	wantarray ? @c : $c[0];
}
sub deflist{
	my $obj = shift;
	my($j, $ff, $fn, $fd) = @$obj;
	wantarray ? @$fn : $$fn[0];
}
sub arraydef{
	my($obj, $name, $count) = @_;
	my($j, $ff, $fn, $fd) = @$obj;
	my(@c, $c, %c);
	for $c (@$fn){
		$c{$c} && next;
		if($c =~ /$name/){
			push @c, $c;
			--$count || last;
		}
		$c{$c}++;
	}
	wantarray ? @c : $c[0];
}
sub cell{
	my($obj, @d) = @_;
	my($j, $ff, $fn, $fd) = @$obj;
	my(@c, $c, $d);
	for $c (@d){
		$d = &charline($$fd[$$ff{$c}]);
		'sjis' eq $j && &euc2sjis(\$d);
		push @c, $d;
	}
	wantarray ? @c : $c[0];
}
sub length{
	my($obj, @d) = @_;
	my($j, $ff, $fn, $fd) = @$obj;
	my(@c, $c);
	for $c (@d){
		push @c, length $$fd[$$ff{$c}];
	}
	wantarray ? @c : $c[0];
}
sub arraycell{
	my($obj, $name) = @_;
	my($j, $ff, $fn, $fd) = @$obj;
	my(@c, $c, $d, $e);
	for $c (@$fn){
		if($c eq $name){
			$d = &charline($$fd[$e]);
			'sjis' eq $j && &euc2sjis(\$d);
			push @c, $d;
		}
		$e++;
	}
	wantarray ? @c : $c[0];
}
sub plaincell{
	my($obj, @d) = @_;
	my($j, $ff, $fn, $fd) = @$obj;
	my(@c, $c, $d);
	for $c (@d){
		$d = &chartrue($$fd[$$ff{$c}]);
		'sjis' eq $j && &euc2sjis(\$d);
		push @c, $d;
	}
	wantarray ? @c : $c[0];
}
sub htmlcell{
	my($obj, @d) = @_;
	my($j, $ff, $fn, $fd) = @$obj;
	my(@c, $c, $d);
	for $c (@d){
		$d = &tagtrue($$fd[$$ff{$c}]);
		'sjis' eq $j && &euc2sjis(\$d);
		push @c, $d;
	}
	wantarray ? @c : $c[0];
}
sub charline{
	my($v, $w, %v);
	$w = (ref ($v = shift)) ? $v : \$v;
	$$w =~ s/[\0-\x20\x7F\xFF]+/ /g;
	%v = ("<"=>"&lt;", ">"=>"&gt;", "\""=>"&quot;");
	$$w =~ s/&[A-Z]+\d?;/uc $&/eg;
	$$w =~ s/[<>\"]/$v{$&}/eg;
	$$w;
}
sub chartrue{
	my($v, $w);
	$w = (ref ($v = shift)) ? $v : \$v;
	$$w =~ s/\r\n?/\n/g;
	$$w =~ s/[^\t\n\x20-\x7E\x80-\xFE]+/ /g;
	$$w;
}
sub formtrue{
	my($v, $w);
	$w = (ref ($v = shift)) ? $v : \$v;
	$$w =~ tr|0-9A-Za-z+=/$%-_.;||cd;
	$$w;
}
sub jtype{
	my($v, $w, $a, $c, $q, $z, $j, @c);
	$w = (ref ($v = shift)) ? $v : \$v;
	$c = shift || $CHARCODE;
	$$w =~ /[\e\x0E\x0F]/ && $j++;
	if($$w !~ /[\e\x0F\x0F\x80-\xFE]/){
		@c = ($c,$j);
	}else{
		$a += length($&) while $$w =~ /[\x81-\x9F\xE0-\xFC][\x40-\x7E\x80-\xFC]/g;
		$z += length($&) while $$w =~ /[\x8E\xA1-\xFE][\xA1-\xFE]/g;
		$q += length($&) while $$w =~ /[\xA0-\xDF]/g;
		if($z < $q){
			@c = ('sjis',$j);
		}else{
			@c = (('euc', $c, 'sjis')[($a <=> $z) + $[ + 1],$j);
		}
	}
	wantarray ? @c : $c[0];
}
sub euc2sjis{
	my($v, $w, $a, $b, $c);
	$w = (ref ($v = shift)) ? $v : \$v;
	$$w =~ s/\x8E\xA0|\xFF/\x20/g;
	$$w =~ s/\x8E([\xA0-\xDF])/"\xFF" . ("\x7F" & $1)/eg;
	$$w =~ s/[\xA1-\xFE][\xA1-\xFE]/$EUC{$&} || do{
		($a, $b) = unpack "CC", $&;
		if($a % 2){
			$a = ($a >> 1) + ($a < 223 ? 49 : 113);
			$b -= 96 + ($b < 224);
		}else{
			$a = ($a >> 1) + ($a < 223 ? 48 : 112);
			$b -= 2;
		}
		$EUC{$&} = pack "CC", $a, $b;
	}/eg;
	$$w =~ s/&#(6[1-5]\d\d\d);/$EUC{$&} || do{
		$c = $&;
		$c = pack "CC", $a, $b if(($a = $1 >> 8) >= 0xF0 && $a < 0xFE
			&& ($b = $1 & 255) >= 0x40 && $b < 0xFE && $b != 0x7F);
		$EUC{$&} = $c;
	}/eg;
	$$w =~ s/\xFF([\x20-\x5F])/"\x80" | $1/eg;
	$$w;
}
sub euc2jis{
	my($v, $w, $c);
	$w = (ref ($v = shift)) ? $v : \$v;
	$$w =~ s/(\x8E[\xA0-\xDF])+/$KANA{$&} || &widek($&)/eg;
	$$w =~ s/([\xA1-\xFE][\xA1-\xFE])+/$JIS{$&} || do{
		$c = $&;
		$c =~ tr|\xA1-\xFE|\x21-\x7E|;
		$JIS{$&} = "\e\$B${c}\e(J";
	}/eg;
	$$w;
}
sub sjis2euc{
	my($v, $w);
	$w = (ref ($v = shift)) ? $v : \$v;
	my($a, $b, $c);
	$$w =~ s/([\x81-\x9F\xE0-\xFD][\x40-\x7E\x80-\xFD])|([\xA0-\xDF])|./$SJIS{$&} || do{
		if($1){
			($a, $b) = unpack "CC", $1;
			if(0xF0 <= $a){			# 外字
				$c = unpack "n", $1;
				$SJIS{$1} = "&#${c};";
			}elsif(0x9F <= $b){		# SJIS 偶数
				$a = $a * 2 - ($a >= 0xE0 ? 0xE0 : 0x60);
				$b += 2;
				$SJIS{$1} = pack "CC", $a, $b;
			}else{				# SJIS 奇数
				$a = $a * 2 - ($a >= 0xE0 ? 0xE1 : 0x61);
				$b += 0x60 + ($b < 0x7F);
				$SJIS{$1} = pack "CC", $a, $b;
			}
		}elsif($2){
			$SJIS{$&} = "\x8E" . $&;
		}else{
			$SJIS{$&} = $&;
		}
	}/egs;
	$$w;
}
sub jis2euc{
	my($v, $w, $d, $i, $s);
	$w = (ref ($v = shift)) ? $v : \$v;
	my @c = split /([\e\x0E\x0F])/, $$w;		# ESCで分ける
	while(@c){
		$d = shift @c;
		if("\x0E" eq $d){			# 半カナIN
			$d = shift @c;
			$d = s/[\x21-\x7E]/"\x8E" . chr(ord($&)|128)/eg;
		}elsif("\x0F" eq $d){			# 半カナOUT
			$d = '';
		}elsif("\e" eq $d){
			$d = shift @c;
			if($d =~ /^\(I/){
				$d = $';
				$d =~ s/[\x21-\x7E]/"\x8E" . chr(ord($&)|128)/eg;
			}elsif($d =~ /^\([BJ]/){	# アスキーIN
				$d = $';
			}elsif($d =~ /^&\@/){		# よく解からない…
				$d = '';
			}elsif($d =~ /^\$[\@BD]/){	# JIS8半カナIN
				$d = $';
				$d =~ s/[\xA1-\xFE]/"\x8E" . $&/eg;
				$d =~ tr/\x21-\x7E\xA0/\xA1-\xFE\x20/;
			}
		}
		$s .= $d;
	}
	$$w = $s;
}
sub qjis2euc{
	my($v, $w, $d);
	$w = (ref ($v = shift)) ? $v : \$v;
	$$w =~ s/=\?ISO-2022-JP\?[QB]\?([\w\=\+\/])\?=/do{
		if(uc$1eq'Q'){				# クォートコード
			$d = $2;
			$d =~ s|_| |g;
			$d =~ s|\=([\dA-F][\dA-F])|chr(hex $1)|egi;
		}else{					# BASEコード
			$d = &bdec($2);
		}
		&jis2euc($d);
	}/egi;
	$$w;
}
sub widek{
	my($v, $w);
	$w = (ref ($v = shift)) ? $v : \$v;
	$$w =~ s/\x8E[\xCA-\xCE]\x8E\xDF|\x8E[\xB3\xB6-\xC4\xCA-\xCE]\x8E\xDE|\x8E[\xA0-\xDF]|[\0-\x8D]+|./defined $EWK{$&} ? $EWK{$&} : $&/eg;
	$$w;
}
sub narrk{
	my($v, $w);
	$w = (ref ($v = shift)) ? $v : \$v;
	$$w =~ s/\x8E[\xA0-\xDF]|[\xA1-\xFE][\xA1-\xFE]|[\0-\x8D]+|./defined $ENK{$&} ? $ENK{$&} : $&/eg;
	$$w;
}
sub swidek{
	my($v, $w);
	$w = (ref ($v = shift)) ? $v : \$v;
	$$w =~ s/[\x81-\x9F\xE0-\xFD][\x40-\x7E\x80-\xFD]|[\xCA-\xCE]\xDF|[\xB3\xB6-\xC4\xCA-\xCE]\xDE|[\xA0-\xDF]|[\0-\x7F]+|./defined $SWK{$&} ? $SWK{$&} : $&/eg;
	$$w;
}
sub snarrk{
	my($v, $w);
	$w = (ref ($v = shift)) ? $v : \$v;
	$$w =~ s/[\x81-\x9F\xE0-\xFD][\x40-\x7E\x80-\xFD]|[\xA0-\xDF]|[\0-\x7F]+|./defined $SNK{$&} ? $SNK{$&} : $&/eg;
	$$w;
}
sub aenc{
	my($v, $w, $r, $d, @d);
	$w = (ref ($v = shift)) ? $v : \$v;
	return undef if(($r = shift) < 2 || $r > 64);
	$d = (abs $$w) + 1;
	@d = ();
	while($d){
		$d --;
		$e = int($d / $r);
		unshift @d, $d - $e * $r;
		$d = $e;
	}
	$d = pack 'C*', @d;
	$d =~ tr/\0-\x3F/a-zA-Z0-9_-/;
	$$w = $d;
}
sub adec{
	my($v, $w, $r, $d, $e, $f, @d);
	$w = (ref ($v = shift)) ? $v : \$v;
	return undef if(($r = shift) < 2 || $r > 64);
	$f = 0;
	$e = (chr $r) . "-\xFF";
	$$w =~ tr/a-zA-Z0-9_-//cd;
	$$w =~ tr/a-zA-Z0-9_-/\0-\x3F/;
	$$w =~ s/[$e]//g;
	if(@d = unpack 'C*', $$w){
		for $e (@d){
			$f *= $r;
			$f += $e;
			$f ++;
		}
		$f --;
	}
	$$w = $f;
}
sub qdec{
	my($v, $w);
	$w = (ref ($v = shift)) ? $v : \$v;
	$$w =~ s/%([\dA-F][\dA-F])/chr(hex $1)/egi;
	$$w;
}
sub qenc{
	my($v, $w);
	$w = (ref ($v = shift)) ? $v : \$v;
	$$w =~ s/[^\w]/"%".uc(unpack "H2", $&)/eg;
	$$w;
}
sub qenc2{
	my($v, $w);
	$w = (ref ($v = shift)) ? $v : \$v;
	$$w =~ s/[\0-\x20\x7F-\xFF+=;]/"%".uc(unpack "H2", $&)/eg;
	$$w;
}
sub benc{
	my($v, $w, $s, $p);
	$w = (ref ($v = shift)) ? $v : \$v;
	$p = length $$w;
	pos $$w = 0;
	while($$w =~ /(.{1,45})/gs){
		$s .= substr pack(u, $1), 1;
		chomp $s;
	}
	$$w = $s;
	$$w =~ tr|\x20-\x60|A-Za-z0-9+/A|;
	($s = (3 - $p % 3) % 3) && $$w =~ s/.{$s}$/'=' x $s/e;
	$$w;
}
sub bdec{
	my($v, $w, $n, $r);
	$w = (ref ($v = shift)) ? $v : \$v;
	$$w =~ tr|A-Za-z0-9+=/||cd;
	length($$w) % 4 && return $$w;
	$$w =~ s|=+$||;
	$$w =~ tr|A-Za-z0-9+/|\x20-\x5F|;
	while($$w =~ /(.{1,60})/g){
		$n = chr(32 + int(length($1) * 3 / 4));
		$r .= unpack "u", ($n . $1);
	}
	$$w = $r;
}
sub renc{
	my($v, $w, $e, $c, $p, $r, $q);
	$w = (ref ($v = shift)) ? $v : \$v;
	$q = ($r = shift) ? $r * 2 : 4;
	$$w =~ s/(.)/$1\0/gs;
	for ($p = 0; $p <= length($$w) - ($q << 1); $p += 2){
		$e = quotemeta(substr $$w, $p, $q);
		pos $$w = $p + $q;
		while($$w =~ /$e/gs){
			if(($c = pos $$w) & 1){
				(pos $$w)--;
			}else{
				substr($$w, $c - $q, $q) = pack 'S', ($p >> 1) + 256;
				pos $$w = $c - $q + 2;
			}
		}
	}
	$c = 2048;
	$$w =~ s/(.)(.)(.)(.)/($c-- > 0) ? $1 . $3 . chr(ord($2) << 4 | ord($4)) : $&/egs;
	$r ? $$w : &MTX::benc($w);
}
sub rdec{
	my($v, $w, $e, $c, $p, $r, $q);
	$w = (ref ($v = shift)) ? $v : \$v;
	$q = ($r = shift) ? $r * 2 : 4;
	$e = $r ? $$w : &MTX::bdec($w);
	$c = 2048;
	$e =~ s/(.)(.)(.)/($c-- > 0) ? $1 . chr(ord($3) >> 4) . $2 . chr(ord($3) & 15) : $&/egs;
	$$w = $e;
	for ($p = $q; $p <= length($$w) - 2; $p += 2){
		if(($c = unpack 'S', (substr $$w, $p, 2)) >= 256){
			substr($$w, $p, 2) = substr $e, ($c - 256) << 1, $q;
			$p -= 2;
		}
	}
	$$w =~ s/(.)\0/$1/gs;
	$$w;
}
sub brenc{
	my($c, $d, $v, $w, $x, $y);
	$w = (ref ($v = shift)) ? $v : \$v;
	$y = (ref ($x = shift)) ? $x : \$x;
	$c = length &MTX::renc($$y, 3);
	$$w = substr &MTX::renc($$y . $$w, 3), $c - $c % 3;
	&MTX::benc($w);
}
sub brdec{
	my($v, $w, $x, $y, $c, $d);
	$w = (ref ($v = shift)) ? $v : \$v;
	$y = (ref ($x = shift)) ? $x : \$x;
	$c = length($d = $$y);
	&MTX::bdec($w);
	&MTX::renc(\$d, 3);
	$$w = substr &MTX::rdec(substr($d, 0, length($d) - length($d) % 3) . $$w, 3), $c;
}
sub splitstr{
	my($v, $w, $c, $i);
	$w = (ref ($v = shift)) ? $v : \$v;
	($c = abs(shift)) || return undef;
	for($i = int(length($$w) / $c); $i > 0; $i --){
		substr($$w, $i * $c, 0) = "\n";
	}
	$$w;
}
sub lf2crlf{
	my($v, $w);
	$w = (ref ($v = shift)) ? $v : \$v;
	$$w =~ s/([^\r]?)\n/$1\r\n/g;
	$$w;
}
sub longanchor{
	my($a, $b, $c, $d, $e, @c);
	$a = $b = $_[0];
	($d, $c) = &jtype(&qdec(\$b));
	$d eq 'sjis' && &sjis2euc(\$b);
	$c && &jis2euc(\$b);
	$b =~ s/[\0-\x20\x7F\xFF]+/+/g;
	if(length($b) > $linklen2){
		"\01a href=\03$a\03 target=\03\_blank\03\02$linkmess\01\/a \02"
	}else{
		if(length($b) > $linklen){
			($d, $e) = $b =~ /^(\w+:\/{0,2})/ ? ($1, $') : (undef, $b);
			if(@c = split /\//, $e){
				$c = pop @c; pop @c;
				for ($i = $#c; $i > 1; $i--){
					pop @c;
					last if length($d . join("/", @c, $c)) <= ($linklen - 3);
				}
				push @c, "...";
				$b = $d . join("/", @c, $c);
			}
		}
		$b = substr($b, 0, $linklen - 3) . "..." if length($b) > $linklen;
		"\01a href=\03$a\03 target=\03\_blank\03\02$b\01\/a \02"
	}
}
sub tagtrue{
	my($v, $w, $a, $b, $c, $d, $e, $f, @c, @d, @e, $i, $j, $p, $q, $r, $s, $t, %t, %v);
	&chartrue($w = (ref ($v = shift)) ? $v : \$v);
	@d = split /(<[^>\n]*>)/, $$w;
	unshift @d, undef;
	for ($i = 1; $i < @d; $i++){
		next if ord($e = $d[$i]) != 0x3C;
		if($e =~ /<(pre)>/i){
			for ($j = $i + 1; $j < @d; $j++){
				next if $d[$j] !~ /<\/pre>/i;
				$d[$j] =~ s/<\/(pre)>/\01\/$1\02/i;
				$d[$i] =~ s/<(pre)>/\01$1\02/i;
				$a = ++$i;
				$b = '';
				@c = ();
				for (; $i < $j; $i++){
					$b .= $d[$i];
					$d[$i] = undef;
				}
				if($b ne ''){
					$b =~ tr/"<>&/\03-\06/;
					for $c (split /\n/, $b){
						$c =~ s/\s+$//g;
						$c = " " if $c eq '';
						push @c, &splitstrj($c, $precols, euc);
					}
					$d[$a] = join "\n", @c;
					$d[$a] =~ s/\x20\x20+/"\07" x length $&/eg;
				}
				last;
			}
		}elsif($e =~ /<(hr)([\x20\t]+[^<>\n]+)?>/i){
			($q, $r) = ($1, $2);
			($a, $b, $c) = ('(#[\dA-F]{6}|[A-Z]{3,16})', '(left|center|right)', '(\d\d\%|\d\d\d?)');
			@c = undef;
			$r =~ s/[\x20\t]*color=(\"$a\"|\'$a\'|$a)/do{push @c, $&; undef}/ei;
			$r =~ s/[\x20\t]*align=(\"$b\"|\'$b\'|$b)/do{push @c, $&; undef}/ei;
			$r =~ s/[\x20\t]*width=(\"$c\"|\'$c\'|$c)/do{push @c, $&; undef}/ei;
			$r =~ s/[\x20\t]*size=(\"\d\d?\"|\'\d\d?\'|\d\d?)/do{push @c, $&; undef}/ei;
			$r =~ s/[\x20\t]*noshade/do{push @c, $&; undef}/ei;
			$r =~ tr/\x20\t//d;
			next if length $r;
			$r = join '', @c;
			$r =~ tr/\"/\03/;
			$d[$i] = "\01$q$r\02";
		}elsif($e =~ /<(div)[\x20\t]*>/i){
			$d[$i] = "<div align=left>";
			$e[$i] = $t{'DIV'};
			$t{'DIV'} = $i;
		}elsif($e =~ /<(a|font)[\x20\t]+[^<>\n]+>/i){
			$e[$i] = $t{uc $1};
			$t{uc $1} = $i;
		}elsif($e =~ /<(h1|h2|h3|h4|h5|h6|div)([\x20\t]+[^<>\n]+)?>/i){
			$e[$i] = $t{uc $1};
			$t{uc $1} = $i;
		}elsif($e =~ /<(b|i|s|u|big|tt|center|small|sub|sup|right)>/i){
			$e[$i] = $t{uc $1};
			$t{uc $1} = $i;
		}elsif($e =~ /<\/(b|i|s|u|big|tt|center|small|sub|sup)>/i){
			next unless $d = $t{uc $1};
			$t{uc $1} = $e[$d];
			$d[$i] = "\01/$1\02";
			$d[$d] = "\01$1\02";
		}elsif($e =~ /<\/(right)>/i){
			next unless $d = $t{'RIGHT'};
			$t{'RIGHT'} = $e[$d];
			$d[$i] = "\01/div\02";
			$d[$d] = "\01div align=right\02";
		}elsif($e =~ /<\/(h1|h2|h3|h4|h5|h6|div)>/i){
			next unless $d = $t{uc $1};
			$t{uc $1} = $e[$d];
			$q = $1;
			$p = undef;
			($r) = $d[$d] =~ /<$q(.*)>/i;
			$r =~ s/[\x20\t]+align=([\"\']?)(left|center|right)\1/do{$p = $&; undef}/ei;
			$r =~ tr/\x20\t//d;
			next if length $r;
			$p =~ tr/\"/\03/;
			$d[$i] = "\01/$q\02";
			$d[$d] = "\01$q$p\02";
		}elsif($e =~ /<\/(font)>/i){
			next unless $d = $t{'FONT'};
			$t{'FONT'} = $e[$d];
			@c = undef;
			$q = $1;
			($r) = $d[$d] =~ /<$q(.*)>/i;
			$r =~ s/[\x20\t]+color=([\"\']?)(#[\dA-F]{6}|[A-Z]{3,16})\1/do{push @c, $&; undef}/ei;
			$r =~ s/[\x20\t]+size=([\"\']?)([1-6])\1/do{push @c, $&; undef}/ei;
			$r =~ s/[\x20\t]+face=([\"\']?)([\-\x20\w\xA1-\xFE]{4,24})\1/do{push @c, $&; undef}/ei;
			$r =~ tr/\x20\t//d;
			next if(!@c || length($r));
			$r = join '', @c;
			$r =~ tr/\"/\03/;
			$d[$i] = "\01/$q\02";
			$d[$d] = "\01$q$r\02";
		}elsif($e =~ /<\/(a)>/i){
			next unless $d = $t{'A'};
			$t{'A'} = $e[$d];
			@c = undef;
			$q = $1;
			($r) = $d[$d] =~ /<$q(.*)>/i;
			$r =~ s/[\x20\t]+href=([\"\']?)((mailto:[\$\w\.\-]{2,32}\@([\w\-]+\.){1,3}[A-Za-z]{2,4})|(((https?|ftp):\/\/(\d\d\d?\.\d{1,3}.\d{1,3}.\d{1,3}|([\w\-]+\.){0,3}([\w\-]|[\xA1-\xFE])+\.[A-Za-z]{2,4})\/~?|\/~?)?[\w\-\.\?\/,%&#=]*))\1/if(length($2) > 2 && length($2) <= $linkmaxlen){push @c, $&; undef}else{ $& }/ei;
			$r =~ s/[\x20\t]+target=([\"\']?)\w{1,16}\1/do{push @c, $&; undef}/ei;
			$r =~ s/[\x20\t]+name=([\"\']?)\w{1,16}\1/do{push @c, $&; undef}/ei;
			$r =~ tr/\x20\t//d;
			next if !@c || length($r);
			$r = join '', @c;
			$r =~ tr/\"./\03\xE/;
			$d[$i] = "\01/$q\02";
			$d[$d] = "\01$q$r\02";
		}
	}
	$$w = join '', @d;
	study $$w;
	$$w =~ s/[\t\x20]+/\x20/g;
	$$w =~ s/<br>\n?/\n/gi;
	$$w =~ s/(\t|\x20|\xA1\xA1)+\n/\n/g;
	$$w =~ s/^\n+//g;
	$$w =~ s/\n+$//g;
	$$w =~ s/\n\n+/\n \n/g;
	$$w =~ s/(mailto:)?([\$\w\.\-]{2,32}\@([\w\-]+\.){1,3}[A-Za-z]{2,4})/(length($&) <= 64) ? "\01a href=\03mailto:$2\03 target=\03\_blank\03\02$&\01\/a \02" : $&/egi;
	$$w =~ s/((https?|ftp):\/\/(\d\d\d?\.\d{1,3}.\d{1,3}.\d{1,3}|([\w\-]+\.){0,3}([\w\-]|[\xA1-\xFE])+\.[A-Za-z]{2,4})\/~?)[\w\-\.\?\/,%&#=]*/&longanchor($&)/egi;
	%v = ("<"=>"&LT;",">"=>"&GT;","\04"=>"&LT;","\05"=>"&GT;",
		"\06"=>"&AMP;","\07"=>" ","\""=>"&QUOT;","\n"=>"<br>");
	$$w =~ s/[<>\04-\07"\n]/$v{$&}/eg;
	$$w =~ tr/\01-\03\xE/<>"./;
	$$w;
}
sub tagrecover{
	my($v, $w, %v);
	$w = (ref ($v = shift)) ? $v : \$v;
	$$w =~ s/<a href=\"mailto:([^\"\n]+)\" target=\"_blank\">\1<\/a >/\1/g;
	$$w =~ s/<a href=\"([a-z]+:)([^\"\n]+)\" target=\"_blank\">\1[^<>\n]+<\/a >/\1\2/g;
	%v = ("&lt;"=>"<", "&gt;"=>">","&amp;"=>"&", "&quot;"=>"\"", "&nbsp;"=>" ");
	$$w =~ s/&(lt|gt|amp|quot|nbsp);/$v{$&}/eg;
	$$w =~ s/[\x20\t]*<br>/\n/gi;
	$$w =~ s/<(\/text[^>]+>)/&#60;$1/gi;
	$$w;
}
sub tagdeath{
	my($v, $w, $r);
	$w = (ref ($v = shift)) ? $v : \$v;
	$$w =~ s/<(\/?h[1-6]|\/?pre|hr|br)>/\n/gi;
	$$w =~ s/<\/?(\w+)[^>]*>/($1 eq"a")?$&:''/egi;
	if($_[0]){
		$$w =~ s/<a[\x20\t]+href=([\"']?)([^<>\"']+)\1[^>]*>[^<>\"']*<\/a\x20?>/$2/gi;
		$$w =~ s/<\/?a[^>]*>//gi;
	}
	$$w =~ s/\n/<br>/g;
	$$w;
}
sub getproxyinfo{
	my(@e, $a, $c, $d, $h);
	for $c(@ENV{HTTP_VIA,HTTP_X_FORWARDED_FOR,HTTP_FROM,HTTP_FORWARDED,CACHE_INFO,HTTP_CLIENT_IP,HTTP_SP_HOST,HTTP_X_LOCKING}){
		push @e, $c if $c;
	}
	($h, $a) = @ENV{REMOTE_HOST,REMOTE_ADDR};
	unshift @e, (('' ne $h && $h ne $a) ? "$a($h)" : $a);
	$d = &charline(join "&#10;", @e);
	$d;
}
sub expires{
	my @t = gmtime $_[0];
	$t[6] = (qw/Sun Mon Tue Wed Thu Fri Sat/)[$t[6]];
	$t[5] += 1900;
	$t[4] = (qw/Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec/)[$t[4]];
	sprintf "$t[6], $t[3] $t[4] $t[5] %2.2d:%2.2d:%2.2d GMT", $t[2], $t[1], $t[0];
}
sub strnum{
	my $s = shift;
	my $k;
	$s .= "\xFF" x 4;
#	$k = unpack('V', $&) ^ ($k >> 1 | ($k & 1 ? 0x80000000 : 0)) while($s =~ /.{4}/gs);
	$k = unpack('V', $&) ^ (($k >> 1) & 0x7FFFFFFF | ($k & 1 ? (1 << 31) : 0)) while $s =~ /.{4}/gs;
	$k;
}
sub rand{
	my $b = $_[0] || 1;
	my $a = (shift @rand) * $b;
	unless(@rand){
		$b = 16;
		srand($srand += rand($^T ^ $$ << 8));
		push(@rand, rand) while --$b;
	}
	int $a;
}
sub indexj{
	my($s, $i, $j) = @_;
	pos $s = $j + 0;
	do{ return pos $s if index($s, $i, pos $s) == pos $s } while $s =~ /$JSPLITER/g;
	-1;
}
sub strchk{
	my($s) = @_;
	$s =~ s/<[^>]*>//g;
	$s =~ s/[\0-\x20]|　//g;
	$s ne '';
}
sub splitstrj{
	my($v, $w, $i, @b, $c, $d, $e, $f, $g, $h);
	$w = (ref ($v = shift)) ? $v : \$v;
        1 while $$w =~ s/\t+/' ' x (length($&) * $tablength - length($`) % $tablength)/e;
	($e = abs(shift)) || return $$w;
	$g = shift || $CHARCODE;
	$h = $g eq 'euc' ? '(\x8E[\xA0-\xDF]|[\xA1-\xFE][\xA1-\xFE]|&#\d{2,5};|&[A-Za-z]+;|.)'
			 : '([\x81-\x9F\xE0-\xFD][\x40-\x7E\x80-\xFD]|&#\d{2,5};|&[A-Za-z]+;|.)';
	push(@b, $1) while $$w =~ /$h/gio;
	for $d (@b){
		if($d =~ /&#(\d+);/){
			$c = ($1 > 256) ? 2 : 1;
		}elsif($d =~ /\x8E[\xA0-\xDF]/ && $g eq euc){
			$c = 1;
		}elsif(length($d) > 1){
			$c = 2;
		}else{
			$c = 1;
		}
		if($c + $i > $e){
			$f .= "\n$d";
			$i = $c;
			next;
		}
		$f .= $d;
		$i += $c;
	}
	$f =~ s/\x20+$//gm;
	$$w = $f;
}
sub headline{
	my($src, $len, $pls) = @_;
	my(@buf, @lin, $cnt, $c, $d, $e, $f, $dst);
	for $e (split /<br>/i, $src){
		$e =~ s/&(nbsp|#160);/ /gi;
		$e =~ s/([\0-\x20\x7F\xFF]|　)+/ /g;
		$e =~ s/<[^>]*>//g;
		$e =~ s/^\x20+//;
		$e =~ s/\x20+$//;
		if($e ne ''){
			push(@buf, $1) while ($e =~ /$JSPLITER/gi);
			for $d (@buf){
				if($d =~ /&#(\d+);/){
					$c = ($1 > 256) ? 2 : 1;
				}elsif($d =~ /\x8E[\xA0-\xDF]/ && $CHARCODE eq 'euc'){
					$c = 1;
				}elsif(length($d) > 1){
					$c = 2;
				}else{
					$c = 1;
				}
				if($c + $cnt > $len){
					$dst .= $pls;
					last;
				}
				$dst .= $d;
				$cnt += $c;
			}
			last;
		}
	}
	$dst;
}
sub import{
	return if defined $CHARCOE;
	my($spliter, $head, $body, $name, $file, $query, $cookie);
	my($a, $b, $i, $j, @b, @c);
	($CHARCODE, $CHARSET) = ("珥" eq "\xE0\xE2") ? ('euc', 'x-euc') : ('sjis', 'Shift_JIS');
	$a = <<_F; $b = <<_F; for $i(split /,/, <<_F){
AChAKIAowCkAKUApgCnAKgAqQCqAKsArACtAK4ArwCwALEAsgCzALQAtQC2ALcAuAC5ALoAuwC8
AL0AvgC/AMAAwQDCAMMAxADFAMYAxwDIAMkAygDLAMwAzQDOAM8A0ADRANIA0wDUANUA1gDXANgA
2QDaANsA3ADdAN4A3wC23gC33gC43gC53gC63gC73gC83gC93gC+3gC/3gDA3gDB3gDC3gDD3gDE
3gDK3gDL3gDM3gDN3gDO3gDK3wDL3wDM3wDN3wDO3wCz3g
_F
ACBQgCBdQCBdgCBQQCBRQCDkgCDQACDQgCDRACDRgCDSACDgwCDhQCDhwCDYgCBWwCDQQCDQwCD
RQCDRwCDSQCDSgCDTACDTgCDUACDUgCDVACDVgCDWACDWgCDXACDXgCDYACDYwCDZQCDZwCDaQCD
agCDawCDbACDbQCDbgCDcQCDdACDdwCDegCDfQCDfgCDgACDgQCDggCDhACDhgCDiACDiQCDigCD
iwCDjACDjQCDjwCDkwCBSgCBSwCDSwCDTQCDTwCDUQCDUwCDVQCDVwCDWQCDWwCDXQCDXwCDYQCD
ZACDZgCDaACDbwCDcgCDdQCDeACDewCDcACDcwCDdgCDeQCDfACDlA
_F
o${a}==,I${b}==,o${b}CBQACBSQCBaACBlACBkACBkwCBlQCBZgCBaQCBagCBlgCBewCBQwCBf
ACBRACBXgCCTwCCUACCUQCCUgCCUwCCVACCVQCCVgCCVwCCWACBRgCBRwCBgwCBgQCBhACBSACBl
wCCYACCYQCCYgCCYwCCZACCZQCCZgCCZwCCaACCaQCCagCCawCCbACCbQCCbgCCbwCCcACCcQCCc
gCCcwCCdACCdQCCdgCCdwCCeACCeQCBbQCBjwCBbgCBTwCBUQCBZQCCgQCCggCCgwCChACChQCCh
gCChwCCiACCiQCCigCCiwCCjACCjQCCjgCCjwCCkACCkQCCkgCCkwCClACClQCClgCClwCCmACCm
QCCmgCBbwCBYgCBcACBYA==,I${a}AgACEAIgAjACQAJQAmACcAKAApACoAKwAsAC0ALgAvADAAM
QAyADMANAA1ADYANwA4ADkAOgA7ADwAPQA+AD8AQABBAEIAQwBEAEUARgBHAEgASQBKAEsATABNA
E4ATwBQAFEAUgBTAFQAVQBWAFcAWABZAFoAWwBcAF0AXgBfAGAAYQBiAGMAZABlAGYAZwBoAGkAa
gBrAGwAbQBuAG8AcABxAHIAcwB0AHUAdgB3AHgAeQB6AHsAfAB9AH4=
_F
		push @c, &bdec(\$i);
		push @c, &sjis2euc(\$i);
	}
	@SWK{split /\0/, $c[0]} = split /\0/, $c[2];
	@EWK{split /\0/, $c[1]} = split /\0/, $c[3];
	@SNK{split /\0/, $c[4]} = split /\0/, $c[6];
	@ENK{split /\0/, $c[5]} = split /\0/, $c[7];
	$SJIS{"\xA0"} = " ";
	$JSPLITER = $CHARCODE eq 'euc'
		? '(\x8E[\xA0-\xDF]|[\xA1-\xFE][\xA1-\xFE]|&#\d{2,5};|&[A-Za-z]+;|.)'
		: '([\x81-\x9F\xE0-\xFD][\x40-\x7E\x80-\xFD]|&#\d{2,5};|&[A-Za-z]+;|.)';
	$cookie = $ENV{HTTP_COOKIE};
	$cookie =~ s/%01|%02|\01|\02/ /g;
	$cookie =~ tr/+=;/\x20\01\02/;
	&qdec(\$cookie);
	if(uc $ENV{REQUEST_METHOD} ne "POST"){
		$query = $ENV{QUERY_STRING};
		$query =~ s/%01|%02|\01|\02/ /g;
		$query =~ tr/+=&/\x20\01\02/;
		&qdec(\$query);
	}else{
		binmode STDIN;
		read STDIN, $query, $ENV{CONTENT_LENGTH};
		if(($spliter) = $ENV{CONTENT_TYPE} =~ /multipart\/form-data;\x20*boundary=([\w\-]+)/i){
			for $thread (split /\r?\n\-+${spliter}\-*/, $query){
				($head, $body) = split /\r?\n\r?\n/, $thread, 2;
				next if $head !~ /Content-Disposition:\x20*form-data;/i;
				$head =~ tr/\0-\x1F//d;
				($file) = $head =~ / filename=\"([^\"]+)\"/i;
				($name) = $head =~ / name=\"([^\"]+)\"/i;
				$name = &formtrue($name);
				if($file){
					($FT{$file}) = $head =~ /Content-Type:\x20*([^\r\n]+)/i;
					$FB{$file} = $body;
					$body = $file;
				}
				$body =~ tr/\01\02//d;
				push @b, "$name\01$body";
			}
			$query = join "\02", @b;
		}else{
			$query =~ s/%01|%02|\01|\02/ /g;
			$query =~ tr/+=&/\x20\01\02/;
			&qdec(\$query);
		}
	}
	$QUERYCHKSUM = unpack "%32C*", $query;
	($JCODE,$JIS) = &jtype($query);
	$JCODE = $_[1] || $JCODE;
	$JCODE eq 'sjis' && &sjis2euc(\$query);
	$JIS && &jis2euc(\$query);
	&qjis2euc(\$query);
	@FN = @FD = (''); %FF = ();
	for $file (split /\02\x20*/, $query){
		($name, $body) = split /\x20*\01/, $file, 2;
		push @FN, &formtrue($name);
		push @FD, $body;
		$FF{$name} = $#FD;
	}
	for $file (split /\02\x20*/, $cookie){
		($name, $body) = split /\x20*\01/, $file, 2;
		$FC{&formtrue($name)} = $body;
	}
	$b = 20; srand($srand = $^T ^ ($$ << 8));
	push(@rand, rand) while --$b;
}
1;
__END__