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