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 new_or_existing HASHREF
 108
 109 Returns an existing location matching the customer and address fields in
 110 HASHREF, if one exists; otherwise returns a new location containing those
 111 fields.  The following fields must match: address1, address2, city, county,
 112 state, zip, country, geocode, disabled.  Other fields are only required
 113 to match if they're specified in HASHREF.
 114
 115 The new location will not be inserted; the calling code must call C<insert>
 116 (or a method such as C<move_to>) to insert it, and check for errors at that
 117 point.
 118
 119 =cut
 120
 121 sub new_or_existing {
 122   my $class = shift;
 123   my %hash = ref($_[0]) ? %{$_[0]} : @_;
 124   # if coords are empty, then it doesn't matter if they're auto or not
 125   if ( !$hash{'latitude'} and !$hash{'longitude'} ) {
 126     delete $hash{'coord_auto'};
 127   }
 128   foreach ( qw(address1 address2 city county state zip country geocode
 129               disabled ) ) {
 130     # empty fields match only empty fields
 131     $hash{$_} = '' if !defined($hash{$_});
 132   }
 133   return qsearchs('cust_location', \%hash) || $class->new(\%hash);
 134 }
 135
 136 =item insert
 137
 138 Adds this record to the database.  If there is an error, returns the error,
 139 otherwise returns false.
 140
 141 =cut
 142
 143 sub insert {
 144   my $self = shift;
 145   my $conf = new FS::Conf;
 146
 147   if ( $self->censustract ) {
 148     $self->set('censusyear' => $conf->config('census_year') || 2012);
 149   }
 150
 151   my $error = $self->SUPER::insert(@_);
 152
 153   #false laziness with cust_main, will go away eventually
 154   if ( !$import and !$error and $conf->config('tax_district_method') ) {
 155
 156     my $queue = new FS::queue {
 157       'job' => 'FS::geocode_Mixin::process_district_update'
 158     };
 159     $error = $queue->insert( ref($self), $self->locationnum );
 160
 161   }
 162
 163   $error || '';
 164 }
 165
 166 =item delete
 167
 168 Delete this record from the database.
 169
 170 =item replace OLD_RECORD
 171
 172 Replaces the OLD_RECORD with this one in the database.  If there is an error,
 173 returns the error, otherwise returns false.
 174
 175 =cut
 176
 177 sub replace {
 178   my $self = shift;
 179   my $old = shift;
 180   $old ||= $self->replace_old;
 181   # the following fields are immutable
 182   foreach (qw(address1 address2 city state zip country)) {
 183     if ( $self->$_ ne $old->$_ ) {
 184       return "can't change cust_location field $_";
 185     }
 186   }
 187
 188   $self->SUPER::replace($old);
 189 }
 190
 191
 192 =item check
 193
 194 Checks all fields to make sure this is a valid location.  If there is
 195 an error, returns the error, otherwise returns false.  Called by the insert
 196 and replace methods.
 197
 198 =cut
 199
 200 #some false laziness w/cust_main, but since it should eventually lose these
 201 #fields anyway...
 202 sub check {
 203   my $self = shift;
 204   my $conf = new FS::Conf;
 205
 206   my $error =
 207     $self->ut_numbern('locationnum')
 208     || $self->ut_foreign_keyn('prospectnum', 'prospect_main', 'prospectnum')
 209     || $self->ut_foreign_keyn('custnum', 'cust_main', 'custnum')
 210     || $self->ut_text('address1')
 211     || $self->ut_textn('address2')
 212     || $self->ut_text('city')
 213     || $self->ut_textn('county')
 214     || $self->ut_textn('state')
 215     || $self->ut_country('country')
 216     || (!$import && $self->ut_zip('zip', $self->country))
 217     || $self->ut_coordn('latitude')
 218     || $self->ut_coordn('longitude')
 219     || $self->ut_enum('coord_auto', [ '', 'Y' ])
 220     || $self->ut_enum('addr_clean', [ '', 'Y' ])
 221     || $self->ut_alphan('location_type')
 222     || $self->ut_textn('location_number')
 223     || $self->ut_enum('location_kind', [ '', 'R', 'B' ] )
 224     || $self->ut_alphan('geocode')
 225     || $self->ut_alphan('district')
 226     || $self->ut_numbern('censusyear')
 227   ;
 228   return $error if $error;
 229   if ( $self->censustract ne '' ) {
 230     $self->censustract =~ /^\s*(\d{9})\.?(\d{2})\s*$/
 231       or return "Illegal census tract: ". $self->censustract;
 232
 233     $self->censustract("$1.$2");
 234   }
 235
 236   if ( $conf->exists('cust_main-require_address2') and
 237        !$self->ship_address2 =~ /\S/ ) {
 238     return "Unit # is required";
 239   }
 240
 241   # tricky...we have to allow for the customer to not be inserted yet
 242   return "No prospect or customer!" unless $self->prospectnum
 243                                         || $self->custnum
 244                                         || $self->get('custnum_pending');
 245   return "Prospect and customer!"       if $self->prospectnum && $self->custnum;
 246
 247   return 'Location kind is required'
 248     if $self->prospectnum
 249     && $conf->exists('prospect_main-alt_address_format')
 250     && ! $self->location_kind;
 251
 252   unless ( $import or qsearch('cust_main_county', {
 253     'country' => $self->country,
 254     'state'   => '',
 255    } ) ) {
 256     return "Unknown state/county/country: ".
 257       $self->state. "/". $self->county. "/". $self->country
 258       unless qsearch('cust_main_county',{
 259         'state'   => $self->state,
 260         'county'  => $self->county,
 261         'country' => $self->country,
 262       } );
 263   }
 264
 265   $self->SUPER::check;
 266 }
 267
 268 =item country_full
 269
 270 Returns this locations's full country name
 271
 272 =cut
 273
 274 sub country_full {
 275   my $self = shift;
 276   code2country($self->country);
 277 }
 278
 279 =item line
 280
 281 Synonym for location_label
 282
 283 =cut
 284
 285 sub line {
 286   my $self = shift;
 287   $self->location_label;
 288 }
 289
 290 =item has_ship_address
 291
 292 Returns false since cust_location objects do not have a separate shipping
 293 address.
 294
 295 =cut
 296
 297 sub has_ship_address {
 298   '';
 299 }
 300
 301 =item location_hash
 302
 303 Returns a list of key/value pairs, with the following keys: address1, address2,
 304 city, county, state, zip, country, geocode, location_type, location_number,
 305 location_kind.
 306
 307 =cut
 308
 309 =item disable_if_unused
 310
 311 Sets the "disabled" flag on the location if it is no longer in use as a
 312 prospect location, package location, or a customer's billing or default
 313 service address.
 314
 315 =cut
 316
 317 sub disable_if_unused {
 318
 319   my $self = shift;
 320   my $locationnum = $self->locationnum;
 321   return '' if FS::cust_main->count('bill_locationnum = '.$locationnum)
 322             or FS::cust_main->count('ship_locationnum = '.$locationnum)
 323             or FS::contact->count(      'locationnum  = '.$locationnum)
 324             or FS::cust_pkg->count('cancel IS NULL AND
 325                                          locationnum  = '.$locationnum)
 326           ;
 327   $self->disabled('Y');
 328   $self->replace;
 329
 330 }
 331
 332 =item move_to
 333
 334 Takes a new L<FS::cust_location> object.  Moves all packages that use the
 335 existing location to the new one, then sets the "disabled" flag on the old
 336 location.  Returns nothing on success, an error message on error.
 337
 338 =cut
 339
 340 sub move_to {
 341   my $old = shift;
 342   my $new = shift;
 343
 344   local $SIG{HUP} = 'IGNORE';
 345   local $SIG{INT} = 'IGNORE';
 346   local $SIG{QUIT} = 'IGNORE';
 347   local $SIG{TERM} = 'IGNORE';
 348   local $SIG{TSTP} = 'IGNORE';
 349   local $SIG{PIPE} = 'IGNORE';
 350
 351   my $oldAutoCommit = $FS::UID::AutoCommit;
 352   local $FS::UID::AutoCommit = 0;
 353   my $dbh = dbh;
 354   my $error = '';
 355
 356   # prevent this from failing because of pkg_svc quantity limits
 357   local( $FS::cust_svc::ignore_quantity ) = 1;
 358
 359   if ( !$new->locationnum ) {
 360     $error = $new->insert;
 361     if ( $error ) {
 362       $dbh->rollback if $oldAutoCommit;
 363       return "Error creating location: $error";
 364     }
 365   }
 366
 367   my @pkgs = qsearch('cust_pkg', {
 368       'locationnum' => $old->locationnum,
 369       'cancel' => ''
 370     });
 371   foreach my $cust_pkg (@pkgs) {
 372     $error = $cust_pkg->change(
 373       'locationnum' => $new->locationnum,
 374       'keep_dates'  => 1
 375     );
 376     if ( $error and not ref($error) ) {
 377       $dbh->rollback if $oldAutoCommit;
 378       return "Error moving pkgnum ".$cust_pkg->pkgnum.": $error";
 379     }
 380   }
 381
 382   $error = $old->disable_if_unused;
 383   if ( $error ) {
 384     $dbh->rollback if $oldAutoCommit;
 385     return "Error disabling old location: $error";
 386   }
 387
 388   $dbh->commit if $oldAutoCommit;
 389   '';
 390 }
 391
 392 =item alternize
 393
 394 Attempts to parse data for location_type and location_number from address1
 395 and address2.
 396
 397 =cut
 398
 399 sub alternize {
 400   my $self = shift;
 401
 402   return '' if $self->get('location_type')
 403             || $self->get('location_number');
 404
 405   my %parse;
 406   if ( 1 ) { #ikano, switch on via config
 407     { no warnings 'void';
 408       eval { 'use FS::part_export::ikano;' };
 409       die $@ if $@;
 410     }
 411     %parse = FS::part_export::ikano->location_types_parse;
 412   } else {
 413     %parse = (); #?
 414   }
 415
 416   foreach my $from ('address1', 'address2') {
 417     foreach my $parse ( keys %parse ) {
 418       my $value = $self->get($from);
 419       if ( $value =~ s/(^|\W+)$parse\W+(\w+)\W*$//i ) {
 420         $self->set('location_type', $parse{$parse});
 421         $self->set('location_number', $2);
 422         $self->set($from, $value);
 423         return '';
 424       }
 425     }
 426   }
 427
 428   #nothing matched, no changes
 429   $self->get('address2')
 430     ? "Can't parse unit type and number from address2"
 431     : '';
 432 }
 433
 434 =item dealternize
 435
 436 Moves data from location_type and location_number to the end of address1.
 437
 438 =cut
 439
 440 sub dealternize {
 441   my $self = shift;
 442
 443   #false laziness w/geocode_Mixin.pm::line
 444   my $lt = $self->get('location_type');
 445   if ( $lt ) {
 446
 447     my %location_type;
 448     if ( 1 ) { #ikano, switch on via config
 449       { no warnings 'void';
 450         eval { 'use FS::part_export::ikano;' };
 451         die $@ if $@;
 452       }
 453       %location_type = FS::part_export::ikano->location_types;
 454     } else {
 455       %location_type = (); #?
 456     }
 457
 458     $self->address1( $self->address1. ' '. $location_type{$lt} || $lt );
 459     $self->location_type('');
 460   }
 461
 462   if ( length($self->location_number) ) {
 463     $self->address1( $self->address1. ' '. $self->location_number );
 464     $self->location_number('');
 465   }
 466
 467   '';
 468 }
 469
 470 =item location_label
 471
 472 Returns the label of the location object, with an optional site ID
 473 string (based on the cust_location-label_prefix config option).
 474
 475 =cut
 476
 477 sub location_label {
 478   my $self = shift;
 479   my %opt = @_;
 480   my $conf = new FS::Conf;
 481   my $prefix = '';
 482   my $format = $conf->config('cust_location-label_prefix') || '';
 483   my $cust_or_prospect;
 484   if ( $self->custnum ) {
 485     $cust_or_prospect = FS::cust_main->by_key($self->custnum);
 486   }
 487   elsif ( $self->prospectnum ) {
 488     $cust_or_prospect = FS::prospect_main->by_key($self->prospectnum);
 489   }
 490
 491   if ( $format eq 'CoStAg' ) {
 492     my $agent = $conf->config('cust_main-custnum-display_prefix',
 493                   $cust_or_prospect->agentnum)
 494                 || $cust_or_prospect->agent->agent;
 495     # else this location is invalid
 496     $prefix = uc( join('',
 497         $self->country,
 498         ($self->state =~ /^(..)/),
 499         ($agent =~ /^(..)/),
 500         sprintf('%05d', $self->locationnum)
 501     ) );
 502   }
 503   elsif ( $self->custnum and
 504           $self->locationnum == $cust_or_prospect->ship_locationnum ) {
 505     $prefix = 'Default service location';
 506   }
 507   $prefix .= ($opt{join_string} ||  ': ') if $prefix;
 508   $prefix . $self->SUPER::location_label(%opt);
 509 }
 510
 511 =item county_state_county
 512
 513 Returns a string consisting of just the county, state and country.
 514
 515 =cut
 516
 517 sub county_state_country {
 518   my $self = shift;
 519   my $label = $self->country;
 520   $label = $self->state.", $label" if $self->state;
 521   $label = $self->county." County, $label" if $self->county;
 522   $label;
 523 }
 524
 525 =back
 526
 527 =head1 CLASS METHODS
 528
 529 =item in_county_sql OPTIONS
 530
 531 Returns an SQL expression to test membership in a cust_main_county
 532 geographic area.  By default, this requires district, city, county,
 533 state, and country to match exactly.  Pass "ornull => 1" to allow
 534 partial matches where some fields are NULL in the cust_main_county
 535 record but not in the location.
 536
 537 Pass "param => 1" to receive a parameterized expression (rather than
 538 one that requires a join to cust_main_county) and a list of parameter
 539 names in order.
 540
 541 =cut
 542
 543 sub in_county_sql {
 544   # replaces FS::cust_pkg::location_sql
 545   my ($class, %opt) = @_;
 546   my $ornull = $opt{ornull} ? ' OR ? IS NULL' : '';
 547   my $x = $ornull ? 3 : 2;
 548   my @fields = (('district') x 3,
 549                 ('city') x 3,
 550                 ('county') x $x,
 551                 ('state') x $x,
 552                 'country');
 553
 554   my $text = (driver_name =~ /^mysql/i) ? 'char' : 'text';
 555
 556   my @where = (
 557     "cust_location.district = ? OR ? = '' OR CAST(? AS $text) IS NULL",
 558     "cust_location.city     = ? OR ? = '' OR CAST(? AS $text) IS NULL",
 559     "cust_location.county   = ? OR (? = '' AND cust_location.county IS NULL) $ornull",
 560     "cust_location.state    = ? OR (? = '' AND cust_location.state IS NULL ) $ornull",
 561     "cust_location.country = ?"
 562   );
 563   my $sql = join(' AND ', map "($_)\n", @where);
 564   if ( $opt{param} ) {
 565     return $sql, @fields;
 566   }
 567   else {
 568     # do the substitution here
 569     foreach (@fields) {
 570       $sql =~ s/\?/cust_main_county.$_/;
 571       $sql =~ s/cust_main_county.$_ = ''/cust_main_county.$_ IS NULL/;
 572     }
 573     return $sql;
 574   }
 575 }
 576
 577 =head1 BUGS
 578
 579 =head1 SEE ALSO
 580
 581 L<FS::cust_main_county>, L<FS::cust_pkg>, L<FS::Record>,
 582 schema.html from the base documentation.
 583
 584 =cut
 585
 586 1;
 587