WebSmart.pm

   1 package Geo::Melissa::WebSmart;
   2
   3 use strict;
   4 use warnings;
   5
   6 use LWP::UserAgent;
   7 use XML::LibXML;
   8 use URI;
   9
  10 =head1 NAME
  11
  12 Geo::Melissa::WebSmart - The Melissa Data WebSmart address verification service
  13
  14 =head1 VERSION
  15
  16 Version 0.01
  17
  18 =cut
  19
  20 our $VERSION = '0.01';
  21 our $DEBUG = 0;
  22
  23 =head1 SYNOPSIS
  24
  25     use Geo::Melissa::WebSmart;
  26
  27     my $request = {
  28       id    => '9876543210',      # API authorization
  29       a1    => '123 Main Street', # first address line
  30       a2    => 'Suite 23',        # second address line, optional
  31       city  => 'San Francisco',   # city
  32       state => 'CA',              # state/province
  33       ctry  => 'US',              # country, US or CA, optional
  34       zip   => '93102',           # zip/postal code
  35       # other options specified in the API docs
  36
  37       parse   => 1,               # request the parsed address elements
  38       geocode => 1,               # request geocoding
  39     };
  40     $result = Geo::Melissa::WebSmart->query($request);
  41
  42     if ($result->address) {
  43       print $result->address->{Address1};
  44     }
  45
  46 =head1 CLASS METHODS
  47
  48 =head2 query HASHREF
  49
  50 Send a request to the web service.  See
  51 L<http://www.melissadata.com/manuals/dqt-websmart-addresscheck-reference-guide.pdf> for API documentation.
  52
  53 Returns an object of class Geo::Melissa::WebSmart.
  54
  55 =cut
  56
  57 my $ua = LWP::UserAgent->new;
  58 my $addresscheck_uri =
  59   'https://addresscheck.melissadata.net/v2/REST/Service.svc/doAddressCheck';
  60 my $geocoder_uri =
  61   'https://geocoder.melissadata.net/v2/REST/Service.svc/doGeoCode';
  62
  63 sub query {
  64   my $class = shift;
  65   my %opt;
  66   if (ref $_[0] eq 'HASH') {
  67     %opt = %{ $_[0] };
  68   } else {
  69     %opt = @_;
  70   }
  71
  72   my $parse = delete($opt{parse});
  73   if ( $parse ) {
  74     $opt{'opt'} = 'True';
  75   }
  76   my $geocode = delete($opt{geocode});
  77
  78   my $uri = URI->new($addresscheck_uri);
  79   $uri->query_form(%opt);
  80   warn "Geo::Melissa::WebSmart->query\n$uri\n\n" if $DEBUG;
  81   my $http_req = HTTP::Request->new(GET => $uri->as_string);
  82   my $resp = $ua->request($http_req);
  83   my $self = { addr_response => $resp };
  84   bless $self, $class;
  85   if ( $resp->is_success ) {
  86     local $@;
  87     my $root = eval { XML::LibXML->load_xml(string => $resp->content) };
  88     if ($@) {
  89       $self->message("Unable to parse XML response:\n$@");
  90       return $self;
  91     }
  92     $root = $root->firstChild; # ResponseArray
  93     my $data = treeify($root);
  94     if (exists $data->{Record}) {
  95       $self->address($data->{Record}->{Address});
  96       $self->code($data->{Record}->{Results});
  97     } else {
  98       $self->code($data->{Results});
  99     }
 100   } else {
 101     $self->message( $resp->status_line );
 102   }
 103   if ( $geocode and $self->address->{AddressKey} ) {
 104     $uri = URI->new($geocoder_uri);
 105     $uri->query_form(
 106       id => $opt{id},
 107       key => $self->address->{AddressKey},
 108     );
 109     my $http_req = HTTP::Request->new(GET => $uri->as_string);
 110     my $resp = $ua->request($http_req);
 111     $self->{geo_response} = $resp;
 112     if ($resp->is_success) {
 113       local $@;
 114       my $root = eval { XML::LibXML->load_xml(string => $resp->content) };
 115       if ($@) {
 116         $self->message("Unable to parse XML response:\n$@");
 117         return $self;
 118       }
 119       $root = $root->firstChild; # ResponseArray
 120       my $data = treeify($root);
 121       if (exists $data->{Record}) {
 122         # merge results
 123         $self->address( { %{ $self->address },
 124                           %{ $data->{Record}->{Address} },
 125                         } );
 126         $self->code( $self->code . ',' . $data->{Record}->{Results} );
 127       } else {
 128         $self->code( $self->code . ',' . $data->{Results} );
 129       }
 130     } else {
 131       $self->message( $resp->status_line );
 132     }
 133   }
 134   $self;
 135 }
 136
 137 sub treeify {
 138   # safe in this case because the XML of the reply record has no duplicate
 139   # element names, and is unordered
 140   my $node = shift;
 141   my $tree = {};
 142   my $text = '';
 143   foreach my $n ($node->childNodes) {
 144     if ($n->isa('XML::LibXML::Text')) {
 145       $text .= ' ' . $n->nodeValue;
 146     } elsif ($n->isa('XML::LibXML::Node')) {
 147       $tree->{$n->nodeName} = treeify($n);
 148     }
 149   }
 150   $text =~ s/^\s*//;
 151   $text =~ s/\s*$//;
 152   if (keys %$tree) {
 153     if ($text) {
 154       $tree->{''} = $text;
 155     }
 156     return $tree;
 157   } else {
 158     return $text;
 159   }
 160 }
 161
 162 =head1 METHODS
 163
 164 =head2 code
 165
 166 Returns the result code(s) generated by the query, as a comma separated
 167 list.
 168
 169 =cut
 170
 171 sub code {
 172   my $self = shift;
 173   if (@_) {
 174     $self->{_code} = shift;
 175   }
 176   $self->{_code} || '';
 177 }
 178
 179 =head2 message
 180
 181 Sets/gets an explicit error status.
 182
 183 =cut
 184
 185 sub message {
 186   my $self = shift;
 187   if (@_) {
 188     $self->{_message} = shift;
 189   }
 190   $self->{_message} || '';
 191 }
 192
 193 =head2 status_message
 194
 195 Returns a semi-readable description of the request status, including any
 196 error or warning messages.
 197
 198 =cut
 199
 200 sub status_message {
 201   my $self = shift;
 202   my $status = join("\n",
 203     map { $self->result_string($_) }
 204     split(',', $self->code)
 205   );
 206   $status = join("\n", $self->message, $status) if $self->message and $status;
 207   $status;
 208 }
 209
 210 =head2 result_string CODE
 211
 212 Returns the string description of the result code CODE.  Melissa provides
 213 both short and long descriptions; this method returns both, separated by
 214 a newline.
 215
 216 =cut
 217
 218 my %result_strings = (
 219 AS01 => "Address Verified\nThe address is valid and deliverable.",
 220 AS02 => "Default Address\nThe default building address was verified but the suite or apartment number is missing or invalid.",
 221 AS03 => "Non USPS Address\nThis address is not deliverable by USPS, but it exists.",
 222 AS09 => "Foreign Address\nAddress is in a non-supported country.",
 223 AS10 => "CMRA Address\nAddress is a Commercial Mail Receiving Agency (CMRA) like the UPS Store. These addresses include a Private Mail Box (PMB or #) number. U.S. only.",
 224 AS13 => "Address Updated By LACS\nLACSLink updated the address from a rural-style (RR 1 Box 2) to a city-style address (123 Main St).",
 225 AS14 => "Suite Appended\nSuiteLink appended a suite number using the address and company name.(US Only)",
 226 AS15 => "Apartment Appended\nAddressPlus appended an apartment number using the address and last name.",
 227 AS16 => "Vacant Address\nAddress has been unoccupied for more than 90 days.(US Only)",
 228 AS17 => "No Mail Delivery\nAddress does not receive mail at this time.(US Only)",
 229 AS18 => "DPV Locked Out\nDPV processing was terminated due to the detection of what is determined to be an artificially created adress.(US Only)",
 230 AS20 => "Deliverable only by USPS\nThis address can only receive mail delivered through USPS (ie. PO Box or a military address)",
 231 AS22 => "No Alternate Address Suggestion\nFound No alternate address suggestion found for this address.",
 232 AS23 => "Extraneous information found\nExtra information not used in verifying the address was found. They have been placed in the ParsedGarbage field.",
 233 AE01 => "Postal Code Error\nThe ZIP or Postal Code does not exist and could not be determined by the city/municipality and state/province.",
 234 AE02 => "Unknown Street\nThe street name was not be found.",
 235 AE03 => "Component Error\nEither the directionals (N, E, SW, etc) or the suffix (AVE, ST, BLVD) are missing or invalid.",
 236 AE04 => "Non-Deliverable\nThe physical location exists but there are no addresses on this side of the street.(US Only)",
 237 AE05 => "Multiple Match\nInput matched to multiple addresses and there is not enough information to break the tie.",
 238 AE06 => "Early Warning System\nThis address cannot be verified now but will be at a future date.(US Only)",
 239 AE07 => "Minimum Address\nThe required combination of address/city/state or address/zip is missing.",
 240 AE08 => "Suite/Apartment Invalid\nThe suite or apartment number is not valid.",
 241 AE09 => "Suite/Apartment Missing\nThe suite or apartment number is missing.",
 242 AE10 => "House/Building Number Invalid\nThe address number in the input address is not valid.",
 243 AE11 => "House/Building Number Missing\nThe address number in the input address is missing.",
 244 AE12 => "Box Number Invalid\nThe input address box number is invalid.",
 245 AE13 => "Box Number Missing\nThe input address box number is missing.",
 246 AE14 => "PMB number Missing\nThe address is a Commercial Mail Receiving Agency (CMRA) and the Private Mail Box (PMB or #) number is missing.",
 247 AE15 => "Demo Mode\nLimited to Demo Mode operation.",
 248 AE16 => "Expired Database\nThe Database has expired.",
 249 AE17 => "Suite/Apartment Not Required\nAddress does not have Suites or Apartments.",
 250 AE19 => "Find Suggestion Timeout\nFindSuggestion function has exceeded time limit.",
 251 AE20 => "Find Suggestion Disabled\nFindSuggestion function is disabled, see manual for details.",
 252 AC01 => "ZIP Code Change\nThe ZIP Code was changed or added.",
 253 AC02 => "State Change\nThe State abbreviation was changed or added.",
 254 AC03 => "City Change\nThe City name was changed or added.",
 255 AC04 => "Address Base Alternate Change\nThe address was found to be an alternate record and changed to the base (preferred) version.",
 256 AC05 => "Alias Name change\nThe street name was changed from a former or nickname street to the USPS preferred street name.",
 257 AC06 => "Address Swapped\nAddress1 was swapped with Address2 (only Address2 contained a valid address).",
 258 AC07 => "Address1 & Company Swapped\nAddress1 and Company were swapped (only Company contained a valid address).",
 259 AC08 => "Plus4 Change\nA non-empty Plus4 was changed.",
 260 AC09 => "Urbanization Change\nThe Urbanization was changed.",
 261 AC10 => "Street Name Change\nThe street name was changed",
 262 AC11 => "Street Suffix Change\nThe street suffix was changed",
 263 AC12 => "Street Predirection or Postdirection Change\nThe street predirection or postdirection was changed",
 264 AC13 => "Suite Name Change\nThe suite name was changed",
 265 AC14 => "Suite Range Change\nThe secondary unit number was changed or appended.",
 266 );
 267
 268 my %general_errors = (
 269   SE01 => "Web Service Internal Error\nThe web service experienced an internal error.",
 270   GE01 => "Empty Request Structure\nThe SOAP, JSON, or XML request structure is empty.",
 271   GE02 => "Empty Request Record Structure\nThe SOAP, JSON, or XML request record structure is empty.",
 272   GE03 => "Records Per Request Exceeded\nThe counted records sent more than the number of records allowed per request.",
 273   GE04 => "Empty CustomerID\nThe CustomerID is empty.",
 274   GE05 => "Invalid CustomerID\nThe CustomerID is invalid.",
 275   GE06 => "Disabled CustomerID\nThe CustomerID is disabled.",
 276   GE07 => "Invalid Request\nThe SOAP, JSON, or XML request is invalid.",
 277 );
 278
 279
 280 sub result_string {
 281   my ($class, $code) = @_;
 282   $result_strings{$code};
 283 }
 284
 285 =head2 address
 286
 287 Returns a hashref of the fields under the Address element of the response.
 288
 289 =cut
 290
 291 sub address {
 292   my $self = shift;
 293   if ( @_ ) {
 294     $self->{_address} = shift;
 295   }
 296   $self->{_address} ||= {};
 297 }
 298
 299 =head1 AUTHOR
 300
 301 Mark Wells, C<< <mark at freeside.biz> >>
 302
 303 =head1 SUPPORT
 304
 305 For all allowed query parameters, and details on the 'address' data structure,
 306 see the Melissa WebSmart documentation:
 307   L<http://www.melissadata.com/manuals/dqt-websmart-addresscheck-reference-guide.pdf>
 308
 309 Commercial support for this module is available from Freeside Internet
 310 Services:
 311
 312     L<http://www.freeside.biz/>
 313
 314 =back
 315
 316
 317 =head1 LICENSE AND COPYRIGHT
 318
 319 Copyright (C) 2013 Freeside Internet Services, Inc.
 320
 321 This program is free software; you can redistribute it and/or modify it
 322 under the terms of either: the GNU General Public License as published
 323 by the Free Software Foundation; or the Artistic License.
 324
 325 See http://dev.perl.org/licenses/ for more information.
 326
 327 =cut
 328
 329 1;