Merge branch 'master' of git.freeside.biz:/home/git/freeside
authorIvan Kohler <ivan@freeside.biz>
Wed, 30 Apr 2014 04:02:15 +0000 (21:02 -0700)
committerIvan Kohler <ivan@freeside.biz>
Wed, 30 Apr 2014 04:02:15 +0000 (21:02 -0700)
FS/FS/Cursor.pm
FS/FS/cust_bill_pkg.pm
FS/FS/cust_main/Location.pm
FS/FS/cust_pkg.pm
FS/bin/freeside-upgrade
bin/wa_tax_rate_update

index 469a678..d94151f 100644 (file)
@@ -2,10 +2,11 @@ package FS::Cursor;
 
 use strict;
 use vars qw($DEBUG $buffer);
-use FS::Record qw(dbh);
+use FS::Record;
+use FS::UID qw(myconnect);
 use Scalar::Util qw(refaddr);
 
-$DEBUG = 0;
+$DEBUG = 2;
 
 # this might become a parameter at some point, but right now, you can
 # "local $FS::Cursor::buffer = X;"
@@ -38,11 +39,13 @@ and returns an FS::Cursor object to fetch the rows one at a time.
 sub new {
   my $class = shift;
   my $q = FS::Record::_query(@_); # builds the statement and parameter list
+  my $dbh = myconnect();
 
   my $self = {
     query => $q,
     class => 'FS::' . ($q->{table} || 'Record'),
     buffer => [],
+    dbh   => $dbh,
   };
   bless $self, $class;
 
@@ -55,8 +58,8 @@ sub new {
   $self->{id} = sprintf('cursor%08x', refaddr($self));
   my $statement = "DECLARE ".$self->{id}." CURSOR FOR ".$q->{statement};
 
-  my $sth = dbh->prepare($statement)
-    or die dbh->errstr;
+  my $sth = $dbh->prepare($statement)
+    or die $dbh->errstr;
   my $bind = 1;
   foreach my $value ( @{ $q->{value} } ) {
     my $bind_type = shift @{ $q->{bind_type} };
@@ -65,7 +68,7 @@ sub new {
 
   $sth->execute or die $sth->errstr;
 
-  $self->{fetch} = dbh->prepare("FETCH FORWARD $buffer FROM ".$self->{id});
+  $self->{fetch} = $dbh->prepare("FETCH FORWARD $buffer FROM ".$self->{id});
 
   $self;
 }
@@ -105,7 +108,10 @@ sub refill {
 sub DESTROY {
   my $self = shift;
   return unless $self->{pid} eq $$;
-  dbh->do('CLOSE '. $self->{id}) or die dbh->errstr; # clean-up the cursor in Pg
+  $self->{dbh}->do('CLOSE '. $self->{id})
+    or die $self->{dbh}->errstr; # clean-up the cursor in Pg
+  $self->{dbh}->rollback;
+  $self->{dbh}->disconnect;
 }
 
 =back
index ef9c01a..034601d 100644 (file)
@@ -970,7 +970,13 @@ sub tax_locationnum {
 
 sub tax_location {
   my $self = shift;
-  FS::cust_location->by_key($self->tax_locationnum);
+  if ( $self->pkgnum ) { # normal sales
+    return $self->cust_pkg->tax_location;
+  } elsif ( $self->feepart ) { # fees
+    return $self->cust_bill->cust_main->ship_location;
+  } else { # taxes
+    return;
+  }
 }
 
 =item part_X
@@ -1576,6 +1582,14 @@ sub _upgrade_data {
   });
   # call it kind of like a class method, not that it matters much
   $job->insert($class, 's' => str2time('2012-01-01'));
+  # if there's a customer location upgrade queued also, wait for it to 
+  # finish
+  my $location_job = qsearchs('queue', {
+      job => 'FS::cust_main::Location::process_upgrade_location'
+    });
+  if ( $location_job ) {
+    $job->depend_insert($location_job->jobnum);
+  }
   # Then mark the upgrade as done, so that we don't queue the job twice
   # and somehow run two of them concurrently.
   FS::upgrade_journal->set_done($upgrade);
index 9899f72..32590bb 100644 (file)
@@ -70,7 +70,11 @@ Returns an L<FS::cust_location> object for the customer's billing address.
 sub bill_location {
   my $self = shift;
   $self->hashref->{bill_location} 
-    ||= FS::cust_location->by_key($self->bill_locationnum);
+    ||= FS::cust_location->by_key($self->bill_locationnum)
+    # degraded mode--let the system keep running during upgrades
+    ||  FS::cust_location->new({
+        map { $_ => $self->get($_) } @location_fields
+      })
 }
 
 =item ship_location
@@ -82,7 +86,11 @@ Returns an L<FS::cust_location> object for the customer's service address.
 sub ship_location {
   my $self = shift;
   $self->hashref->{ship_location}
-    ||= FS::cust_location->by_key($self->ship_locationnum);
+    ||= FS::cust_location->by_key($self->ship_locationnum)
+    ||  FS::cust_location->new({
+        map { $_ => $self->get('ship_'.$_) || $self->get($_) } @location_fields
+      })
+
 }
 
 =item location TYPE
@@ -118,6 +126,8 @@ sub location_fields { @location_fields }
 
 sub _upgrade_data {
   my $class = shift;
+  my %opt = @_;
+
   eval "use FS::contact;
         use FS::contact_class;
         use FS::contact_phone;
@@ -127,11 +137,6 @@ sub _upgrade_data {
   local $DEBUG = 0;
   my $error;
 
-  my $tax_prefix = 'bill_';
-  if ( FS::Conf->new->exists('tax-ship_address') ) {
-    $tax_prefix = 'ship_';
-  }
-
   # Step 0: set up contact classes and phone types
   my $service_contact_class = 
     qsearchs('contact_class', { classname => 'Service'})
@@ -160,147 +165,24 @@ sub _upgrade_data {
     }
   }
 
-  warn "Migrating customer locations.\n";
-  my $search = FS::Cursor->new('cust_main',
-                        { bill_locationnum  => '',
-                          address1          => { op=>'!=', value=>'' }
-                        });
-  while (my $cust_main = $search->fetch) {
-    # Step 1: extract billing and service addresses into cust_location
-    my $custnum = $cust_main->custnum;
-    my $bill_location = FS::cust_location->new(
-      {
-        custnum => $custnum,
-        map { $_ => $cust_main->get($_) } location_fields(),
-      }
-    );
-    $bill_location->set('censustract', '');
-    $bill_location->set('censusyear', '');
-     # properly goes with ship_location; if they're the same, will be set
-     # on ship_location before inserting either one
-    my $ship_location = $bill_location; # until proven otherwise
-
-    if ( $cust_main->get('ship_address1') ) {
-      # detect duplicates
-      my $same = 1;
-      foreach (location_fields()) {
-        if ( length($cust_main->get("ship_$_")) and
-             $cust_main->get($_) ne $cust_main->get("ship_$_") ) {
-          $same = 0;
-        }
-      }
-
-      if ( !$same ) {
-        $ship_location = FS::cust_location->new(
-          {
-            custnum => $custnum,
-            map { $_ => $cust_main->get("ship_$_") } location_fields()
-          }
-        );
-      } # else it stays equal to $bill_location
-
-      # Step 2: Extract shipping address contact fields into contact
-      my %unlike = map { $_ => 1 }
-        grep { $cust_main->get($_) ne $cust_main->get("ship_$_") }
-        qw( last first company daytime night fax mobile );
-
-      if ( %unlike ) {
-        # then there IS a service contact
-        my $contact = FS::contact->new({
-          'custnum'     => $custnum,
-          'classnum'    => $service_contact_class->classnum,
-          'locationnum' => $ship_location->locationnum,
-          'last'        => $cust_main->get('ship_last'),
-          'first'       => $cust_main->get('ship_first'),
-        });
-        if ( !$cust_main->get('ship_last') or !$cust_main->get('ship_first') )
-        {
-          warn "customer $custnum has no service contact name; substituting ".
-               "customer name\n";
-          $contact->set('last' => $cust_main->get('last'));
-          $contact->set('first' => $cust_main->get('first'));
-        }
-
-        if ( $unlike{'company'} ) {
-          # there's no contact.company field, but keep a record of it
-          $contact->set(comment => 'Company: '.$cust_main->get('ship_company'));
-        }
-        $error = $contact->insert;
-        die "error migrating service contact for customer $custnum: $error"
-          if $error;
-
-        foreach ( grep { $unlike{$_} } qw( daytime night fax mobile ) ) {
-          my $phone = $cust_main->get("ship_$_");
-          next if !$phone;
-          my $contact_phone = FS::contact_phone->new({
-            'contactnum'    => $contact->contactnum,
-            'phonetypenum'  => $phone_type{$_}->phonetypenum,
-            FS::contact::_parse_phonestring( $phone )
-          });
-          $error = $contact_phone->insert;
-          # die "whose responsible this"
-          die "error migrating service contact phone for customer $custnum: $error"
-            if $error;
-          $cust_main->set("ship_$_" => '');
-        }
-
-        $cust_main->set("ship_$_" => '') foreach qw(last first company);
-      } #if %unlike
-    } #if ship_address1
-
-    # special case: should go with whichever location is used to calculate
-    # taxes, because that's the one it originally came from
-    if ( my $geocode = $cust_main->get('geocode') ) {
-      $bill_location->set('geocode' => '');
-      $ship_location->set('geocode' => '');
-
-      if ( $tax_prefix eq 'bill_' ) {
-        $bill_location->set('geocode', $geocode);
-      } elsif ( $tax_prefix eq 'ship_' ) {
-        $ship_location->set('geocode', $geocode);
+  my $num_to_upgrade = FS::cust_main->count('bill_locationnum is null or ship_locationnum is null');
+  my $num_jobs = FS::queue->count('job = \'FS::cust_main::Location::process_upgrade_location\' and status != \'failed\'');
+  if ( $num_to_upgrade > 0 ) {
+    warn "Need to migrate $num_to_upgrade customer locations.\n";
+
+    if ( $opt{queue} ) {
+      if ( $num_jobs > 0 ) {
+        warn "Upgrade already queued.\n";
+      } else {
+        warn "Scheduling upgrade.\n";
+        my $job = FS::queue->new({ job => 'FS::cust_main::Location::process_upgrade_location' });
+        $job->insert;
       }
+    } else { #do it now
+      process_upgrade_location();
     }
 
-    # this always goes with the ship_location (whether it's the same as
-    # bill_location or not)
-    $ship_location->set('censustract', $cust_main->get('censustract'));
-    $ship_location->set('censusyear',  $cust_main->get('censusyear'));
-
-    $error = $bill_location->insert;
-    die "error migrating billing address for customer $custnum: $error"
-      if $error;
-
-    $cust_main->set(bill_locationnum => $bill_location->locationnum);
-
-    if (!$ship_location->locationnum) {
-      $error = $ship_location->insert;
-      die "error migrating service address for customer $custnum: $error"
-        if $error;
-    }
-
-    $cust_main->set(ship_locationnum => $ship_location->locationnum);
-
-    # Step 3: Wipe the migrated fields and update the cust_main
-
-    $cust_main->set("ship_$_" => '') foreach location_fields();
-    $cust_main->set($_ => '') foreach location_fields();
-
-    $error = $cust_main->replace;
-    die "error migrating addresses for customer $custnum: $error"
-      if $error;
-
-    # Step 4: set packages at the "default service location" to ship_location
-    my $pkg_search =
-      FS::Cursor->new('cust_pkg', { custnum => $custnum, locationnum => '' });
-    while (my $cust_pkg = $pkg_search->fetch) {
-      # not a location change
-      $cust_pkg->set('locationnum', $cust_main->ship_locationnum);
-      $error = $cust_pkg->replace;
-      die "error migrating package ".$cust_pkg->pkgnum.": $error"
-        if $error;
-    }
-
-  } #while (my $cust_main...)
+  }
 
   # repair an error in earlier upgrades
   if (!FS::upgrade_journal->is_done('cust_location_censustract_repair')
@@ -332,9 +214,198 @@ sub _upgrade_data {
     } # foreach $cust_location
     FS::upgrade_journal->set_done('cust_location_censustract_repair');
   }
+}
+
+sub process_upgrade_location {
+  my $class = shift;
+
+  my $dbh = dbh;
+  local $FS::cust_location::import = 1;
+  local $FS::UID::AutoCommit = 0;
+
+  my $tax_prefix = 'bill_';
+  if ( FS::Conf->new->exists('tax-ship_address') ) {
+    $tax_prefix = 'ship_';
+  }
+
+  # load some records that were created during the initial upgrade
+  my $service_contact_class = 
+    qsearchs('contact_class', { classname => 'Service'});
+
+  my %phone_type = (
+    daytime => 'Work',
+    night   => 'Home',
+    mobile  => 'Mobile',
+    fax     => 'Fax'
+  );
+  foreach (keys %phone_type) {
+    $phone_type{$_} = qsearchs('phone_type', { typename => $phone_type{$_}});
+  }
 
+  my %opt = (
+    tax_prefix            => $tax_prefix,
+    service_contact_class => $service_contact_class,
+    phone_type            => \%phone_type,
+  );
+
+  my $search = FS::Cursor->new('cust_main',
+                        { bill_locationnum => '',
+                          address1         => { op=>'!=', value=>'' }
+                        });
+  while (my $cust_main = $search->fetch) {
+    my $error = $cust_main->upgrade_location(%opt);
+    if ( $error ) {
+      warn "cust#".$cust_main->custnum.": $error\n";
+      $dbh->rollback;
+    } else {
+      # commit as we go
+      $dbh->commit;
+    }
+  }
 }
 
+sub upgrade_location { # instance method
+  my $cust_main = shift;
+  my %opt = @_;
+  my $error;
+
+  # Step 1: extract billing and service addresses into cust_location
+  my $custnum = $cust_main->custnum;
+  my $bill_location = FS::cust_location->new(
+    {
+      custnum => $custnum,
+      map { $_ => $cust_main->get($_) } location_fields(),
+    }
+  );
+  $bill_location->set('censustract', '');
+  $bill_location->set('censusyear', '');
+   # properly goes with ship_location; if they're the same, will be set
+   # on ship_location before inserting either one
+  my $ship_location = $bill_location; # until proven otherwise
+
+  if ( $cust_main->get('ship_address1') ) {
+    # detect duplicates
+    my $same = 1;
+    foreach (location_fields()) {
+      if ( length($cust_main->get("ship_$_")) and
+           $cust_main->get($_) ne $cust_main->get("ship_$_") ) {
+        $same = 0;
+      }
+    }
+
+    if ( !$same ) {
+      $ship_location = FS::cust_location->new(
+        {
+          custnum => $custnum,
+          map { $_ => $cust_main->get("ship_$_") } location_fields()
+        }
+      );
+    } # else it stays equal to $bill_location
+
+    # Step 2: Extract shipping address contact fields into contact
+    my %unlike = map { $_ => 1 }
+      grep { $cust_main->get($_) ne $cust_main->get("ship_$_") }
+      qw( last first company daytime night fax mobile );
+
+    if ( %unlike ) {
+      # then there IS a service contact
+      my $contact = FS::contact->new({
+        'custnum'     => $custnum,
+        'classnum'    => $opt{service_contact_class}->classnum,
+        'locationnum' => $ship_location->locationnum,
+        'last'        => $cust_main->get('ship_last'),
+        'first'       => $cust_main->get('ship_first'),
+      });
+      if ( !$cust_main->get('ship_last') or !$cust_main->get('ship_first') )
+      {
+        warn "customer $custnum has no service contact name; substituting ".
+             "customer name\n";
+        $contact->set('last' => $cust_main->get('last'));
+        $contact->set('first' => $cust_main->get('first'));
+      }
+
+      if ( $unlike{'company'} ) {
+        # there's no contact.company field, but keep a record of it
+        $contact->set(comment => 'Company: '.$cust_main->get('ship_company'));
+      }
+      $error = $contact->insert;
+      return "error migrating service contact for customer $custnum: $error"
+        if $error;
+
+      foreach ( grep { $unlike{$_} } qw( daytime night fax mobile ) ) {
+        my $phone = $cust_main->get("ship_$_");
+        next if !$phone;
+        my $contact_phone = FS::contact_phone->new({
+          'contactnum'    => $contact->contactnum,
+          'phonetypenum'  => $opt{phone_type}->{$_}->phonetypenum,
+          FS::contact::_parse_phonestring( $phone )
+        });
+        $error = $contact_phone->insert;
+        return "error migrating service contact phone for customer $custnum: $error"
+          if $error;
+        $cust_main->set("ship_$_" => '');
+      }
+
+      $cust_main->set("ship_$_" => '') foreach qw(last first company);
+    } #if %unlike
+  } #if ship_address1
+
+  # special case: should go with whichever location is used to calculate
+  # taxes, because that's the one it originally came from
+  if ( my $geocode = $cust_main->get('geocode') ) {
+    $bill_location->set('geocode' => '');
+    $ship_location->set('geocode' => '');
+
+    if ( $opt{tax_prefix} eq 'bill_' ) {
+      $bill_location->set('geocode', $geocode);
+    } elsif ( $opt{tax_prefix} eq 'ship_' ) {
+      $ship_location->set('geocode', $geocode);
+    }
+  }
+
+  # this always goes with the ship_location (whether it's the same as
+  # bill_location or not)
+  $ship_location->set('censustract', $cust_main->get('censustract'));
+  $ship_location->set('censusyear',  $cust_main->get('censusyear'));
+
+  $error = $bill_location->insert;
+  return "error migrating billing address for customer $custnum: $error"
+    if $error;
+
+  $cust_main->set(bill_locationnum => $bill_location->locationnum);
+
+  if (!$ship_location->locationnum) {
+    $error = $ship_location->insert;
+    return "error migrating service address for customer $custnum: $error"
+      if $error;
+  }
+
+  $cust_main->set(ship_locationnum => $ship_location->locationnum);
+
+  # Step 3: Wipe the migrated fields and update the cust_main
+
+  $cust_main->set("ship_$_" => '') foreach location_fields();
+  $cust_main->set($_ => '') foreach location_fields();
+
+  $error = $cust_main->replace;
+  return "error migrating addresses for customer $custnum: $error"
+    if $error;
+
+  # Step 4: set packages at the "default service location" to ship_location
+  my $pkg_search =
+    FS::Cursor->new('cust_pkg', { custnum => $custnum, locationnum => '' });
+  while (my $cust_pkg = $pkg_search->fetch) {
+    # not a location change
+    $cust_pkg->set('locationnum', $cust_main->ship_locationnum);
+    $error = $cust_pkg->replace;
+    return "error migrating package ".$cust_pkg->pkgnum.": $error"
+      if $error;
+  }
+  '';
+
+}
+
+
 =back
 
 =cut
index d546e55..cf9e324 100644 (file)
@@ -3416,7 +3416,16 @@ Returns the L<FS::cust_location> object for tax_locationnum.
 
 sub tax_location {
   my $self = shift;
-  FS::cust_location->by_key( $self->tax_locationnum )
+  my $conf = FS::Conf->new;
+  if ( $conf->exists('tax-pkg_address') and $self->locationnum ) {
+    return FS::cust_location->by_key($self->locationnum);
+  }
+  elsif ( $conf->exists('tax-ship_address') ) {
+    return $self->cust_main->ship_location;
+  }
+  else {
+    return $self->cust_main->bill_location;
+  }
 }
 
 =item seconds_since TIMESTAMP
index 45d2709..3755a81 100755 (executable)
@@ -1,7 +1,7 @@
 #!/usr/bin/perl -w
 
 use strict;
-use vars qw( $opt_d $opt_s $opt_q $opt_v $opt_r $opt_c );
+use vars qw( $opt_d $opt_s $opt_q $opt_v $opt_r $opt_c $opt_j );
 use vars qw( $DEBUG $DRY_RUN );
 use Getopt::Std;
 use DBIx::DBSchema 0.31; #0.39
@@ -17,7 +17,7 @@ my $start = time;
 
 die "Not running uid freeside!" unless checkeuid();
 
-getopts("dqrcs");
+getopts("dqrcsj");
 
 $DEBUG = !$opt_q;
 #$DEBUG = $opt_v;
@@ -30,6 +30,14 @@ $FS::UID::callback_hack = 1;
 my $dbh = adminsuidsetup($user);
 $FS::UID::callback_hack = 0;
 
+# pass command line opts through to upgrade* routines
+my %upgrade_opts = (
+  quiet   => $opt_q,
+  verbose => $opt_v,
+  queue   => $opt_j,
+  # others?
+);
+
 if ( driver_name =~ /^mysql/i ) { #until 0.39 is required above
   eval "use DBIx::DBSchema 0.39;";
   die $@ if $@;
@@ -102,7 +110,7 @@ if ( $DRY_RUN ) {
       or die "Error: ". $dbh->errstr. "\n executing: $statement";
   }
 
-  upgrade_schema();
+  upgrade_schema(%upgrade_opts);
 
   dbdef_create($dbh, $dbdef_file);
   delete $FS::Schema::dbdef_cache{$dbdef_file}; #force an actual reload
@@ -286,7 +294,7 @@ foreach my $cfst ( @cfst ) {
 }
 warn "Custom fields data upgrade completed";
 
-upgrade_config()
+upgrade_config(%upgrade_opts)
   unless $DRY_RUN || $opt_s;
 
 $dbh->commit or die $dbh->errstr;
@@ -294,7 +302,7 @@ $dbh->commit or die $dbh->errstr;
 warn "Config updates completed in ". (time-$start). " seconds\n"; # if $DEBUG;
 $start = time;
 
-upgrade()
+upgrade(%upgrade_opts)
   unless $DRY_RUN || $opt_s;
 
 $dbh->commit or die $dbh->errstr;
@@ -302,7 +310,7 @@ $dbh->commit or die $dbh->errstr;
 warn "Table updates completed in ". (time-$start). " seconds\n"; # if $DEBUG;
 $start = time;
 
-upgrade_sqlradius()
+upgrade_sqlradius(%upgrade_opts)
   unless $DRY_RUN || $opt_s || $opt_r;
 
 warn "SQL RADIUS updates completed in ". (time-$start). " seconds\n"; # if $DEBUG;
@@ -364,6 +372,11 @@ Also performs other upgrade functions:
   [ -s ]: Schema changes only.  Useful for Pg/slony slaves where the data
           changes will be replicated from the Pg/slony master.
 
+  [ -j ]: Run certain upgrades asychronously from the job queue.  Currently 
+          used only for the 2.x -> 3.x cust_location upgrade.  This may cause
+          odd behavior before the upgrade is complete, so it's recommended 
+          only for very large cust_main tables that take too long to upgrade.
+
 =head1 SEE ALSO
 
 =cut
index 27d1527..2d493db 100644 (file)
@@ -15,9 +15,13 @@ and relies on a heinous screen-scraping of the interactive search tool.
 This script just updates the cust_main_county records that already exist
 with the latest quarterly tax rates.
 
-The only option it accepts is "-c" to operate on a specific tax class 
-(named after the -c).  If this isn't included it will operate on records
-with null tax class.
+Options:
+
+-c <taxclass>: operate only on records with the named tax class.  If not 
+specified, this operates on records with null tax class.
+
+-t <taxname>: operate only on records with that tax name.  If not specified,
+it operates on records where the tax name is either null or 'Tax'.
 
 =cut
 
@@ -31,7 +35,7 @@ use File::Slurp qw(read_file write_file);
 use Text::CSV;
 use Getopt::Std;
 
-getopts('c:');
+getopts('c:t:');
 my $user = shift or die usage();
 
 # download the update file
@@ -68,6 +72,7 @@ adminsuidsetup($user) or die "bad username '$user'\n";
 $FS::UID::AutoCommit = 0;
 
 $opt_c ||= ''; # taxclass
+$opt_t ||= ''; # taxname
 my $total_changed = 0;
 my $total_skipped = 0;
 while ( !$csv->eof ) {
@@ -82,7 +87,17 @@ while ( !$csv->eof ) {
       state     => 'WA', # this is specific to WA
       district  => $district,
       taxclass  => $opt_c,
+      taxname   => $opt_t,
   });
+  if ($opt_t eq '') {
+    push @rates, qsearch('cust_main_county', {
+      country   => 'US',
+      state     => 'WA', # this is specific to WA
+      district  => $district,
+      taxclass  => $opt_c,
+      taxname   => 'Tax'
+    });
+  }
   foreach my $rate (@rates) {
     if ( $rate->tax == $tax ) {
       $skipped++;
@@ -103,6 +118,6 @@ dbh->commit;
 
 sub usage {
   "usage:
-  wa_tax_rate_update [ -c taxclass ] user
+  wa_tax_rate_update [ -c taxclass ] [ -t taxname ] user
 ";
 }