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