EZLocate.pm

   1 package Geo::EZLocate;
   2
   3 use 5.006;
   4 use strict;
   5 use warnings;
   6
   7 use Geo::EZLocate::Interfaces::Authentication::Authentication;
   8 use Geo::EZLocate::Interfaces::Geocoding::Geocoding;
   9
  10 =head1 NAME
  11
  12 Geo::EZLocate - TomTom EZLocate geocoding service interface
  13
  14 =head1 VERSION
  15
  16 Version 0.02
  17
  18 =cut
  19
  20 our $VERSION = '0.02';
  21
  22 our $timeout = 10; # in minutes
  23
  24 =head1 SYNOPSIS
  25
  26     use Geo::EZLocate;
  27
  28     my $geo = Geo::EZLocate->new();
  29     my $result = $geo->login('myusername', 'mypassword');
  30     $
  31     ...
  32
  33 =head1 METHODS
  34
  35 =head2 login USERNAME PASSWORD
  36
  37 Authenticates and caches a login token.  Returns the result code, which
  38 is zero on success and nonzero on failure.
  39
  40 =cut
  41
  42 # shorthand class names
  43
  44 my $Interfaces = 'Geo::EZLocate::Interfaces';
  45 my $Auth = $Interfaces.'::Authentication::Authentication';
  46 my $EZClient = $Interfaces.'::EZClient::EZClient';
  47 my $Geocoding = $Interfaces.'::Geocoding::Geocoding';
  48
  49 sub new {
  50   my $class = shift;
  51   # mimic the official API
  52   my $username = shift;
  53   my $password = shift;
  54   return bless { username => $username, password => $password, @_ },
  55          'Geo::EZLocate';
  56 }
  57
  58 sub login {
  59   my $self = shift;
  60
  61   if ( $self->{identity} and (time - $self->{authtime}) < $timeout ) {
  62     return; # no need to reauth
  63   }
  64
  65   my ($username, $password) = @_;
  66   if ( $username ) {
  67     $self->{username} = $username;
  68     $self->{password} = $password;
  69   }
  70
  71   # preprocess key
  72   my $key = 0;
  73   for (split(//, $self->{password})) {
  74     $key = ($key << 4) + ord($_);
  75     my $bits = $key & 0xf0000000;
  76     $bits >>= 24;
  77     $key = ($key ^ $bits);
  78   }
  79   $key = $key & 0x0fffffff;
  80
  81   my $client = $self->{'auth'} ||= $Auth->new;
  82   my $r_requestChallenge = $client->requestChallenge({
  83       userName => $self->{username},
  84       minutesValid => $timeout,
  85   });
  86   my $eid = $r_requestChallenge->get_encryptedID;
  87
  88   # XOR $eid with key, multiply it by the magic number, XOR it back
  89   my $ans = $eid ^ $key;
  90   $ans = ($ans * 39371) % 0x3fffffff;
  91   $ans = $ans ^ $key;
  92
  93   my $r_answerChallenge = $client->answerChallenge({
  94       originalChallenge => $eid,
  95       encryptedResponse => $ans,
  96   });
  97
  98   my $id = $r_answerChallenge->get_credential;
  99   if ( $id ) {
 100     $self->{identity} = $id;
 101     $self->{authtime} = time;
 102   }
 103   return $r_answerChallenge->get_resultCode;
 104 }
 105
 106 =head2 findAddress ADDRESS, CITY, STATE, ZIP, [OPTION => VALUE] ...
 107
 108 Validate the specified address.  The only OPTION that matters currently
 109 is 'country', which can be set to "CA" to search for addresses in Canada.
 110
 111 =cut
 112
 113 sub findAddress {
 114   my $self = shift;
 115   my %params;
 116   # again, imitate the positional parameters in the official SDK
 117   $params{Addr} = shift;
 118   $params{City} = shift;
 119   $params{State} = shift;
 120   $params{ZIP} = shift;
 121   my %opt = @_;
 122
 123   my $client = $self->{geocoding} ||= $Geocoding->new;
 124   $self->login();
 125   die "authentication failed" unless $self->{identity};
 126
 127   my $service = 'USA_Geo_004';
 128   if ( lc($opt{'country'} || '') eq 'ca' ) {
 129     $service = 'CAN_Geo_001';
 130   }
 131   my $input = {
 132     nv => [ map { +{ name => $_, value => $params{$_} } } keys %params ]
 133   };
 134   my $r_findAddress = $client->findAddress({
 135     'service'   => $service,
 136     'identity'  => $self->{identity},
 137     'input'     => $input,
 138   });
 139
 140   my $nvs = $r_findAddress->get_result->get_mAttributes->get_nv;
 141
 142   my $match = {};
 143   foreach my $nv (@$nvs) {
 144     $match->{$nv->get_name} = '' . $nv->get_value; #force stringification
 145   }
 146
 147   $match;
 148 }
 149
 150 =head1 AUTHOR
 151
 152 Mark Wells, C<< <mark at freeside.biz> >>
 153
 154 =head1 BUGS
 155
 156 Much of the API is unsupported.  The Geo::EZLocate::Interfaces::*
 157 packages have autogenerated wrappers for all of the API methods, and
 158 they work, but I haven't documented or tested most of them.
 159
 160 This module shouldn't even be necessary, but the EZLocate SDK has a
 161 restrictive license which makes it impractical for open-source
 162 development.  This is a shame, because their geocoding service is
 163 very good.
 164
 165 =head1 SUPPORT
 166
 167 You can find documentation for this module with the perldoc command.
 168
 169     perldoc Geo::EZLocate
 170
 171 This library is not supported by TomTom.  Commercial support is available
 172 from Freeside Internet Services, L<http://www.freeside.biz>.
 173
 174 =head1 LICENSE AND COPYRIGHT
 175
 176 Copyright 2012 Mark Wells.
 177
 178 This program is free software; you can redistribute it and/or modify it
 179 under the terms of either: the GNU General Public License as published
 180 by the Free Software Foundation; or the Artistic License.
 181
 182 See http://dev.perl.org/licenses/ for more information.
 183
 184 =cut
 185
 186 1; # End of Geo::EZLocate