package BE::Lib;  # assumes Some/Module.pm

use strict;
use warnings;
use Socket;

BEGIN {
	use Exporter   ();
	our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS);

	# set the version for version checking
	$VERSION     = 0.01;

	@ISA         = qw(Exporter);
	@EXPORT      = qw(
		&url_deescape
		&url_addbase
		&url_loadtldomain
		&url_getdomain
		&read_iplist
		&loadlist
		&loadtable
		&ipinlist);
	%EXPORT_TAGS = ( );     # eg: TAG => [ qw!name1 name2! ],

	# your exported package globals go here,
	# as well as any optionally exported functions
	@EXPORT_OK   = (); #qw(&func3);
}
our @EXPORT_OK;

# exported package globals go here
#our %Hashit;

# non-exported package globals go here
our @TLTLD;

# initialize package globals, first exported ones
#$Var1   = '';
#%Hashit = ();

# then the others (which are still accessible as $Some::Module::stuff)
@TLTLD=();

# file-private lexicals go here
#my $priv_var    = '';
#my %secret_hash = ();

sub normalize_domain{
	$_=shift;
	if(/[^.]{7}$/){
		s/(biz|com|net|org)$/.$1/;
	}
	return $_;
}
                                                
sub url_deescape($@)
{
	use URI::URL;
	use URI::Escape;

	my $url=shift;
	my @opts=@_;
	
	my $redir=undef;
	
	$url=~s~\\~/~;
	my @url=split(/&/,$url);
	map($_=uri_escape(uri_unescape($_),'^-a-zA-Z0-9\@\$/?:;*.,=_!~(){}/\''),@url);
	$url=join('&',@url);
	$url=~s/(https?:\/\/[^\/]+)/\L$1\E/;
	$url=~m~^(https?:/+)?([0-9a-z]+\@)?([^/\?:]+)~i;
	my $domain=$3;
	if(grep($_ eq "redir",@opts)){
		if(($url=~s;^http://(((eur|us)\.)?rds?|drs|pa)\.yahoo\.com/.*\*-?;;i)
		|| ($url=~s;http://ads\.msn\.com/ads/adredir\.asp\?.*?&url=;;i)
		|| ($url=~s;http://g.msn.com/.*?\?;;i)
		|| ($url=~s;http://urllog.com/\w+/;;i)
		|| ($url=~s;http://adlog.com.com/adlog/.*?=/http;http;i)
		|| ($url=~s;http://www\d+\.gmx\.net/de/cgi/derefer\?TYPE=1&DEST=http;http;i))
		{
			$url=~s/(https?:\/\/[^\/]+)/\L$1\E/i;
			$redir=["redir",$domain,$url];
	}	}
	if(grep($_ eq "correct",@opts)){
		$url=~s~^(https?:/+)?([0-9a-z]+\@)?([^/\?:]+)~
		      ($1?$1:'').($2?$2:'').normalize_domain($3)~eix;
	}
	return wantarray?($url,$redir):$url;
}

sub url_addbase($$){
	my $url;
	($_,$url)=@_;
	$url=~m~^(\S+:/+[\w.]+)~;
	my $base=$1;
	$_=url_deescape($_);
	if(!(m~\w+:/+~)) {
		if(/^\//) {$_= "$base$_";}
		else{$_="$url/$_";}
	}
	return $_;
}

sub loadlist(\@$) {
	local $/="\n";
	open(F,'<',$_[1]) || die "$_[1]: $!";
	@{$_[0]}=<F>;
	close(F);
	map(chomp,@{$_[0]});
}

sub loadtable(\%$;$) {
	my $h=$_[0];
	my $max_split=$_[2]||65535;
	local $/="\n";
	open(F,'<',$_[1]) || die "$_[1]: $!";
	while(<F>){
		chomp;
		my @F=split(/\s+/,$_,$max_split);
		if(@F>1){${$h}{$F[0]}=$F[1]}
	}
	close(F);
}

sub url_loadtldomain($){loadlist(@TLTLD,$_[0])}

sub url_getdomain($){
	if($_[0]=~m~^(https?:/+)?(www\.)?([0-9a-z]+\@)?([^/\?:'">]+)~i){
		if(!wantarray){return $4}
		my $domain=$4;
		my @domain=($4);
		if($domain=~/^(\d+\.){0,3}\d+$/){return @domain}
		for my $a (@TLTLD){
			if($domain=~/(\.?)([^.]+\.\Q$a\E)$/){
				$domain[1]=$2;
				return(@domain);
			}
		}
		if($domain=~/([^.]+\.[^.]+)\.?$/){
			$domain[1]=$1;
		}
		return(@domain);
	}
	return undef;
}

sub read_iplist($){
	if(open(GOODIP,'<',$_[0])) {
		my %ips=();
		for(map([split(/\s+/,$_,3)],
		          grep(!/^#|^$/,
		               <GOODIP>))){
			if(!${$_}[2]){
				${$_}[2]=${$_}[1];
				${$_}[1]=0xffffffff;
			}elsif(${$_}[1]=~/^\d+$/){
				${$_}[1]=(${$_}[1]== 0)?0:~((1<<(32-${$_}[1]))-1);
			} else {
				${$_}[1]=unpack('N',inet_aton(${$_}[1]));
			}
			${$_}[0]=unpack('N',inet_aton(${$_}[0]));
			$ips{${$_}[0]}=[${$_}[1],${$_}[2]];
			#print "added ${$_}[0] ${$_}[1] ${$_}[2]";
		}
		close(GOODIP);
		return %ips;
	}else{return undef}
}

sub ipinlist($\%)
{
	my $ip=$_[0];
	my %ips=%{$_[1]};
	$ip=inet_aton($ip);
	if(!defined($ip)){return undef}
	my $IP=unpack('N',$ip);
	my $i;
	for($i=0;$i<=31;$i++){
		my $R=(~((1<<$i)-1));
		my $IP2=$IP&$R;
		if(!$ips{$IP2}){next}
		my ($r,$b)=@{$ips{$IP2}};
		if($b){
			if($r==$R){return $b}
			return "";
		}
	}
	return "";
}



END { }  # module clean-up code here (global destructor)

1; # don't forget to return a true value from the file