use Date::Parse;
use Digest::MD5  qw(md5 md5_hex md5_base64);
use IPC::Open2;
#use EPIC ();
EPIC::cmd "echo Loading Perl.";

sub encode {
	local @ret=@_;
	map {
		$_=unpack "H*",$_;
		tr/0-9a-f/A-P/;
	} @ret;
	wantarray ? @ret : "@ret";
}

sub decode {
	local @ret=@_;
	map {
		tr/A-P/0-9a-f/;
		$_=pack "H*",$_;
	} @ret;
	wantarray ? @ret : "@ret";
}

sub enquote {
	my %trans=("\0"=>"\\0", "\001"=>"\\a", "\n"=>"\\n", "\r"=>"\\r", "\\"=>"\\\\");
	my @ret=@_;
	my $foo;
	@ret=map {
		s/[\0\001\n\r\\]/$trans{$&}/g;
		$_;
	} @ret;
	wantarray ? @ret : "@ret";
}

sub dequote {
	my %trans=("\\0"=>"\0", "\\a"=>"\001", "\\n"=>"\n", "\\r"=>"\r", "\\\\"=>"\\");
	my @ret=@_;
	my $foo;
	@ret=map {
		s/\\[0anr\\]/$trans{$&}/g;
		$_;
	} @ret;
	wantarray ? @ret : "@ret";
}

sub encrypt {
	my ($RD,$WD);
	my $proto=shift;
	my $key=shift;
	my @ret=@_;
	@ret=map {
		local $/=0777;
		open2($RD,$WD,"gpg","-c","--batch","--passphrase-fd","0","--cipher-algo",$proto);
		print $WD "$key\n";
		print $WD $_;
		close $WD;
		<$RD>;
	} @ret;
	wantarray ? @ret : "@ret";
}

sub decrypt {
	my ($RD,$WD);
	my $proto=shift;
	my $key=shift;
	my @ret=@_;
	@ret=map {
		local $/=0777;
		open2($RD,$WD,"gpg","--batch","--passphrase-fd","0");
		print $WD "$key\n";
		print $WD $_;
		close $WD;
		<$RD>;
	} @ret;
	wantarray ? @ret : "@ret";
}

sub encryptquot { enquote encrypt @_ }
sub encryptcode { encode encrypt @_ }
sub dequotecode { map {/^([A-P]{2})+$/ ? decode($_) : dequote($_)} @_ }
sub decrypttext { decrypt shift,shift,dequotecode @_ }

sub splitcall {
	my @ret = map {
		my ($sub, $args, $foo) = split /\s+/,$_,3;
		my @foo = split /\s+/,$foo,$args;
		&$sub(@foo);
	} @_;
	wantarray ? @ret : "@ret";
}

sub poper {
	local $arg=shift;
	pop @$arg;
}

sub pusher {
	local $arg=shift;
	push @$arg, @_;
}

sub shifter {
	local $arg=shift;
	shift @$arg;
}

sub regextrans {
	map {
		s/(.)\s+(.)/$1|$2/g;
		s/[\\\+\*\.]/\\$&/g;
		s/\?/./g;
		s/\*/.*/g;
		s/%/\\S*/g;
	} @_;
	wantarray ? @_ : "@_" ;
}

sub clearhigh {
	$_ =~y/\x80-\xff/\x00-\x7f/ for @_;
	wantarray ? @_ : "@_" ;
}

#
# General IRC stuff.
#

sub attr2html {
	map {
		s/\x02(.*?)\x02/<b>\1<\/b>/g;
		s/\x16(.*?)\x16/<i>\1<\/i>/g;
		s/\x1f(.*?)\x1f/<u>\1<\/u>/g;
	} @_;
	wantarray ? @_ : "@_";
}

#
# Epic stuff.
#

sub listfix {
	local @expr;
	push @expr,"^assign last[eserv] $eserv";
	push @expr,"^assign lag[\$servernum()][activity] ".time;
	push @expr,"\@lag[\$servernum()][received]+=".$length;
	if ($_[0] =~ /!.*\@/) {
		$_[2] =~ s/^://;
		local ($efrom,$eto)=encode map{lc} @_[0,2];
		#push @expr,"^assign last[$eserv][from] $_[0]";
		#push @expr,"^assign last[$eserv][efrom] $efrom";
		#push @expr,"^assign lag[\$servernum()][nonpong] ".time;
		push @expr,"^assign list[nuh][$efrom] ".time;
		if ($_[2] eq $nick) {
		} elsif ($_[1] =~ /^(PRIVMSG|NOTICE|JOIN|PART|TOPIC|MODE|KICK)$/) {
			push @expr,"defer uhfix.wason $_[2] \$chanusers($_[2])" if $& eq "KICK" and $_[3] eq $nick;
			push @expr,"defer wiq \$chanusers($_[2])" if $& eq "KICK" and $_[3] eq $nick;
			#push @expr,"\@list[chan][$eto][net][\$servergroup(\$lastserver())]=".time;
			push @expr,"^assign list[chan][$eto][nuh][$efrom] ".time;
		}
	} else {
		#push @expr,"^assign last[$eserv][from] 0","^assign last[$eserv][efrom] 0";
		if ($_[1] eq "PONG") {
#			$_[3] =~ s/[\D\.]//;
#			push @expr,"^assign lag[\$servernum()][pong] ".time;
#			push @expr,"^assign lag[\$servernum()][ping] ".(0<$_[3] ? $_[3]+$^T : "?");
#			push @expr,"^assign lag[\$servernum()][lag] ".(0<$_[3] ? time-$_[3]-$^T : "?");
#			push @expr,"^assign lag[\$servernum()][pingorpong] ".(0<$_[3] ? $_[3]+$^T : time);
		} elsif ($_[1] < 300 || $_[1] >= 400) {
		} elsif ($_[1] == 314 || $_[1] == 311) {
		} elsif ($_[1] == 318 || $_[1] == 369) {
		} elsif ($_[1] == 302) {
		} elsif ($_[1] == 322) {
		} elsif ($_[1] == 352) {
			local $enuh = encode lc "$_[7]!$_[4]\@$_[5]";
			local $chan = encode lc $_[3];
			#push @expr, "assign.ifnul list[chan][$chan] ".time;
			push @expr, "assign.ifnul list[chan][$chan][nuh][$enuh] ".time if $_[7] ne $nick;
			push @expr, "assign.ifnul list[chan][$chan][onuh][$enuh] ".time if $_[8]=~/\@/;
			push @expr, "assign.ifnul list[onuh][$enuh] ".time if $_[8]=~/\*/;
			push @expr, "assign.add list[nuh][$enuh][servers] $_[6]";
			push @expr, "\@list[nuh][$enuh][flags]=chr(\$uniq(\$ascii($_[8]\$list[nuh][$enuh][flags])))";
			#push @expr, "if (isuser(\$decode($enuh))){slownotify $_[7]}";
		} elsif ($_[1] == 312) {
		} elsif ($_[1] == 313) {
		} elsif ($_[1] == 319) {
		} elsif ($_[1] == 329) {
		} else {
		}
	}
	EPIC::eval @expr;
}

sub interesting {
	local $foo;
	local @line=@_;
	local $line=pop @line;
	push @line, "." if 2 > $#line;
	local $type=$line[1];
	$type="msg" if $type=~/^(PRIVMSG|NOTICE|TOPIC|QUIT)$/;
	if ($wwordwatch{$type}&&$wwordnot{$type}&&int(rand(20))) {
	} else {
		($foo,$bar)=EPIC::expr "wordwatch##[ ]##(wordwatch[$type]?wordwatch[$type]:wordwatch[other])","wordnot##[ ]##(wordnot[$type]?wordnot[$type]:wordnot[other])";
		regextrans($wordwatch{$type} = $foo) unless $foo eq $wwordwatch{$type}; $wwordwatch{$type} = $foo;
		regextrans($wordnot{$type} = $bar) unless $bar eq $wwordnot{$type}; $wwordnot{$type} = $bar;
	}
	local @foo = grep {!/\b($wordnot{$type})\b/i} (/\b($nick|$wordwatch{$type})\b/xgi);
	EPIC::cmd "interesting.show @line $line" if @foo or "\L$nick" eq "\L$line[2]";
}

sub raw_hook {
	local ($eserv,$lastserver,$nick,undef) = map{lc} EPIC::expr 'serversref()','lastserver()','servernick()';
	local $eserv = encode $eserv;
	for (@_) {
		local $length=length;
		local @line;
		push @line,$1 while s/^\s*([^:]\S*)\s*//;
		push @line,$_;
		listfix @line;
		interesting @line if $line[0]=~/!.*\@/;
	}
}

EPIC::cmd "echo Loaded Perl.";
return 1;