#----------------------------------------------
# Multi Talk "DRESS MACRO LUNGAGE Processer"
# Rel.2.0.16 (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 dml;sub import{goto &DML::import}1;
package DML;

	$gzip = "/gzip";			# gzip パス
	$nest_limit = 32;			# 再帰リミット
	@wrpt = qw/FALSE NO TRUE VOID YES/;	# 書込禁止変数

# オブジェクト

sub new{
	my $C = shift;
	my @D;
	my @E;
	my @F;
	my %S = %ES;
	my %E = %EE;
	my %G = %EG;
	my %P = %EP;
	my %X = %EX;
	my %V = %EV;
	my @A = (\@D, \%S, \%E, \%G, \%P, \%V, \%X, \@E, \@F);
	my $X = \@A;
	bless $X, $C;
	return $X;
}
sub load{
	my $X = shift;
	my $F = shift;
	my $C;
	my($D, $S) = @$X;
	if('SCALAR' eq ref $F){
		&parser($D, $$S{DML} = 's'.unpack('%32C*', $$F), $$F);
		1;
	}else{
		local(*F, $_);
		$$S{DML} = $F = $C = &pathchk($F, 3);
		$C = "$gzip -c -d <$F|" if $F =~ /\.gz$/i;
		if($F && open(F, $C)){
			my @F;
			while(<F>){
				next unless /^\s*<[^>]*>/;
				@F = <F>;
				unshift @F, $_;
				last;
			}
			close F;
			&parser($D, $F, join '', @F);
			1;
		}else{	0; }
	}
}
sub run{
	my $X = shift;
	my $C = shift;
	my $B;
	local($D, *ES, *EE, *EG, *EP, *EV, *EX, *EV, *ES) = @$X;
	local $ES = $D;
	local $EX = $X;
	if('SCALAR' eq ref $C){
		$$C = undef;
		$B = sub{$$C .= $_[0]};
	}elsif('CODE' eq ref $C){
		$B = $C;
	}else{
		$B = sub{print @_};
	}
	local $EPRINT = $B;
	&runobj($D, $B);
}
sub save{
	my $X = shift;
	local *FH = shift;
	local($D, *ES, *EE, *EG, *EP, *EV, *EX, *EV, *ES) = @$X;
	local $ES = $D;
	local $EX = $X;
	local $EPRINT;
	&runobj($D, ($EPRINT = sub{print FH @_}));
}
sub entmac{
	my $X = shift;
	my $N = shift;
	my $C = shift;
	my $E = $$X[6];
	$$E{uc $N} = $C;
}
sub entput{
	my $X = shift;
	my $N = shift;
	my $C = shift;
	my $E = $$X[4];
	$$E{uc $N} = $C;
}
sub entget{
	my $X = shift;
	my $N = shift;
	my $C = shift;
	my $E = $$X[3];
	$$E{uc $N} = $C;
}


# ソースコンパイル

sub parser{
	local $_;
	my($D, $q, $s) = @_;
	my($a, $b, $c, $d, $e, $f, $i, $j, $k, $m, $n, $p, @a, @b, @B0, @B1, @B2, @B3, @B4, %s, %t, %u, %v, %w);
	%t = ("SET"=>1, "REM"=>1, "SPLIT"=>1);
	%u = ("SET"=>"ENDS", "REM"=>"ENDR");
	%v = ("ELIFN"=>"ELSE|ENDIF", "ELIF"=>"ELSE|ENDIF",
		"IF"=>"ELSE|ENDIF", "IFN"=>"ELSE|ENDIF", "EACH"=>"ENDE", "MACRO"=>"ENDM");
	%w = ("IF"=>"ELS?IFN?|", "IFN"=>"ELS?IFN?|");
	$s =~ s/\r+\n?/\n/g;
	my @A = ('BL', 0 - @$D, undef, undef, undef, $q);
	push @$D, \@A;
	my @B = ($D, scalar @$D);
	$EE{lc $q} = \@B;
	$q = \($$D[$#$D][1]);
	for (split /\n/, $s){
		$_ .= "\n";
		if(ref $b){
			if(/<!-*\x20*($k)\x20*-*\/?>/i){
				if($k eq 'ENDR' && $d eq ''){
					pop @$D;
					my @A = ('PR', 0, undef, undef, undef, undef);
					push @$D, \@A;
				}
				$a = $b = $k = undef;
			}else{	$$b .= $_ }
			next;
		}elsif($m && /<!-*\x20*($m)\x20*-*\/?>/i){
			if(($a = uc $1) eq 'ENDIF'){
				pop @B0;
				$b = pop @B1;
				$m = pop @B2;
				$n = pop @B3;
				pop @B4;
				$$D[$b][1] = $#$D - $b;
				my @A = ('EF', 0);
				push @$D, \@A;
			}elsif($a eq 'ELSE'){
				$b = pop @B1;
				$m = 'ENDIF';
				$n = undef;
				$$D[$b][1] = $#$D - $b;
				my @A = ('EL', 0);
				push @$D, \@A;
				push @B1, $#$D;
				$B0[$#B0] .= "\n" . $#$D;
				$B4[$#B4] .= $_;
			}else{
				pop @B0;
				$b = pop @B1;
				$m = pop @B2;
				$n = pop @B3;
				pop @B4;
				$$D[$b][1] = $#$D - $b;
			}
			next;
		}elsif(/<!(!?)-*\x20*(${n}IFN?|SET|EACH|MACRO|REM|SPLIT)(\x20*([\w:]*)(=(([\"\'\`\/])(.*)\7(e?|[ims]{0,3}))|(=([\w:]+)?))?)?\x20*-*\/?>/i){
			$1 && next;
			$e = lc $9;
			$e =~ tr/eims//cds;
			my @A = $10 eq '' ? (uc $2, 0, uc $4, $7,  $e, $8) :
					    (uc $2, 0, uc $4, '%', '', uc $11);
			$e = $4;
			$f = $5;
			$A[0] =~ s/(EL)S?(IFN?)/$1$2/i;
			push @$D, \@A;
			if(($c = $u{$a = $A[0]}) && $f eq ''){	# Multi Line SET
				$b = \($$D[$#$D][5]);
				$k = $c;
				$d = $e;
				next;
			}elsif($a eq 'MACRO' && $f ne ''){ next;
			}elsif($t{$a}){ next }
			$c = $v{$a};
			if($a =~ /^ELIF/){
				$b = pop @B1;
				$m = 'ELSE|ENDIF';
				$$D[$b][1] = $#$D - $b - 1;
				push @B1, $#$D;
				$B0[$#B0] .= "\n". $#$D;
				$B4[$#B4] .= $_;
			}else{
				push @B0, $#$D;
				push @B1, $#$D;
				push @B2, $m;
				push @B3, $n;
				push @B4, $_;
				$m = $c;
				$n = $w{$a};
			}
			next;
		}
		if(ref $a){
			$$a .= $_;
		}else{
			my @A = ('PR', 0, undef, undef, undef, $_);
			push @$D, \@A;
			$a = \($$D[$#$D][5]);
		}
	}
	for($i = 0; $i < @B0; $i++){
		$a = $B0[$i];
		$b = $B4[$i];
		@a = split /\n/, $a;
		@b = split /\n/, $b;
		for($j = 0; $j < @a; $j++){
			my @A = ('PR', 0, undef, undef, undef, $b[$j] . "\n");
			$$D[$a[$j]] = \@A;
		}
	}
	$$q += $#$D;
}
sub runobj{
	my($D, $p, $s) = @_;
	my(@a, %v, $a, $b, $c, $f, $i, $j, $v, $x, $z);
	return unless $$D[$s][1];
	local @ev;
	local $PRINT = $p;
	$v = $] >= 5.005 ? sub{		# 5.005 以降の IF
			$f = $a[4] ? "(?$a[4])" : undef;
			$c = @ES = $ES{m} =~ /$f$z/;
			$ES{l} = length $`;
			$ES{r} = length $&;
		} : sub{			# 5.005 以前の IF
			undef @ES;
			$ES{l} = $ES{r} = undef;
			if($a[4] eq "i"){
				$c = undef;
				if($ES{m} =~ /$z/i){
					$c = 1;
					$ES{l} = length $`;
					$ES{r} = length $&;
					@ES = $ES{m} =~ /$z/i;
				}
			}else{
				$c = undef;
				if($ES{m} =~ /$z/){
					$c = 1;
					$ES{l} = length $`;
					$ES{r} = length $&;
					@ES = $ES{m} =~ /$z/;
				}
			}
		};
	$v{PR} = sub{ &$PRINT($_[0]) };
	$v{SET} = sub{ &envset($a[2], $z) };
	$v{REM} = sub{ &envset($a[2], $a[5]) };
	$v{EACH} = sub{
		$a = &envget($a[2]);
		$j = 0;
		if($a[3] eq ''){
			while($a =~ /[^\n]*\n|[^\n]+$/g){
				local $ES{NUM} = ++$j;
				local $EV{_} = $&;
				&runobj($D, $PRINT, $i);
			}
		}else{
			$z =~ s/\$/\\\$/g;
			for $c(split /$z/, $a){
				local $ES{NUM} = ++$j;
				local $EV{_} = $c;
				&runobj($D, $PRINT, $i);
			}
		}
		$ES{NUM} = $j;
		$i += $a[1];
	};
	$v{SPLIT} = sub{
		$a = &envget($a[2]);
		chomp $a;
		@EV = ();
		if($a[3] eq ''){
			while($a =~ /\s*(\"[^\"\\]*(?:\\[^\"\\])*\")\s*,?|\s*([^,]+)\s*,?|,/g){
				if(ord($1) == 0x22){
					$b = substr $1, 1, length($1) - 2;
					$b =~ s/\\(\"|\\)/$1/g;
					push(@EV, $b);
				}else{	push(@EV, $+) }
			}
			push(@EV, undef) if substr($a, -1, 1) eq ',';
		}else{
			$z =~ s/\$/\\\$/g;
			@EV = split /$z/, $a, $ES{SPLIT_LIMIT};
		}
		$ES{COLS} = @EV;
	};
	$v{MACRO} = sub{
		($z) = (uc $z) =~ /(\w+)/;
		if($a[2] =~ /^(\w*):([\w:]*)$/){
			if($c = $EX{$a = ($1 eq '') ? '_' : $1}){
				if($a[1]){
					&$c($a, $2, $D, $PRINT, $i);
				}else{
					&$c($a, $2, $$b[0], $PRINT, $$b[1]) if $b = $EE{$z};
				}
			}
		}elsif($a[2] eq ''){
			if($a[1]){
				&runobj($D, sub{}, $i);
			}else{
				&runobj($$b[0], sub{}, $$b[1]) if $b = $EE{$z};
			}
		}else{
			my @b = ($D, $i);
			$EE{$a[2]} = \@b;
			$EE{$a[2]} = $EE{$z} if !$a[1];
			$EG{$a[2]} = \&envrun if $EG{$a[2]} eq undef || $EG{$a[2]} == \&envrun;
			$EP{$a[2]} = \&envput if $EP{$a[2]} eq undef || $EP{$a[2]} == \&envput;
			$EX{$a[2]} = \&envblk if $EX{$a[2]} eq undef || $EX{$a[2]} == \&envblk;
		}
		$i += $a[1];
	};
	$v{IF} = $v{IFN} = sub{
	IF1:
		if($a[3] eq ''){
			$c = &envget($a[2]);
		}elsif($a[3] eq '/'){
			$ES{m} = &envget($a[2]) if $a[2] ne ':';
			&$v();
			unshift @ES, scalar(@ES);
		}elsif($a[2] eq ':'){
			$c = $z;
		}else{
			$a = &envget($a[2]);
			$c = $a[4] eq 'e' ? ($a == $z) : ($a eq $z);
		}
		$c = !$c if $a[0] =~ /IFN$/;
		$b = $a[1] + $i + 1;
		@a = @{$$D[$b]};
		if($c){
			&runobj($D, $PRINT, $i);
			$i = $b;
			while($$D[$i][0] ne 'EF'){
				$$D[$i][0] || last;
				$i += $$D[$i][1] + 1;
			}
		}else{
			$i = $b;
			if($a[0] =~ /^ELIFN?/){
				$z = $a[4] eq 'e' ? &evalstr($a[5]) : $a[3] eq '%' ? &envget($a[5]) : &envout($a[5]);
				goto IF1;
			}elsif($a[0] eq 'EL'){
				&runobj($D, $PRINT, $i);
				$i += $a[1];
			}
		}
	};
	$v{EF} = $v{EL} = $v{ELIF} = $v{ELIFN} = sub{};
	$s = $$D[$s][1] + ($i = $s + 1);
	for(; $ES && $i < $s; $i++){
		@a = @{$$D[$i]};
		$z = $a[4] eq 'e' ? &evalstr($a[5]) : $a[3] eq '%' ? &envget($a[5]) : &envout($a[5]);
		&{$v{$a[0]}}($z);
	}
	&envset(split(/,/, $c, 2)) while $c = pop @ev;
}
sub pathchk{
	my $s = $_[0];
	$s =~ s/\\/\//g;
	$s =~ tr/A-Za-z0-9_.:\/\-//cd;
	$s =~ s/\.*\/+/\//g unless $ES{OPTIM} & 1;
	$s .= ".dml" if $s !~ /\.[\w\-]+$/;
	if($_[1] >= 3){
		$s = undef if $s !~ /[\w\-]+\.(cgi|s?html?|h?dml?)(\.gz)?$/i;
	}else{
		$s =~ s/^(\w+:)?\///g;
		$s = undef if $_[1] == 0 && $s !~ /[\w\-]+\.(s?html?|h?dml?)(\.gz)?$/i;
		$s = undef if $_[1] == 1 && $s !~ /[\w\-]+\.(cgi|d?plg?)$/i;
	}
	$s;
}
sub evalstr{
	my $s = $_[0];
	my($e, @e);
	local $SIG{__DIE__} = sub{};
	$s =~ s/%(%)|%({([\w:]+)}|([_\d])\b)/$1 ? $1 : do{ push @e, &envget("$3$4"); "[$#e]" }/egi;
	$s =~ tr/^0-9a-z.+%<=>&|!?:^~[]()*\/\-\"\'/ /cs;
	$s =~ s/([A-Za-z]+)/($e=$1)=~m[^(x|eq|ne|lt|le|gt|ge|cmp|and|xor|or|not|abs|cos|exp|int|log|rand|sin|sqrt|time)$]?$e:''/egi;
	$s =~ s/\[\d+\]/\${e$&}/g;
	eval "$s";
}

# 変数展開

sub envout{
	my($s, $e) = @_;
	$s =~ s/%(%)|<([^<>\n]*)\x20+%({([\w:]+)}|([_\d])\b)%\x20*-*\/?>|%({([\w:]+)}|([_\d])\b)/do{
		if($1){
			$e = $1;
		}elsif($3){
			$ES[0] = $2;
			$e = index($2, "!--") == 0 ? "" : "<$2>" if ($e = &envget("$4$5")) eq '';
		}else{	$e = &envget("$7$8") }
		$e;
	}/egi;
	$s;
}
sub envout2{
	my($s, $e) = @_;
	$s =~ s/<([^<>\n]*)\x20+%{([\w:]+)}%\x20*-*\/?>/do{
		$ES[0] = $1; (($e = &envget($2)) eq '') ? (index($1, "!--") == 0 ? "" : "<$1>") : $e;
	}/egi;
	$s;
}
sub envget{
	$_[0] =~ /^(\w*)(:([\w:]*))?$/;
	my $a = $1 eq '' ? '_' : uc $1;
	if($2){
		my $b = $EG{$a};
		$a = (++$EL < $nest_limit && $b) ? &$b($a, uc $3) : &envget($3);
		$EL--;
		$a;
	}elsif($a =~ /^\d+$/){
		$EV[$a];
	}else{	$EV{$a} }
}
sub envset{
	$_[0] =~ /^(\w*)(:([\w:]*))?$/;
	my $a = $1 eq '' ? '_' : uc $1;
	if($2){
		my $b = $EP{$a};
		(++$EL < $nest_limit && $b) && &$b($a, uc $3, $_[1]);
		$EL--;
	}elsif($a =~ /^\d+$/){
		$EV[$a] = $_[1];
	}elsif(!$wrpt{$a}){
		$EV{$a} = $_[1]
	}
	undef;
}
sub envput{
	my $stdout;
	my $b = $EE{$_[0]};
	my @es = @ES;
	local $EV{_} = $_[2];
	local $ES{_} = $_[1];
	$ES{MODE} = 'PUT';
	if($_[1] eq ''){
		&runobj($$b[0], $PRINT, $$b[1]);
		@ES = @es;
	}else{
		&runobj($$b[0], sub{ $stdout .= $_[0] }, $$b[1]);
		@ES = @es;
		chomp $stdout;
		&envset($_[1], $stdout);
	}
}
sub envrun{
	my $stdout;
	my $b = $EE{$_[0]};
	my $c = $_[1] ne '' ? &envget($_[1]) : undef;
	my @es = @ES;
	local $EV{_} = $c;
	local $ES{_} = $_[1];
	$ES{MODE} = 'GET';
	&runobj($$b[0], sub{ $stdout .= $_[0] }, $$b[1]);
	@ES = @es;
	chomp $stdout;
	$stdout;
}
sub envblk{
	my($a, $b, $D, $p, $i, $d, $s, $t) = @_;
	if($EE{$a}){
		&runobj($D, sub{$s .= $_[0]}, $i);
		&envput($a, $b, $s);
	}else{
		&runobj($D, $p, $i);
	}
}
sub sysmac{
	my($a, $b, $D, $PRINT, $i, $c, $d, $e, $f) = @_;
	$v{WRITE} = sub{
		$c = &pathchk(&envget($f), 2);
		local $stdout = '';
		local $ES{$a} = $c;
		&runobj($D, sub{$stdout .= $_[0]}, $i);
		$a = $ES{APPEND} ? ">>$c" : ">$c";
		$a = "|$gzip -c >$c" if $c =~ /\.gz$/i;
		local *SAVE;
		if($c && $ES{OPTIM} & 2 && open(SAVE, $a)){
			print SAVE $stdout;
			close SAVE;
		}else{	&$PRINT("[SYS:$b -- file error: $c]\n") }
	};
	$v{TRANS} = sub{
		if($d){
			local $trans = '';
			&runobj($D, sub{$trans .= $_[0]}, $i);
			&envset($f, $trans);
		}else{
			&runobj($D, $PRINT, $i);
		}
	};
	($e, $d, $f) = $b =~ /^(\w+)(:([\w:]*))?$/;
	&$d() if $d = $v{$e};
}
sub getmac{
	my($a, $b, $c, $d, $e, $f, $i, %v) = @_;
	$v{TAGESC} = sub{
		$a = &envget($f);
		my %x = ('<'=>'lt', '>'=>'gt', '"'=>'quot');
		$a =~ s/[<>\"]/"&$x{$&};"/eg;
		$a;
	};
	$v{EVAL} = sub{&evalstr(&envget($f))};
	$v{QUOTEMETA} = sub{quotemeta(&envget($f))};
	$v{FORM} = sub{$form=newform MTX unless$form;$form->cell(&envget($f))};
	$v{MATCH} = sub{substr $ES{m}, $ES{l}, $ES{r}};
	$v{PREMATCH} = sub{substr $ES{m}, 0, $ES{l}};
	$v{POSTMATCH} = sub{substr $ES{m}, $ES{l} + $ES{r}};
	$v{READ} = sub{
		local *L;
		$c = &pathchk(&envget($f), 2);
		$a = ($c =~ /\.gz/i) ? "$gzip -d <$c|" : "<$c";
		if($c && $ES{OPTIM} & 4 && open(L, $a)){
			join '', <L>;
			close L;
		}else{	&$PRINT("[SYS:$d -- read error: $c]\n"); undef }
	};
	($d, $e, $f) = $b =~ /^(\w+)(:([\w:]*))?$/;
	($i = $v{$d}) ? &$i() : $d eq '' ? $ES{_} : $d =~ /[^\d]/ ? $ES{$d} : $ES[$d];
}
sub putmac{
	my($a, $b, $c, $d, $e, $f, $i, @a, %v) = @_;
	$i = sub{$ES{$d}=$c};
	@v{RESSLINE,TIMESTR,PINDEX,HEADLINE,IMAGEADDR,SPLIT_LIMIT,SPLIT_PATTERN,ANCHOR} = ($i) x 8;
	$v{TAGESC} = sub{
		my %x = ('<'=>'lt', '>'=>'gt', '"'=>'quot');
		$c =~ s/[<>\"]/"&$x{$&};"/eg;
		&envset($f, $c);
	};
	$v{EVAL} = sub{&envset($f,&evalstr($c))};
	$v{QUOTEMETA} = sub{&envset($f,quotemeta($c))};
	$v{WRITE} = sub{
		$e = &pathchk(&envget($f), 2);
		local $ES{$d} = $e;
		$a = $ES{APPEND} ? ">>$e" : ">$e";
		$a = "|$gzip -c >$e" if $e =~ /\.gz$/i;
		local *SAVE;
		if($e && $ES{OPTIM} & 2 && open(SAVE, $a)){
			print SAVE $c;
			close SAVE;
		}else{	&$PRINT("[SYS:$d -- file error: $e]\n") }
	};
	$v{RELOAD} = sub{
		$c = &pathchk($c);
		if($c && -f $c){
			unless($EE{lc $c}){
				return unless $ES;
				local $ES{$d} = $c;
				$i = @$ES + 0;
				local(*F, $_, $g, @F);
				$a = ($c =~ /\.gz/i) ? "$gzip -d <$c|" : "<$c";
				if(open F, $a){
					while(<F>){
						next unless /^\s*<.*>/;
						@F = <F>;
						unshift @F, $_;
						last;
					}
					close F;
				}else{	push @F, "[SYS:$d -- read error: $F]\n" }
				&parser($ES, $c, join '', @F);
				&runobj($ES, $EPRINT, $i);
				$ES = undef;
			}else{
				&$PRINT("[SYS:$d -- not double executed: $c]\n");
			}
		}else{	&$PRINT("[SYS:$d -- file not found: $c]\n") }
	};
	$v{INCLUDE} = sub{
		$c = &pathchk($c);
		if($c && -f $c){
			($e, $i) = $$EE{lc $c};
			unless($e){
				return unless $ES;
				$e = $ES;
				$i = @$ES;
				local(*F, $_, @F);
				$a = ($c =~ /\.gz/i) ? "$gzip -d <$c|" : "<$c";
				if(open F, $a){
					while(<F>){
						next unless /^\s*<.*>/;
						@F = <F>;
						unshift @F, $_;
						last;
					}
					close F;
				}else{	push @F, "[SYS:$d -- read error: $F]\n" }
				&parser($e, $c, join('', @F));
			}
			local $ES{$d} = $c;
			&runobj($e, $PRINT, $i) if ++$EL < $nest_limit;
			$EL--;
		}else{	&$PRINT("[SYS:$d -- file not found: $c]\n") }
	};
	$v{PLUGIN} = sub{
		$c = &pathchk($c, 1);
		if($c){
			local $SIG{__DIE__};
			local $SIG{__WARN__} = $SIG{__DIE__} = sub{
				$e = $_[0];
				chomp $e;
				$e =~ s/\(eval \d+\)/$c/g;
				&$PRINT("[SYS:$d -- $e]\n");
			};
			eval "package PLUGIN;require \"$c\";";
		}else{	&$PRINT("[SYS:$d -- file not found: $c]\n") }
	};
	$v{READ} = sub{
		local *L;
		$c = &pathchk($c, 2);
		$a = ($c =~ /\.gz/i) ? "$gzip -d <$c|" : "<$c";
		if($c && $ES{OPTIM} & 4 && open(L, $a)){
			&envset($f, join('', <L>));
			close L;
		}else{	&$PRINT("[SYS:$d -- read error: $c]\n") }
	};
	$v{WITH} = sub{
		$c =~ /^(\w+)/;
		$c =  ($c eq '_' || $c eq '') ? "SYS" : uc $1;
		$ES{$d} = $c;
		$EP{_} = $EP{$c};
		$EG{_} = $EG{$c};
		$EX{_} = $EX{$c};
	};
	$v{VAR} = sub{
		if($e){
			push @ev, "$f," . &envget($f);
			&envset($f, $c);
		}else{
			for $e (split /[\s,]+/, uc $c){
				next if $e !~ /^[\w:]+$/;
				push @ev, "$e," . &envget($e);
			}
		}
	};
	$v{VOID} = sub{
		for $e (split /[\s,]+/, uc $c){
			next if $e !~ /^[\w:]+$/;
			&envset($e, undef);
		}
	};
	$v{APPEND} = sub{
		if($e){
			&envset($f, &envget($f) . $c);
		}else{
			$ES{$a} = $c;
		}
	};
	$v{FORM} = sub{$form=newform MTX unless$form;&envset($f,$form->cell($c))};
	$v{PRINT} = sub{&$PRINT($c)};
	($d, $e, $f) = $b =~ /^(\w+)(:([\w:]*))?$/;
	&$i() if $i = $v{$d};
}
sub timeput{
	my($a, $b, $c)=@_;
	&envset($b, &timestr($c));
}
sub timeget{
	my($a, $b)=@_;
	&timestr(&envget($b));
}
sub timestr{
	my $c = $ES{TIMESTR} || "yyyy/MM/dd(w(Sun Mon Tue Wed Thu Fri Sat)) HH:mm:ss";
	my @c = localtime($_[0]);
	my($b, @b, %v);
	$c[5] += 1900;
	$c[4] ++;
	%v = (	"yyyy"=>sub{$c[5]},
		"YY"=>sub{$c[5]-1988},
		"yy"=>sub{substr($c[5],length($c[5])-2)},
		"MM"=>sub{sprintf"%02d",$c[4]},
		"M" =>sub{$c[4]},
		"dd"=>sub{sprintf"%02d",$c[3]},
		"d" =>sub{$c[3]},
		"HH"=>sub{sprintf"%02d",$c[2]},
		"H" =>sub{$c[2]},
		"hh"=>sub{sprintf"%02d",$c[2]%12},
		"h" =>sub{$c[2]%12},
		"mm"=>sub{sprintf"%02d",$c[1]},
		"m" =>sub{$c[1]},
		"ss"=>sub{sprintf"%02d",$c[0]},
		"s" =>sub{$c[0]},
		"w" =>sub{@b=split/\s/,$b;$b[$c[6]]},
		"t" =>sub{@b=split/\s/,$b;$b[int($c[2]/12)]},
		"n" =>sub{@b=split/\s/,$b;$b[$c[4]]},
		"BBB"=>sub{sprintf"%03d",int(($c[2]*3600+$c[1]*60+$c[0])/86.4)},
		"YYYY"=>sub{$c[5]+661});
	$c =~ s/([ntw])\(([^\)]*)\)|[MdHhms]{1,2}|YYYY|yyyy|YY|yy|BBB/
		if($1){
			$b = $2;
			&{$v{$1}};
		}else{
			&{$v{$&}};
		}
		/eg;
	$c;
}
sub import{
	return if defined %ES;
	my($i, $j);
	$ES{OPTIM} = 0;
	my %u = ("DOTPATH"=>1, "WRITE"=>2, "READ"=>4, "ENV"=>8);
	my %w = ("NODOTPATH"=>1, "NOWRITE"=>2, "NOREAD"=>4, "NOENV"=>8);
	my $form;
	for $i (@_){
		$ES{OPTIM} |= $j if $j = $u{uc $i};
		$ES{OPTIM} &= -1 - $j if $j = $w{uc $i};
	}
	for $i (@wrpt){
		$wrpt{$i} = 1;
	}
	$EG{_} = $EG{SYS} = \&getmac;
	$EP{_} = $EP{SYS} = \&putmac;
	$EX{_} = $EX{SYS} = \&sysmac;
	$EV{VOID} = undef;
	@EV{YES,TRUE} = (1, 1);
	@EV{NO,FALSE} = (0, 0);
	@ES{TIME,ALIAS,PINDEX,HEADLINE,SPLIT_PATTERN,ANCHOR,RESSLINE}
		= ($^T, 'SYS', 16, 40,",","[CLICK HERE]","<small>%s</small>");
	$EG{TIMESTR} = \&timeget;
	$EP{TIMESTR} = \&timeput;
	$EG{ENV} = sub{ $main::ENV{$_[1]} };
	$EP{ENV} = sub{ $main::ENV{$_[1]} = $_[2] } if $ES{OPTIM} & 8;
	$EG{EXPAND} = sub{&envout(&envget($_[1]))};
	$EP{EXPAND} = sub{&envset($_[1],&envout($_[2]))};
	$EG{HASH} = sub{my($a,$b)=@_;$a=&envget($b);&envget($a)if""ne$a};
	$EP{HASH} = sub{my($a,$b,$c)=@_;$a=&envget($b);&envset($a,$c)if""ne$a};
	$EG{CHOMP} = sub{my($a,$b)=@_;$a=&envget($b);chomp$a;$a};
	$EP{CHOMP} = sub{my($a,$b,$c)=@_;chomp$c;&envset($b,$c)};
	my$ex=sub{my($d,$h,$i);my$e=$EV{"e$_[0]"};my$g=$_[1];study$g;for$d(@$e){($h,$i)=split/,/,$d,2;$g=~s/$h/$i/i}$g};
	$EG{EXCHG}=sub{my($a,$b,$g,$h)=@_;my($d,$e,$f)=$b=~/^(\w*)(:([\w:]*))?$/;''eq$d&&($d='_');$e?&$ex($d,&envget($f)):$EV{"r$d"}};
	$EP{EXCHG}=sub{
		my($a,$b,$c)=@_;
		my($d,$e,$f)=$b=~/^(\w*)(:([\w:]*))?$/;
		''eq$d&&($d='_');
		if($e){&envset($f,&$ex($d,$c))
		}else{my@g=();$EV{"e$d"}=\@g;$EV{"r$d"}=$c;@g=split/\n/,$c}};
	my$rt=sub{my($d,$h,$i);my$e=$EV{"e$_[0]"};my$g=$_[1];study$g;for$d(@$e){($h,$i)=split/,/,$d,2;return$i if$g=~/$h/i}undef};
	$EG{RETBL}=sub{my($a,$b,$g,$h)=@_;my($d,$e,$f)=$b=~/^(\w*)(:([\w:]*))?$/;''eq$d&&($d='_');$e?&$rt($d,&envget($f)):$EV{"r$d"}};
	$EP{RETBL}=sub{
		my($a,$b,$c)=@_;
		my($d,$e,$f)=$b=~/^(\w*)(:([\w:]*))?$/;''eq$d&&($d='_');
		if($e){&envset($f,&$rt($d,$c))
		}else{my@g=();$EV{"e$d"}=\@g;$EV{"r$d"}=$c;@g=split/\n/,$c}};
	$EG{HASHTBL} = sub{
		my($a, $b) = @_;
		my($d, $e, $f) = $b =~ /^(\w*)(:([\w:]*))?$/;
		$d eq '' && ($d = '_');
		if($e){
			$e = $EV{"h$d"};
			$$e{ &envget($f) };
		}else{
			$EV{"t$d"};
		}
	};
	$EP{HASHTBL} = sub{
		my($a, $b, $c) = @_;
		my($d, $e, $f) = $b =~ /^(\w*)(:([\w:]*))?$/;
		$d eq '' && ($d = '_');
		if($e){
			$e = $EV{"h$d"};
			&envset($f, $$e{$c}) if $e;
		}else{
			my %g = ();
			$EV{"h$d"} = \%g;
			$EV{"t$d"} = $c;
			for $b (split /\n/, $c){
				($e, $f) = split /,/, $b, 2;
				$g{$e} = $f;
			}
		}
	};
	my $rl = sub{
		my($c, @p, @c) = @_;
		local $_;
		return $c if $ES{RESSLINE} !~ /%s/;
		$c =~ s/(<a href=[^<>]+>)\[CLICK HERE\](<\/a >)/$1$ES{ANCHOR}$2/gi;
		$c =~ s/<pre>/\01/gi;
		$c =~ s/<\/pre>/\02/gi;
		$c =~ s/\01([^\01\02]*)\02/push @p, $1; "<$#p>"/eg;
		@c = split /<br>/i, $c;
		map{
			$c = $_;
			$c =~ s/<[^>]*>//g;
			$_ = sprintf($ES{RESSLINE}, $_) if $c =~ /^(&gt;|#|＞|＃)/i;
		} @c;
		$c = join "<br>", @c;
		$c =~ s/<(\d+)>/"<pre>$p[$1]<\/pre>"/eg;
		$c;
	};
	$EG{RESSLINE} = sub{&$rl(&envget($_[1]))};
	$EP{RESSLINE} = sub{&envset($_[1],&$rl($_[2]))};
	my $ia = sub{
		my($c, $d, @p) = @_;
		$c =~ s/<pre>/\01/gi;
		$c =~ s/<\/pre>/\02/gi;
		$c =~ s/\01([^\01\02]*)\02/push @p, $1; "<$#p>"/eg;
		$ES{IMAGEADDR} ?
			$c =~ s/image:((\/\/)?[\w~\/\.\-]+\.(gif|jpe?g|png))(;(<br>)?)?/<a href="http:$1" target="_blank"><img src="$ES{IMAGEADDR}" border=0 alt="http:$1"><\/a>/gi :
			$c =~ s/image:((\/\/)?[\w~\/\.\-]+\.(gif|jpe?g|png))(;(<br>)?)?/<img src="http:$1" alt="http:$1">/gi;
		$c =~ s/<(\d+)>/"<pre>$p[$1]<\/pre>"/eg;
		$c;
	};
	$EG{IMAGEADDR} = sub{&$ia(&envget($_[1]))};
	$EP{IMAGEADDR} = sub{&envset($_[1],&$ia($_[2]))};
	if(defined $MTX::CHARCODE){
		$EG{TAGRECOVER} = sub{&MTX::tagrecover(&envget($_[1]))};
		$EG{HEADLINE} = sub{&MTX::headline(&envget($_[1]),$ES{$_[0]}||40,"...")||"(none)"};
		$EP{HEADLINE} = sub{&envset($_[1],&MTX::headline($_[2],$ES{$_[0]}||40, "...")||"(none)")};
		$EG{PINDEX} = sub{
			my($a, $b, $c) = @_;
			$c = &envget($b);
			$MTX::CHARCODE eq 'sjis' ? &MTX::snarrk(\$c) : &MTX::narrk(\$c);
			&MTX::headline($c, ($ES{$a} || 16));
		};
		$EP{PINDEX} = sub{
			my($a, $b, $c) = @_;
			$MTX::CHARCODE eq 'sjis' ? &MTX::snarrk(\$c) : &MTX::narrk(\$c);
			&envset($b, &MTX::headline($c, ($ES{$a} || 16)));
		};
		my $td = sub{
			my($c) = @_;
			$c =~ s/<pre>/\01/gi;
			$c =~ s/<\/pre>/\02/gi;
			&MTX::tagdeath(\$c);
			$c =~ s/\01/<pre>/gi;
			$c =~ s/\02/<\/pre>/gi;
			$c;
		};
		$EG{TAGDEATH} = sub{&$td(&envget($_[1]))};
		$EP{TAGDEATH} = sub{&envset($_[1],&$td($_[2]))};
		my $tt = sub{
			my($c) = @_;
			$MTX::CHARCODE eq 'sjis' && &MTX::sjis2euc(\$c);
			&MTX::tagtrue(\$c);	# $c =~ s/(<br>)/$1\n/gi;
			$MTX::CHARCODE eq 'sjis' && &MTX::euc2sjis(\$c);
			$c;
		};
		$EG{TAGTRUE} = sub{&$tt(&envget($_[1]))};
		$EP{TAGTRUE} = sub{&envset($_[1],&$tt($_[2]))};
	}
}
__END__