File Coverage

blib/lib/Geo/Google.pm

Criterion	Covered	Total	%
statement	112	291	38.4
branch	16	100	16.0
condition	2	34	5.8
subroutine	20	26	76.9
pod	5	6	83.3
total	155	457	33.9

=head1 NAME

Geo::Google - Perform geographical queries using Google Maps

=head1 SYNOPSIS

  use strict;
  use Data::Dumper;
  use Geo::Google;

  #Allen's office
  my $gonda_addr = '695 Charles E Young Dr S, Los Angeles, Los Angeles, California 90024, United States';
  #Stan's Donuts
  my $stans_addr = '10948 Weyburn Ave, Westwood, CA 90024';
  #Roscoe's House of Chicken and Waffles
  my $roscoes_addr = "5006 W Pico Blvd, Los Angeles, CA 90019";

  #Instantiate a new Geo::Google object.
  my $geo = Geo::Google->new();

  #Create Geo::Google::Location objects.  These contain
  #latitude/longitude coordinates, along with a few other details
  #about the locus.
  my ( $gonda ) = $geo->location( address => $gonda_addr );
  my ( $stans ) = $geo->location( address => $stans_addr );
  my ( $roscoes ) = $geo->location( address => $roscoes_addr );
  print $gonda->latitude, " / ", $gonda->longitude, "\n";
  print $stans->latitude, " / ", $stans->longitude, "\n";
  print $roscoes->latitude, " / ", $roscoes->longitude, "\n";

  #Create a Geo::Google::Path object from $gonda to $roscoes
  #by way of $stans.
  my ( $donut_path ) = $geo->path($gonda, $stans, $roscoes);

  #A path contains a series of Geo::Google::Segment objects with
  #text labels representing turn-by-turn driving directions between
  #two or more locations.
  my @segments = $donut_path->segments();

  #This is the human-readable directions for the first leg of the
  #journey.
  print $segments[0]->text(),"\n";

  #Geo::Google::Segment objects contain a series of
  #Geo::Google::Location objects -- one for each time the segment
  #deviates from a straight line to the end of the segment.
  my @points = $segments[1]->points;
  print $points[0]->latitude, " / ", $points[0]->longitude, "\n";

  #Now how about some coffee nearby?
  my @coffee = $geo->near($stans,'coffee');
  #Too many.  How about some Coffee Bean & Tea Leaf?
  @coffee = grep { $_->title =~ /Coffee.*?Bean/i } @coffee;

  #Still too many.  Let's find the closest with a little trig and
  #a Schwartzian transform
  my ( $coffee ) = map { $_->[1] }
                   sort { $a->[0] <=> $b->[0] }
                   map { [ sqrt(
                            ($_->longitude - $stans->longitude)**2
                              +
                            ($_->latitude - $stans->latitude)**2
                           ), $_ ] } @coffee;

  # Export a location as XML for part of a Google Earth KML file
  my $strStansDonutsXML = $stans->toXML();

  # Export a location as JSON data to use with Google Maps
  my $strRoscoesJSON = $roscoes->toJSON();

=head1 DESCRIPTION

Geo::Google provides access to the map data used by the popular
L web application.

=head2 WHAT IS PROVIDED

=over

=item Conversion of a street address to a 2D Cartesian point
(latitude/longitude)

=item Conversion of a pair of points to a multi-segmented path of
driving directions between the two points.

=item Querying Google's "Local Search" given a point and one or more
query terms.

=back

=head2 WHAT IS NOT PROVIDED

=over

=item Documentation of the Google Maps map data XML format

=item Documentation of the Google Maps web application API

=item Functionality to create your own Google Maps web page.

=back

=head1 AUTHOR

Allen Day [e-mail], Michael Trowbridge
[e-mail]

=head1 COPYRIGHT AND LICENSE

Copyright (c) 2004-2007 Allen Day.  All rights
reserved. This program is free software; you can redistribute it
and/or modify it under the same terms as Perl itself.

=head1 BUGS / TODO

Report documentation and software bugs to the author, or better yet,
send a patch.  Known bugs/issues:

=over

=item Lack of documentation.

=item JSON exporting is not exactly identical to the original Google
JSON response.  Some of the Google Maps-specific data is discarded
during parsing, and the perl JSON module does not allow for bare keys
while exporting to a JSON string.  It should still be functionally
interchangeable with a Google JSON reponse.

=back

=head1 SEE ALSO

  http://maps.google.com
  http://www.google.com/apis/maps/
  http://libgmail.sourceforge.net/googlemaps.html

=cut

package Geo::Google;
use strict;
our $VERSION = '0.05';

#this gets a javascript page containing map XML
use constant LQ => 'http://maps.google.com/maps?output=js&v=1&q=%s';

#this gets a javascript page containing map XML.  special for "nearby" searches
use constant NQ => 'http://maps.google.com/maps?output=js&v=1&near=%s&q=%s';

#used in polyline codec
use constant END_OF_STREAM => 9999;

#external libs
use Data::Dumper;
use Digest::MD5 qw( md5_hex );
use HTML::Entities;
use JSON;
use LWP::Simple;
use URI::Escape;

#our libs
use Geo::Google::Location;
use Geo::Google::Path;
use Geo::Google::Segment;

sub version { return $VERSION }

=head1 CONSTRUCTOR

=cut

=head2 new()

 Usage    : my $geo = Geo::Google->new();
 Function : constructs and returns a new Geo::Google object
 Returns  : a Geo::Google object
 Args     : n/a

=cut

sub new {
  return bless {}, __PACKAGE__;
}

=head1 OBJECT METHODS

=cut

=head2 error()

 Usage    : my $error = $geo->error();
 Function : Fetch error messages produced by the Google Maps XML server.
            Errors can be produced for a number of reasons, e.g. inability
            of the server to resolve a street address to geographical
            coordinates.
 Returns  : The most recent error string.  Calling this method clears the
            last error.
 Args     : n/a

=cut

sub error {
  my ( $self, $msg ) = @_;
  if ( !defined($msg) or ! $self->isa(__PACKAGE__) ) {
    my $error = $self->{error};
    $self->{error} = undef;
    return $error;
  }
  else {
    $self->{error} = $msg;
  }
}

=head2 location()

 Usage    : my $loc = $geo->location( address => $address );
 Function : creates a new Geo::Google::Location object, given a
            street address.
 Returns  : a Geo::Google::Location object, or undef on error
 Args     : an anonymous hash:
            key       required?   value
            -------   ---------   -----
            address   yes         address to search for
            id        no          unique identifier for the
                                  location.  useful if producing
                                  XML.
            icon      no          image to be used to represent
                                  point in Google Maps web
                                  application
            infoStyle no          unknown.  css-related, perhaps?

=cut

sub location {
  my ( $self, %arg ) = @_;
  my @result = ();

  my $address   = $arg{'address'} or ($self->error("must provide an address to location()") and return undef);

  my $json = new JSON (skipinvalid => 1, barekey => 1, quotapos => 1, unmapping => 1 );
  my $response_json = undef;
  # I'm using an an array here because I might need to parse several pages if Google suggests a different address
  my @pages = ( get( sprintf( LQ, uri_escape($address) ) ) );

  # See if google returned no results
  if ( $pages[0] =~ /did\snot\smatch\sany\slocations/i ) {
    $self->error( "Google couldn't find any locations matching $address." ) and return undef;
  }
  # See if Google was unable to resolve the address, but suggested other addresses
  # To see this, run a query for 695 Charles E Young Dr S, Westwood, CA 90024
  elsif ( $pages[0] =~ m#Did you mean:#is ) {
    # Extract the queries from all the http get queries for alterate addresses
    # \u003cdiv class=\"ref\"\u003e\u003ca href=\"/maps?v=1\u0026amp;q=695+Charles+E+Young+Drive+East,+Los+Angeles,+Los+Angeles,+California+90024,+United+States\u0026amp;ie=UTF8\u0026amp;hl=en\u0026amp;oi=georefine\u0026amp;ct=clnk\u0026amp;cd=2\" onclick=\"return loadUrl(this.href)\"\u003e
    # We need it to fit the LQ query 'http://maps.google.com/maps?output=js&v=1&q=%s'
    my @queries = $pages[0] =~ m#\\u003cdiv class=\\"ref\\"\\u003e\\u003ca href=\\"/maps\?v=1\\u0026amp;q=(.+?)\\u0026amp;#gsi;
    # clear the $pages array so we can fill it with the pages from the @urls
    @pages = ();
    foreach my $suggested_query (@queries) {
      push( @pages, get( sprintf( LQ, $suggested_query ) ) );
    }
  }
  # Verify that we actually retrieved pages to parse
  if ( scalar(@pages) > 0 ) {
    foreach my $page (@pages) {
      # attempt to locate the JSON formatted data block
      if ($page =~ m#loadVPage\((.+), "\w+"\);}//]]>#is) { $response_json = $json->jsonToObj($1); }
      else {
	$self->error( "Unable to locate the JSON format data in google's response.") and return undef;
      }
      if ( scalar(@{$response_json->{"overlays"}->{"markers"}}) > 0 ) {
        foreach my $marker (@{$response_json->{"overlays"}->{"markers"}}) {
	  my $loc = $self->_obj2location($marker, %arg);
	  push @result, $loc;
        }
      }
      else {
	$self->error("Found the JSON Data block and was able to parse it, but it had no location markers "
	  . "in it.  Maybe Google changed their JSON data structure?.") and return undef;
      }
    }
  }
  else {
    $self->error("Google couldn't resolve the address $address but suggested alternate addresses.  "
      . "I attempted to download them but failed.") and return undef;
  }
  return @result;
}

=head2 near()

 Usage    : my @near = $geo->near( $loc, $phrase );
 Function : searches Google Local for records matching the
            phrase provided, with the constraint that they are
            physically nearby the Geo::Google::Location object
            provided.  search phrase is passed verbatim to Google.
 Returns  : a list of Geo::Google::Location objects
 Args     : 1. A Geo::Google::Location object
            2. A search phrase.

=cut

sub near {
  my ( $self, $where, $query ) = @_;
  my $page = get( sprintf( NQ, join(',', $where->lines ), $query ) );

  my $json = new JSON (skipinvalid => 1, barekey => 1,
			quotapos => 1, unmapping => 1 );
  my $response_json = undef;

  # See if google returned no results
  if ( $page =~ /did\snot\smatch\sany\slocations/i ) {
    $self->error( "Google couldn't find a $query near " . $where->title) and return undef;
  }
  # attempt to locate the JSON formatted data block
  elsif ($page =~ m#loadVPage\((.+), "\w+"\);}//]]>#is) {
    my $strJSON = $1;
    $response_json = $json->jsonToObj($strJSON);
  }
  else {
    $self->error( "Unable to locate the JSON format data in Google's response.") and return undef;
  }

  if ( scalar(@{$response_json->{"overlays"}->{"markers"}}) > 0 ) {
    my @result = ();
    foreach my $marker (@{$response_json->{"overlays"}->{"markers"}}) {
      my $loc = $self->_obj2location($marker);
      push @result, $loc;
    }
    return @result;
  }
  else {
    $self->error("Found the JSON Data block and was "
      . "able to parse it, but it had no location markers"
      . "in it.  Maybe Google changed their "
      . "JSON data structure?") and return undef;
  }
}

=head2 path()

 Usage    : my $path = $geo->path( $from, $OptionalWaypoints, $to );
 Function : get driving directions between two points
 Returns  : a Geo::Google::Path object
 Args     : 1. a Geo::Google::Location object (from)
	    2. optional Geo::Google::Location waypoints
            3. a Geo::Google::Location object (final destination)

=cut

sub path {
  my ( $self, @locations ) = @_;
  my $json = new JSON (skipinvalid => 1, barekey => 1,
			quotapos => 1, unmapping => 1 );
  my $response_json = undef;

  if(scalar(@locations) < 2) {
    $self->error("Less than two locations were passed to the path function");
    return undef;
  }
  #check each @locations element to see if it is a Geo::Google::Location
  for (my $i=0; $i<=$#locations; $i++) {
	if(!$locations[$i]->isa('Geo::Google::Location')) {
	    $self->error("Location " . ($i+1)
			. " passed to the path function is not a "
			. "Geo::Google::Location"
			. " object, or subclass thereof");
	    return undef;
	}
  }

  # construct the google search text
  my $googlesearch = "from: " . join(', ', $locations[0]->lines);
  for (my $i=1; $i<=$#locations; $i++){
	$googlesearch .= " to:" . join(', ', $locations[$i]->lines);
  }
  my $page = get( sprintf( LQ, uri_escape( $googlesearch ) ) );

  # See if google returned no results
  if ( $page =~ /did\snot\smatch\sany\slocations/i ) {
    $self->error( "Google couldn't find one of the locations you provided for your directions query") and return undef;
  }
  # See if google didn't recognize an input, but suggested
  # a correction to the input that it does recognize
  elsif ( $page =~ m#didyou#s )
  {
    # Parse the JSON to unescape the escaped unicode characters in the URLs we need to parse
    my ( $strJSON ) = $page =~ m#loadVPage\((.+), "\w+"\);}//]]>#s;
    my $suggestion_json = $json->jsonToObj($strJSON);
    # Did you mean:695 Charles E Young Dr S, Los Angeles, Los Angeles, California 90024, United States
    my ( $first_suggestion ) = $suggestion_json->{panel} =~ m#(saddr=.+?)" onclick#s;
    # Get the directions using google's first suggestion
    $page = get ( _html_unescape("http://maps.google.com/maps?output=js&$1") );

    # warn the user using the error method, but don't return undef.
    $self->error("Google suggested a different address for your query.  Using the google suggestion instead.");
  }
  # attept to locate the JSON formatted data block
  if ($page =~ m#loadVPage\((.+), "\w+"\);}//]]>#s) {
    # Extract the JSON data structure from the response.
    $response_json = $json->jsonToObj( $1 );
  }
  else {
    $self->error( "Unable to locate the JSON format data in Google's response.") and return undef;
  }

  my @points;
  my @enc_points;
  for (my $i = 0; $i<=$#{$response_json->{"overlays"}->{"polylines"}}; $i++) {
    $enc_points[$i] = $response_json->{"overlays"}->{"polylines"}->[$i]->{"points"};
    $points[$i] = [ _decode($enc_points[$i]) ];
  }

  # extract a series of directions from HTML inside the panel
  # portion of the JSON data response, stuffing them in @html_segs
  my @html_segs;
  my $stepsfound = 0;

  my $panel = $response_json->{'panel'};
  $panel =~ s/ / /g;

  my @subpaths = $panel =~ m#(\s*)#gs; #ddspt_table \s*


#s; #s; 




421




 





 





 





 





 





 



   #my ( $subpanel ) = $response_json->{'panel'} =~ m#(.+)#s; 




422




 





 





 





 





 





 



   




423




0





 





 





 





 





0



   foreach my $subpath ( @subpaths ) { 




424




0





 





 





 





 





0



     my @segments = split m#

425




0





 





 





 





 





0



     foreach my $segment ( @segments ) { 




426




 





 





 





 





 





 



       #skip irrelevant waypoint rows 




427




0




  
  0
  



  
  0
  




 





 





0



       if ( $subpath =~ m#ddwpt_table#s && $segment !~ m#ddptlnk#s ) { next } 




 




0





 





 





 





 





0



   




428




 





 





 





 





 





 



   




429




0





 





 





 





 





0



       my ( $id, $pointIndex ) = $segment =~ m#id="(.+?)" polypoint="(.+?)"#s; 




430




0





 





 





 





 





0



       my ( $html )       = $segment =~ m#"dirsegtext_\d+_\d+">(.+?)




431




0





 





 





 





 





0



       my ( $distance )   = $segment =~ m#"sxdist".+?>(.+?)<#s; 




432




0





 





 





 





 





0



       my ( $time )       = $segment =~ m#"segtime nw pw">(.+?)<#s; 




433




 





 





 





 





 





 



   




434




0




  
  0
  




 





 





 





0



       if ( ! defined( $id ) ) { 




435




0




  
  0
  




 





 





 





0



         if ( $subpath =~ m#waypoint="(.+?)"#s ) { 




436




0





 





 





 





 





0



           $id = "waypoint_$1"; 




437




0





 





 





 





 





0



 	  $html = $locations[$1]->title(); 




438




0





 





 





 





 





0



           ($pointIndex)  = $segment =~ m#polypoint="(.+?)"#s; 




439




 





 





 





 





 





 



         } 




440




 





 





 





 





 





 



       } 




441




 





 





 





 





 





 



   




442




0




  
  0
  




 





 





 





0



       next unless $id; 




443




 





 





 





 





 





 



   




444




0




  
  0
  




 





 





 





0



       if ( ! $time ) { 




445




 





 





 





 





 





 



         #some segments are different (why? what is the pattern?) 




446




0





 





 





 





 





0



         my ( $d2, $t2 ) = $segment =~ m#timedist ul.+?>(.+?)\(about&\#160;(.+?)\)




447




0





 





 





 





 





0



         $time = $t2; 




448




0





 




  
  0
  




 





 





0



         $distance ||= $d2; 




449




 





 





 





 





 





 



       } 




450




 





 





 





 





 





 



   




451




 





 





 





 





 





 



       #some segments have no associated point, e.g. when there are long-distance driving segments 




452




 





 





 





 





 





 



   




453




 





 





 





 





 





 



       #some segments have time xor distance (not both) 




454




0





 




  
  0
  




 





 





0



       $distance   ||= ''; $distance = decode_entities( $distance ); $distance =~ s/\s+/ /g; 




 




0





 





 





 





 





0



   




 




0





 





 





 





 





0



   




455




0





 




  
  0
  




 





 





0



       $time       ||= ''; $time     = decode_entities( $time     ); $time =~ s/\s+/ /g; 




 




0





 





 





 





 





0



   




 




0





 





 





 





 





0



   




456




 





 





 





 





 





 



   




457




0





 





 





 





 





0



       push (@html_segs, { 




458




 





 





 





 





 





 



         distance   => $distance, 




459




 





 





 





 





 





 



         time       => $time, 




460




 





 





 





 





 





 



         pointIndex => $pointIndex, 




461




 





 





 





 





 





 



         id         => $id, 




462




 





 





 





 





 





 



         html       => $html 




463




 





 





 





 





 





 



       }); 




464




0





 





 





 





 





0



       $stepsfound++; 




465




 





 





 





 





 





 



     } 




466




 





 





 





 





 





 



   } 




467




 





 





 





 





 





 



   




468




0




  
  0
  




 





 





 





0



   if ($stepsfound == 0) { 




469




0




  
  0
  




 





 





 





0



     $self->error("Found the HTML directions from the JSON " 




470




 





 





 





 





 





 



       . "reponse, but was not able to extract " 




471




 





 





 





 





 





 



       . "the driving directions from the HTML") and return undef; 




472




 





 





 





 





 





 



   } 




473




0





 





 





 





 





0



   my @segments = (); 




474




 





 





 





 





 





 



   # Problem:  When you create a Geo::Google::Location by 




475




 





 





 





 





 





 



   # looking it up on Google from an address, it returns coordinates 




476




 





 





 





 





 





 



   # with millionth of a degree precision.  Coordinates that come out  




477




 





 





 





 





 





 



   # the polyline string only have hundred thousandth of a degree 




478




 





 





 





 





 





 



   # precision.  This means that the correlation algorithm won't find 




479




 





 





 





 





 





 



   # the start, stop or waypoints in the polyline unless we round 




480




 





 





 





 





 





 



   # start, stop and waypoint coordinates to the hundred-thousandth 




481




 





 





 





 





 





 



   # degree precision. 




482




0





 





 





 





 





0



   foreach my $location (@locations) { 




483




0





 





 





 





 





0



     $location->{'latitude'} = sprintf("%3.5f", $location->{'latitude'} ); 




484




0





 





 





 





 





0



     $location->{'longitude'} = sprintf("%3.5f", $location->{'longitude'} ); 




485




 





 





 





 





 





 



   } 




486




 





 





 





 





 





 



   




487




 





 





 





 





 





 



   #  Correlate the arrays of lats and longs we decoded from the  




488




 





 





 





 





 





 



   # JSON object with the segments we extracted from the panel  




489




 





 





 





 





 





 



   # HTML and put the result into an array of 




490




 





 





 





 





 





 



   # Geo::Google::Location objects 




491




0





 





 





 





 





0



   my @points_subset = ( $locations[0] ); 




492




0





 





 





 





 





0



   push (@segments, Geo::Google::Segment->new( 




493




 





 





 





 





 





 



         pointIndex => $html_segs[0]{'pointIndex'}, 




494




 





 





 





 





 





 



         id         => $html_segs[0]{'id'}, 




495




 





 





 





 





 





 



         html       => $html_segs[0]{"html"}, 




496




 





 





 





 





 





 



         distance   => $html_segs[0]{'distance'}, 




497




 





 





 





 





 





 



         time       => $html_segs[0]{'time'}, 




498




 





 





 





 





 





 



         from       => $locations[0], 




499




 





 





 





 





 





 



         to         => $locations[0], 




500




 





 





 





 





 





 



         points     => [@points_subset]) 




501




 





 





 





 





 





 



 	); 




502




0





 





 





 





 





0



   shift @html_segs; 




503




0





 





 





 





 





0



   for (my $i = 0; $i <= $#points; $i++) { 




504




 





 





 





 





 





 



     # start/points cause us problems because they're often the same 




505




 





 





 





 





 





 



     # the same pointindex as the first segment of the directions 




506




 





 





 





 





 





 



     # pulling the first html_seg off the stack now makes the next 




507




 





 





 





 





 





 



     # control loop easier to maintain. 




508




0





 





 





 





 





0



     @points_subset = (); 




509




 





 





 





 





 





 



   




510




0





 





 





 





 





0



     my $m = 0; 




511




0





 





 





 





 





0



     my @pointset = @{$points[$i]}; 




 




0





 





 





 





 





0



   




512




0





 





 





 





 





0



     while ( @pointset ) { 




513




0





 





 





 





 





0



       my $lat = shift @pointset; 




514




0





 





 





 





 





0



       my $lon = shift @pointset; 




515




0





 





 





 





 





0



       $m++; 




516




0





 





 





 





 





0



       my %html_seg; 




517




 





 





 





 





 





 



   




518




 





 





 





 





 





 



       # Check to see if the lat and long belong to a start, stop or waypoint 




519




0





 





 





 





 





0



       my $pointislocation = -1; 




520




0





 





 





 





 





0



       for (my $j=0; $j <= $#locations; $j++) { 




521




0




  
  0
  



  
  0
  




 





 





0



 	if ( ( $lat == $locations[$j]->latitude() ) && ( $lon == $locations[$j]->longitude() ) ) { $pointislocation = $j; last; } 




 




0





 





 





 





 





0



   




 




0





 





 





 





 





0



   




522




 





 





 





 





 





 



       } 




523




 





 





 





 





 





 



       # If the point that just came off the pointset array is a start, stop or waypoint, use that start/stop/waypoint. 




524




 





 





 





 





 





 



       # otherwise, create a new point for the lat/long that just came off the pointset array. 




525




0





 





 





 





 





0



       my $point; 




526




0




  
  0
  




 





 





 





0



       if ( $pointislocation >= 0 ){ $point = $locations[$pointislocation]; } 




 




0





 





 





 





 





0



   




527




0





 





 





 





 





0



       else			  { $point = Geo::Google::Location->new( latitude  => $lat, longitude => $lon ); } 




528




 





 





 





 





 





 



   




529




0





 





 





 





 





0



       push @points_subset, $point; 




530




 





 





 





 





 





 



   




531




0




  
  0
  




 





 





 





0



       if ( $html_segs[1] ) {  




 




 




  
  0
  




 





 





 





 



   




532




 





 





 





 





 





 



 	# There's a segment after the one we're working on 




533




 





 





 





 





 





 



 	# This tests to see if we need to wrap up the current segment 




534




0




  
  0
  




 





 





 





0



         if ( defined( $html_segs[1]{'pointIndex'} ) ) { 




535




0




  
  0
  



  
  0
  




 





 





0



           next unless ((($m == $html_segs[1]{'pointIndex'}) && ($#html_segs > 1) ) || (! @pointset) ); 




 




 





 




  
  0
  




 





 





 



   




536




 





 





 





 





 





 



         } 




537




0





 





 





 





 





0



         %html_seg = %{shift @html_segs}; 




 




0





 





 





 





 





0



   




538




0





 





 





 





 





0



         push @segments, Geo::Google::Segment->new( 




539




 





 





 





 





 





 



           pointIndex => $html_seg{'pointIndex'}, 




540




 





 





 





 





 





 



           id         => $html_seg{'id'}, 




541




 





 





 





 





 





 



           html       => decode_entities($html_seg{"html"}), 




542




 





 





 





 





 





 



           distance   => $html_seg{'distance'}, 




543




 





 





 





 





 





 



           time       => $html_seg{'time'}, 




544




 





 





 





 





 





 



           from       => $points_subset[0], 




545




 





 





 





 





 





 



           to         => $point, 




546




 





 





 





 





 





 



           points     => [@points_subset] 




547




 





 





 





 





 





 



         ); 




548




0





 





 





 





 





0



         @points_subset = (); 




549




 





 





 





 





 





 



       } elsif ($html_segs[0]) { # We're working on the last segment 




550




 





 





 





 





 





 



 	# This tests to see if we need to wrap up the last segment 




551




0




  
  0
  




 





 





 





0



          next unless (! $pointset[0]); 




552




0





 





 





 





 





0



          %html_seg = %{shift @html_segs}; 




 




0





 





 





 





 





0



   




553




 





 





 





 





 





 



   




554




 





 





 





 





 





 



 	 # An attempt to get the last point in the last segment 




555




 





 





 





 





 





 



 	 # set.  Google doesn't include it in their polylines. 




556




0





 





 





 





 





0



 	 push @points_subset, $locations[$i+1]; 




557




0





 





 





 





 





0



          push @segments, Geo::Google::Segment->new( 




558




 





 





 





 





 





 



             pointIndex => $html_seg{'pointIndex'}, 




559




 





 





 





 





 





 



             id         => $html_seg{'id'}, 




560




 





 





 





 





 





 



             html       => decode_entities($html_seg{"html"}), 




561




 





 





 





 





 





 



             distance   => $html_seg{'distance'}, 




562




 





 





 





 





 





 



             time       => $html_seg{'time'}, 




563




 





 





 





 





 





 



             from       => $points_subset[0], 




564




 





 





 





 





 





 



             to         => $locations[$i+1], 




565




 





 





 





 





 





 



             points     => [@points_subset] 




566




 





 





 





 





 





 



           ); 




567




0





 





 





 





 





0



           @points_subset = (); 




568




 





 





 





 





 





 



       } else { # we accidentally closed out the last segment early 




569




0





 





 





 





 





0



           push @{ $segments[$#segments]->{points} }, $point; 




 




0





 





 





 





 





0



   




570




 





 





 





 





 





 



       } 




571




 





 





 





 





 





 



     } 




572




 





 





 





 





 





 



   } 




573




 





 





 





 





 





 



   # Dirty:  add the final waypoint 




574




0





 





 





 





 





0



   push (@segments, Geo::Google::Segment->new( 




575




 





 





 





 





 





 



           pointIndex => $html_segs[0]{'pointIndex'}, 




576




 





 





 





 





 





 



           id         => $html_segs[0]{'id'}, 




577




 





 





 





 





 





 



           html       => $html_segs[0]{"html"}, 




578




 





 





 





 





 





 



           distance   => $html_segs[0]{'distance'}, 




579




 





 





 





 





 





 



           time       => $html_segs[0]{'time'}, 




580




 





 





 





 





 





 



           from       => $locations[$#locations], 




581




 





 





 





 





 





 



           to         => $locations[$#locations], 




582




 





 





 





 





 





 



           points     => [ ($locations[$#locations]) ]) 




583




 





 





 





 





 





 



 	); 




584




 





 





 





 





 





 



   # Extract the total information using a regex on the panel hash.  At the end of the "printheader", we're looking for: 




585




 





 





 





 





 





 



   # 9.4 mi – about 17 mins
  #my ( $subpanel ) = $response_json->{'panel'} =~ m#(.+)#s;

  foreach my $subpath ( @subpaths ) {
    my @segments = split m#
    foreach my $segment ( @segments ) {
      #skip irrelevant waypoint rows
      if ( $subpath =~ m#ddwpt_table#s && $segment !~ m#ddptlnk#s ) { next }

      my ( $id, $pointIndex ) = $segment =~ m#id="(.+?)" polypoint="(.+?)"#s;
      my ( $html )       = $segment =~ m#"dirsegtext_\d+_\d+">(.+?)
      my ( $distance )   = $segment =~ m#"sxdist".+?>(.+?)<#s;
      my ( $time )       = $segment =~ m#"segtime nw pw">(.+?)<#s;

      if ( ! defined( $id ) ) {
        if ( $subpath =~ m#waypoint="(.+?)"#s ) {
          $id = "waypoint_$1";
	  $html = $locations[$1]->title();
          ($pointIndex)  = $segment =~ m#polypoint="(.+?)"#s;
        }
      }

      next unless $id;

      if ( ! $time ) {
        #some segments are different (why? what is the pattern?)
        my ( $d2, $t2 ) = $segment =~ m#timedist ul.+?>(.+?)\(about&\#160;(.+?)\)
        $time = $t2;
        $distance ||= $d2;
      }

      #some segments have no associated point, e.g. when there are long-distance driving segments

      #some segments have time xor distance (not both)
      $distance   ||= ''; $distance = decode_entities( $distance ); $distance =~ s/\s+/ /g;
      $time       ||= ''; $time     = decode_entities( $time     ); $time =~ s/\s+/ /g;

      push (@html_segs, {
        distance   => $distance,
        time       => $time,
        pointIndex => $pointIndex,
        id         => $id,
        html       => $html
      });
      $stepsfound++;
    }
  }

  if ($stepsfound == 0) {
    $self->error("Found the HTML directions from the JSON "
      . "reponse, but was not able to extract "
      . "the driving directions from the HTML") and return undef;
  }
  my @segments = ();
  # Problem:  When you create a Geo::Google::Location by
  # looking it up on Google from an address, it returns coordinates
  # with millionth of a degree precision.  Coordinates that come out
  # the polyline string only have hundred thousandth of a degree
  # precision.  This means that the correlation algorithm won't find
  # the start, stop or waypoints in the polyline unless we round
  # start, stop and waypoint coordinates to the hundred-thousandth
  # degree precision.
  foreach my $location (@locations) {
    $location->{'latitude'} = sprintf("%3.5f", $location->{'latitude'} );
    $location->{'longitude'} = sprintf("%3.5f", $location->{'longitude'} );
  }

  #  Correlate the arrays of lats and longs we decoded from the
  # JSON object with the segments we extracted from the panel
  # HTML and put the result into an array of
  # Geo::Google::Location objects
  my @points_subset = ( $locations[0] );
  push (@segments, Geo::Google::Segment->new(
        pointIndex => $html_segs[0]{'pointIndex'},
        id         => $html_segs[0]{'id'},
        html       => $html_segs[0]{"html"},
        distance   => $html_segs[0]{'distance'},
        time       => $html_segs[0]{'time'},
        from       => $locations[0],
        to         => $locations[0],
        points     => [@points_subset])
	);
  shift @html_segs;
  for (my $i = 0; $i <= $#points; $i++) {
    # start/points cause us problems because they're often the same
    # the same pointindex as the first segment of the directions
    # pulling the first html_seg off the stack now makes the next
    # control loop easier to maintain.
    @points_subset = ();

    my $m = 0;
    my @pointset = @{$points[$i]};
    while ( @pointset ) {
      my $lat = shift @pointset;
      my $lon = shift @pointset;
      $m++;
      my %html_seg;

      # Check to see if the lat and long belong to a start, stop or waypoint
      my $pointislocation = -1;
      for (my $j=0; $j <= $#locations; $j++) {
	if ( ( $lat == $locations[$j]->latitude() ) && ( $lon == $locations[$j]->longitude() ) ) { $pointislocation = $j; last; }
      }
      # If the point that just came off the pointset array is a start, stop or waypoint, use that start/stop/waypoint.
      # otherwise, create a new point for the lat/long that just came off the pointset array.
      my $point;
      if ( $pointislocation >= 0 ){ $point = $locations[$pointislocation]; }
      else			  { $point = Geo::Google::Location->new( latitude  => $lat, longitude => $lon ); }

      push @points_subset, $point;

      if ( $html_segs[1] ) {
	# There's a segment after the one we're working on
	# This tests to see if we need to wrap up the current segment
        if ( defined( $html_segs[1]{'pointIndex'} ) ) {
          next unless ((($m == $html_segs[1]{'pointIndex'}) && ($#html_segs > 1) ) || (! @pointset) );
        }
        %html_seg = %{shift @html_segs};
        push @segments, Geo::Google::Segment->new(
          pointIndex => $html_seg{'pointIndex'},
          id         => $html_seg{'id'},
          html       => decode_entities($html_seg{"html"}),
          distance   => $html_seg{'distance'},
          time       => $html_seg{'time'},
          from       => $points_subset[0],
          to         => $point,
          points     => [@points_subset]
        );
        @points_subset = ();
      } elsif ($html_segs[0]) { # We're working on the last segment
	# This tests to see if we need to wrap up the last segment
         next unless (! $pointset[0]);
         %html_seg = %{shift @html_segs};

	 # An attempt to get the last point in the last segment
	 # set.  Google doesn't include it in their polylines.
	 push @points_subset, $locations[$i+1];
         push @segments, Geo::Google::Segment->new(
            pointIndex => $html_seg{'pointIndex'},
            id         => $html_seg{'id'},
            html       => decode_entities($html_seg{"html"}),
            distance   => $html_seg{'distance'},
            time       => $html_seg{'time'},
            from       => $points_subset[0],
            to         => $locations[$i+1],
            points     => [@points_subset]
          );
          @points_subset = ();
      } else { # we accidentally closed out the last segment early
          push @{ $segments[$#segments]->{points} }, $point;
      }
    }
  }
  # Dirty:  add the final waypoint
  push (@segments, Geo::Google::Segment->new(
          pointIndex => $html_segs[0]{'pointIndex'},
          id         => $html_segs[0]{'id'},
          html       => $html_segs[0]{"html"},
          distance   => $html_segs[0]{'distance'},
          time       => $html_segs[0]{'time'},
          from       => $locations[$#locations],
          to         => $locations[$#locations],
          points     => [ ($locations[$#locations]) ])
	);
  # Extract the total information using a regex on the panel hash.  At the end of the "printheader", we're looking for:
  #
  # Replace XML numeric character references with spaces to make the next regex less dependent upon Google's precise formatting choices
  $response_json->{"printheader"} =~ s/&#\d+;/ /g;
  if ( $response_json->{"printheader"} =~ m#(\d+\.?\d*)\s*(mi|km|m)\s*about\s*(.+?)