#!/usr/bin/perl -w
use strict;

eval 'exec /usr/local/bin/perl -w -S $0 ${1+"$@"}'
    if 0; # not running under some shell

# $Id: google-latlong,v 1.4 2005/03/02 07:22:58 asc Exp $

use LWP::UserAgent;
use HTTP::Request;
use XML::XPath;
use URI::Escape;

use constant MAPS => "http://maps.google.com/maps";

{
  &main();
  exit;
}

sub main {

  my $query = uri_escape($ARGV[0]);
  my $loc   = sprintf("%s?q=%s",MAPS,$query);

  my $ua  = LWP::UserAgent->new();
  my $req = HTTP::Request->new(GET=>$loc);

  my $res = $ua->request($req);

  if (! $res->is_success()) {
    warn $res->status_line();
    return 0;
  }

  my $garbage = $res->content();
  (my $xml = $garbage) =~ s/.*vpage = '([^\']*)'.*/$1/s;

  # So dumb...so so dumb

  $xml =~ /^(<\?(?:[^\?]+)\?>)/;
  my $decl = $1;

  if (! $decl) {
      warn "No XML declaration";
      return 0;
  }

  if ($decl !~ /encoding/i) {	     
    $xml =~ s/^(<\?xml version="1.0")(.*)/$1 encoding="ISO-8859-1"$2/;
  }

  my $xpath = undef;

  eval {
    $xpath = XML::XPath->new($xml);
  };

  if ($@) {
    warn $@;
    return 0;
  }

  my $point = ($xpath->findnodes("/page/overlay/location/point"))[0];

  if (! $point) {
      warn "Unknown XML tree";
      return 0;
  }

  my $lat   = $point->getAttribute("lat");
  my $long  = $point->getAttribute("lng");

  if ((! $lat) || (! $long)) {
    return 0;
  }

  print sprintf("%s,%s",$lat,$long);
  return 1;
}

__END__

=head1 NAME

google-latlong - get the latitude and longitude for a query string

=head1 SYNOPSIS

 # prints 40.722907,-73.998565

 $> perl google-latlong '88 Spring Street New York'

=head1 DESCRIPTION

Command-line tool to get the latitude and longitude for a
query string from Google

=head1 IMPORTANT

There is no magic here. This script depends entirely on the fact
that useful XML can be teased out the Google Maps results. If,
like plain vanilla queries, this feature is removed from the public
domain this program will stop working.

=head1 VERSION

1.1

=head1 DATE

$Date: 2005/03/02 07:22:58 $

=head1 AUTHOR

Aaron Straup Cope E<lt>ascope@cpan.orgE<gt>

=head1 LICENSE

Copyright (c) Aaron Straup Cope. All rights reserved.

This is free software. You may redistribute it and/or
modify it under the same terms as Perl itself.

=cut
