File Coverage

blib/lib/Geo/Caching.pm

Criterion	Covered	Total	%
statement	10	12	83.3
branch			n/a
condition			n/a
subroutine	4	4	100.0
pod			n/a
total	14	16	87.5

package Geo::Caching;

use strict;
use warnings;
use WWW::Mechanize;
use Geo::Cache;
use Geo::Gpx;
use XML::Simple;

# Docs {{{

=head1 NAME

Geo::Caching - Object interface for querying Geocaching.com website

=head1 SYNOPSIS

    use Geo::Caching;
    my $gc = new Geo::Caching(
        login       => 'casey',   # Your Geocaching username
	password    => 'mypass',  # Your Geocaching password
	max_results => 500,	 # Max number of caches to return
	cache_days  => 3,	 # Cache results for 3 days
	cache_dir   => '/tmp/geocache' #directory to cache into
    );

    ### Get one Geo::Cache
    my $cache = $gc->get('GCMMVH');

    ### Get Geo::Cache list that my user found
    my @caches = $gc->query(
	type => 'UL',
	username => 'cpnkr,
    );


    #### List of valid query types
    ####################################
    # ZIP => By Postal Code
    # WPT => By Coordinate
    # UL  => By Username (Found)
    # U   => By Username (Hidden)
    # WN  => By Waypoint Name
    ####################################
    ####

=head1 DESCRIPTION

Provide an object interface to query Geocaching.com

=head1 AUTHOR

	Casey Lee
	[e-mail]

=head1 COPYRIGHT

This program is free software; you can redistribute
it and/or modify it under the same terms as Perl itself.

The full text of the license can be found in the
LICENSE file included with this module.

=cut

# }}}

use vars qw($VERSION $AUTOLOAD);
$VERSION = '0.11';

# sub new {{{

sub new {
    my $class = shift;
    my $params = { @_ };
    my $self = {};
    my %config = ( login => ($params->{login} || ''),
		   password => ($params->{password} || ''),
		   max_results => ($params->{max_results} || 500),
		   sleep => ($params->{sleep} || 1),
		   cache_days => ($params->{cache_days} || 1),
		   cache_dir => ($params->{cache_dir} || '/tmp/geocache'),
		 );

    $self = bless( \%config, ref($class) || $class );

    return ($self);
} # }}}

# AUTOLOADER {{{

sub AUTOLOAD {
    my $self = shift;
    my $val = shift;
    my ( $method );
    ( $method = $AUTOLOAD ) =~ s/.*:://;

    if (defined $val) {
        $self->{$method} = $val;
    } else {
        # Use the existing value
    }

    return $self->{$method};
} # }}}


sub get {
	my $self = shift;
	my $wpt  = shift;

	##########################
	my $login_url = 'http://www.geocaching.com/login/default.aspx';
	my $details_url = 'http://www.geocaching.com/seek/cache_details.aspx';
	##########################

	my $login = $self->{login};
	my $password = $self->{password};

	my $mech = new WWW::Mechanize(cookie_jar => {});

	# login to geocaching.com
	$mech->get($login_url);
	$mech->field('myUsername', $login);
	$mech->field('myPassword', $password);
	$mech->click_button(value => 'Login');

	# get the user's caches
	$mech->get("$details_url?WP=$wpt");
	my $res = $mech->click_button(name => 'btnGPXDL');
	my @caches = $self->parse_gpx(xml => $res->content());

	return $caches[0];
}

sub query {
	my $self = shift;
	my $args = {@_};

	##########################
	my $login_url = 'http://www.geocaching.com/login/default.aspx';
	my $nearest_url = 'http://www.geocaching.com/seek/nearest.aspx';
	##########################

	my $login = ($args->{login} || $self->{login});
	my $password = ($args->{password} || $self->{password});
	my $sleep = ($args->{sleep}      || $self->{sleep});
	my $max   = ($args->{max_results} || $self->{max_results} || 500);
	my $type  = $args->{type};
	my $cache_list = ($args->{cache_list} || []);
	my $cache_dir = ($args->{cache_dir} || $self->{cache_dir});
	my $cache_days = ($args->{cache_days} || $self->{cache_days});
	my $no_cache = $args->{no_cache};

	my $query;

        `mkdir -p $cache_dir`;

	####################################
	# ZIP => By Postal Code
	# WPT => By Coordinate
	# SC  => By State/Country
	# KW  => By Keyword
	# UL  => By Username (Found)
	# U   => By Username (Hidden)
	# WN  => By Waypoint Name
	####################################

	if($type eq 'ZIP') {
		my $zip = $args->{zipcode};
		if($zip =~ /^\d{5}$/) {
			$query = "ZIP=$zip";
		}
	} elsif ($type eq 'WPT') {
		my $lat = $args->{lat};
		my $lon = $args->{lon};

		if($lat =~ /^[-\d\.]+$/ &&
		   $lon =~ /^[-\d\.]+$/) {
			$query = "LAT=$lat&LON=$lon";
		}
	} elsif ($type eq 'SC') {
	} elsif ($type eq 'KW') {
	} elsif ($type eq 'UL') {
		my $user = $args->{username} || $self->{login};
		$query = "UL=$user";
	} elsif ($type eq 'U') {
		my $user = $args->{username} || $self->{login};
		$query = "U=$user";
	} elsif ($type eq 'WN') {
		my $wpt = $args->{waypoint};
		if($wpt =~ /^GC(\w+)$/) {
			$query = "WN=$wpt";
		}
	} else {
		warn "Unsupported type: $type\n";
	}


	unless($query) {
		warn "Error...bailing out";
		return;
	}

	### caching
        my $t_file = $query;
        $t_file =~ s/[\.\/]//g;
        my $t_path = "$cache_dir/$t_file";


        ### Use the cache
        if(!$no_cache
           && (-e $t_path)
           && (-M $t_path < $cache_days))
        {
		my $content;
		open (F, $t_path);
		while() {$content .= $_};
		close(F);
		$self->parse_gpx(xml => $content,
				 cache_list => $cache_list,
				 );
		return @$cache_list;
        }


	if($query =~ /^WN/) {
		push @$cache_list, $self->get($args->{waypoint});
	} else {
		my $mech = new WWW::Mechanize(cookie_jar => {});
		my $cache_attribs = {};

		# login to geocaching.com
		$mech->get($login_url);
		$mech->field('myUsername', $login);
		$mech->field('myPassword', $password);
		$mech->click_button(value => 'Login');

		# get the user's caches
		$mech->get("$nearest_url?$query");

		my $page = 1;
		while((scalar @$cache_list) < $max) {

			## Get some info about each cache
			my $c = $mech->content;
			$c =~ m{(.*?)}is;
			my $t = $1;
			my @rows = $t =~ m{\s*\s*(.*?)
			shift @rows;
			foreach my $r (@rows) {
				my @cells = $r =~ m{(.*?)
				my $attribs = {};
				my $name = '';

				## force init of cells
				for(my $ci=0; $ci<8; $ci++) {
					$cells[$ci] ||= "";
				}

				## Get the cache name
				if($cells[5] =~ /\((GC.+)\)/) {
					$name = $1;
				}

				## Get the cache type
				if( $cells[2] =~ /
					$attribs->{type} = $1;
				}

				## Get the difficulty/terrain/size
				if($cells[3] =~ /\(([\d\.]+)\/([\d\.]+)\).*title="Size: (.*)"/) {
					$attribs->{difficulty} = $1;
					$attribs->{terrain} = $2;
					$attribs->{size} = $3;
				}

				## Get the dates
				$attribs->{hidden_date} = $cells[4];

				if(my @fdates = $cells[6] =~ m{(\d{2} \w{3} \d{2})}gs) {
					$attribs->{last_found_date} = $fdates[0];
					$attribs->{user_found_date} = $fdates[1];
				}

				# Get and chek the box, if it exists
				if($cells[7] =~ //i) {
				#	warn "$name -> $1: ".join(',',%$attribs)."\n";
					$mech->tick('CID',$1);

					## add the attribs to a hash keyed by GCNAME
					$cache_attribs->{$name} = $attribs;
				}
				else
				{
				}
			}
	if(0) {
			my @images = $mech->find_all_images(
				url_regex => qr/\/images\/WptTypes\/\d/);
			my @sym;
			foreach my $i (@images) {
				my $a = $i->alt();
				push @sym, $a;
			}

			my $form = $mech->form_number(1);
			my @cids = $form->find_input('CID','checkbox');
			foreach my $cid (@cids) {
				$cid->check();
			}
	}
			my $res = $mech->click_button(value => 'Download Waypoints');
			$self->parse_loc(xml => $res->content(),
					 cache_attribs => $cache_attribs,
					 cache_list => $cache_list);

			$mech->back();


			my $next_link = $mech->find_link( text_regex => qr/Next/i );
			if($next_link) {
				my $url = $next_link->url();
				if($url =~ /javascript:__doPostBack\('(.+)\$(.+)','(.*)'\)/) {
					my $target = "$1:$2";
					my $argument = $3;

					$mech->field('__EVENTTARGET',$target);
					$mech->field('__EVENTARGUMENT',$argument);
					$mech->submit();

					sleep $sleep if $sleep;  # be nice to geocaching.com :)
				}
			} else {
				last;
			}
		}
	}

	if(open(F,">$t_path"))
	{
		my $gpx = new Geo::Gpx(@$cache_list);
		print F $gpx->xml();
		close(F);
	}


	return @$cache_list;
}




sub parse_gpx {
	my $self = shift;
	my $args = {@_};
	my $xml = $args->{xml};
	my $caches = $args->{cache_list} || [];
	my $xs = new XML::Simple();
	my $ref = $xs->XMLin($xml);
	if(ref $ref->{wpt} eq 'ARRAY') {
		foreach my $w (@{ $ref->{wpt} }) {
			my $gc = new Geo::Cache(%$w);
			push @$caches, $gc;
		}
	} elsif(ref $ref->{wpt} eq 'HASH') {
		if(exists $ref->{wpt}->{name}) {
			my $gc = new Geo::Cache(%{$ref->{wpt}});
			push @$caches, $gc;
		} else {
			foreach my $k (keys %{ $ref->{wpt} }) {
				my $w = $ref->{wpt}->{$k};
				$w->{name} = $k;
				my $gc = new Geo::Cache(%$w);
				push @$caches, $gc;
			}
		}
	}

	return @$caches;
}

sub parse_loc {
	my $self = shift;
	my $args = {@_};
	my $xml = $args->{xml};
	my $caches = $args->{cache_list} || [];
	my $xs = new XML::Simple();
	my $ref = $xs->XMLin($xml);

	my $cache_attribs = $args->{cache_attribs} || {};

	if(ref $ref->{waypoint} eq 'ARRAY') {
		foreach my $w (@{ $ref->{waypoint} }) {
			my $attribs = $cache_attribs->{$w->{name}->{id}};
#warn $w->{name}->{id}."-->".join(",",%$attribs)."\n";
			my $desc = $w->{name}->{content}." (".$attribs->{difficulty}."/".$attribs->{terrain}.")";
			my $gc = new Geo::Cache(
				lat => $w->{coord}->{lat},
				lon => $w->{coord}->{lon},
				name => $w->{name}->{id},
				desc => $desc,
				time => 0,
				sym => 'Geocache',
				type  => ($w->{type}."|".($attribs->{type}||'Traditional Cache')),
				url  => $w->{link}->{content},   );
			push @$caches, $gc;
		}
	} else {
			my $w = $ref->{waypoint};
			my $attribs = $cache_attribs->{$w->{name}->{id}};
			my $desc = $w->{name}->{content}." (".$attribs->{difficulty}."/".$attribs->{terrain}.")";
			my $gc = new Geo::Cache(
				lat => $w->{coord}->{lat},
				lon => $w->{coord}->{lon},
				name => $w->{name}->{id},
				desc => $desc,
				time => 0,
				sym  => 'Geocache',
				type  => ($w->{type}."|".($attribs->{type}||'Traditional Cache')),
				url  => $w->{link}->{content},   );
			push @$caches, $gc;
	}

	return @$caches;
}

1;