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