FS/FS/cust_location.pm

   1 package FS::cust_location;
   2 use base qw( FS::geocode_Mixin FS::Record );
   3
   4 use strict;
   5 use vars qw( $import );
   6 use Locale::Country;
   7 use FS::UID qw( dbh driver_name );
   8 use FS::Record qw( qsearch qsearchs );
   9 use FS::Conf;
  10 use FS::prospect_main;
  11 use FS::cust_main;
  12 use FS::cust_main_county;
  13
  14 $import = 0;
  15
  16 =head1 NAME
  17
  18 FS::cust_location - Object methods for cust_location records
  19
  20 =head1 SYNOPSIS
  21
  22   use FS::cust_location;
  23
  24   $record = new FS::cust_location \%hash;
  25   $record = new FS::cust_location { 'column' => 'value' };
  26
  27   $error = $record->insert;
  28
  29   $error = $new_record->replace($old_record);
  30
  31   $error = $record->delete;
  32
  33   $error = $record->check;
  34
  35 =head1 DESCRIPTION
  36
  37 An FS::cust_location object represents a customer location.  FS::cust_location
  38 inherits from FS::Record.  The following fields are currently supported:
  39
  40 =over 4
  41
  42 =item locationnum
  43
  44 primary key
  45
  46 =item custnum
  47
  48 custnum
  49
  50 =item address1
  51
  52 Address line one (required)
  53
  54 =item address2
  55
  56 Address line two (optional)
  57
  58 =item city
  59
  60 City
  61
  62 =item county
  63
  64 County (optional, see L<FS::cust_main_county>)
  65
  66 =item state
  67
  68 State (see L<FS::cust_main_county>)
  69
  70 =item zip
  71
  72 Zip
  73
  74 =item country
  75
  76 Country (see L<FS::cust_main_county>)
  77
  78 =item geocode
  79
  80 Geocode
  81
  82 =item district
  83
  84 Tax district code (optional)
  85
  86 =item disabled
  87
  88 Disabled flag; set to 'Y' to disable the location.
  89
  90 =back
  91
  92 =head1 METHODS
  93
  94 =over 4
  95
  96 =item new HASHREF
  97
  98 Creates a new location.  To add the location to the database, see L<"insert">.
  99
 100 Note that this stores the hash reference, not a distinct copy of the hash it
 101 points to.  You can ask the object for a copy with the I<hash> method.
 102
 103 =cut
 104
 105 sub table { 'cust_location'; }
 106
 107 =item find_or_insert
 108
 109 Finds an existing location matching the customer and address values in this
 110 location, if one exists, and sets the contents of this location equal to that
 111 one (including its locationnum).
 112
 113 If an existing location is not found, this one I<will> be inserted.  (This is a
 114 change from the "new_or_existing" method that this replaces.)
 115
 116 The following fields are considered "essential" and I<must> match: custnum,
 117 address1, address2, city, county, state, zip, country, location_number,
 118 location_type, location_kind.  Disabled locations will be found only if this
 119 location is set to disabled.
 120
 121 If 'coord_auto' is null, and latitude and longitude are not null, then
 122 latitude and longitude are also essential fields.
 123
 124 All other fields are considered "non-essential".  If a non-essential field is
 125 empty in this location, it will be ignored in determining whether an existing
 126 location matches.
 127
 128 If a non-essential field is non-empty in this location, existing locations
 129 that contain a different non-empty value for that field will not match.  An
 130 existing location in which the field is I<empty> will match, but will be
 131 updated in-place with the value of that field.
 132
 133 Returns an error string if inserting or updating a location failed.
 134
 135 It is unfortunately hard to determine if this created a new location or not.
 136
 137 =cut
 138
 139 sub find_or_insert {
 140   my $self = shift;
 141
 142   my @essential = (qw(custnum address1 address2 city county state zip country
 143     location_number location_type location_kind disabled));
 144
 145   if ( !$self->coord_auto and $self->latitude and $self->longitude ) {
 146     push @essential, qw(latitude longitude);
 147     # but NOT coord_auto; if the latitude and longitude match the geocoded
 148     # values then that's good enough
 149   }
 150
 151   # put nonempty, nonessential fields/values into this hash
 152   my %nonempty = map { $_ => $self->get($_) }
 153                  grep {$self->get($_)} $self->fields;
 154   delete @nonempty{@essential};
 155   delete $nonempty{'locationnum'};
 156
 157   my %hash = map { $_ => $self->get($_) } @essential;
 158   my @matches = qsearch('cust_location', \%hash);
 159
 160   # consider candidate locations
 161   MATCH: foreach my $old (@matches) {
 162     my $reject = 0;
 163     foreach my $field (keys %nonempty) {
 164       my $old_value = $old->get($field);
 165       if ( length($old_value) > 0 ) {
 166         if ( $field eq 'latitude' or $field eq 'longitude' ) {
 167           # special case, because these are decimals
 168           if ( abs($old_value - $nonempty{$field}) > 0.000001 ) {
 169             $reject = 1;
 170           }
 171         } elsif ( $old_value ne $nonempty{$field} ) {
 172           $reject = 1;
 173         }
 174       } else {
 175         # it's empty in $old, has a value in $self
 176         $old->set($field, $nonempty{$field});
 177       }
 178       next MATCH if $reject;
 179     } # foreach $field
 180
 181     if ( $old->modified ) {
 182       my $error = $old->replace;
 183       return $error if $error;
 184     }
 185     # set $self equal to $old
 186     foreach ($self->fields) {
 187       $self->set($_, $old->get($_));
 188     }
 189     return "";
 190   }
 191
 192   # didn't find a match
 193   return $self->insert;
 194 }
 195
 196 =item insert
 197
 198 Adds this record to the database.  If there is an error, returns the error,
 199 otherwise returns false.
 200
 201 =cut
 202
 203 sub insert {
 204   my $self = shift;
 205   my $conf = new FS::Conf;
 206
 207   if ( $self->censustract ) {
 208     $self->set('censusyear' => $conf->config('census_year') || 2012);
 209   }
 210
 211   my $error = $self->SUPER::insert(@_);
 212
 213   #false laziness with cust_main, will go away eventually
 214   if ( !$import and !$error and $conf->config('tax_district_method') ) {
 215
 216     my $queue = new FS::queue {
 217       'job' => 'FS::geocode_Mixin::process_district_update'
 218     };
 219     $error = $queue->insert( ref($self), $self->locationnum );
 220
 221   }
 222
 223   $error || '';
 224 }
 225
 226 =item delete
 227
 228 Delete this record from the database.
 229
 230 =item replace OLD_RECORD
 231
 232 Replaces the OLD_RECORD with this one in the database.  If there is an error,
 233 returns the error, otherwise returns false.
 234
 235 =cut
 236
 237 sub replace {
 238   my $self = shift;
 239   my $old = shift;
 240   $old ||= $self->replace_old;
 241   # the following fields are immutable
 242   foreach (qw(address1 address2 city state zip country)) {
 243     if ( $self->$_ ne $old->$_ ) {
 244       return "can't change cust_location field $_";
 245     }
 246   }
 247
 248   $self->SUPER::replace($old);
 249 }
 250
 251
 252 =item check
 253
 254 Checks all fields to make sure this is a valid location.  If there is
 255 an error, returns the error, otherwise returns false.  Called by the insert
 256 and replace methods.
 257
 258 =cut
 259
 260 #some false laziness w/cust_main, but since it should eventually lose these
 261 #fields anyway...
 262 sub check {
 263   my $self = shift;
 264   my $conf = new FS::Conf;
 265
 266   my $error =
 267     $self->ut_numbern('locationnum')
 268     || $self->ut_foreign_keyn('prospectnum', 'prospect_main', 'prospectnum')
 269     || $self->ut_foreign_keyn('custnum', 'cust_main', 'custnum')
 270     || $self->ut_text('address1')
 271     || $self->ut_textn('address2')
 272     || $self->ut_text('city')
 273     || $self->ut_textn('county')
 274     || $self->ut_textn('state')
 275     || $self->ut_country('country')
 276     || (!$import && $self->ut_zip('zip', $self->country))
 277     || $self->ut_coordn('latitude')
 278     || $self->ut_coordn('longitude')
 279     || $self->ut_enum('coord_auto', [ '', 'Y' ])
 280     || $self->ut_enum('addr_clean', [ '', 'Y' ])
 281     || $self->ut_alphan('location_type')
 282     || $self->ut_textn('location_number')
 283     || $self->ut_enum('location_kind', [ '', 'R', 'B' ] )
 284     || $self->ut_alphan('geocode')
 285     || $self->ut_alphan('district')
 286     || $self->ut_numbern('censusyear')
 287   ;
 288   return $error if $error;
 289   if ( $self->censustract ne '' ) {
 290     $self->censustract =~ /^\s*(\d{9})\.?(\d{2})\s*$/
 291       or return "Illegal census tract: ". $self->censustract;
 292
 293     $self->censustract("$1.$2");
 294   }
 295
 296   if ( $conf->exists('cust_main-require_address2') and
 297        !$self->ship_address2 =~ /\S/ ) {
 298     return "Unit # is required";
 299   }
 300
 301   # tricky...we have to allow for the customer to not be inserted yet
 302   return "No prospect or customer!" unless $self->prospectnum
 303                                         || $self->custnum
 304                                         || $self->get('custnum_pending');
 305   return "Prospect and customer!"       if $self->prospectnum && $self->custnum;
 306
 307   return 'Location kind is required'
 308     if $self->prospectnum
 309     && $conf->exists('prospect_main-alt_address_format')
 310     && ! $self->location_kind;
 311
 312   unless ( $import or qsearch('cust_main_county', {
 313     'country' => $self->country,
 314     'state'   => '',
 315    } ) ) {
 316     return "Unknown state/county/country: ".
 317       $self->state. "/". $self->county. "/". $self->country
 318       unless qsearch('cust_main_county',{
 319         'state'   => $self->state,
 320         'county'  => $self->county,
 321         'country' => $self->country,
 322       } );
 323   }
 324
 325   # set coordinates, unless we already have them
 326   if (!$import and !$self->latitude and !$self->longitude) {
 327     $self->set_coord;
 328   }
 329
 330   $self->SUPER::check;
 331 }
 332
 333 =item country_full
 334
 335 Returns this locations's full country name
 336
 337 =cut
 338
 339 sub country_full {
 340   my $self = shift;
 341   code2country($self->country);
 342 }
 343
 344 =item line
 345
 346 Synonym for location_label
 347
 348 =cut
 349
 350 sub line {
 351   my $self = shift;
 352   $self->location_label;
 353 }
 354
 355 =item has_ship_address
 356
 357 Returns false since cust_location objects do not have a separate shipping
 358 address.
 359
 360 =cut
 361
 362 sub has_ship_address {
 363   '';
 364 }
 365
 366 =item location_hash
 367
 368 Returns a list of key/value pairs, with the following keys: address1, address2,
 369 city, county, state, zip, country, geocode, location_type, location_number,
 370 location_kind.
 371
 372 =cut
 373
 374 =item disable_if_unused
 375
 376 Sets the "disabled" flag on the location if it is no longer in use as a
 377 prospect location, package location, or a customer's billing or default
 378 service address.
 379
 380 =cut
 381
 382 sub disable_if_unused {
 383
 384   my $self = shift;
 385   my $locationnum = $self->locationnum;
 386   return '' if FS::cust_main->count('bill_locationnum = '.$locationnum)
 387             or FS::cust_main->count('ship_locationnum = '.$locationnum)
 388             or FS::contact->count(      'locationnum  = '.$locationnum)
 389             or FS::cust_pkg->count('cancel IS NULL AND
 390                                          locationnum  = '.$locationnum)
 391           ;
 392   $self->disabled('Y');
 393   $self->replace;
 394
 395 }
 396
 397 =item move_to
 398
 399 Takes a new L<FS::cust_location> object.  Moves all packages that use the
 400 existing location to the new one, then sets the "disabled" flag on the old
 401 location.  Returns nothing on success, an error message on error.
 402
 403 =cut
 404
 405 sub move_to {
 406   my $old = shift;
 407   my $new = shift;
 408
 409   local $SIG{HUP} = 'IGNORE';
 410   local $SIG{INT} = 'IGNORE';
 411   local $SIG{QUIT} = 'IGNORE';
 412   local $SIG{TERM} = 'IGNORE';
 413   local $SIG{TSTP} = 'IGNORE';
 414   local $SIG{PIPE} = 'IGNORE';
 415
 416   my $oldAutoCommit = $FS::UID::AutoCommit;
 417   local $FS::UID::AutoCommit = 0;
 418   my $dbh = dbh;
 419   my $error = '';
 420
 421   # prevent this from failing because of pkg_svc quantity limits
 422   local( $FS::cust_svc::ignore_quantity ) = 1;
 423
 424   if ( !$new->locationnum ) {
 425     $error = $new->insert;
 426     if ( $error ) {
 427       $dbh->rollback if $oldAutoCommit;
 428       return "Error creating location: $error";
 429     }
 430   }
 431
 432   # find all packages that have the old location as their service address,
 433   # and aren't canceled,
 434   # and aren't supplemental to another package.
 435   my @pkgs = qsearch('cust_pkg', {
 436       'locationnum' => $old->locationnum,
 437       'cancel'      => '',
 438       'main_pkgnum' => '',
 439     });
 440   foreach my $cust_pkg (@pkgs) {
 441     $error = $cust_pkg->change(
 442       'locationnum' => $new->locationnum,
 443       'keep_dates'  => 1
 444     );
 445     if ( $error and not ref($error) ) {
 446       $dbh->rollback if $oldAutoCommit;
 447       return "Error moving pkgnum ".$cust_pkg->pkgnum.": $error";
 448     }
 449   }
 450
 451   $error = $old->disable_if_unused;
 452   if ( $error ) {
 453     $dbh->rollback if $oldAutoCommit;
 454     return "Error disabling old location: $error";
 455   }
 456
 457   $dbh->commit if $oldAutoCommit;
 458   '';
 459 }
 460
 461 =item alternize
 462
 463 Attempts to parse data for location_type and location_number from address1
 464 and address2.
 465
 466 =cut
 467
 468 sub alternize {
 469   my $self = shift;
 470
 471   return '' if $self->get('location_type')
 472             || $self->get('location_number');
 473
 474   my %parse;
 475   if ( 1 ) { #ikano, switch on via config
 476     { no warnings 'void';
 477       eval { 'use FS::part_export::ikano;' };
 478       die $@ if $@;
 479     }
 480     %parse = FS::part_export::ikano->location_types_parse;
 481   } else {
 482     %parse = (); #?
 483   }
 484
 485   foreach my $from ('address1', 'address2') {
 486     foreach my $parse ( keys %parse ) {
 487       my $value = $self->get($from);
 488       if ( $value =~ s/(^|\W+)$parse\W+(\w+)\W*$//i ) {
 489         $self->set('location_type', $parse{$parse});
 490         $self->set('location_number', $2);
 491         $self->set($from, $value);
 492         return '';
 493       }
 494     }
 495   }
 496
 497   #nothing matched, no changes
 498   $self->get('address2')
 499     ? "Can't parse unit type and number from address2"
 500     : '';
 501 }
 502
 503 =item dealternize
 504
 505 Moves data from location_type and location_number to the end of address1.
 506
 507 =cut
 508
 509 sub dealternize {
 510   my $self = shift;
 511
 512   #false laziness w/geocode_Mixin.pm::line
 513   my $lt = $self->get('location_type');
 514   if ( $lt ) {
 515
 516     my %location_type;
 517     if ( 1 ) { #ikano, switch on via config
 518       { no warnings 'void';
 519         eval { 'use FS::part_export::ikano;' };
 520         die $@ if $@;
 521       }
 522       %location_type = FS::part_export::ikano->location_types;
 523     } else {
 524       %location_type = (); #?
 525     }
 526
 527     $self->address1( $self->address1. ' '. $location_type{$lt} || $lt );
 528     $self->location_type('');
 529   }
 530
 531   if ( length($self->location_number) ) {
 532     $self->address1( $self->address1. ' '. $self->location_number );
 533     $self->location_number('');
 534   }
 535
 536   '';
 537 }
 538
 539 =item location_label
 540
 541 Returns the label of the location object, with an optional site ID
 542 string (based on the cust_location-label_prefix config option).
 543
 544 =cut
 545
 546 sub location_label {
 547   my $self = shift;
 548   my %opt = @_;
 549   my $conf = new FS::Conf;
 550   my $prefix = '';
 551   my $format = $conf->config('cust_location-label_prefix') || '';
 552   my $cust_or_prospect;
 553   if ( $self->custnum ) {
 554     $cust_or_prospect = FS::cust_main->by_key($self->custnum);
 555   }
 556   elsif ( $self->prospectnum ) {
 557     $cust_or_prospect = FS::prospect_main->by_key($self->prospectnum);
 558   }
 559
 560   if ( $format eq 'CoStAg' ) {
 561     my $agent = $conf->config('cust_main-custnum-display_prefix',
 562                   $cust_or_prospect->agentnum)
 563                 || $cust_or_prospect->agent->agent;
 564     # else this location is invalid
 565     $prefix = uc( join('',
 566         $self->country,
 567         ($self->state =~ /^(..)/),
 568         ($agent =~ /^(..)/),
 569         sprintf('%05d', $self->locationnum)
 570     ) );
 571   }
 572   elsif ( $self->custnum and
 573           $self->locationnum == $cust_or_prospect->ship_locationnum ) {
 574     $prefix = 'Default service location';
 575   }
 576   $prefix .= ($opt{join_string} ||  ': ') if $prefix;
 577   $prefix . $self->SUPER::location_label(%opt);
 578 }
 579
 580 =item county_state_county
 581
 582 Returns a string consisting of just the county, state and country.
 583
 584 =cut
 585
 586 sub county_state_country {
 587   my $self = shift;
 588   my $label = $self->country;
 589   $label = $self->state.", $label" if $self->state;
 590   $label = $self->county." County, $label" if $self->county;
 591   $label;
 592 }
 593
 594 =back
 595
 596 =head1 CLASS METHODS
 597
 598 =item in_county_sql OPTIONS
 599
 600 Returns an SQL expression to test membership in a cust_main_county
 601 geographic area.  By default, this requires district, city, county,
 602 state, and country to match exactly.  Pass "ornull => 1" to allow
 603 partial matches where some fields are NULL in the cust_main_county
 604 record but not in the location.
 605
 606 Pass "param => 1" to receive a parameterized expression (rather than
 607 one that requires a join to cust_main_county) and a list of parameter
 608 names in order.
 609
 610 =cut
 611
 612 sub in_county_sql {
 613   # replaces FS::cust_pkg::location_sql
 614   my ($class, %opt) = @_;
 615   my $ornull = $opt{ornull} ? ' OR ? IS NULL' : '';
 616   my $x = $ornull ? 3 : 2;
 617   my @fields = (('district') x 3,
 618                 ('city') x 3,
 619                 ('county') x $x,
 620                 ('state') x $x,
 621                 'country');
 622
 623   my $text = (driver_name =~ /^mysql/i) ? 'char' : 'text';
 624
 625   my @where = (
 626     "cust_location.district = ? OR ? = '' OR CAST(? AS $text) IS NULL",
 627     "cust_location.city     = ? OR ? = '' OR CAST(? AS $text) IS NULL",
 628     "cust_location.county   = ? OR (? = '' AND cust_location.county IS NULL) $ornull",
 629     "cust_location.state    = ? OR (? = '' AND cust_location.state IS NULL ) $ornull",
 630     "cust_location.country = ?"
 631   );
 632   my $sql = join(' AND ', map "($_)\n", @where);
 633   if ( $opt{param} ) {
 634     return $sql, @fields;
 635   }
 636   else {
 637     # do the substitution here
 638     foreach (@fields) {
 639       $sql =~ s/\?/cust_main_county.$_/;
 640       $sql =~ s/cust_main_county.$_ = ''/cust_main_county.$_ IS NULL/;
 641     }
 642     return $sql;
 643   }
 644 }
 645
 646 =back
 647
 648 =head2 SUBROUTINES
 649
 650 =over 4
 651
 652 =item process_censustract_update LOCATIONNUM
 653
 654 Queueable function to update the census tract to the current year (as set in
 655 the 'census_year' configuration variable) and retrieve the new tract code.
 656
 657 =cut
 658
 659 sub process_censustract_update {
 660   eval "use FS::GeocodeCache";
 661   die $@ if $@;
 662   my $locationnum = shift;
 663   my $cust_location =
 664     qsearchs( 'cust_location', { locationnum => $locationnum })
 665       or die "locationnum '$locationnum' not found!\n";
 666
 667   my $conf = FS::Conf->new;
 668   my $new_year = $conf->config('census_year') or return;
 669   my $loc = FS::GeocodeCache->new( $cust_location->location_hash );
 670   $loc->set_censustract;
 671   my $error = $loc->get('censustract_error');
 672   die $error if $error;
 673   $cust_location->set('censustract', $loc->get('censustract'));
 674   $cust_location->set('censusyear',  $new_year);
 675   $error = $cust_location->replace;
 676   die $error if $error;
 677   return;
 678 }
 679
 680
 681 sub process_set_coord {
 682   my $job = shift;
 683   # avoid starting multiple instances of this job
 684   my @others = qsearch('queue', {
 685       'status'  => 'locked',
 686       'job'     => $job->job,
 687       'jobnum'  => {op=>'!=', value=>$job->jobnum},
 688   });
 689   return if @others;
 690
 691   $job->update_statustext('finding locations to update');
 692   my @missing_coords = qsearch('cust_location', {
 693       'disabled'  => '',
 694       'latitude'  => '',
 695       'longitude' => '',
 696   });
 697   my $i = 0;
 698   my $n = scalar @missing_coords;
 699   for my $cust_location (@missing_coords) {
 700     $cust_location->set_coord;
 701     my $error = $cust_location->replace;
 702     if ( $error ) {
 703       warn "error geocoding location#".$cust_location->locationnum.": $error\n";
 704     } else {
 705       $i++;
 706       $job->update_statustext("updated $i / $n locations");
 707       dbh->commit; # so that we don't have to wait for the whole thing to finish
 708       # Rate-limit to stay under the Google Maps usage limit (2500/day).
 709       # 86,400 / 35 = 2,468 lookups per day.
 710     }
 711     sleep 35;
 712   }
 713   if ( $i < $n ) {
 714     die "failed to update ".$n-$i." locations\n";
 715   }
 716   return;
 717 }
 718
 719 =head1 BUGS
 720
 721 =head1 SEE ALSO
 722
 723 L<FS::cust_main_county>, L<FS::cust_pkg>, L<FS::Record>,
 724 schema.html from the base documentation.
 725
 726 =cut
 727
 728 1;
 729