+my %subloc_forms = (
+ # Postal Addressing Standards, Appendix C
+ # (plus correction of "hanger" to "hangar")
+ US => {qw(
+ APARTMENT APT
+ BASEMENT BSMT
+ BUILDING BLDG
+ DEPARTMENT DEPT
+ FLOOR FL
+ FRONT FRNT
+ HANGAR HNGR
+ HANGER HNGR
+ KEY KEY
+ LOBBY LBBY
+ LOT LOT
+ LOWER LOWR
+ OFFICE OFC
+ PENTHOUSE PH
+ PIER PIER
+ REAR REAR
+ ROOM RM
+ SIDE SIDE
+ SLIP SLIP
+ SPACE SPC
+ STOP STOP
+ SUITE STE
+ TRAILER TRLR
+ UNIT UNIT
+ UPPER UPPR
+ )},
+ # Canada Post Addressing Guidelines 4.3
+ CA => {qw(
+ APARTMENT APT
+ APPARTEMENT APP
+ BUREAU BUREAU
+ SUITE SUITE
+ UNIT UNIT
+ UNITÉ UNITÉ
+ )},
+);
+
+sub subloc_address2 {
+ # Some things seen in the address2 field:
+ # Whitespace
+ # The complete address (with address1 containing part of the company name,
+ # or an ATTN or DBA line, or P.O. Box, or department name, or building/suite
+ # number, etc.)
+
+ # try to parse sublocation parts from address1; if they are present we'll
+ # append them back to address1 after standardizing
+ my $subloc = '';
+ my ($addr1, $addr2, $country) = map uc, @_;
+ my $dict = $subloc_forms{$country} or return('', $addr2);
+
+ my $found_in = 0; # which address is the sublocation
+ my $h;
+ foreach my $string (
+ # patterns to try to parse
+ $addr1,
+ "$addr1 Nullcity, CA"
+ ) {
+ $h = Geo::StreetAddress::US->parse_location($addr1);
+ last if exists($h->{sec_unit_type});
+ }
+ if (exists($h->{sec_unit_type})) {
+ $found_in = 1
+ } else {
+ foreach my $string (
+ # more patterns
+ $addr2,
+ "$addr1, $addr2",
+ "$addr1, $addr2 Nullcity, CA"
+ ) {
+ $h = Geo::StreetAddress::US->parse_location("$addr1, $addr2");
+ last if exists($h->{sec_unit_type});
+ }
+ if (exists($h->{sec_unit_type})) {
+ $found_in = 2;
+ }
+ }
+ if ( $found_in ) {
+ $subloc = $h->{sec_unit_type};
+ # special case: do not combine P.O. box sublocs with address1
+ if ( $h->{sec_unit_type} =~ /^P *O *BOX/i ) {
+ if ( $found_in == 2 ) {
+ $addr2 = "PO BOX ".$h->{sec_unit_num};
+ } # else it's in addr1, and leave it alone
+ return ('', $addr2);
+ } elsif ( exists($dict->{$subloc}) ) {
+ # substitute the official abbreviation
+ $subloc = $dict->{$subloc};
+ }
+ $subloc .= ' ' . $h->{sec_unit_num} if length($h->{sec_unit_num});
+ } # otherwise $subloc = ''
+
+ if ( $found_in == 2 ) {
+ # address2 should be fully combined into address1
+ return ($subloc, '');
+ }
+ # else address2 is not the canonical sublocation, but do our best to
+ # clean it up
+ #
+ # protect this
+ $addr2 =~ s/#\s*(\d)/NUMBER$1/; # /g?
+ my @words;
+ # remove all punctuation and spaces
+ foreach my $w (split(/\W+/, $addr2)) {
+ if ( exists($dict->{$w}) ) {
+ push @words, $dict->{$w};
+ } else {
+ push @words, $w;
+ }
+ my $result = join(' ', @words);
+ # correct spacing of pound sign + number
+ $result =~ s/NUMBER(\d)/# $1/;
+ warn "normalizing '$addr2' to '$result'\n" if $DEBUG > 1;
+ $addr2 = $result;
+ }
+ $addr2 = '' if $addr2 eq $subloc; # if it was entered redundantly
+ ($subloc, $addr2);
+}
+
+sub standardize_melissa {
+ my $class = shift;
+ my $location = shift;
+
+ local $@;
+ eval "use Geo::Melissa::WebSmart";
+ die $@ if $@;
+
+ my $id = $conf->config('melissa-userid')
+ or die "no melissa-userid configured\n";
+ my $geocode = $conf->exists('melissa-enable_geocoding') ? 1 : 0;
+
+ my $request = {
+ id => $id,
+ a1 => $location->{address1},
+ a2 => $location->{address2},
+ city => $location->{city},
+ state => $location->{state},
+ ctry => $location->{country},
+ zip => $location->{zip},
+ geocode => $geocode,
+ };
+ my $result = Geo::Melissa::WebSmart->query($request);
+ if ( $result->code =~ /AS01/ ) { # always present on success
+ my $addr = $result->address;
+ warn Dumper $addr if $DEBUG > 1;
+ my $out = {
+ address1 => $addr->{Address1},
+ address2 => $addr->{Address2},
+ city => $addr->{City}->{Name},
+ state => $addr->{State}->{Abbreviation},
+ country => $addr->{Country}->{Abbreviation},
+ zip => $addr->{Zip},
+ latitude => $addr->{Latitude},
+ longitude => $addr->{Longitude},
+ addr_clean => 'Y',
+ };
+ if ( $addr->{Census}->{Tract} ) {
+ my $censustract = $addr->{County}->{Fips} . $addr->{Census}->{Tract};
+ # insert decimal point two digits from the end
+ $censustract =~ s/(\d\d)$/\.$1/;
+ $out->{censustract} = $censustract;
+ $out->{censusyear} = $conf->config('census_year');
+ }
+ # we could do a lot more nuanced reporting of the warning/status codes,
+ # but the UI doesn't support that yet.
+ return $out;
+ } else {
+ die $result->status_message;
+ }
+}
+
+sub standardize_freeside {
+ my $class = shift;
+ my $location = shift;
+
+ my $url = 'https://ws.freeside.biz/normalize';
+
+ #free freeside.biz normalization only for US
+ if ( $location->{country} ne 'US' ) {
+ # soft failure
+ #why? something else could have cleaned it $location->{addr_clean} = '';
+ return $location;
+ }
+
+ my $ua = LWP::UserAgent->new(
+ 'ssl_opts' => {
+ verify_hostname => 0,
+ SSL_verify_mode => IO::Socket::SSL::SSL_VERIFY_NONE,
+ },
+ );
+ my $response = $ua->request( POST $url, [
+ 'support-key' => scalar($conf->config('support-key')),
+ %$location,
+ ]);
+
+ die "Address normalization error: ". $response->message
+ unless $response->is_success;
+
+ local $@;
+ my $content = eval { decode_json($response->content) };
+ if ( $@ ) {
+ warn $response->content;
+ die "Address normalization JSON error : $@\n";
+ }
+
+ die $content->{error}."\n"
+ if $content->{error};
+
+ { 'addr_clean' => 'Y',
+ map { $_ => $content->{$_} }
+ qw( address1 address2 city state zip country )
+ };
+
+}
+
+=back
+
+=cut