path: root/WebSmart.pm

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<http://www.melissadata.com/manuals/dqt-websmart-addresscheck-reference-guide.pdf> 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<< <mark at freeside.biz> >>

=head1 SUPPORT

For all allowed query parameters, and details on the 'address' data structure,
see the Melissa WebSmart documentation:
  L<http://www.melissadata.com/manuals/dqt-websmart-addresscheck-reference-guide.pdf>

Commercial support for this module is available from Freeside Internet 
Services:

    L<http://www.freeside.biz/>

=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;