File Coverage

blib/lib/Mail/Maps/Lookup.pm

Criterion	Covered	Total	%
statement	36	47	76.6
branch	2	12	16.6
condition			n/a
subroutine	9	9	100.0
pod	2	4	50.0
total	49	72	68.0

package Mail::Maps::Lookup;

use strict;
use warnings;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK $LIBRARY);

use Exporter ();
@ISA = qw(Exporter);
@EXPORT_OK = qw(host activation_code ip_address);

$VERSION = '0.02';
$LIBRARY = __PACKAGE__;

use Net::DNS;

$|=1;

sub new {
	my $class = shift;
	my $self = bless {}, $class;
	return $self->init(@_);
}

sub init {
	my $self = shift;
	my %args = @_;

	map($self->{$_}=$args{$_}, keys %args);

	return $self;
}

sub lookup {
	my $self = shift;

	my $host            = $self->{host};
	my $activation_code = $self->{activation_code};
	my $ip_address      = $self->{ip_address};

	$host = $host ? $host : "r.mail-abuse.com";

	my $reverse_ip_address = reverse_ip($ip_address);
	my $address = "0.0.0.0.$activation_code.r.mail-abuse.com.";

	my $res = Net::DNS::Resolver->new;
	my $query = $res->search("$address",'A');

	if ($query){
		if ($res->errorstring =~ /NOERROR/){
			my $address = "$reverse_ip_address.$activation_code.$host.";
			my $res = Net::DNS::Resolver->new;
			my $query = $res->search("$address",'A');
			if ($res->errorstring =~ /NOERROR/){
				foreach my $rr ($query->answer){
					if ($rr->type eq "A"){
						$res = "address";
						if ($rr->$res){
							# listed
							return 1;
						}
					}
				}
			} else{
				# not listed
				return 0;
			}
		}
	} else{
		# unable to connect to maps server or invalid activation code
		return 2;
	}
}

sub reverse_ip {
	my $ip = shift;
	my @ad = split ('\.', $ip);
	return join('.', reverse(@ad));
}

1;
__END__