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 $DEBUG $conf $label_prefix $allow_location_edit );
   6 use Data::Dumper;
   7 use Date::Format qw( time2str );
   8 use FS::UID qw( dbh driver_name );
   9 use FS::Record qw( qsearch qsearchs );
  10 use FS::Conf;
  11 use FS::prospect_main;
  12 use FS::cust_main;
  13 use FS::cust_main_county;
  14 use FS::part_export;
  15 use FS::GeocodeCache;
  16
  17 # Essential fields. Can't be modified in place, will be considered in
  18 # deciding if a location is "new", and (because of that) can't have
  19 # leading/trailing whitespace.
  20 my @essential = (qw(custnum address1 address2 city county state zip country
  21   location_number location_type location_kind disabled));
  22
  23 $import = 0;
  24
  25 $DEBUG = 0;
  26
  27 FS::UID->install_callback( sub {
  28   $conf = FS::Conf->new;
  29   $label_prefix = $conf->config('cust_location-label_prefix') || '';
  30 });
  31
  32 =head1 NAME
  33
  34 FS::cust_location - Object methods for cust_location records
  35
  36 =head1 SYNOPSIS
  37
  38   use FS::cust_location;
  39
  40   $record = new FS::cust_location \%hash;
  41   $record = new FS::cust_location { 'column' => 'value' };
  42
  43   $error = $record->insert;
  44
  45   $error = $new_record->replace($old_record);
  46
  47   $error = $record->delete;
  48
  49   $error = $record->check;
  50
  51 =head1 DESCRIPTION
  52
  53 An FS::cust_location object represents a customer (or prospect) location.
  54 FS::cust_location inherits from FS::Record.  The following fields are currently
  55 supported:
  56
  57 =over 4
  58
  59 =item locationnum
  60
  61 primary key
  62
  63 =item custnum
  64
  65 Customer (see L<FS::cust_main>).
  66
  67 =item prospectnum
  68
  69 Prospect (see L<FS::prospect_main>).
  70
  71 =item locationname
  72
  73 Optional location name.
  74
  75 =item address1
  76
  77 Address line one (required)
  78
  79 =item address2
  80
  81 Address line two (optional)
  82
  83 =item city
  84
  85 City (if cust_main-no_city_in_address config is set when inserting, this will be forced blank)
  86
  87 =item county
  88
  89 County (optional, see L<FS::cust_main_county>)
  90
  91 =item state
  92
  93 State (see L<FS::cust_main_county>)
  94
  95 =item zip
  96
  97 Zip
  98
  99 =item country
 100
 101 Country (see L<FS::cust_main_county>)
 102
 103 =item geocode
 104
 105 Geocode
 106
 107 =item latitude
 108
 109 =item longitude
 110
 111 =item coord_auto
 112
 113 Flag indicating whether coordinates were obtained automatically or manually
 114 entered
 115
 116 =item addr_clean
 117
 118 Flag indicating whether address has been normalized
 119
 120 =item censustract
 121
 122 =item censusyear
 123
 124 =item district
 125
 126 Tax district code (optional)
 127
 128 =item incorporated
 129
 130 Incorporated city flag: set to 'Y' if the address is in the legal borders
 131 of an incorporated city.
 132
 133 =item disabled
 134
 135 Disabled flag; set to 'Y' to disable the location.
 136
 137 =back
 138
 139 =head1 METHODS
 140
 141 =over 4
 142
 143 =item new HASHREF
 144
 145 Creates a new location.  To add the location to the database, see L<"insert">.
 146
 147 Note that this stores the hash reference, not a distinct copy of the hash it
 148 points to.  You can ask the object for a copy with the I<hash> method.
 149
 150 =cut
 151
 152 sub table { 'cust_location'; }
 153
 154 =item find_or_insert
 155
 156 Finds an existing location matching the customer and address values in this
 157 location, if one exists, and sets the contents of this location equal to that
 158 one (including its locationnum).
 159
 160 If an existing location is not found, this one I<will> be inserted.  (This is a
 161 change from the "new_or_existing" method that this replaces.)
 162
 163 The following fields are considered "essential" and I<must> match: custnum,
 164 address1, address2, city, county, state, zip, country, location_number,
 165 location_type, location_kind.  Disabled locations will be found only if this
 166 location is set to disabled.
 167
 168 All other fields are considered "non-essential" and will be ignored in
 169 finding a matching location.  If the existing location doesn't match
 170 in these fields, it will be updated in-place to match.
 171
 172 Returns an error string if inserting or updating a location failed.
 173
 174 It is unfortunately hard to determine if this created a new location or not.
 175
 176 =cut
 177
 178 sub find_or_insert {
 179   my $self = shift;
 180
 181   warn "find_or_insert:\n".Dumper($self) if $DEBUG;
 182
 183   if ($conf->exists('cust_main-no_city_in_address')) {
 184     warn "Warning: passed city to find_or_insert when cust_main-no_city_in_address is configured, ignoring it"
 185       if $self->get('city');
 186     $self->set('city','');
 187   }
 188
 189   # I don't think this is necessary
 190   #if ( !$self->coord_auto and $self->latitude and $self->longitude ) {
 191   #  push @essential, qw(latitude longitude);
 192   #  # but NOT coord_auto; if the latitude and longitude match the geocoded
 193   #  # values then that's good enough
 194   #}
 195
 196   # put nonempty, nonessential fields/values into this hash
 197   my %nonempty = map { $_ => $self->get($_) }
 198                  grep {$self->get($_)} $self->fields;
 199   delete @nonempty{@essential};
 200   delete $nonempty{'locationnum'};
 201
 202   my %hash = map { $_ => $self->get($_) } @essential;
 203   foreach (values %hash) {
 204     s/^\s+//;
 205     s/\s+$//;
 206   }
 207   my @matches = qsearch('cust_location', \%hash);
 208
 209   # we no longer reject matches for having different values in nonessential
 210   # fields; we just alter the record to match
 211   if ( @matches ) {
 212     my $old = $matches[0];
 213     warn "found existing location #".$old->locationnum."\n" if $DEBUG;
 214     foreach my $field (keys %nonempty) {
 215       if ($old->get($field) ne $nonempty{$field}) {
 216         warn "altering $field to match requested location" if $DEBUG;
 217         $old->set($field, $nonempty{$field});
 218       }
 219     } # foreach $field
 220
 221     if ( $old->modified ) {
 222       warn "updating non-essential fields\n" if $DEBUG;
 223       my $error = $old->replace;
 224       return $error if $error;
 225     }
 226     # set $self equal to $old
 227     foreach ($self->fields) {
 228       $self->set($_, $old->get($_));
 229     }
 230     return "";
 231   }
 232
 233   # didn't find a match
 234   warn "not found; inserting new location\n" if $DEBUG;
 235   return $self->insert;
 236 }
 237
 238 =item insert
 239
 240 Adds this record to the database.  If there is an error, returns the error,
 241 otherwise returns false.
 242
 243 =cut
 244
 245 sub insert {
 246   my $self = shift;
 247
 248   if ($conf->exists('cust_main-no_city_in_address')) {
 249     warn "Warning: passed city to insert when cust_main-no_city_in_address is configured, ignoring it"
 250       if $self->get('city');
 251     $self->set('city','');
 252   }
 253
 254   if ( $self->censustract ) {
 255     $self->set('censusyear' => $conf->config('census_legacy') || 2020);
 256   }
 257
 258   my $oldAutoCommit = $FS::UID::AutoCommit;
 259   local $FS::UID::AutoCommit = 0;
 260   my $dbh = dbh;
 261
 262   my $error = $self->SUPER::insert(@_);
 263   if ( $error ) {
 264     $dbh->rollback if $oldAutoCommit;
 265     return $error;
 266   }
 267
 268   # If using tax_district_method, for rows in state of Washington,
 269   # without a tax district already specified, queue a job to find
 270   # the tax district
 271   if (
 272        !$import
 273     && !$self->district
 274     && lc $self->state eq 'wa'
 275     && $conf->config('tax_district_method')
 276   ) {
 277
 278     my $queue = new FS::queue {
 279       'job' => 'FS::geocode_Mixin::process_district_update'
 280     };
 281     $error = $queue->insert( ref($self), $self->locationnum );
 282     if ( $error ) {
 283       $dbh->rollback if $oldAutoCommit;
 284       return $error;
 285     }
 286
 287   }
 288
 289   # cust_location exports
 290   #my $export_args = $options{'export_args'} || [];
 291
 292   # don't export custnum_pending cases, let follow-up replace handle that
 293   if ($self->custnum || $self->prospectnum) {
 294     my @part_export =
 295       map qsearch( 'part_export', {exportnum=>$_} ),
 296         $conf->config('cust_location-exports'); #, $agentnum
 297
 298     foreach my $part_export ( @part_export ) {
 299       my $error = $part_export->export_insert($self); #, @$export_args);
 300       if ( $error ) {
 301         $dbh->rollback if $oldAutoCommit;
 302         return "exporting to ". $part_export->exporttype.
 303                " (transaction rolled back): $error";
 304       }
 305     }
 306   }
 307
 308   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 309   '';
 310 }
 311
 312 =item delete
 313
 314 Delete this record from the database.
 315
 316 =item replace OLD_RECORD
 317
 318 Replaces the OLD_RECORD with this one in the database.  If there is an error,
 319 returns the error, otherwise returns false.
 320
 321 =cut
 322
 323 sub replace {
 324   my $self = shift;
 325   my $old = shift;
 326   $old ||= $self->replace_old;
 327
 328   warn "Warning: passed city to replace when cust_main-no_city_in_address is configured"
 329     if $conf->exists('cust_main-no_city_in_address') && $self->get('city');
 330
 331   # the following fields are immutable if this is a customer location. if
 332   # it's a prospect location, then there are no active packages, no billing
 333   # history, no taxes, and in general no reason to keep the old location
 334   # around.
 335   if ( !$allow_location_edit and $self->custnum ) {
 336     foreach (qw(address1 address2 city state zip country)) {
 337       if ( $self->$_ ne $old->$_ ) {
 338         return "can't change cust_location field $_";
 339       }
 340     }
 341   }
 342
 343   my $oldAutoCommit = $FS::UID::AutoCommit;
 344   local $FS::UID::AutoCommit = 0;
 345   my $dbh = dbh;
 346
 347   my $error = $self->SUPER::replace($old);
 348   if ( $error ) {
 349     $dbh->rollback if $oldAutoCommit;
 350     return $error;
 351   }
 352
 353   # cust_location exports
 354   #my $export_args = $options{'export_args'} || [];
 355
 356   # don't export custnum_pending cases, let follow-up replace handle that
 357   if ($self->custnum || $self->prospectnum) {
 358     my @part_export =
 359       map qsearch( 'part_export', {exportnum=>$_} ),
 360         $conf->config('cust_location-exports'); #, $agentnum
 361
 362     foreach my $part_export ( @part_export ) {
 363       my $error = $part_export->export_replace($self, $old); #, @$export_args);
 364       if ( $error ) {
 365         $dbh->rollback if $oldAutoCommit;
 366         return "exporting to ". $part_export->exporttype.
 367                " (transaction rolled back): $error";
 368       }
 369     }
 370   }
 371
 372   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 373   '';
 374 }
 375
 376
 377 =item check
 378
 379 Checks all fields to make sure this is a valid location.  If there is
 380 an error, returns the error, otherwise returns false.  Called by the insert
 381 and replace methods.
 382
 383 =cut
 384
 385 sub check {
 386   my $self = shift;
 387
 388   return '' if $self->disabled; # so that disabling locations never fails
 389
 390   # whitespace in essential fields leads to problems figuring out if a
 391   # record is "new"; get rid of it.
 392   $self->trim_whitespace(@essential);
 393
 394   my $error =
 395     $self->ut_numbern('locationnum')
 396     || $self->ut_foreign_keyn('prospectnum', 'prospect_main', 'prospectnum')
 397     || $self->ut_foreign_keyn('custnum', 'cust_main', 'custnum')
 398     || $self->ut_textn('locationname')
 399     || $self->ut_text('address1')
 400     || $self->ut_textn('address2')
 401     || ($conf->exists('cust_main-no_city_in_address')
 402         ? $self->ut_textn('city')
 403         : $self->ut_text('city'))
 404     || $self->ut_textn('county')
 405     || $self->ut_textn('state')
 406     || $self->ut_country('country')
 407     || (!$import && $self->ut_zip('zip', $self->country))
 408     || $self->ut_coordn('latitude')
 409     || $self->ut_coordn('longitude')
 410     || $self->ut_enum('coord_auto', [ '', 'Y' ])
 411     || $self->ut_enum('addr_clean', [ '', 'Y' ])
 412     || $self->ut_alphan('location_type')
 413     || $self->ut_textn('location_number')
 414     || $self->ut_enum('location_kind', [ '', 'R', 'B' ] )
 415     || $self->ut_alphan('geocode')
 416     || $self->ut_alphan('district')
 417     || $self->ut_numbern('censusyear')
 418     || $self->ut_flag('incorporated')
 419   ;
 420   return $error if $error;
 421   if ( $self->censustract ne '' ) {
 422     if ( $self->censustract =~ /^\s*(\d{9})\.?(\d{2})\s*$/ ) { #old
 423       $self->censustract("$1.$2");
 424     } elsif ($self->censustract =~ /^\s*(\d{15})\s*$/ ) { #new
 425       $self->censustract($1);
 426     } else {
 427       return "Illegal census tract: ". $self->censustract;
 428     }
 429   }
 430
 431   #yikes... this is ancient, pre-dates cust_location and will be harder to
 432   # implement now... how do we know this location is a service location from
 433   # here and not a billing? we can't just check locationnums, we might be new :/
 434   return "Unit # is required"
 435     if $conf->exists('cust_main-require_address2')
 436     && ! $self->address2 =~ /\S/;
 437
 438   # tricky...we have to allow for the customer to not be inserted yet
 439   return "No prospect or customer!" unless $self->prospectnum
 440                                         || $self->custnum
 441                                         || $self->get('custnum_pending');
 442   return "Prospect and customer!"       if $self->prospectnum && $self->custnum;
 443
 444   return 'Location kind is required'
 445     if $self->prospectnum
 446     && $conf->exists('prospect_main-alt_address_format')
 447     && ! $self->location_kind;
 448
 449   # Do not allow bad tax district values in cust_location when
 450   # using Washington State district sales tax calculation - would result
 451   # in incorrect or missing sales tax on invoices.
 452   my $tax_district_method = FS::Conf->new->config('tax_district_method');
 453   if (
 454     $tax_district_method
 455     && $tax_district_method eq 'wa_sales'
 456     && $self->district
 457   ) {
 458     my $cust_main_county = qsearchs(
 459       cust_main_county => { district => $self->district }
 460     );
 461     unless ( ref $cust_main_county ) {
 462       return sprintf (
 463         'WA State tax district %s does not exist in tax table',
 464         $self->district
 465       );
 466     }
 467   }
 468
 469   unless ( $import or qsearch('cust_main_county', {
 470     'country' => $self->country,
 471     'state'   => '',
 472    } ) ) {
 473     return "Unknown state/county/country: ".
 474       $self->state. "/". $self->county. "/". $self->country
 475       unless qsearch('cust_main_county',{
 476         'state'   => $self->state,
 477         'county'  => $self->county,
 478         'country' => $self->country,
 479       } );
 480   }
 481
 482   # set coordinates, unless we already have them
 483   if (!$import and !$self->latitude and !$self->longitude) {
 484     $self->set_coord;
 485   }
 486
 487   $self->SUPER::check;
 488 }
 489
 490 =item country_full
 491
 492 Returns this location's full country name
 493
 494 =cut
 495
 496 #moved to geocode_Mixin.pm
 497
 498 =item line
 499
 500 Synonym for location_label
 501
 502 =cut
 503
 504 sub line {
 505   my $self = shift;
 506   $self->location_label(@_);
 507 }
 508
 509 =item has_ship_address
 510
 511 Returns false since cust_location objects do not have a separate shipping
 512 address.
 513
 514 =cut
 515
 516 sub has_ship_address {
 517   '';
 518 }
 519
 520 =item location_hash
 521
 522 Returns a list of key/value pairs, with the following keys: address1, address2,
 523 city, county, state, zip, country, geocode, location_type, location_number,
 524 location_kind.
 525
 526 =cut
 527
 528 =item disable_if_unused
 529
 530 Sets the "disabled" flag on the location if it is no longer in use as a
 531 prospect location, package location, or a customer's billing or default
 532 service address.
 533
 534 =cut
 535
 536 sub disable_if_unused {
 537
 538   my $self = shift;
 539   my $locationnum = $self->locationnum;
 540   return '' if FS::cust_main->count('bill_locationnum = '.$locationnum.' OR
 541                                      ship_locationnum = '.$locationnum)
 542             or FS::contact->count(      'locationnum  = '.$locationnum)
 543             or FS::cust_pkg->count('cancel IS NULL AND
 544                                          locationnum  = '.$locationnum)
 545           ;
 546   $self->disabled('Y');
 547   $self->replace;
 548
 549 }
 550
 551 =item move_pkgs
 552
 553 Returns array of cust_pkg objects that would have their location
 554 updated by L</move_to> (all packages that have this location as
 555 their service address, and aren't canceled, and aren't supplemental
 556 to another package, and aren't one-time charges that have already been charged.)
 557
 558 =cut
 559
 560 sub move_pkgs {
 561   my $self = shift;
 562   my @pkgs = ();
 563   # find all packages that have the old location as their service address,
 564   # and aren't canceled,
 565   # and aren't supplemental to another package
 566   # and aren't one-time charges that have already been charged
 567   foreach my $cust_pkg (
 568     qsearch('cust_pkg', {
 569       'locationnum' => $self->locationnum,
 570       'cancel'      => '',
 571       'main_pkgnum' => '',
 572     })
 573   ) {
 574     next if $cust_pkg->part_pkg->freq eq '0'
 575             and ($cust_pkg->setup || 0) > 0;
 576     push @pkgs, $cust_pkg;
 577   }
 578   return @pkgs;
 579 }
 580
 581 =item move_to NEW [ move_pkgs => \@move_pkgs ]
 582
 583 Takes a new L<FS::cust_location> object.  Moves all packages that use the
 584 existing location to the new one, then sets the "disabled" flag on the old
 585 location.  Returns nothing on success, an error message on error.
 586
 587 Use option I<move_pkgs> to override the list of packages to update
 588 (see L</move_pkgs>.)
 589
 590 =cut
 591
 592 sub move_to {
 593   my $old = shift;
 594   my $new = shift;
 595   my %opt = @_;
 596
 597   warn "move_to:\nFROM:".Dumper($old)."\nTO:".Dumper($new) if $DEBUG;
 598
 599   local $SIG{HUP} = 'IGNORE';
 600   local $SIG{INT} = 'IGNORE';
 601   local $SIG{QUIT} = 'IGNORE';
 602   local $SIG{TERM} = 'IGNORE';
 603   local $SIG{TSTP} = 'IGNORE';
 604   local $SIG{PIPE} = 'IGNORE';
 605
 606   my $oldAutoCommit = $FS::UID::AutoCommit;
 607   local $FS::UID::AutoCommit = 0;
 608   my $dbh = dbh;
 609   my $error = '';
 610
 611   # prevent this from failing because of pkg_svc quantity limits
 612   local( $FS::cust_svc::ignore_quantity ) = 1;
 613
 614   if ( !$new->locationnum ) {
 615     $error = $new->insert;
 616     if ( $error ) {
 617       $dbh->rollback if $oldAutoCommit;
 618       return "Error creating location: $error";
 619     }
 620   } elsif ( $new->locationnum == $old->locationnum ) {
 621     # then they're the same location; the normal result of doing a minor
 622     # location edit
 623     $dbh->commit if $oldAutoCommit;
 624     return '';
 625   }
 626
 627   my @pkgs;
 628   if ($opt{'move_pkgs'}) {
 629     @pkgs = @{$opt{'move_pkgs'}};
 630     my $pkgerr;
 631     foreach my $pkg (@pkgs) {
 632       my $pkgnum = $pkg->pkgnum;
 633       $pkgerr = "cust_pkg $pkgnum has already been charged"
 634         if $pkg->part_pkg->freq eq '0'
 635           and ($pkg->setup || 0) > 0;
 636       $pkgerr = "cust_pkg $pkgnum is supplemental"
 637         if $pkg->main_pkgnum;
 638       $pkgerr = "cust_pkg $pkgnum already cancelled"
 639         if $pkg->cancel;
 640       $pkgerr = "cust_pkg $pkgnum does not use this location"
 641         unless $pkg->locationnum eq $old->locationnum;
 642       last if $pkgerr;
 643     }
 644     if ($pkgerr) {
 645       $dbh->rollback if $oldAutoCommit;
 646       return "Cannot update package location: $pkgerr";
 647     }
 648   } else {
 649     @pkgs = $old->move_pkgs;
 650   }
 651
 652   foreach my $cust_pkg (@pkgs) {
 653     $error = $cust_pkg->change(
 654       'locationnum' => $new->locationnum,
 655       'keep_dates'  => 1
 656     );
 657     if ( $error and not ref($error) ) {
 658       $dbh->rollback if $oldAutoCommit;
 659       return "Error moving pkgnum ".$cust_pkg->pkgnum.": $error";
 660     }
 661   }
 662
 663   $error = $old->disable_if_unused;
 664   if ( $error ) {
 665     $dbh->rollback if $oldAutoCommit;
 666     return "Error disabling old location: $error";
 667   }
 668
 669   $dbh->commit if $oldAutoCommit;
 670   '';
 671 }
 672
 673 =item alternize
 674
 675 Attempts to parse data for location_type and location_number from address1
 676 and address2.
 677
 678 =cut
 679
 680 sub alternize {
 681   my $self = shift;
 682
 683   return '' if $self->get('location_type')
 684             || $self->get('location_number');
 685
 686   my %parse;
 687   if ( 1 ) { #ikano, switch on via config
 688     { no warnings 'void';
 689       eval { 'use FS::part_export::ikano;' };
 690       die $@ if $@;
 691     }
 692     %parse = FS::part_export::ikano->location_types_parse;
 693   } else {
 694     %parse = (); #?
 695   }
 696
 697   foreach my $from ('address1', 'address2') {
 698     foreach my $parse ( keys %parse ) {
 699       my $value = $self->get($from);
 700       if ( $value =~ s/(^|\W+)$parse\W+(\w+)\W*$//i ) {
 701         $self->set('location_type', $parse{$parse});
 702         $self->set('location_number', $2);
 703         $self->set($from, $value);
 704         return '';
 705       }
 706     }
 707   }
 708
 709   #nothing matched, no changes
 710   $self->get('address2')
 711     ? "Can't parse unit type and number from address2"
 712     : '';
 713 }
 714
 715 =item dealternize
 716
 717 Moves data from location_type and location_number to the end of address1.
 718
 719 =cut
 720
 721 sub dealternize {
 722   my $self = shift;
 723
 724   #false laziness w/geocode_Mixin.pm::line
 725   my $lt = $self->get('location_type');
 726   if ( $lt ) {
 727
 728     my %location_type;
 729     if ( 1 ) { #ikano, switch on via config
 730       { no warnings 'void';
 731         eval { 'use FS::part_export::ikano;' };
 732         die $@ if $@;
 733       }
 734       %location_type = FS::part_export::ikano->location_types;
 735     } else {
 736       %location_type = (); #?
 737     }
 738
 739     $self->address1( $self->address1. ' '. $location_type{$lt} || $lt );
 740     $self->location_type('');
 741   }
 742
 743   if ( length($self->location_number) ) {
 744     $self->address1( $self->address1. ' '. $self->location_number );
 745     $self->location_number('');
 746   }
 747
 748   '';
 749 }
 750
 751 =item location_label
 752
 753 Returns the label of the location object.
 754
 755 Options:
 756
 757 =over 4
 758
 759 =item cust_main
 760
 761 Customer object (see L<FS::cust_main>)
 762
 763 =item prospect_main
 764
 765 Prospect object (see L<FS::prospect_main>)
 766
 767 =item join_string
 768
 769 String used to join location elements
 770
 771 =item no_prefix
 772
 773 Don't label the default service location as "Default service location".
 774 May become the default at some point.
 775
 776 =back
 777
 778 =cut
 779
 780 sub location_label {
 781   my( $self, %opt ) = @_;
 782
 783   my $prefix = $self->label_prefix(%opt);
 784   $prefix .= ($opt{join_string} ||  ': ') if $prefix;
 785   $prefix = '' if $opt{'no_prefix'};
 786
 787   $prefix . $self->SUPER::location_label(%opt);
 788 }
 789
 790 =item label_prefix
 791
 792 Returns the optional site ID string (based on the cust_location-label_prefix
 793 config option), "Default service location", or the empty string.
 794
 795 Options:
 796
 797 =over 4
 798
 799 =item cust_main
 800
 801 Customer object (see L<FS::cust_main>)
 802
 803 =item prospect_main
 804
 805 Prospect object (see L<FS::prospect_main>)
 806
 807 =back
 808
 809 =cut
 810
 811 sub label_prefix {
 812   my( $self, %opt ) = @_;
 813
 814   my $cust_or_prospect = $opt{cust_main} || $opt{prospect_main};
 815   unless ( $cust_or_prospect ) {
 816     if ( $self->custnum ) {
 817       $cust_or_prospect = FS::cust_main->by_key($self->custnum);
 818     } elsif ( $self->prospectnum ) {
 819       $cust_or_prospect = FS::prospect_main->by_key($self->prospectnum);
 820     }
 821   }
 822
 823   my $prefix = '';
 824   if ( $label_prefix eq 'CoStAg' ) {
 825     my $agent = $conf->config('cust_main-custnum-display_prefix',
 826                   $cust_or_prospect->agentnum)
 827                 || $cust_or_prospect->agent->agent;
 828     # else this location is invalid
 829     $prefix = uc( join('',
 830         $self->country,
 831         ($self->state =~ /^(..)/),
 832         ($agent =~ /^(..)/),
 833         sprintf('%05d', $self->locationnum)
 834     ) );
 835
 836   } elsif ( $label_prefix eq '_location' && $self->locationname ) {
 837     $prefix = $self->locationname;
 838
 839   #} elsif (    ( $opt{'cust_main'} || $self->custnum )
 840   #        && $self->locationnum == $cust_or_prospect->ship_locationnum ) {
 841   #  $prefix = 'Default service location';
 842   #}
 843   } else {
 844     $prefix = '';
 845   }
 846
 847   $prefix;
 848 }
 849
 850 =item county_state_country
 851
 852 Returns a string consisting of just the county, state and country.
 853
 854 =cut
 855
 856 sub county_state_country {
 857   my $self = shift;
 858   my $label = $self->country;
 859   $label = $self->state.", $label" if $self->state;
 860   $label = $self->county." County, $label" if $self->county;
 861   $label;
 862 }
 863
 864 =back
 865
 866 =head2 SUBROUTINES
 867
 868 =over 4
 869
 870 =item process_censustract_update LOCATIONNUM
 871
 872 Queueable function to update the census tract to the current year (as set in
 873 the 'census_year' configuration variable) and retrieve the new tract code.
 874
 875 =cut
 876
 877 sub process_censustract_update {
 878   eval "use FS::GeocodeCache";
 879   die $@ if $@;
 880   my $locationnum = shift;
 881   my $cust_location =
 882     qsearchs( 'cust_location', { locationnum => $locationnum })
 883       or die "locationnum '$locationnum' not found!\n";
 884
 885   my $new_year = $conf->config('census_legacy') || 2020;
 886   my $loc = FS::GeocodeCache->new( $cust_location->location_hash );
 887   $loc->set_censustract;
 888   my $error = $loc->get('censustract_error');
 889   die $error if $error;
 890   $cust_location->set('censustract', $loc->get('censustract'));
 891   $cust_location->set('censusyear',  $new_year);
 892   $error = $cust_location->replace;
 893   die $error if $error;
 894   return;
 895 }
 896
 897 =item process_set_coord
 898
 899 Queueable function to find and fill in coordinates for all locations that
 900 lack them.  Because this uses the Google Maps API, it's internally rate
 901 limited and must run in a single process.
 902
 903 =cut
 904
 905 sub process_set_coord {
 906   my $job = shift;
 907   # avoid starting multiple instances of this job
 908   my @others = qsearch('queue', {
 909       'status'  => 'locked',
 910       'job'     => $job->job,
 911       'jobnum'  => {op=>'!=', value=>$job->jobnum},
 912   });
 913   return if @others;
 914
 915   $job->update_statustext('finding locations to update');
 916   my @missing_coords = qsearch('cust_location', {
 917       'disabled'  => '',
 918       'latitude'  => '',
 919       'longitude' => '',
 920   });
 921   my $i = 0;
 922   my $n = scalar @missing_coords;
 923   for my $cust_location (@missing_coords) {
 924     $cust_location->set_coord;
 925     my $error = $cust_location->replace;
 926     if ( $error ) {
 927       warn "error geocoding location#".$cust_location->locationnum.": $error\n";
 928     } else {
 929       $i++;
 930       $job->update_statustext("updated $i / $n locations");
 931       dbh->commit; # so that we don't have to wait for the whole thing to finish
 932       # Rate-limit to stay under the Google Maps usage limit (2500/day).
 933       # 86,400 / 35 = 2,468 lookups per day.
 934     }
 935     sleep 35;
 936   }
 937   if ( $i < $n ) {
 938     die "failed to update ".$n-$i." locations\n";
 939   }
 940   return;
 941 }
 942
 943 =item process_standardize [ LOCATIONNUMS ]
 944
 945 Performs address standardization on locations with unclean addresses,
 946 using whatever method you have configured.  If the standardize_* method
 947 returns a I<clean> address match, the location will be updated.  This is
 948 always an in-place update (because the physical location is the same,
 949 and is just being referred to by a more accurate name).
 950
 951 Disabled locations will be skipped, as nobody cares.
 952
 953 If any LOCATIONNUMS are provided, only those locations will be updated.
 954
 955 =cut
 956
 957 sub process_standardize {
 958   my $job = shift;
 959   my @others = qsearch('queue', {
 960       'status'  => 'locked',
 961       'job'     => $job->job,
 962       'jobnum'  => {op=>'!=', value=>$job->jobnum},
 963   });
 964   return if @others;
 965   my @locationnums = grep /^\d+$/, @_;
 966   my $where = "AND locationnum IN(".join(',',@locationnums).")"
 967     if scalar(@locationnums);
 968   my @locations = qsearch({
 969       table     => 'cust_location',
 970       hashref   => { addr_clean => '', disabled => '' },
 971       extra_sql => $where,
 972   });
 973   my $n_todo = scalar(@locations);
 974   my $n_done = 0;
 975
 976   # special: log this
 977   my $log;
 978   eval "use Text::CSV";
 979   open $log, '>', "$FS::UID::cache_dir/process_standardize-" .
 980                   time2str('%Y%m%d',time) .
 981                   ".csv";
 982   my $csv = Text::CSV->new({binary => 1, eol => "\n"});
 983
 984   foreach my $cust_location (@locations) {
 985     $job->update_statustext( int(100 * $n_done/$n_todo) . ",$n_done / $n_todo locations" ) if $job;
 986     my $result = FS::GeocodeCache->standardize($cust_location);
 987     if ( $result->{addr_clean} and !$result->{error} ) {
 988       my @cols = ($cust_location->locationnum);
 989       foreach (keys %$result) {
 990         push @cols, $cust_location->get($_), $result->{$_};
 991         $cust_location->set($_, $result->{$_});
 992       }
 993       # bypass immutable field restrictions
 994       my $error = $cust_location->FS::Record::replace;
 995       warn "location ".$cust_location->locationnum.": $error\n" if $error;
 996       $csv->print($log, \@cols);
 997     }
 998     $n_done++;
 999     dbh->commit; # so that we can resume if interrupted
1000   }
1001   close $log;
1002 }
1003
1004 sub _upgrade_data {
1005   my $class = shift;
1006
1007   # are we going to need to update tax districts?
1008   my $use_districts = $conf->config('tax_district_method') ? 1 : 0;
1009
1010   # trim whitespace on records that need it
1011   local $allow_location_edit = 1;
1012   foreach my $field (@essential) {
1013     next if $field eq 'custnum';
1014     next if $field eq 'disabled';
1015     foreach my $location (qsearch({
1016       table => 'cust_location',
1017       extra_sql => " WHERE disabled IS NULL AND ($field LIKE ' %' OR $field LIKE '% ')"
1018     })) {
1019       my $error = $location->replace;
1020       die "$error (fixing whitespace in $field, locationnum ".$location->locationnum.')'
1021         if $error;
1022
1023       if (
1024         $use_districts
1025         && !$location->district
1026         && lc $location->state eq 'wa'
1027       ) {
1028         my $queue = new FS::queue {
1029           'job' => 'FS::geocode_Mixin::process_district_update'
1030         };
1031         $error = $queue->insert( 'FS::cust_location' => $location->locationnum );
1032         die $error if $error;
1033       }
1034     } # foreach $location
1035   } # foreach $field
1036   '';
1037 }
1038
1039 =head1 BUGS
1040
1041 =head1 SEE ALSO
1042
1043 L<FS::cust_main_county>, L<FS::cust_pkg>, L<FS::Record>,
1044 schema.html from the base documentation.
1045
1046 =cut
1047
1048 1;
1049