package Geo::Melissa::WebSmart; use strict; use warnings; use LWP::UserAgent; use XML::LibXML; use URI; =head1 NAME Geo::Melissa::WebSmart - The Melissa Data WebSmart address verification service =head1 VERSION Version 0.01 =cut our $VERSION = '0.01'; our $DEBUG = 0; =head1 SYNOPSIS use Geo::Melissa::WebSmart; my $request = { id => '9876543210', # API authorization a1 => '123 Main Street', # first address line a2 => 'Suite 23', # second address line, optional city => 'San Francisco', # city state => 'CA', # state/province ctry => 'US', # country, US or CA, optional zip => '93102', # zip/postal code # other options specified in the API docs parse => 1, # request the parsed address elements geocode => 1, # request geocoding }; $result = Geo::Melissa::WebSmart->query($request); if ($result->address) { print $result->address->{Address1}; } =head1 CLASS METHODS =head2 query HASHREF Send a request to the web service. See L for API documentation. Returns an object of class Geo::Melissa::WebSmart. =cut my $ua = LWP::UserAgent->new; my $addresscheck_uri = 'https://addresscheck.melissadata.net/v2/REST/Service.svc/doAddressCheck'; my $geocoder_uri = 'https://geocoder.melissadata.net/v2/REST/Service.svc/doGeoCode'; sub query { my $class = shift; my %opt; if (ref $_[0] eq 'HASH') { %opt = %{ $_[0] }; } else { %opt = @_; } my $parse = delete($opt{parse}); if ( $parse ) { $opt{'opt'} = 'True'; } my $geocode = delete($opt{geocode}); my $uri = URI->new($addresscheck_uri); $uri->query_form(%opt); warn "Geo::Melissa::WebSmart->query\n$uri\n\n" if $DEBUG; my $http_req = HTTP::Request->new(GET => $uri->as_string); my $resp = $ua->request($http_req); my $self = { addr_response => $resp }; bless $self, $class; if ( $resp->is_success ) { local $@; my $root = eval { XML::LibXML->load_xml(string => $resp->content) }; if ($@) { $self->message("Unable to parse XML response:\n$@"); return $self; } $root = $root->firstChild; # ResponseArray my $data = treeify($root); if (exists $data->{Record}) { $self->address($data->{Record}->{Address}); $self->code($data->{Record}->{Results}); } else { $self->code($data->{Results}); } } else { $self->message( $resp->status_line ); } if ( $geocode and $self->address->{AddressKey} ) { $uri = URI->new($geocoder_uri); $uri->query_form( id => $opt{id}, key => $self->address->{AddressKey}, ); my $http_req = HTTP::Request->new(GET => $uri->as_string); my $resp = $ua->request($http_req); $self->{geo_response} = $resp; if ($resp->is_success) { local $@; my $root = eval { XML::LibXML->load_xml(string => $resp->content) }; if ($@) { $self->message("Unable to parse XML response:\n$@"); return $self; } $root = $root->firstChild; # ResponseArray my $data = treeify($root); if (exists $data->{Record}) { # merge results $self->address( { %{ $self->address }, %{ $data->{Record}->{Address} }, } ); $self->code( $self->code . ',' . $data->{Record}->{Results} ); } else { $self->code( $self->code . ',' . $data->{Results} ); } } else { $self->message( $resp->status_line ); } } $self; } sub treeify { # safe in this case because the XML of the reply record has no duplicate # element names, and is unordered my $node = shift; my $tree = {}; my $text = ''; foreach my $n ($node->childNodes) { if ($n->isa('XML::LibXML::Text')) { $text .= ' ' . $n->nodeValue; } elsif ($n->isa('XML::LibXML::Node')) { $tree->{$n->nodeName} = treeify($n); } } $text =~ s/^\s*//; $text =~ s/\s*$//; if (keys %$tree) { if ($text) { $tree->{''} = $text; } return $tree; } else { return $text; } } =head1 METHODS =head2 code Returns the result code(s) generated by the query, as a comma separated list. =cut sub code { my $self = shift; if (@_) { $self->{_code} = shift; } $self->{_code} || ''; } =head2 message Sets/gets an explicit error status. =cut sub message { my $self = shift; if (@_) { $self->{_message} = shift; } $self->{_message} || ''; } =head2 status_message Returns a semi-readable description of the request status, including any error or warning messages. =cut sub status_message { my $self = shift; my $status = join("\n", map { $self->result_string($_) } split(',', $self->code) ); $status = join("\n", $self->message, $status) if $self->message and $status; $status; } =head2 result_string CODE Returns the string description of the result code CODE. Melissa provides both short and long descriptions; this method returns both, separated by a newline. =cut my %result_strings = ( AS01 => "Address Verified\nThe address is valid and deliverable.", AS02 => "Default Address\nThe default building address was verified but the suite or apartment number is missing or invalid.", AS03 => "Non USPS Address\nThis address is not deliverable by USPS, but it exists.", AS09 => "Foreign Address\nAddress is in a non-supported country.", 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.", 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).", AS14 => "Suite Appended\nSuiteLink appended a suite number using the address and company name.(US Only)", AS15 => "Apartment Appended\nAddressPlus appended an apartment number using the address and last name.", AS16 => "Vacant Address\nAddress has been unoccupied for more than 90 days.(US Only)", AS17 => "No Mail Delivery\nAddress does not receive mail at this time.(US Only)", AS18 => "DPV Locked Out\nDPV processing was terminated due to the detection of what is determined to be an artificially created adress.(US Only)", AS20 => "Deliverable only by USPS\nThis address can only receive mail delivered through USPS (ie. PO Box or a military address)", AS22 => "No Alternate Address Suggestion\nFound No alternate address suggestion found for this address.", AS23 => "Extraneous information found\nExtra information not used in verifying the address was found. They have been placed in the ParsedGarbage field.", AE01 => "Postal Code Error\nThe ZIP or Postal Code does not exist and could not be determined by the city/municipality and state/province.", AE02 => "Unknown Street\nThe street name was not be found.", AE03 => "Component Error\nEither the directionals (N, E, SW, etc) or the suffix (AVE, ST, BLVD) are missing or invalid.", AE04 => "Non-Deliverable\nThe physical location exists but there are no addresses on this side of the street.(US Only)", AE05 => "Multiple Match\nInput matched to multiple addresses and there is not enough information to break the tie.", AE06 => "Early Warning System\nThis address cannot be verified now but will be at a future date.(US Only)", AE07 => "Minimum Address\nThe required combination of address/city/state or address/zip is missing.", AE08 => "Suite/Apartment Invalid\nThe suite or apartment number is not valid.", AE09 => "Suite/Apartment Missing\nThe suite or apartment number is missing.", AE10 => "House/Building Number Invalid\nThe address number in the input address is not valid.", AE11 => "House/Building Number Missing\nThe address number in the input address is missing.", AE12 => "Box Number Invalid\nThe input address box number is invalid.", AE13 => "Box Number Missing\nThe input address box number is missing.", AE14 => "PMB number Missing\nThe address is a Commercial Mail Receiving Agency (CMRA) and the Private Mail Box (PMB or #) number is missing.", AE15 => "Demo Mode\nLimited to Demo Mode operation.", AE16 => "Expired Database\nThe Database has expired.", AE17 => "Suite/Apartment Not Required\nAddress does not have Suites or Apartments.", AE19 => "Find Suggestion Timeout\nFindSuggestion function has exceeded time limit.", AE20 => "Find Suggestion Disabled\nFindSuggestion function is disabled, see manual for details.", AC01 => "ZIP Code Change\nThe ZIP Code was changed or added.", AC02 => "State Change\nThe State abbreviation was changed or added.", AC03 => "City Change\nThe City name was changed or added.", AC04 => "Address Base Alternate Change\nThe address was found to be an alternate record and changed to the base (preferred) version.", AC05 => "Alias Name change\nThe street name was changed from a former or nickname street to the USPS preferred street name.", AC06 => "Address Swapped\nAddress1 was swapped with Address2 (only Address2 contained a valid address).", AC07 => "Address1 & Company Swapped\nAddress1 and Company were swapped (only Company contained a valid address).", AC08 => "Plus4 Change\nA non-empty Plus4 was changed.", AC09 => "Urbanization Change\nThe Urbanization was changed.", AC10 => "Street Name Change\nThe street name was changed", AC11 => "Street Suffix Change\nThe street suffix was changed", AC12 => "Street Predirection or Postdirection Change\nThe street predirection or postdirection was changed", AC13 => "Suite Name Change\nThe suite name was changed", AC14 => "Suite Range Change\nThe secondary unit number was changed or appended.", ); my %general_errors = ( SE01 => "Web Service Internal Error\nThe web service experienced an internal error.", GE01 => "Empty Request Structure\nThe SOAP, JSON, or XML request structure is empty.", GE02 => "Empty Request Record Structure\nThe SOAP, JSON, or XML request record structure is empty.", GE03 => "Records Per Request Exceeded\nThe counted records sent more than the number of records allowed per request.", GE04 => "Empty CustomerID\nThe CustomerID is empty.", GE05 => "Invalid CustomerID\nThe CustomerID is invalid.", GE06 => "Disabled CustomerID\nThe CustomerID is disabled.", GE07 => "Invalid Request\nThe SOAP, JSON, or XML request is invalid.", ); sub result_string { my ($class, $code) = @_; $result_strings{$code}; } =head2 address Returns a hashref of the fields under the Address element of the response. =cut sub address { my $self = shift; if ( @_ ) { $self->{_address} = shift; } $self->{_address} ||= {}; } =head1 AUTHOR Mark Wells, C<< >> =head1 SUPPORT For all allowed query parameters, and details on the 'address' data structure, see the Melissa WebSmart documentation: L Commercial support for this module is available from Freeside Internet Services: L =back =head1 LICENSE AND COPYRIGHT Copyright (C) 2013 Freeside Internet Services, Inc. This program is free software; you can redistribute it and/or modify it under the terms of either: the GNU General Public License as published by the Free Software Foundation; or the Artistic License. See http://dev.perl.org/licenses/ for more information. =cut 1;