X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2Fcust_main.pm;h=011308ca075889e3dbf971c7bb6f7b63f78ad32b;hb=05430ec3d4d7d2303c0d8012d195923ec86fc289;hp=5bea9fe264ac89cf899e34f86c07ccb98d3efca7;hpb=71058abd8ab7b56a9a7757fe298dc2dcc6cb12f4;p=freeside.git

diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm
index 5bea9fe26..011308ca0 100644
--- a/FS/FS/cust_main.pm
+++ b/FS/FS/cust_main.pm
@@ -1,7 +1,7 @@
 package FS::cust_main;
 
 use strict;
-use vars qw( @ISA $conf $Debug $import );
+use vars qw( @ISA $conf $DEBUG $import );
 use Safe;
 use Carp;
 BEGIN {
@@ -20,6 +20,7 @@ use FS::cust_bill;
 use FS::cust_bill_pkg;
 use FS::cust_pay;
 use FS::cust_credit;
+use FS::cust_refund;
 use FS::part_referral;
 use FS::cust_main_county;
 use FS::agent;
@@ -37,8 +38,8 @@ use FS::Msgcat qw(gettext);
 
 @ISA = qw( FS::Record );
 
-$Debug = 0;
-#$Debug = 1;
+$DEBUG = 0;
+#$DEBUG = 1;
 
 $import = 0;
 
@@ -222,10 +223,16 @@ invoicing_list destination to the newly-created svc_acct.  Here's an example:
 
   $cust_main->insert( {}, [ $email, 'POST' ] );
 
-Currently available options are: I<noexport>
+Currently available options are: I<depend_jobnum> and I<noexport>.
 
-If I<noexport> is set true, no provisioning jobs (exports) are scheduled.
-(You can schedule them later with the B<reexport> method.)
+If I<depend_jobnum> is set, all provisioning jobs will have a dependancy
+on the supplied jobnum (they will not run until the specific job completes).
+This can be used to defer provisioning until some action completes (such
+as running the customer's credit card sucessfully).
+
+The I<noexport> option is deprecated.  If I<noexport> is set true, no
+provisioning jobs (exports) are scheduled.  (You can schedule them later with
+the B<reexport> method.)
 
 =cut
 
@@ -234,6 +241,9 @@ sub insert {
   my $cust_pkgs = @_ ? shift : {};
   my $invoicing_list = @_ ? shift : '';
   my %options = @_;
+  warn "FS::cust_main::insert called with options ".
+       join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
+    if $DEBUG;
 
   local $SIG{HUP} = 'IGNORE';
   local $SIG{INT} = 'IGNORE';
@@ -285,7 +295,6 @@ sub insert {
   }
 
   # packages
-  #local $FS::svc_Common::noexport_hack = 1 if $options{'noexport'};
   $error = $self->order_pkgs($cust_pkgs, \$seconds, %options);
   if ( $error ) {
     $dbh->rollback if $oldAutoCommit;
@@ -320,7 +329,7 @@ sub insert {
 
 }
 
-=item order_pkgs HASHREF, [ , OPTION => VALUE ... ] ]
+=item order_pkgs HASHREF, [ SECONDSREF, [ , OPTION => VALUE ... ] ]
 
 Like the insert method on an existing record, this method orders a package
 and included services atomicaly.  Pass a Tie::RefHash data structure to this
@@ -333,14 +342,20 @@ be a better explanation of this, but until then, here's an example:
     $cust_pkg => [ $svc_acct ],
     ...
   );
-  $cust_main->order_pkgs( \%hash, 'noexport'=>1 );
+  $cust_main->order_pkgs( \%hash, \'0', 'noexport'=>1 );
+
+Currently available options are: I<depend_jobnum> and I<noexport>.
 
-Currently available options are: I<noexport>
+If I<depend_jobnum> is set, all provisioning jobs will have a dependancy
+on the supplied jobnum (they will not run until the specific job completes).
+This can be used to defer provisioning until some action completes (such
+as running the customer's credit card sucessfully).
 
-If I<noexport> is set true, no provisioning jobs (exports) are scheduled.
-(You can schedule them later with the B<reexport> method for each
-cust_pkg object.  Using the B<reexport> method on the cust_main object is not
-recommended, as existing services will also be reexported.)
+The I<noexport> option is deprecated.  If I<noexport> is set true, no
+provisioning jobs (exports) are scheduled.  (You can schedule them later with
+the B<reexport> method for each cust_pkg object.  Using the B<reexport> method
+on the cust_main object is not recommended, as existing services will also be
+reexported.)
 
 =cut
 
@@ -349,6 +364,12 @@ sub order_pkgs {
   my $cust_pkgs = shift;
   my $seconds = shift;
   my %options = @_;
+  my %svc_options = ();
+  $svc_options{'depend_jobnum'} = $options{'depend_jobnum'}
+    if exists $options{'depend_jobnum'};
+  warn "FS::cust_main::order_pkgs called with options ".
+       join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
+    if $DEBUG;
 
   local $SIG{HUP} = 'IGNORE';
   local $SIG{INT} = 'IGNORE';
@@ -376,7 +397,7 @@ sub order_pkgs {
         $svc_something->seconds( $svc_something->seconds + $$seconds );
         $$seconds = 0;
       }
-      $error = $svc_something->insert;
+      $error = $svc_something->insert(%svc_options);
       if ( $error ) {
         $dbh->rollback if $oldAutoCommit;
         #return "inserting svc_ (transaction rolled back): $error";
@@ -391,6 +412,9 @@ sub order_pkgs {
 
 =item reexport
 
+This method is deprecated.  See the I<depend_jobnum> option to the insert and
+order_pkgs methods for a better way to defer provisioning.
+
 Re-schedules all exports by calling the B<reexport> method of all associated
 packages (see L<FS::cust_pkg>).  If there is an error, returns the error;
 otherwise returns false.
@@ -400,6 +424,9 @@ otherwise returns false.
 sub reexport {
   my $self = shift;
 
+  carp "warning: FS::cust_main::reexport is deprectated; ".
+       "use the depend_jobnum option to insert or order_pkgs to delay export";
+
   local $SIG{HUP} = 'IGNORE';
   local $SIG{INT} = 'IGNORE';
   local $SIG{QUIT} = 'IGNORE';
@@ -458,19 +485,19 @@ sub delete {
   local $FS::UID::AutoCommit = 0;
   my $dbh = dbh;
 
-  if ( qsearch( 'cust_bill', { 'custnum' => $self->custnum } ) ) {
+  if ( $self->cust_bill ) {
     $dbh->rollback if $oldAutoCommit;
     return "Can't delete a customer with invoices";
   }
-  if ( qsearch( 'cust_credit', { 'custnum' => $self->custnum } ) ) {
+  if ( $self->cust_credit ) {
     $dbh->rollback if $oldAutoCommit;
     return "Can't delete a customer with credits";
   }
-  if ( qsearch( 'cust_pay', { 'custnum' => $self->custnum } ) ) {
+  if ( $self->cust_pay ) {
     $dbh->rollback if $oldAutoCommit;
     return "Can't delete a customer with payments";
   }
-  if ( qsearch( 'cust_refund', { 'custnum' => $self->custnum } ) ) {
+  if ( $self->cust_refund ) {
     $dbh->rollback if $oldAutoCommit;
     return "Can't delete a customer with refunds";
   }
@@ -985,6 +1012,38 @@ sub suspend {
   grep { $_->suspend } $self->unsuspended_pkgs;
 }
 
+=item suspend_if_pkgpart PKGPART [ , PKGPART ... ]
+
+Suspends all unsuspended packages (see L<FS::cust_pkg>) matching the listed
+PKGPARTs (see L<FS::part_pkg>).  Always returns a list: an empty list on
+success or a list of errors.
+
+=cut
+
+sub suspend_if_pkgpart {
+  my $self = shift;
+  my @pkgparts = @_;
+  grep { $_->suspend }
+    grep { my $pkgpart = $_->pkgpart; grep { $pkgpart eq $_ } @pkgparts }
+      $self->unsuspended_pkgs;
+}
+
+=item suspend_unless_pkgpart PKGPART [ , PKGPART ... ]
+
+Suspends all unsuspended packages (see L<FS::cust_pkg>) unless they match the
+listed PKGPARTs (see L<FS::part_pkg>).  Always returns a list: an empty list
+on success or a list of errors.
+
+=cut
+
+sub suspend_unless_pkgpart {
+  my $self = shift;
+  my @pkgparts = @_;
+  grep { $_->suspend }
+    grep { my $pkgpart = $_->pkgpart; ! grep { $pkgpart eq $_ } @pkgparts }
+      $self->unsuspended_pkgs;
+}
+
 =item cancel [ OPTION => VALUE ... ]
 
 Cancels all uncancelled packages (see L<FS::cust_pkg>) for this customer.
@@ -999,7 +1058,7 @@ Always returns a list: an empty list on success or a list of errors.
 
 sub cancel {
   my $self = shift;
-  grep { $_->cancel(@_) } $self->ncancelled_pkgs;
+  grep { $_ } map { $_->cancel(@_) } $self->ncancelled_pkgs;
 }
 
 =item agent
@@ -1039,6 +1098,7 @@ If there is an error, returns the error, otherwise returns false.
 
 sub bill {
   my( $self, %options ) = @_;
+  return '' if $self->payby eq 'COMP';
   my $time = $options{'time'} || time;
 
   my $error;
@@ -1055,6 +1115,8 @@ sub bill {
   local $FS::UID::AutoCommit = 0;
   my $dbh = dbh;
 
+  $self->select_for_update; #mutex
+
   # find the packages which are due for billing, find out how much they are
   # & generate invoice database.
  
@@ -1182,15 +1244,15 @@ sub bill {
       }
       $setup = sprintf( "%.2f", $setup );
       $recur = sprintf( "%.2f", $recur );
-      if ( $setup < 0 ) {
+      if ( $setup < 0 && ! $conf->exists('allow_negative_charges') ) {
         $dbh->rollback if $oldAutoCommit;
         return "negative setup $setup for pkgnum ". $cust_pkg->pkgnum;
       }
-      if ( $recur < 0 ) {
+      if ( $recur < 0 && ! $conf->exists('allow_negative_charges') ) {
         $dbh->rollback if $oldAutoCommit;
         return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum;
       }
-      if ( $setup > 0 || $recur > 0 ) {
+      if ( $setup != 0 || $recur != 0 ) {
         my $cust_bill_pkg = new FS::cust_bill_pkg ({
           'pkgnum' => $cust_pkg->pkgnum,
           'setup'  => $setup,
@@ -1219,6 +1281,16 @@ sub bill {
                                                                       } );
           }
 
+          #one more try at a whole-country tax rate
+          unless ( @taxes ) {
+            @taxes =  qsearch( 'cust_main_county', {
+                                  'state'    => '',
+                                  'county'   => '',
+                                  'country'  => $self->country,
+                                  'taxclass' => '',
+                                                                      } );
+          }
+
           # maybe eliminate this entirely, along with all the 0% records
           unless ( @taxes ) {
             $dbh->rollback if $oldAutoCommit;
@@ -1297,7 +1369,7 @@ sub bill {
 
         } #unless $self->tax =~ /Y/i || $self->payby eq 'COMP'
 
-      } #if $setup > 0 || $recur > 0
+      } #if $setup != 0 || $recur != 0
       
     } #if $cust_pkg_mod_flag
 
@@ -1389,41 +1461,6 @@ sub bill {
   ''; #no error
 }
 
-=item reexport
-
-document me.  Re-schedules all exports by calling the B<reexport> method
-of all associated packages (see L<FS::cust_pkg>).  If there is an error,
-returns the error; otherwise returns false.
-
-=cut
-
-sub reexport {
-  my $self = shift;
-
-  local $SIG{HUP} = 'IGNORE';
-  local $SIG{INT} = 'IGNORE';
-  local $SIG{QUIT} = 'IGNORE';
-  local $SIG{TERM} = 'IGNORE';
-  local $SIG{TSTP} = 'IGNORE';
-  local $SIG{PIPE} = 'IGNORE';
-
-  my $oldAutoCommit = $FS::UID::AutoCommit;
-  local $FS::UID::AutoCommit = 0;
-  my $dbh = dbh;
-
-  foreach my $cust_pkg ( $self->ncancelled_pkgs ) {
-    my $error = $cust_pkg->reexport;
-    if ( $error ) {
-      $dbh->rollback if $oldAutoCommit;
-      return $error;
-    }
-  }
-
-  $dbh->commit or die $dbh->errstr if $oldAutoCommit;
-  '';
-
-}
-
 =item collect OPTIONS
 
 (Attempt to) collect money for this customer's outstanding invoices (see
@@ -1477,8 +1514,10 @@ sub collect {
   local $FS::UID::AutoCommit = 0;
   my $dbh = dbh;
 
+  $self->select_for_update; #mutex
+
   my $balance = $self->balance;
-  warn "collect customer". $self->custnum. ": balance $balance" if $Debug;
+  warn "collect customer". $self->custnum. ": balance $balance" if $DEBUG;
   unless ( $balance > 0 ) { #redundant?????
     $dbh->rollback if $oldAutoCommit; #hmm
     return '';
@@ -1496,31 +1535,22 @@ sub collect {
     }
   }
 
-  foreach my $cust_bill ( $self->cust_bill ) {
-
-    #this has to be before next's
-    my $amount = sprintf( "%.2f", $balance < $cust_bill->owed
-                                  ? $balance
-                                  : $cust_bill->owed
-    );
-    $balance = sprintf( "%.2f", $balance - $amount );
-
-    next unless $cust_bill->owed > 0;
+  foreach my $cust_bill ( $self->open_cust_bill ) {
 
     # don't try to charge for the same invoice if it's already in a batch
     #next if qsearchs( 'cust_pay_batch', { 'invnum' => $cust_bill->invnum } );
 
-    warn "invnum ". $cust_bill->invnum. " (owed ". $cust_bill->owed. ", amount $amount, balance $balance)" if $Debug;
-
-    next unless $amount > 0;
+    last if $self->balance <= 0;
 
+    warn "invnum ". $cust_bill->invnum. " (owed ". $cust_bill->owed. ")"
+      if $DEBUG;
 
     foreach my $part_bill_event (
       sort {    $a->seconds   <=> $b->seconds
              || $a->weight    <=> $b->weight
              || $a->eventpart <=> $b->eventpart }
         grep { $_->seconds <= ( $invoice_time - $cust_bill->_date )
-               && ! qsearchs( 'cust_bill_event', {
+               && ! qsearch( 'cust_bill_event', {
                                 'invnum'    => $cust_bill->invnum,
                                 'eventpart' => $_->eventpart,
                                 'status'    => 'done',
@@ -1530,10 +1560,11 @@ sub collect {
                                        'disabled' => '',           } )
     ) {
 
-      last unless $cust_bill->owed > 0; #don't run subsequent events if owed=0
+      last if $cust_bill->owed <= 0  # don't run subsequent events if owed<=0
+           || $self->balance   <= 0; # or if balance<=0
 
       warn "calling invoice event (". $part_bill_event->eventcode. ")\n"
-        if $Debug;
+        if $DEBUG;
       my $cust_main = $self; #for callback
 
       my $error;
@@ -2142,6 +2173,54 @@ sub open_cust_bill {
   grep { $_->owed > 0 } $self->cust_bill;
 }
 
+=item cust_credit
+
+Returns all the credits (see L<FS::cust_credit>) for this customer.
+
+=cut
+
+sub cust_credit {
+  my $self = shift;
+  sort { $a->_date <=> $b->_date }
+    qsearch( 'cust_credit', { 'custnum' => $self->custnum } )
+}
+
+=item cust_pay
+
+Returns all the payments (see L<FS::cust_pay>) for this customer.
+
+=cut
+
+sub cust_pay {
+  my $self = shift;
+  sort { $a->_date <=> $b->_date }
+    qsearch( 'cust_pay', { 'custnum' => $self->custnum } )
+}
+
+=item cust_refund
+
+Returns all the refunds (see L<FS::cust_refund>) for this customer.
+
+=cut
+
+sub cust_refund {
+  my $self = shift;
+  sort { $a->_date <=> $b->_date }
+    qsearch( 'cust_refund', { 'custnum' => $self->custnum } )
+}
+
+=item select_for_update
+
+Selects this record with the SQL "FOR UPDATE" command.  This can be useful as
+a mutex.
+
+=cut
+
+sub select_for_update {
+  my $self = shift;
+  qsearch('cust_main', { 'custnum' => $self->custnum }, '*', 'FOR UPDATE' );
+}
+
 =back
 
 =head1 SUBROUTINES
@@ -2332,7 +2411,7 @@ sub batch_import {
     my %cust_main = (
       agentnum => $agentnum,
       refnum   => $refnum,
-      country  => 'US', #default
+      country  => $conf->config('countrydefault') || 'US',
       payby    => 'BILL', #default
       paydate  => '12/2037', #default
     );