RT# 78356 - made status bar more responsive on export. Changed svc update to only...

[freeside.git] / FS / FS / cust_location.pm

diff --git a/FS/FS/cust_location.pm b/FS/FS/cust_location.pm
index 9ab94f2..fee77a8 100644 (file)
--- a/FS/FS/cust_location.pm
+++ b/FS/FS/cust_location.pm
@@ -2,10 +2,9 @@ package FS::cust_location;
 use base qw( FS::geocode_Mixin FS::Record );
 
 use strict;
 use base qw( FS::geocode_Mixin FS::Record );
 
 use strict;

-use vars qw( $import $DEBUG $conf $label_prefix );
+use vars qw( $import $DEBUG $conf $label_prefix $allow_location_edit );

 use Data::Dumper;
 use Date::Format qw( time2str );
 use Data::Dumper;
 use Date::Format qw( time2str );

-use Locale::Country;

 use FS::UID qw( dbh driver_name );
 use FS::Record qw( qsearch qsearchs );
 use FS::Conf;
 use FS::UID qw( dbh driver_name );
 use FS::Record qw( qsearch qsearchs );
 use FS::Conf;


@@ -15,6 +14,12 @@ use FS::cust_main_county;
 use FS::part_export;
 use FS::GeocodeCache;
 
 use FS::part_export;
 use FS::GeocodeCache;
 

+# Essential fields. Can't be modified in place, will be considered in
+# deciding if a location is "new", and (because of that) can't have
+# leading/trailing whitespace.
+my @essential = (qw(custnum address1 address2 city county state zip country
+  location_number location_type location_kind disabled));
+

 $import = 0;
 
 $DEBUG = 0;
 $import = 0;
 
 $DEBUG = 0;


@@ -45,8 +50,9 @@ FS::cust_location - Object methods for cust_location records
 
 =head1 DESCRIPTION
 
 
 =head1 DESCRIPTION
 

-An FS::cust_location object represents a customer location.  FS::cust_location
-inherits from FS::Record.  The following fields are currently supported:
+An FS::cust_location object represents a customer (or prospect) location.
+FS::cust_location inherits from FS::Record.  The following fields are currently
+supported:

 
 =over 4
 
 
 =over 4
 


@@ -56,7 +62,15 @@ primary key
 
 =item custnum
 
 
 =item custnum
 

-custnum
+Customer (see L<FS::cust_main>).
+
+=item prospectnum
+
+Prospect (see L<FS::prospect_main>).
+
+=item locationname
+
+Optional location name.

 
 =item address1
 
 
 =item address1
 


@@ -68,7 +82,7 @@ Address line two (optional)
 
 =item city
 
 
 =item city
 

-City (optional only if cust_main-no_city_in_address config is set)
+City (if cust_main-no_city_in_address config is set when inserting, this will be forced blank)

 
 =item county
 
 
 =item county
 


@@ -90,6 +104,23 @@ Country (see L<FS::cust_main_county>)
 
 Geocode
 
 
 Geocode
 

+=item latitude
+
+=item longitude
+
+=item coord_auto
+
+Flag indicating whether coordinates were obtained automatically or manually
+entered
+
+=item addr_clean
+
+Flag indicating whether address has been normalized
+
+=item censustract
+
+=item censusyear
+

 =item district
 
 Tax district code (optional)
 =item district
 
 Tax district code (optional)


@@ -149,18 +180,10 @@ sub find_or_insert {
 
   warn "find_or_insert:\n".Dumper($self) if $DEBUG;
 
 
   warn "find_or_insert:\n".Dumper($self) if $DEBUG;
 

-  my @essential = (qw(custnum address1 address2 county state zip country
-    location_number location_type location_kind disabled));
-
-  # Just in case this conf was accidentally/temporarily set,
-  # we'll never overwrite existing city; see city method

   if ($conf->exists('cust_main-no_city_in_address')) {
   if ($conf->exists('cust_main-no_city_in_address')) {

-    warn "Warning: find_or_insert specified city when cust_main-no_city_in_address was configured"
+    warn "Warning: passed city to find_or_insert when cust_main-no_city_in_address is configured, ignoring it"

       if $self->get('city');
       if $self->get('city');

-    $self->set('city',''); # won't end up in %nonempty, hence old value is preserved
-  } else {
-    # otherwise, of course, city is essential
-    push(@essential,'city') 
+    $self->set('city','');

   }
 
   # I don't think this is necessary
   }
 
   # I don't think this is necessary


@@ -177,6 +200,10 @@ sub find_or_insert {
   delete $nonempty{'locationnum'};
 
   my %hash = map { $_ => $self->get($_) } @essential;
   delete $nonempty{'locationnum'};
 
   my %hash = map { $_ => $self->get($_) } @essential;

+  foreach (values %hash) {
+    s/^\s+//;
+    s/\s+$//;
+  }

   my @matches = qsearch('cust_location', \%hash);
 
   # we no longer reject matches for having different values in nonessential
   my @matches = qsearch('cust_location', \%hash);
 
   # we no longer reject matches for having different values in nonessential


@@ -218,10 +245,11 @@ otherwise returns false.
 sub insert {
   my $self = shift;
 
 sub insert {
   my $self = shift;
 

-  # Ideally, this should never happen,
-  # but throw a warning and save the value anyway, to avoid data loss
-  warn "Warning: inserting city when cust_main-no_city_in_address is configured"
-    if $conf->exists('cust_main-no_city_in_address') && $self->get('city');
+  if ($conf->exists('cust_main-no_city_in_address')) {
+    warn "Warning: passed city to insert when cust_main-no_city_in_address is configured, ignoring it"
+      if $self->get('city');
+    $self->set('city','');
+  }

 
   if ( $self->censustract ) {
     $self->set('censusyear' => $conf->config('census_year') || 2012);
 
   if ( $self->censustract ) {
     $self->set('censusyear' => $conf->config('census_year') || 2012);


@@ -254,20 +282,22 @@ sub insert {
   # cust_location exports
   #my $export_args = $options{'export_args'} || [];
 
   # cust_location exports
   #my $export_args = $options{'export_args'} || [];
 

-  my @part_export =
-    map qsearch( 'part_export', {exportnum=>$_} ),
-      $conf->config('cust_location-exports'); #, $agentnum
-
-  foreach my $part_export ( @part_export ) {
-    my $error = $part_export->export_insert($self); #, @$export_args);
-    if ( $error ) {
-      $dbh->rollback if $oldAutoCommit;
-      return "exporting to ". $part_export->exporttype.
-             " (transaction rolled back): $error";
+  # don't export custnum_pending cases, let follow-up replace handle that
+  if ($self->custnum || $self->prospectnum) {
+    my @part_export =
+      map qsearch( 'part_export', {exportnum=>$_} ),
+        $conf->config('cust_location-exports'); #, $agentnum
+
+    foreach my $part_export ( @part_export ) {
+      my $error = $part_export->export_insert($self); #, @$export_args);
+      if ( $error ) {
+        $dbh->rollback if $oldAutoCommit;
+        return "exporting to ". $part_export->exporttype.
+               " (transaction rolled back): $error";
+      }

     }
   }
 
     }
   }
 

-

   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
   '';
 }
   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
   '';
 }


@@ -288,18 +318,18 @@ sub replace {
   my $old = shift;
   $old ||= $self->replace_old;
 
   my $old = shift;
   $old ||= $self->replace_old;
 

-  # Just in case this conf was accidentally/temporarily set,
-  # we'll never overwrite existing city; see city method
-  if ($conf->exists('cust_main-no_city_in_address')) {
-    warn "Warning: replace attempted to change city when cust_main-no_city_in_address was configured"
-      if $self->get('city') && ($old->get('city') != $self->get('city'));
-    $self->set('city',$old->get('city'));
-  }
+  warn "Warning: passed city to replace when cust_main-no_city_in_address is configured"
+    if $conf->exists('cust_main-no_city_in_address') && $self->get('city');

 
 

-  # the following fields are immutable
-  foreach (qw(address1 address2 city state zip country)) {
-    if ( $self->$_ ne $old->$_ ) {
-      return "can't change cust_location field $_";
+  # the following fields are immutable if this is a customer location. if
+  # it's a prospect location, then there are no active packages, no billing
+  # history, no taxes, and in general no reason to keep the old location
+  # around.
+  if ( !$allow_location_edit and $self->custnum ) {
+    foreach (qw(address1 address2 city state zip country)) {
+      if ( $self->$_ ne $old->$_ ) {
+        return "can't change cust_location field $_";
+      }

     }
   }
 
     }
   }
 


@@ -316,20 +346,22 @@ sub replace {
   # cust_location exports
   #my $export_args = $options{'export_args'} || [];
 
   # cust_location exports
   #my $export_args = $options{'export_args'} || [];
 

-  my @part_export =
-    map qsearch( 'part_export', {exportnum=>$_} ),
-      $conf->config('cust_location-exports'); #, $agentnum
-
-  foreach my $part_export ( @part_export ) {
-    my $error = $part_export->export_replace($self, $old); #, @$export_args);
-    if ( $error ) {
-      $dbh->rollback if $oldAutoCommit;
-      return "exporting to ". $part_export->exporttype.
-             " (transaction rolled back): $error";
+  # don't export custnum_pending cases, let follow-up replace handle that
+  if ($self->custnum || $self->prospectnum) {
+    my @part_export =
+      map qsearch( 'part_export', {exportnum=>$_} ),
+        $conf->config('cust_location-exports'); #, $agentnum
+
+    foreach my $part_export ( @part_export ) {
+      my $error = $part_export->export_replace($self, $old); #, @$export_args);
+      if ( $error ) {
+        $dbh->rollback if $oldAutoCommit;
+        return "exporting to ". $part_export->exporttype.
+               " (transaction rolled back): $error";
+      }

     }
   }
 
     }
   }
 

-

   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
   '';
 }
   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
   '';
 }


@@ -348,6 +380,10 @@ sub check {
 
   return '' if $self->disabled; # so that disabling locations never fails
 
 
   return '' if $self->disabled; # so that disabling locations never fails
 

+  # whitespace in essential fields leads to problems figuring out if a
+  # record is "new"; get rid of it.
+  $self->trim_whitespace(@essential);
+

   my $error = 
     $self->ut_numbern('locationnum')
     || $self->ut_foreign_keyn('prospectnum', 'prospect_main', 'prospectnum')
   my $error = 
     $self->ut_numbern('locationnum')
     || $self->ut_foreign_keyn('prospectnum', 'prospect_main', 'prospectnum')


@@ -382,10 +418,12 @@ sub check {
     $self->censustract("$1.$2");
   }
 
     $self->censustract("$1.$2");
   }
 

-  if ( $conf->exists('cust_main-require_address2') and 
-       !$self->ship_address2 =~ /\S/ ) {
-    return "Unit # is required";
-  }
+  #yikes... this is ancient, pre-dates cust_location and will be harder to
+  # implement now... how do we know this location is a service location from
+  # here and not a billing? we can't just check locationnums, we might be new :/
+  return "Unit # is required"
+    if $conf->exists('cust_main-require_address2')
+    && ! $self->address2 =~ /\S/;

 
   # tricky...we have to allow for the customer to not be inserted yet
   return "No prospect or customer!" unless $self->prospectnum 
 
   # tricky...we have to allow for the customer to not be inserted yet
   return "No prospect or customer!" unless $self->prospectnum 


@@ -419,40 +457,13 @@ sub check {
   $self->SUPER::check;
 }
 
   $self->SUPER::check;
 }
 

-=item city
-
-When the I<cust_main-no_city_in_address> config is set, the
-city method will return a blank string no matter the previously
-set value of the field.  You can still use the get method to
-access the contents of the field directly.
-
-Just in case this config was accidentally/temporarily set,
-we'll never overwrite existing city while the config is active.
-L</find_or_insert> will throw a warning if passed any true value for city,
-ignore the city field when finding, and preserve the existing value.
-L</replace> will only throw a warning if passed a true value that is 
-different than the existing value of city, and will preserve the existing value.
-L</insert> will throw a warning but still insert a true city value,
-to avoid unnecessary data loss.
-
-=cut
-
-sub city {
-  my $self = shift;
-  return '' if $conf->exists('cust_main-no_city_in_address');
-  return $self->get('city');
-}
-

 =item country_full
 
 =item country_full
 

-Returns this locations's full country name
+Returns this location's full country name

 
 =cut
 
 
 =cut
 

-sub country_full {
-  my $self = shift;
-  code2country($self->country);
-}
+#moved to geocode_Mixin.pm

 
 =item line
 
 
 =item line
 


@@ -507,17 +518,51 @@ sub disable_if_unused {
 
 }
 
 
 }
 

-=item move_to
+=item move_pkgs
+
+Returns array of cust_pkg objects that would have their location
+updated by L</move_to> (all packages that have this location as 
+their service address, and aren't canceled, and aren't supplemental 
+to another package, and aren't one-time charges that have already been charged.)
+
+=cut
+
+sub move_pkgs {
+  my $self = shift;
+  my @pkgs = ();
+  # find all packages that have the old location as their service address,
+  # and aren't canceled,
+  # and aren't supplemental to another package
+  # and aren't one-time charges that have already been charged
+  foreach my $cust_pkg (
+    qsearch('cust_pkg', { 
+      'locationnum' => $self->locationnum,
+      'cancel'      => '',
+      'main_pkgnum' => '',
+    })
+  ) {
+    next if $cust_pkg->part_pkg->freq eq '0'
+            and ($cust_pkg->setup || 0) > 0;
+    push @pkgs, $cust_pkg;
+  }
+  return @pkgs;
+}
+
+=item move_to NEW [ move_pkgs => \@move_pkgs ]

 
 Takes a new L<FS::cust_location> object.  Moves all packages that use the 
 existing location to the new one, then sets the "disabled" flag on the old
 location.  Returns nothing on success, an error message on error.
 
 
 Takes a new L<FS::cust_location> object.  Moves all packages that use the 
 existing location to the new one, then sets the "disabled" flag on the old
 location.  Returns nothing on success, an error message on error.
 

+Use option I<move_pkgs> to override the list of packages to update
+(see L</move_pkgs>.)
+

 =cut
 
 sub move_to {
   my $old = shift;
   my $new = shift;
 =cut
 
 sub move_to {
   my $old = shift;
   my $new = shift;

+  my %opt = @_;

   
   warn "move_to:\nFROM:".Dumper($old)."\nTO:".Dumper($new) if $DEBUG;
 
   
   warn "move_to:\nFROM:".Dumper($old)."\nTO:".Dumper($new) if $DEBUG;
 


@@ -549,19 +594,32 @@ sub move_to {
     return '';
   }
 
     return '';
   }
 

-  # find all packages that have the old location as their service address,
-  # and aren't canceled,
-  # and aren't supplemental to another package.
-  my @pkgs = qsearch('cust_pkg', { 
-      'locationnum' => $old->locationnum,
-      'cancel'      => '',
-      'main_pkgnum' => '',
-    });
-  foreach my $cust_pkg (@pkgs) {
-    # don't move one-time charges that have already been charged
-    next if $cust_pkg->part_pkg->freq eq '0'
-            and ($cust_pkg->setup || 0) > 0;
+  my @pkgs;
+  if ($opt{'move_pkgs'}) {
+    @pkgs = @{$opt{'move_pkgs'}};
+    my $pkgerr;
+    foreach my $pkg (@pkgs) {
+      my $pkgnum = $pkg->pkgnum;
+      $pkgerr = "cust_pkg $pkgnum has already been charged"
+        if $pkg->part_pkg->freq eq '0'
+          and ($pkg->setup || 0) > 0;
+      $pkgerr = "cust_pkg $pkgnum is supplemental"
+        if $pkg->main_pkgnum;
+      $pkgerr = "cust_pkg $pkgnum already cancelled"
+        if $pkg->cancel;
+      $pkgerr = "cust_pkg $pkgnum does not use this location"
+        unless $pkg->locationnum eq $old->locationnum;
+      last if $pkgerr;
+    }
+    if ($pkgerr) {
+      $dbh->rollback if $oldAutoCommit;
+      return "Cannot update package location: $pkgerr";
+    }
+  } else {
+    @pkgs = $old->move_pkgs;
+  }

 
 

+  foreach my $cust_pkg (@pkgs) {

     $error = $cust_pkg->change(
       'locationnum' => $new->locationnum,
       'keep_dates'  => 1
     $error = $cust_pkg->change(
       'locationnum' => $new->locationnum,
       'keep_dates'  => 1


@@ -680,6 +738,11 @@ Prospect object (see L<FS::prospect_main>)
 
 String used to join location elements
 
 
 String used to join location elements
 

+=item no_prefix
+
+Don't label the default service location as "Default service location".
+May become the default at some point.
+

 =back
 
 =cut
 =back
 
 =cut


@@ -687,8 +750,9 @@ String used to join location elements
 sub location_label {
   my( $self, %opt ) = @_;
 
 sub location_label {
   my( $self, %opt ) = @_;
 

-  my $prefix = $self->label_prefix;
+  my $prefix = $self->label_prefix(%opt);

   $prefix .= ($opt{join_string} ||  ': ') if $prefix;
   $prefix .= ($opt{join_string} ||  ': ') if $prefix;

+  $prefix = '' if $opt{'no_prefix'};

 
   $prefix . $self->SUPER::location_label(%opt);
 }
 
   $prefix . $self->SUPER::location_label(%opt);
 }


@@ -742,15 +806,18 @@ sub label_prefix {
   } elsif ( $label_prefix eq '_location' && $self->locationname ) {
     $prefix = $self->locationname;
 
   } elsif ( $label_prefix eq '_location' && $self->locationname ) {
     $prefix = $self->locationname;
 

-  } elsif (    ( $opt{'cust_main'} || $self->custnum )
-          && $self->locationnum == $cust_or_prospect->ship_locationnum ) {
-    $prefix = 'Default service location';
+  #} elsif (    ( $opt{'cust_main'} || $self->custnum )
+  #        && $self->locationnum == $cust_or_prospect->ship_locationnum ) {
+  #  $prefix = 'Default service location';
+  #}
+  } else {
+    $prefix = '';

   }
 
   $prefix;
 }
 
   }
 
   $prefix;
 }
 

-=item county_state_county
+=item county_state_country

 
 Returns a string consisting of just the county, state and country.
 
 
 Returns a string consisting of just the county, state and country.
 


@@ -766,62 +833,6 @@ sub county_state_country {
 
 =back
 
 
 =back
 

-=head1 CLASS METHODS
-
-=item in_county_sql OPTIONS
-
-Returns an SQL expression to test membership in a cust_main_county 
-geographic area.  By default, this requires district, city, county,
-state, and country to match exactly.  Pass "ornull => 1" to allow 
-partial matches where some fields are NULL in the cust_main_county 
-record but not in the location.
-
-Pass "param => 1" to receive a parameterized expression (rather than
-one that requires a join to cust_main_county) and a list of parameter
-names in order.
-
-=cut
-
-### Is this actually used for anything anymore?  Grep doesn't show anything...
-sub in_county_sql {
-  # replaces FS::cust_pkg::location_sql
-  my ($class, %opt) = @_;
-  my $ornull = $opt{ornull} ? ' OR ? IS NULL' : '';
-  my $x = $ornull ? 3 : 2;
-  my @fields = (('district') x 3,
-                ('county') x $x,
-                ('state') x $x,
-                'country');
-
-  unless ($conf->exists('cust_main-no_city_in_address')) {
-    push( @fields, (('city') x 3) );
-  }
-
-  my $text = (driver_name =~ /^mysql/i) ? 'char' : 'text';
-
-  my @where = (
-    "cust_location.district = ? OR ? = '' OR CAST(? AS $text) IS NULL",
-    "cust_location.county   = ? OR (? = '' AND cust_location.county IS NULL) $ornull",
-    "cust_location.state    = ? OR (? = '' AND cust_location.state IS NULL ) $ornull",
-    "cust_location.country = ?",
-    "cust_location.city     = ? OR ? = '' OR CAST(? AS $text) IS NULL"
-  );
-  my $sql = join(' AND ', map "($_)\n", @where);
-  if ( $opt{param} ) {
-    return $sql, @fields;
-  }
-  else {
-    # do the substitution here
-    foreach (@fields) {
-      $sql =~ s/\?/cust_main_county.$_/;
-      $sql =~ s/cust_main_county.$_ = ''/cust_main_county.$_ IS NULL/;
-    }
-    return $sql;
-  }
-}
-
-=back
-

 =head2 SUBROUTINES
 
 =over 4
 =head2 SUBROUTINES
 
 =over 4


@@ -960,6 +971,37 @@ sub process_standardize {
   close $log;
 }
 
   close $log;
 }
 

+sub _upgrade_data {
+  my $class = shift;
+
+  # are we going to need to update tax districts?
+  my $use_districts = $conf->config('tax_district_method') ? 1 : 0;
+
+  # trim whitespace on records that need it
+  local $allow_location_edit = 1;
+  foreach my $field (@essential) {
+    next if $field eq 'custnum';
+    next if $field eq 'disabled';
+    foreach my $location (qsearch({
+      table => 'cust_location',
+      extra_sql => " WHERE disabled IS NULL AND ($field LIKE ' %' OR $field LIKE '% ')"
+    })) {
+      my $error = $location->replace;
+      die "$error (fixing whitespace in $field, locationnum ".$location->locationnum.')'
+        if $error;
+
+      if ( $use_districts ) {
+        my $queue = new FS::queue {
+          'job' => 'FS::geocode_Mixin::process_district_update'
+        };
+        $error = $queue->insert( 'FS::cust_location' => $location->locationnum );
+        die $error if $error;
+      }
+    } # foreach $location
+  } # foreach $field
+  '';
+}
+

 =head1 BUGS
 
 =head1 SEE ALSO
 =head1 BUGS
 
 =head1 SEE ALSO