File Coverage

blib/lib/Ham/Reference/Callook.pm

Criterion	Covered	Total	%
statement	7	9	77.7
branch			n/a
condition			n/a
subroutine	3	3	100.0
pod			n/a
total	10	12	83.3

package Ham::Reference::Callook;

# --------------------------------------------------------------------------
# Ham::Reference::Callook - An interface to the Callook.info Database Service
#
# Copyright (c) 2010-2011 Brad McConahay N8QQ.
# Cincinnati, Ohio USA
# --------------------------------------------------------------------------

use strict;
use warnings;
use XML::Simple;
use LWP::UserAgent;
use vars qw($VERSION);

our $VERSION = '0.02';

my $callook_url = "http://callook.info/";
my $site_name = 'Callook.info';
my $default_timeout = 10;
my $default_type = 'xml';

sub new
{
	my $class = shift;
	my %args = @_;
	my $self = {};
	bless $self, $class;
	$self->_clear_errors;
	$self->_set_agent;
	$self->timeout($args{timeout});
	$self->type($args{type});
	return($self);
}

sub listing
{
	my $self = shift;
	my $callsign = shift;
	$self->_clear_errors;
	$callsign =~ tr/a-z/A-Z/;
	$self->{_callsign} = $callsign;
	my $url = "$callook_url/$self->{_callsign}/$self->{_type}";
	if ($self->{_type} eq 'text')
	{
		$self->{_data} = $self->_get_http($url);
	}
	elsif ($self->{_type} eq 'xml')
	{
		$self->{_data} = $self->_get_xml($url);
	}
	else # unknown type
	{
		$self->{is_error} = 1;
		$self->{error_message} = "Unknown type: $self->{_type}";
		$self->{_data} = undef;
	}
	return $self->{_data};
}

sub timeout
{
	my $self = shift;
	my $timeout = shift || $default_timeout;
	$self->{_timeout} = $timeout;
}

sub type
{
	my $self = shift;
	my $type = shift || $default_type;
	$self->{_type} = $type;
}

sub is_error { my $self = shift; $self->{is_error} }
sub error_message { my $self = shift; $self->{error_message} }


# -----------------------
#	PRIVATE
# -----------------------

sub _set_agent
{
	my $self = shift;
	$self->{_agent} = "Perl-Module-Ham-Reference-Callook-$VERSION";
}

sub _get_xml
{
	my $self = shift;
	my $url = shift;
	my $content = $self->_get_http($url);
	return undef if $self->{is_error};
	chomp $content;
	$content =~ s/(\r|\n)//g;
	my $xs = XML::Simple->new( SuppressEmpty => 0 );
	my $data = $xs->XMLin($content);
	return $data;
}

sub _get_http
{
	my $self = shift;
	my $url = shift;
	$self->_clear_errors;
	my $ua = LWP::UserAgent->new( timeout=>$self->{_timeout} );
	$ua->agent( $self->{_agent} );
	my $request = HTTP::Request->new('GET', $url);
	my $response = $ua->request($request);
	if (!$response->is_success) {
		$self->{is_error} = 1;
		$self->{error_message} = "Could not contact $site_name - ".HTTP::Status::status_message($response->code);
		return undef;
	}
	return $response->content;
}

sub _clear_errors
{
	my $self = shift;
	$self->{is_error} = 0;
	$self->{error_message} = '';
}


1;
__END__