FS/FS/geocode_Mixin.pm

   1 package FS::geocode_Mixin;
   2
   3 use strict;
   4 use vars qw( $DEBUG $me );
   5 use Carp;
   6 use Cpanel::JSON::XS;
   7 use Data::Dumper;
   8 use Locale::Country ();
   9 use LWP::UserAgent;
  10 use URI::Escape;
  11 use FS::Record qw( qsearchs qsearch );
  12 use FS::Conf;
  13 use FS::cust_pkg;
  14 use FS::cust_location;
  15 use FS::cust_tax_location;
  16 use FS::part_pkg;
  17 use FS::part_pkg_taxclass;
  18
  19 $DEBUG = 0;
  20 $me = '[FS::geocode_Mixin]';
  21
  22 =head1 NAME
  23
  24 FS::geocode_Mixin - Mixin class for records that contain address and other
  25 location fields.
  26
  27 =head1 SYNOPSIS
  28
  29   package FS::some_table;
  30   use base ( FS::geocode_Mixin FS::Record );
  31
  32 =head1 DESCRIPTION
  33
  34 FS::geocode_Mixin - This is a mixin class for records that contain address
  35 and other location fields.
  36
  37 =head1 METHODS
  38
  39 =over 4
  40
  41 =cut
  42
  43 =item location_hash
  44
  45 Returns a list of key/value pairs, with the following keys: address1, address2,
  46 city, county, state, zip, country, geocode, location_type, location_number,
  47 location_kind.  The shipping address is used if present.
  48
  49 =cut
  50
  51 #geocode dependent on tax-ship_address config
  52
  53 sub location_hash {
  54   my $self = shift;
  55   my $prefix = $self->has_ship_address ? 'ship_' : '';
  56
  57   map { my $method = ($_ eq 'geocode') ? $_ : $prefix.$_;
  58         $_ => $self->get($method);
  59       }
  60       qw( address1 address2 city county state zip country geocode
  61         location_type location_number location_kind );
  62 }
  63
  64 =item location_label [ OPTION => VALUE ... ]
  65
  66 Returns the label of the service location (see analog in L<FS::cust_location>) for this customer.
  67
  68 Options are
  69
  70 =over 4
  71
  72 =item join_string
  73
  74 used to separate the address elements (defaults to ', ')
  75
  76 =item escape_function
  77
  78 a callback used for escaping the text of the address elements
  79
  80 =back
  81
  82 =cut
  83
  84 sub location_label {
  85   my $self = shift;
  86   my %opt = @_;
  87
  88   my $separator = $opt{join_string} || ', ';
  89   my $escape = $opt{escape_function} || sub{ shift };
  90   my $ds = $opt{double_space} || '  ';
  91   my $line = '';
  92   my $cydefault =
  93     $opt{'countrydefault'} || FS::Conf->new->config('countrydefault') || 'US';
  94   my $prefix = $self->has_ship_address ? 'ship_' : '';
  95
  96   my $notfirst = 0;
  97   foreach (qw ( address1 address2 ) ) {
  98     my $method = "$prefix$_";
  99     $line .= ($notfirst ? $separator : ''). &$escape($self->$method)
 100       if $self->$method;
 101     $notfirst++;
 102   }
 103
 104   my $lt = $self->get($prefix.'location_type');
 105   if ( $lt ) {
 106     my %location_type;
 107     if ( 1 ) { #ikano, switch on via config
 108       { no warnings 'void';
 109         eval { 'use FS::part_export::ikano;' };
 110         die $@ if $@;
 111       }
 112       %location_type = FS::part_export::ikano->location_types;
 113     } else {
 114       %location_type = (); #?
 115     }
 116
 117     $line .= ' '.&$escape( $location_type{$lt} || $lt );
 118   }
 119
 120   $line .= ' '. &$escape($self->get($prefix.'location_number'))
 121     if $self->get($prefix.'location_number');
 122
 123   $notfirst = 0;
 124   foreach (qw ( city county state zip ) ) {
 125     my $method = "$prefix$_";
 126     if ( $self->$method ) {
 127       $line .= ' (' if $method eq 'county';
 128       $line .= ($notfirst ? ' ' : $separator). &$escape($self->$method);
 129       $line .= ' )' if $method eq 'county';
 130       $notfirst++;
 131     }
 132   }
 133   $line .= $separator. &$escape($self->country_full)
 134     if $self->country ne $cydefault;
 135
 136   $line;
 137 }
 138
 139 =item country_full
 140
 141 Returns the full country name.
 142
 143 =cut
 144
 145 sub country_full {
 146   my $self = shift;
 147   $self->code2country($self->get('country'));
 148 }
 149
 150 sub code2country {
 151   my( $self, $country ) = @_;
 152
 153   #a hash?  not expecting an explosion of business from unrecognized countries..
 154   return 'KKTC' if $country eq 'XC';
 155
 156   Locale::Country::code2country($country);
 157 }
 158
 159 =item set_coord
 160
 161 Look up the coordinates of the location using (currently) the Google Maps
 162 API and set the 'latitude' and 'longitude' fields accordingly.
 163
 164 =cut
 165
 166 sub set_coord {
 167   my $self = shift;
 168
 169   # Google documetnation:
 170   # https://developers.google.com/maps/documentation/geocoding/start
 171
 172
 173   my $api_key = FS::Conf->new->config('google_maps_api_key');
 174
 175   unless ( $api_key ) {
 176     # Google API now requires a valid key with a payment method attached
 177     warn 'Geocoding unavailable, install a google_maps_api_key';
 178     return;
 179   }
 180
 181   my $google_api_url = 'https://maps.googleapis.com/maps/api/geocode/json';
 182
 183   my $address =
 184     join ',',
 185     map { $self->get( $_ ) ? uri_escape( $self->get( $_ ) ) : () }
 186     qw( address1 address2 city state zip country_full );
 187
 188   my $query_url = sprintf
 189     '%s?address=%s&key=%s',
 190     $google_api_url, $address, $api_key;
 191
 192   my $ua = LWP::UserAgent->new;
 193   $ua->timeout(10);
 194   my $res = $ua->get( $query_url );
 195   my $json_res = decode_json( $res->decoded_content );
 196   my $json_error = $json_res->{error_message}
 197     if ref $json_res && $json_res->{error_message};
 198
 199   if ( $DEBUG ) {
 200     warn "\$query_url: $query_url\n";
 201     warn "\$json_error: $json_error\n";
 202     warn Dumper( $json_res || $res->decoded_content )."\n";
 203   }
 204
 205   if ( !$res->is_success || $json_error ) {
 206     warn "Error using google GeoCoding API";
 207     warn Dumper( $json_res || $res->decoded_content );
 208     return;
 209   }
 210
 211   if (
 212        ref $json_res
 213     && ref $json_res->{results}
 214     && ref $json_res->{results}->[0]
 215     && ref $json_res->{results}->[0]->{geometry}
 216     && ref $json_res->{results}->[0]->{geometry}->{location}
 217   ) {
 218     my $location = $json_res->{results}->[0]->{geometry}->{location};
 219     if ( $location->{lat} && $location->{lng} ) {
 220       $self->set( latitude   => $location->{lat} );
 221       $self->set( longitude  => $location->{lng} );
 222       $self->set( coord_auto => 'Y' );
 223     }
 224   } else {
 225     # If google changes the API response structure, warnings abound
 226     warn "No location match found using google GeoCoding API for $address";
 227     warn Dumper( $json_res || $res->decoded_content );
 228   }
 229 }
 230
 231 =item geocode DATA_VENDOR
 232
 233 Returns a value for the customer location as encoded by DATA_VENDOR.
 234 Currently this only makes sense for "CCH" as DATA_VENDOR.
 235
 236 =cut
 237
 238 sub geocode {
 239   my ($self, $data_vendor) = (shift, shift);  #always cch for now
 240
 241   my $geocode = $self->get('geocode');  #XXX only one data_vendor for geocode
 242   return $geocode if $geocode;
 243
 244   if ( $self->isa('FS::cust_main') ) {
 245     warn "WARNING: FS::cust_main->geocode deprecated";
 246
 247     # do the best we can
 248     my $m = FS::Conf->new->exists('tax-ship_address') ? 'ship_location'
 249                                                       : 'bill_location';
 250     my $location = $self->$m or return '';
 251     return $location->geocode($data_vendor);
 252   }
 253
 254   my($zip,$plus4) = split /-/, $self->get('zip')
 255     if $self->country eq 'US';
 256
 257   $zip ||= '';
 258   $plus4 ||= '';
 259   #CCH specific location stuff
 260   my $extra_sql = $plus4 ? "AND plus4lo <= '$plus4' AND plus4hi >= '$plus4'"
 261                          : '';
 262
 263   my @cust_tax_location =
 264     qsearch( {
 265                'table'     => 'cust_tax_location',
 266                'hashref'   => { 'zip' => $zip, 'data_vendor' => $data_vendor },
 267                'extra_sql' => $extra_sql,
 268                'order_by'  => 'ORDER BY plus4hi',#overlapping with distinct ends
 269              }
 270            );
 271   $geocode = $cust_tax_location[0]->geocode
 272     if scalar(@cust_tax_location);
 273
 274   warn "WARNING: customer ". $self->custnum.
 275        ": multiple locations for zip ". $self->get("zip").
 276        "; using arbitrary geocode $geocode\n"
 277     if scalar(@cust_tax_location) > 1;
 278
 279   $geocode;
 280 }
 281
 282 =item process_district_update CLASS ID
 283
 284 Queueable function to update the tax district code using the selected method
 285 (config 'tax_district_method').  CLASS is either 'FS::cust_main' or
 286 'FS::cust_location'; ID is the key in one of those tables.
 287
 288 =cut
 289
 290 # this is run from the job queue so I'm not transactionizing it.
 291
 292 sub process_district_update {
 293   my $class = shift;
 294   my $id = shift;
 295   my $log = FS::Log->new('FS::cust_location::process_district_update');
 296
 297   eval "use FS::Misc::Geo qw(get_district); use FS::Conf; use $class;";
 298   die $@ if $@;
 299   die "$class has no location data" if !$class->can('location_hash');
 300
 301   my $error;
 302   my $conf = FS::Conf->new;
 303   my $method = $conf->config('tax_district_method')
 304     or return; #nothing to do if null
 305   my $self = $class->by_key($id) or die "object $id not found";
 306   return if $self->disabled;
 307
 308   # dies on error, fine
 309   my $tax_info = get_district({ $self->location_hash }, $method);
 310   return unless $tax_info;
 311
 312   if ($self->district ne $tax_info->{'district'}) {
 313     $self->set('district', $tax_info->{'district'} );
 314     $error = $self->replace;
 315     die $error if $error;
 316   }
 317
 318   my %hash = map { $_ => uc( $tax_info->{$_} ) }
 319     qw( district city county state country );
 320   $hash{'source'} = $method; # apply the update only to taxes we maintain
 321
 322   my @classes = FS::part_pkg_taxclass->taxclass_names;
 323   my $taxname = $conf->config('tax_district_taxname');
 324   # there must be exactly one cust_main_county for each district+taxclass.
 325   # do NOT exclude taxes that are zero.
 326
 327   # mutex here so that concurrent queue jobs can't make duplicates.
 328   FS::cust_main_county->lock_table;
 329   foreach my $taxclass (@classes) {
 330     my @existing = qsearch('cust_main_county', {
 331       %hash,
 332       'taxclass' => $taxclass
 333     });
 334
 335     if ( scalar(@existing) == 0 ) {
 336
 337       # then create one with the assigned tax name, and the tax rate from
 338       # the lookup.
 339       my $new = new FS::cust_main_county({
 340         %hash,
 341         'taxclass'      => $taxclass,
 342         'taxname'       => $taxname,
 343         'tax'           => $tax_info->{tax},
 344         'exempt_amount' => 0,
 345       });
 346       $log->info("creating tax rate for district ".$tax_info->{'district'});
 347       $error = $new->insert;
 348
 349     } else {
 350
 351       my $to_update = $existing[0];
 352       # if there's somehow more than one, find the best candidate to be
 353       # updated:
 354       # - prefer tax > 0 over tax = 0 (leave disabled records disabled)
 355       # - then, prefer taxname = the designated taxname
 356       if ( scalar(@existing) > 1 ) {
 357         $log->warning("tax district ".$tax_info->{district}." has multiple $method taxes.");
 358         foreach (@existing) {
 359           if ( $to_update->tax == 0 ) {
 360             if ( $_->tax > 0 and $to_update->tax == 0 ) {
 361               $to_update = $_;
 362             } elsif ( $_->tax == 0 and $to_update->tax > 0 ) {
 363               next;
 364             } elsif ( $_->taxname eq $taxname and $to_update->tax ne $taxname ) {
 365               $to_update = $_;
 366             }
 367           }
 368         }
 369         # don't remove the excess records here; upgrade does that.
 370       }
 371       my $taxnum = $to_update->taxnum;
 372       if ( $to_update->tax == 0 ) {
 373         $log->debug("tax#$taxnum is set to zero; not updating.");
 374       } elsif ( $to_update->tax == $tax_info->{tax} ) {
 375         # do nothing, no need to update
 376       } else {
 377         $to_update->set('tax', $tax_info->{tax});
 378         $log->info("updating tax#$taxnum with new rate ($tax_info->{tax}).");
 379         $error = $to_update->replace;
 380       }
 381     }
 382
 383     die $error if $error;
 384
 385   } # foreach $taxclass
 386
 387   return;
 388 }
 389
 390 =back
 391
 392 =head1 BUGS
 393
 394 =head1 SEE ALSO
 395
 396 L<FS::Record>, schema.html from the base documentation.
 397
 398 =cut
 399
 400 1;
 401