File Coverage

blib/lib/Ham/Scraper.pm

Criterion	Covered	Total	%
statement	16	18	88.8
branch			n/a
condition			n/a
subroutine	6	6	100.0
pod			n/a
total	22	24	91.6

package Ham::Scraper;

use 5.008008;
use strict;
use warnings;
use diagnostics;

use FileHandle;
use HTML::TableExtract;
use HTTP::Request::Common qw(GET POST);
use LWP::Simple;
use LWP::UserAgent;
use Net::HTTP;
use XML::Element;
use XML::TreeBuilder;

require Exporter;

our @ISA = qw(Exporter);
our @EXPORT_OK = ( [ qw(FindU FindUXml APRSWorld APRSWorldXml QRZ QRZxml) ] );

our $VERSION = '0.9';

sub AppendElement
{
	my $tree = shift;
	my $elementName = shift;
	my $elementContent = shift;

	my $element = XML::Element->new($elementName);
	$element->push_content($elementContent);
	$tree->push_content($element);

	return $tree;
}

sub CreateStationXml(\%)
{
	my %argumentHash = %{(shift)};
	my @now = localtime;
	my $date = $now[4] . '/' . $now[3];

	my $tree = XML::Element->new('station', 'local-date' => $date);

	foreach my $elementName (keys (%argumentHash))
	{
		&AppendElement($tree, $elementName, $argumentHash{$elementName});
	}

    return $tree;
}

sub WriteRawTextToFile
{
	my %stationInfo = @_;
	my $callsign = $stationInfo{Callsign};
	my $timestamp =$stationInfo{LastHeard};
	my $position = $stationInfo{Position};
	my $status = $stationInfo{Status};

	my $output = new IO::File("station.txt", O_WRONLY);

	print $output "Callsign: $callsign\n";
	print $output "Timestamp: $timestamp\n";
	print $output "Position (Latitude & Longitude), Region: $position\n";
	print $output "Status: $status\n";
}

sub PrintXmlTree
{
	my $tree = shift;
	print STDOUT $tree->as_XML;
}

sub WriteXmlTreeToFile
{
	my $xmlTree = shift;
	my $handle = new IO::File ">station.xml" or die "Can't open station.xml for writing\n";
	print $handle $xmlTree;
}

sub FindU
{
	# Our requesting agent. Define our URL and POST.
	my $baseUrl  = 'http://www.findu.com/cgi-bin/find.cgi';
	my $post = "call=" . shift;

	# Here are the headers we'll send off...
	my $headers = HTTP::Headers->new(Accept => 'text/plain',
	                 'User-Agent' => 'AutoLookup/1.0');

	# and the final requested web page.
	my $uable = HTTP::Request->new('POST', $baseUrl, $headers, $post);
	my $userAgent = LWP::UserAgent->new;
	my $request = $userAgent->request($uable);

	die $request->message unless $request->is_success;

	my $webPage = $request->content;

	$webPage =~ s/(<[^>]*>)*//isg; # Remove all HTML tags
	$webPage =~ s/ / /g; # As well as NBSPs

	my $callsign = "N/A";
	if ($webPage =~ m/Position of ([A-Z]{1,2}[0-9]{1}[A-Z]{2,3})/)
	{
		$callsign = $1;
	}
	# Write a regex that matches the following string:
	# 	1.2 miles southwest of Bolingbrook, IL
	#	(\d)*.(\d)*\s(rest of string)

	my $status = "N/A";
	if ($webPage =~ m/Status: ([^,]*)/g)
	{
		$status = $1;
	}

	my $reportReceived = "N/A";
	if ($webPage =~ m/Report received  ([^\n]*)/)
	{
		$reportReceived = $1;
	}

	my $rawPacket = "N/A";
	if ($webPage =~ m/Raw packet: ([^\n]*)/)
	{
		$rawPacket = $1;
	}

	return ( Callsign=>$callsign, LastHeard=>$reportReceived, Status=>$status );
}

sub FindUXml
{
	my $queryCallsign = shift;
	my %aprsInfo = FindU($queryCallsign);
	my $xmlTree = CreateStationXml(%aprsInfo)->as_XML;
	return $xmlTree;
}

sub APRSWorld
{
	my $queryCallsign = shift;
	my $baseUrl = "http://db.aprsworld.net/datamart/switch.php?call=$queryCallsign&table=position&maps=yes";

	my $webPage = get("$baseUrl") or die $!;

	my $tableData = new HTML::TableExtract->new(headers => [
	    "Callsign", "Date", "Latitude / Longitude", "Status"]);
	$tableData->parse($webPage);

	my $callsign;
	my $position;
	my $timestamp;
	my $status;

	foreach my $tableStates ($tableData->table_states) {
	    foreach my $row ($tableStates->rows) {

	        my $currentCallsign = @$row[0];
	        next if length $currentCallsign == 0;
	        $callsign = $currentCallsign;

	        $timestamp = "Timestamp not available";
	        if (defined(@$row[1])) {
	        	$timestamp = @$row[1];
	        }

	        $position = "Position not available";
	        if (defined(@$row[2])) {
	        	$position = @$row[2];
	        }

	        $status = "Status not available";
	        if (defined(@$row[4])) {
	        	$status = @$row[4];
	        }
	    }
	}

	return ( Callsign=>$callsign, Position=>$position, LastHeard=>$timestamp, Status=>$status );
}

sub APRSWorldXml
{
	my $queryCallsign = shift;
	my %aprsInfo = APRSWorld($queryCallsign);
	my $xmlTree = CreateStationXml(%aprsInfo)->as_XML;
	return $xmlTree;
}

sub QRZ
{
	my $queryCallsign = shift;
	my $baseUrl = "http://www.qrz.com/detail/";

	my $webPage = get("$baseUrl$queryCallsign") or die $!;
	$webPage =~ s/(<[^>]*>)*//isg;
	$webPage =~ s/ / /g;

	$webPage =~ m/Name:([^\n]*)/;
	my $name = $1;

	# This pattern currently does not match!
	$webPage =~ m/Class: (Novice|Technician|General)/;
	my $class = $1;

	$webPage =~ m/GMT Offset:([^\n]*)/;
	my $gmtOffset = $1;

	$webPage =~ m/Time Zone:([^\n]*)/;
	my $timeZone = $1;

	$webPage =~ m/Addr2:([^\n]*)/;
	my $cityStateZip = $1;

	$webPage =~ m/County:([^\n]*)/;
	my $county = $1;

	$webPage =~ m/Grid:([^\n]*)/;
	my $grid = $1;

	return ( Name=>$name, Class=>$class, CityStateZip => $cityStateZip, GMTOffset=>$gmtOffset, TimeZone=>$timeZone, Grid=>$grid );
}

sub QRZxml
{
	my $queryCallsign = shift;
	my %qrzInfo = QRZ($queryCallsign);
	my $xmlTree = CreateStationXml(%qrzInfo)->as_XML;
	return $xmlTree;
}

1;
__END__