File Coverage

blib/lib/Telephone/Lookup/Americom.pm

Criterion	Covered	Total	%
statement	26	26	100.0
branch	2	4	50.0
condition	1	3	33.3
subroutine	4	4	100.0
pod	0	2	0.0
total	33	39	84.6

package Telephone::Lookup::Americom;
our $VERSION = 0.01;

use strict;

use LWP::Simple;


sub new {
	my $type = shift;
	my $class = ref($type) || $type;
	my $self = {};
	bless $self, $class;
	return $self;
}

sub lookup {
	my ($self, $query) = @_;
	my $url = "http://decoder.americom.com/decoderscript?Search=$query&handle=101";

	## Using LWP::Simple to get the html content
	my $content = get($url);

	## Format the content, naively, making it easier to parse
	$content =~ s/[\r\n]+//g;       ## get rid of newlines
	{
	    local $/;                   ## clear default newline separator
	    $content =~ s/<[^>]*>//gs;  ## strip html comments.  not a very good method, but works for us
	}

	my (@results);

	## AREA_CODE Record match
	if ($content =~ /Found Area Code Match(.?\d+-\d{3}) .{10}(.*?)Created on (.*?\d{4}).*?((Area)|( Country)|( Found))/) {
		my $record = { _type => 'AREA_CODE',
				area_code => $1,
				location => $2,
				created_on => $3
				};
		push(@results, $record);
	}

	## EXCHANGE_CODE Record match
	if ($content =~ /Exchange Location:..(.*?)Exchange Type:..(.*?)Owner:..(.*?)Created On:..(.*?\d{4})/) {
		my $record = { _type => 'EXCHANGE_CODE',
				exchange_location => $1,
				exchange_type => $2,
				exchange_owner => $3,
				created_on => $4
				};
		push(@results, $record);
	}

	return @results;
}

1;
__END__