add more options to freeside-overdue

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

diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm
index 2d7dae4..6c18f93 100644 (file)
--- a/FS/FS/cust_main.pm
+++ b/FS/FS/cust_main.pm
@@ -1,12 +1,9 @@
-#this is so kludgy i'd be embarassed if it wasn't cybercash's fault
-package main;
-use vars qw($paymentserversecret $paymentserverport $paymentserverhost);
-

 package FS::cust_main;
 
 use strict;
 use vars qw( @ISA $conf $lpr $processor $xaction $E_NoErr $invoice_from
 package FS::cust_main;
 
 use strict;
 use vars qw( @ISA $conf $lpr $processor $xaction $E_NoErr $invoice_from

-             $smtpmachine $Debug );
+             $smtpmachine $Debug $bop_processor $bop_login $bop_password
+             $bop_action @bop_options $import );

 use Safe;
 use Carp;
 use Time::Local;
 use Safe;
 use Carp;
 use Time::Local;


@@ -16,7 +13,7 @@ use Mail::Internet;
 use Mail::Header;
 use Business::CreditCard;
 use FS::UID qw( getotaker dbh );
 use Mail::Header;
 use Business::CreditCard;
 use FS::UID qw( getotaker dbh );

-use FS::Record qw( qsearchs qsearch );
+use FS::Record qw( qsearchs qsearch dbdef );

 use FS::cust_pkg;
 use FS::cust_bill;
 use FS::cust_bill_pkg;
 use FS::cust_pkg;
 use FS::cust_bill;
 use FS::cust_bill_pkg;


@@ -27,13 +24,19 @@ use FS::part_referral;
 use FS::cust_main_county;
 use FS::agent;
 use FS::cust_main_invoice;
 use FS::cust_main_county;
 use FS::agent;
 use FS::cust_main_invoice;

+use FS::cust_credit_bill;
+use FS::cust_bill_pay;

 use FS::prepay_credit;
 use FS::prepay_credit;

+use FS::queue;
+use FS::part_pkg;

 
 @ISA = qw( FS::Record );
 
 $Debug = 0;
 #$Debug = 1;
 
 
 @ISA = qw( FS::Record );
 
 $Debug = 0;
 #$Debug = 1;
 

+$import = 0;
+

 #ask FS::UID to run this stuff for us later
 $FS::UID::callback{'FS::cust_main'} = sub { 
   $conf = new FS::Conf;
 #ask FS::UID to run this stuff for us later
 $FS::UID::callback{'FS::cust_main'} = sub { 
   $conf = new FS::Conf;


@@ -62,18 +65,31 @@ $FS::UID::callback{'FS::cust_main'} = sub {
       die "CCMckLib3_2::InitConfig fatal error: $errmsg\n";
     }
     $processor='cybercash3.2';
       die "CCMckLib3_2::InitConfig fatal error: $errmsg\n";
     }
     $processor='cybercash3.2';

-  } elsif ( $conf->exists('cybercash2') ) {
-    require CCLib;
-      #qw(sendmserver);
-    ( $main::paymentserverhost, 
-      $main::paymentserverport, 
-      $main::paymentserversecret,
-      $xaction,
-    ) = $conf->config('cybercash2');
-    $processor='cybercash2';
+  } elsif ( $conf->exists('business-onlinepayment') ) {
+    ( $bop_processor,
+      $bop_login,
+      $bop_password,
+      $bop_action,
+      @bop_options
+    ) = $conf->config('business-onlinepayment');
+    $bop_action ||= 'normal authorization';
+    eval "use Business::OnlinePayment";  
+    $processor="Business::OnlinePayment::$bop_processor";

   }
 };
 
   }
 };
 

+sub _cache {
+  my $self = shift;
+  my ( $hashref, $cache ) = @_;
+  if ( exists $hashref->{'pkgnum'} ) {
+#    #@{ $self->{'_pkgnum'} } = ();
+    my $subcache = $cache->subcache( 'pkgnum', 'cust_pkg', $hashref->{custnum});
+    $self->{'_pkgnum'} = $subcache;
+    #push @{ $self->{'_pkgnum'} },
+    FS::cust_pkg->new_or_cached($hashref, $subcache) if $hashref->{pkgnum};
+  }
+}
+

 =head1 NAME
 
 FS::cust_main - Object methods for cust_main records
 =head1 NAME
 
 FS::cust_main - Object methods for cust_main records


@@ -97,6 +113,8 @@ FS::cust_main - Object methods for cust_main records
 
   @cust_pkg = $record->ncancelled_pkgs;
 
 
   @cust_pkg = $record->ncancelled_pkgs;
 

+  @cust_pkg = $record->suspended_pkgs;
+

   $error = $record->bill;
   $error = $record->bill %options;
   $error = $record->bill 'time' => $time;
   $error = $record->bill;
   $error = $record->bill %options;
   $error = $record->bill 'time' => $time;


@@ -149,6 +167,32 @@ FS::Record.  The following fields are currently supported:
 
 =item fax - phone (optional)
 
 
 =item fax - phone (optional)
 

+=item ship_first - name
+
+=item ship_last - name
+
+=item ship_company - (optional)
+
+=item ship_address1
+
+=item ship_address2 - (optional)
+
+=item ship_city
+
+=item ship_county - (optional, see L<FS::cust_main_county>)
+
+=item ship_state - (see L<FS::cust_main_county>)
+
+=item ship_zip
+
+=item ship_country - (see L<FS::cust_main_county>)
+
+=item ship_daytime - phone (optional)
+
+=item ship_night - phone (optional)
+
+=item ship_fax - phone (optional)
+

 =item payby - `CARD' (credit cards), `BILL' (billing), `COMP' (free), or `PREPAY' (special billing type: applies a credit - see L<FS::prepay_credit> and sets billing type to BILL)
 
 =item payinfo - card number, P.O., comp issuer (4-8 lowercase alphanumerics; think username) or prepayment identifier (see L<FS::prepay_credit>)
 =item payby - `CARD' (credit cards), `BILL' (billing), `COMP' (free), or `PREPAY' (special billing type: applies a credit - see L<FS::prepay_credit> and sets billing type to BILL)
 
 =item payinfo - card number, P.O., comp issuer (4-8 lowercase alphanumerics; think username) or prepayment identifier (see L<FS::prepay_credit>)


@@ -161,6 +205,8 @@ FS::Record.  The following fields are currently supported:
 
 =item otaker - order taker (assigned automatically, see L<FS::UID>)
 
 
 =item otaker - order taker (assigned automatically, see L<FS::UID>)
 

+=item comments - comments (optional)
+

 =back
 
 =head1 METHODS
 =back
 
 =head1 METHODS


@@ -178,16 +224,16 @@ points to.  You can ask the object for a copy with the I<hash> method.
 
 sub table { 'cust_main'; }
 
 
 sub table { 'cust_main'; }
 

-=item insert
+=item insert [ CUST_PKG_HASHREF [ , INVOICING_LIST_ARYREF ] ]

 
 Adds this customer to the database.  If there is an error, returns the error,
 otherwise returns false.
 
 
 Adds this customer to the database.  If there is an error, returns the error,
 otherwise returns false.
 

-There is a special insert mode in which you pass a data structure to the insert
-method containing FS::cust_pkg and FS::svc_I<tablename> objects.  When
-running under a transactional database, all records are inserted atomicly, or
-the transaction is rolled back.  There should be a better explanation of this,
-but until then, here's an example:
+CUST_PKG_HASHREF: If you pass a Tie::RefHash data structure to the insert
+method containing FS::cust_pkg and FS::svc_I<tablename> objects, all records
+are inserted atomicly, or the transaction is rolled back.  Passing an empty
+hash reference is equivalent to not supplying this parameter.  There should be
+a better explanation of this, but until then, here's an example:

 
   use Tie::RefHash;
   tie %hash, 'Tie::RefHash'; #this part is important
 
   use Tie::RefHash;
   tie %hash, 'Tie::RefHash'; #this part is important


@@ -197,6 +243,15 @@ but until then, here's an example:
   );
   $cust_main->insert( \%hash );
 
   );
   $cust_main->insert( \%hash );
 

+INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
+be set as the invoicing list (see L<"invoicing_list">).  Errors return as
+expected and rollback the entire transaction; it is not necessary to call 
+check_invoicing_list first.  The invoicing_list is set after the records in the
+CUST_PKG_HASHREF above are inserted, so it is now possible to set an
+invoicing_list destination to the newly-created svc_acct.  Here's an example:
+
+  $cust_main->insert( {}, [ $email, 'POST' ] );
+

 =cut
 
 sub insert {
 =cut
 
 sub insert {


@@ -231,24 +286,24 @@ sub insert {
     my $error = $prepay_credit->delete;
     if ( $error ) {
       $dbh->rollback if $oldAutoCommit;
     my $error = $prepay_credit->delete;
     if ( $error ) {
       $dbh->rollback if $oldAutoCommit;

-      return $error;
+      return "removing prepay_credit (transaction rolled back): $error";

     }
   }
 
   my $error = $self->SUPER::insert;
   if ( $error ) {
     $dbh->rollback if $oldAutoCommit;
     }
   }
 
   my $error = $self->SUPER::insert;
   if ( $error ) {
     $dbh->rollback if $oldAutoCommit;

-    return $error;
+    return "inserting cust_main record (transaction rolled back): $error";

   }
 
   }
 

-  if ( @param ) {
+  if ( @param ) { # CUST_PKG_HASHREF

     my $cust_pkgs = shift @param;
     foreach my $cust_pkg ( keys %$cust_pkgs ) {
       $cust_pkg->custnum( $self->custnum );
       $error = $cust_pkg->insert;
       if ( $error ) {
         $dbh->rollback if $oldAutoCommit;
     my $cust_pkgs = shift @param;
     foreach my $cust_pkg ( keys %$cust_pkgs ) {
       $cust_pkg->custnum( $self->custnum );
       $error = $cust_pkg->insert;
       if ( $error ) {
         $dbh->rollback if $oldAutoCommit;

-        return $error;
+        return "inserting cust_pkg (transaction rolled back): $error";

       }
       foreach my $svc_something ( @{$cust_pkgs->{$cust_pkg}} ) {
         $svc_something->pkgnum( $cust_pkg->pkgnum );
       }
       foreach my $svc_something ( @{$cust_pkgs->{$cust_pkg}} ) {
         $svc_something->pkgnum( $cust_pkg->pkgnum );


@@ -259,7 +314,7 @@ sub insert {
         $error = $svc_something->insert;
         if ( $error ) {
           $dbh->rollback if $oldAutoCommit;
         $error = $svc_something->insert;
         if ( $error ) {
           $dbh->rollback if $oldAutoCommit;

-          return $error;
+          return "inserting svc_ (transaction rolled back): $error";

         }
       }
     }
         }
       }
     }


@@ -270,6 +325,16 @@ sub insert {
     return "No svc_acct record to apply pre-paid time";
   }
 
     return "No svc_acct record to apply pre-paid time";
   }
 

+  if ( @param ) { # INVOICING_LIST_ARYREF
+    my $invoicing_list = shift @param;
+    $error = $self->check_invoicing_list( $invoicing_list );
+    if ( $error ) {
+      $dbh->rollback if $oldAutoCommit;
+      return "checking invoicing_list (transaction rolled back): $error";
+    }
+    $self->invoicing_list( $invoicing_list );
+  }
+

   if ( $amount ) {
     my $cust_credit = new FS::cust_credit {
       'custnum' => $self->custnum,
   if ( $amount ) {
     my $cust_credit = new FS::cust_credit {
       'custnum' => $self->custnum,


@@ -278,7 +343,23 @@ sub insert {
     $error = $cust_credit->insert;
     if ( $error ) {
       $dbh->rollback if $oldAutoCommit;
     $error = $cust_credit->insert;
     if ( $error ) {
       $dbh->rollback if $oldAutoCommit;

-      return $error;
+      return "inserting credit (transaction rolled back): $error";
+    }
+  }
+
+  my $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
+  $error = $queue->insert($self->getfield('last'), $self->company);
+  if ( $error ) {
+    $dbh->rollback if $oldAutoCommit;
+    return "queueing job (transaction rolled back): $error";
+  }
+
+  if ( defined $self->dbdef_table->column('ship_last') && $self->ship_last ) {
+    $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
+    $error = $queue->insert($self->getfield('last'), $self->company);
+    if ( $error ) {
+      $dbh->rollback if $oldAutoCommit;
+      return "queueing job (transaction rolled back): $error";

     }
   }
 
     }
   }
 


@@ -296,11 +377,13 @@ This will completely remove all traces of the customer record.  This is not
 what you want when a customer cancels service; for that, cancel all of the
 customer's packages (see L<FS::cust_pkg/cancel>).
 
 what you want when a customer cancels service; for that, cancel all of the
 customer's packages (see L<FS::cust_pkg/cancel>).
 

-If the customer has any packages, you need to pass a new (valid) customer
-number for those packages to be transferred to.
+If the customer has any uncancelled packages, you need to pass a new (valid)
+customer number for those packages to be transferred to.  Cancelled packages
+will be deleted.  Did I mention that this is NOT what you want when a customer
+cancels service and that you really should be looking see L<FS::cust_pkg/cancel>?

 
 You can't delete a customer with invoices (see L<FS::cust_bill>),
 
 You can't delete a customer with invoices (see L<FS::cust_bill>),

-or credits (see L<FS::cust_credit>).
+or credits (see L<FS::cust_credit>) or payments (see L<FS::cust_pay>).

 
 =cut
 
 
 =cut
 


@@ -326,8 +409,12 @@ sub delete {
     $dbh->rollback if $oldAutoCommit;
     return "Can't delete a customer with credits";
   }
     $dbh->rollback if $oldAutoCommit;
     return "Can't delete a customer with credits";
   }

+  if ( qsearch( 'cust_pay', { 'custnum' => $self->custnum } ) ) {
+    $dbh->rollback if $oldAutoCommit;
+    return "Can't delete a customer with payments";
+  }

 
 

-  my @cust_pkg = qsearch( 'cust_pkg', { 'custnum' => $self->custnum } );
+  my @cust_pkg = $self->ncancelled_pkgs;

   if ( @cust_pkg ) {
     my $new_custnum = shift;
     unless ( qsearchs( 'cust_main', { 'custnum' => $new_custnum } ) ) {
   if ( @cust_pkg ) {
     my $new_custnum = shift;
     unless ( qsearchs( 'cust_main', { 'custnum' => $new_custnum } ) ) {


@@ -345,6 +432,15 @@ sub delete {
       }
     }
   }
       }
     }
   }

+  my @cancelled_cust_pkg = $self->all_pkgs;
+  foreach my $cust_pkg ( @cancelled_cust_pkg ) {
+    my $error = $cust_pkg->delete;
+    if ( $error ) {
+      $dbh->rollback if $oldAutoCommit;
+      return $error;
+    }
+  }
+

   foreach my $cust_main_invoice (
     qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } )
   ) {
   foreach my $cust_main_invoice (
     qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } )
   ) {


@@ -366,11 +462,58 @@ sub delete {
 
 }
 
 
 }
 

-=item replace OLD_RECORD
+=item replace OLD_RECORD [ INVOICING_LIST_ARYREF ]

 
 Replaces the OLD_RECORD with this one in the database.  If there is an error,
 returns the error, otherwise returns false.
 
 
 Replaces the OLD_RECORD with this one in the database.  If there is an error,
 returns the error, otherwise returns false.
 

+INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
+be set as the invoicing list (see L<"invoicing_list">).  Errors return as
+expected and rollback the entire transaction; it is not necessary to call 
+check_invoicing_list first.  Here's an example:
+
+  $new_cust_main->replace( $old_cust_main, [ $email, 'POST' ] );
+
+=cut
+
+sub replace {
+  my $self = shift;
+  my $old = shift;
+  my @param = @_;
+
+  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;
+
+  my $error = $self->SUPER::replace($old);
+
+  if ( $error ) {
+    $dbh->rollback if $oldAutoCommit;
+    return $error;
+  }
+
+  if ( @param ) { # INVOICING_LIST_ARYREF
+    my $invoicing_list = shift @param;
+    $error = $self->check_invoicing_list( $invoicing_list );
+    if ( $error ) {
+      $dbh->rollback if $oldAutoCommit;
+      return $error;
+    }
+    $self->invoicing_list( $invoicing_list );
+  }
+
+  $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+  '';
+
+}
+

 =item check
 
 Checks all fields to make sure this is a valid customer record.  If there is
 =item check
 
 Checks all fields to make sure this is a valid customer record.  If there is


@@ -386,12 +529,17 @@ sub check {
     $self->ut_numbern('custnum')
     || $self->ut_number('agentnum')
     || $self->ut_number('refnum')
     $self->ut_numbern('custnum')
     || $self->ut_number('agentnum')
     || $self->ut_number('refnum')

+    || $self->ut_name('last')
+    || $self->ut_name('first')

     || $self->ut_textn('company')
     || $self->ut_text('address1')
     || $self->ut_textn('address2')
     || $self->ut_text('city')
     || $self->ut_textn('county')
     || $self->ut_textn('state')
     || $self->ut_textn('company')
     || $self->ut_text('address1')
     || $self->ut_textn('address2')
     || $self->ut_text('city')
     || $self->ut_textn('county')
     || $self->ut_textn('state')

+    || $self->ut_country('country')
+    || $self->ut_anything('comments')
+    || $self->ut_numbern('referral_custnum')

   ;
   #barf.  need message catalogs.  i18n.  etc.
   $error .= "Please select a referral."
   ;
   #barf.  need message catalogs.  i18n.  etc.
   $error .= "Please select a referral."


@@ -404,13 +552,9 @@ sub check {
   return "Unknown referral"
     unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } );
 
   return "Unknown referral"
     unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } );
 

-  $self->getfield('last') =~ /^([\w \,\.\-\']+)$/
-    or return "Illegal last name: ". $self->getfield('last');
-  $self->setfield('last',$1);
-
-  $self->first =~ /^([\w \,\.\-\']+)$/
-    or return "Illegal first name: ". $self->first;
-  $self->first($1);
+  return "Unknown referring custnum ". $self->referral_custnum
+    unless ! $self->referral_custnum 
+           || qsearchs( 'cust_main', { 'custnum' => $self->referral_custnum } );

 
   if ( $self->ss eq '' ) {
     $self->ss('');
 
   if ( $self->ss eq '' ) {
     $self->ss('');


@@ -422,31 +566,81 @@ sub check {
     $self->ss("$1-$2-$3");
   }
 
     $self->ss("$1-$2-$3");
   }
 

-  $self->country =~ /^(\w\w)$/ or return "Illegal country: ". $self->country;
-  $self->country($1);
-  unless ( qsearchs('cust_main_county', {
-    'country' => $self->country,
-    'state'   => '',
-   } ) ) {
-    return "Unknown state/county/country: ".
-      $self->state. "/". $self->county. "/". $self->country
-      unless qsearchs('cust_main_county',{
-        'state'   => $self->state,
-        'county'  => $self->county,
-        'country' => $self->country,
-      } );
+  unless ( $import ) {
+    unless ( qsearchs('cust_main_county', {
+      'country' => $self->country,
+      'state'   => '',
+     } ) ) {
+      return "Unknown state/county/country: ".
+        $self->state. "/". $self->county. "/". $self->country
+        unless qsearchs('cust_main_county',{
+          'state'   => $self->state,
+          'county'  => $self->county,
+          'country' => $self->country,
+        } );
+    }

   }
 
   $error =
     $self->ut_phonen('daytime', $self->country)
     || $self->ut_phonen('night', $self->country)
     || $self->ut_phonen('fax', $self->country)
   }
 
   $error =
     $self->ut_phonen('daytime', $self->country)
     || $self->ut_phonen('night', $self->country)
     || $self->ut_phonen('fax', $self->country)

+    || $self->ut_zip('zip', $self->country)

   ;
   return $error if $error;
 
   ;
   return $error if $error;
 

-  $self->zip =~ /^\s*(\w[\w\-\s]{2,8}\w)\s*$/
-    or return "Illegal zip: ". $self->zip;
-  $self->zip($1);
+  my @addfields = qw(
+    last first company address1 address2 city county state zip
+    country daytime night fax
+  );
+
+  if ( defined $self->dbdef_table->column('ship_last') ) {
+    if ( grep { $self->getfield($_) ne $self->getfield("ship_$_") } @addfields
+         && grep $self->getfield("ship_$_"), grep $_ ne 'state', @addfields
+       )
+    {
+      my $error =
+        $self->ut_name('ship_last')
+        || $self->ut_name('ship_first')
+        || $self->ut_textn('ship_company')
+        || $self->ut_text('ship_address1')
+        || $self->ut_textn('ship_address2')
+        || $self->ut_text('ship_city')
+        || $self->ut_textn('ship_county')
+        || $self->ut_textn('ship_state')
+        || $self->ut_country('ship_country')
+      ;
+      return $error if $error;
+
+      #false laziness with above
+      unless ( qsearchs('cust_main_county', {
+        'country' => $self->ship_country,
+        'state'   => '',
+       } ) ) {
+        return "Unknown ship_state/ship_county/ship_country: ".
+          $self->ship_state. "/". $self->ship_county. "/". $self->ship_country
+          unless qsearchs('cust_main_county',{
+            'state'   => $self->ship_state,
+            'county'  => $self->ship_county,
+            'country' => $self->ship_country,
+          } );
+      }
+      #eofalse
+
+      $error =
+        $self->ut_phonen('ship_daytime', $self->ship_country)
+        || $self->ut_phonen('ship_night', $self->ship_country)
+        || $self->ut_phonen('ship_fax', $self->ship_country)
+        || $self->ut_zip('ship_zip', $self->ship_country)
+      ;
+      return $error if $error;
+
+    } else { # ship_ info eq billing info, so don't store dup info in database
+      $self->setfield("ship_$_", '')
+        foreach qw( last first company address1 address2 city county state zip
+                    country daytime night fax );
+    }
+  }

 
   $self->payby =~ /^(CARD|BILL|COMP|PREPAY)$/
     or return "Illegal payby: ". $self->payby;
 
   $self->payby =~ /^(CARD|BILL|COMP|PREPAY)$/
     or return "Illegal payby: ". $self->payby;


@@ -495,8 +689,6 @@ sub check {
       or return "Illegal expiration date: ". $self->paydate;
     if ( length($2) == 4 ) {
       $self->paydate("$2-$1-01");
       or return "Illegal expiration date: ". $self->paydate;
     if ( length($2) == 4 ) {
       $self->paydate("$2-$1-01");

-    } elsif ( $2 > 97 ) { #should pry change to check for "this year"
-      $self->paydate("19$2-$1-01");

     } else {
       $self->paydate("20$2-$1-01");
     }
     } else {
       $self->paydate("20$2-$1-01");
     }


@@ -526,7 +718,11 @@ Returns all packages (see L<FS::cust_pkg>) for this customer.
 
 sub all_pkgs {
   my $self = shift;
 
 sub all_pkgs {
   my $self = shift;

-  qsearch( 'cust_pkg', { 'custnum' => $self->custnum });
+  if ( $self->{'_pkgnum'} ) {
+    values %{ $self->{'_pkgnum'}->cache };
+  } else {
+    qsearch( 'cust_pkg', { 'custnum' => $self->custnum });
+  }

 }
 
 =item ncancelled_pkgs
 }
 
 =item ncancelled_pkgs


@@ -537,16 +733,82 @@ Returns all non-cancelled packages (see L<FS::cust_pkg>) for this customer.
 
 sub ncancelled_pkgs {
   my $self = shift;
 
 sub ncancelled_pkgs {
   my $self = shift;

-  @{ [ # force list context
-    qsearch( 'cust_pkg', {
-      'custnum' => $self->custnum,
-      'cancel'  => '',
-    }),
-    qsearch( 'cust_pkg', {
-      'custnum' => $self->custnum,
-      'cancel'  => 0,
-    }),
-  ] };
+  if ( $self->{'_pkgnum'} ) {
+    grep { ! $_->getfield('cancel') } values %{ $self->{'_pkgnum'}->cache };
+  } else {
+    @{ [ # force list context
+      qsearch( 'cust_pkg', {
+        'custnum' => $self->custnum,
+        'cancel'  => '',
+      }),
+      qsearch( 'cust_pkg', {
+        'custnum' => $self->custnum,
+        'cancel'  => 0,
+      }),
+    ] };
+  }
+}
+
+=item suspended_pkgs
+
+Returns all suspended packages (see L<FS::cust_pkg>) for this customer.
+
+=cut
+
+sub suspended_pkgs {
+  my $self = shift;
+  grep { $_->susp } $self->ncancelled_pkgs;
+}
+
+=item unflagged_suspended_pkgs
+
+Returns all unflagged suspended packages (see L<FS::cust_pkg>) for this
+customer (thouse packages without the `manual_flag' set).
+
+=cut
+
+sub unflagged_suspended_pkgs {
+  my $self = shift;
+  return $self->suspended_pkgs
+    unless dbdef->table('cust_pkg')->column('manual_flag');
+  grep { ! $_->manual_flag } $self->suspended_pkgs;
+}
+
+=item unsuspended_pkgs
+
+Returns all unsuspended (and uncancelled) packages (see L<FS::cust_pkg>) for
+this customer.
+
+=cut
+
+sub unsuspended_pkgs {
+  my $self = shift;
+  grep { ! $_->susp } $self->ncancelled_pkgs;
+}
+
+=item unsuspend
+
+Unsuspends all unflagged suspended packages (see L</unflagged_suspended_pkgs>
+and L<FS::cust_pkg>) for this customer.  Always returns a list: an empty list
+on success or a list of errors.
+
+=cut
+
+sub unsuspend {
+  my $self = shift;
+  grep { $_->unsuspend } $self->suspended_pkgs;
+}
+
+=item suspend
+
+Suspends all unsuspended packages (see L<FS::cust_pkg>) for this customer.
+Always returns a list: an empty list on success or a list of errors.
+
+=cut
+
+sub suspend {
+  my $self = shift;
+  grep { $_->suspend } $self->unsuspended_pkgs;

 }
 
 =item bill OPTIONS
 }
 
 =item bill OPTIONS


@@ -554,10 +816,16 @@ sub ncancelled_pkgs {
 Generates invoices (see L<FS::cust_bill>) for this customer.  Usually used in
 conjunction with the collect method.
 
 Generates invoices (see L<FS::cust_bill>) for this customer.  Usually used in
 conjunction with the collect method.
 

+Options are passed as name-value pairs.
+

 The only currently available option is `time', which bills the customer as if
 it were that time.  It is specified as a UNIX timestamp; see
 L<perlfunc/"time">).  Also see L<Time::Local> and L<Date::Parse> for conversion
 The only currently available option is `time', which bills the customer as if
 it were that time.  It is specified as a UNIX timestamp; see
 L<perlfunc/"time">).  Also see L<Time::Local> and L<Date::Parse> for conversion

-functions.
+functions.  For example:
+
+ use Date::Parse;
+ ...
+ $cust_main->bill( 'time' => str2time('April 20th, 2001') );

 
 If there is an error, returns the error, otherwise returns false.
 
 
 If there is an error, returns the error, otherwise returns false.
 


@@ -585,12 +853,14 @@ sub bill {
   # & generate invoice database.
  
   my( $total_setup, $total_recur ) = ( 0, 0 );
   # & generate invoice database.
  
   my( $total_setup, $total_recur ) = ( 0, 0 );

-  my @cust_bill_pkg;
+  my( $taxable_setup, $taxable_recur ) = ( 0, 0 );
+  my @cust_bill_pkg = ();

 
   foreach my $cust_pkg (
 
   foreach my $cust_pkg (

-    qsearch('cust_pkg',{'custnum'=> $self->getfield('custnum') } )
+    qsearch('cust_pkg', { 'custnum' => $self->custnum } )

   ) {
 
   ) {
 

+    #NO!! next if $cust_pkg->cancel;  

     next if $cust_pkg->getfield('cancel');  
 
     #? to avoid use of uninitialized value errors... ?
     next if $cust_pkg->getfield('cancel');  
 
     #? to avoid use of uninitialized value errors... ?


@@ -608,20 +878,25 @@ sub bill {
     my $setup = 0;
     unless ( $cust_pkg->setup ) {
       my $setup_prog = $part_pkg->getfield('setup');
     my $setup = 0;
     unless ( $cust_pkg->setup ) {
       my $setup_prog = $part_pkg->getfield('setup');

-      $setup_prog =~ /^(.*)$/ #presumably trusted
-        or die "Illegal setup for package ". $cust_pkg->pkgnum. ": $setup_prog";
+      $setup_prog =~ /^(.*)$/ or do {
+        $dbh->rollback if $oldAutoCommit;
+        return "Illegal setup for pkgpart ". $part_pkg->pkgpart.
+               ": $setup_prog";
+      };

       $setup_prog = $1;
       $setup_prog = $1;

-      my $cpt = new Safe;
-      #$cpt->permit(); #what is necessary?
-      $cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
-      $setup = $cpt->reval($setup_prog);
+
+        #my $cpt = new Safe;
+        ##$cpt->permit(); #what is necessary?
+        #$cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
+        #$setup = $cpt->reval($setup_prog);
+      $setup = eval $setup_prog;

       unless ( defined($setup) ) {
       unless ( defined($setup) ) {

-        warn "Error reval-ing part_pkg->setup pkgpart ", 
-             $part_pkg->pkgpart, ": $@";
-      } else {
-        $cust_pkg->setfield('setup',$time);
-        $cust_pkg_mod_flag=1; 
+        $dbh->rollback if $oldAutoCommit;
+        return "Error eval-ing part_pkg->setup pkgpart ". $part_pkg->pkgpart.
+               "(expression $setup_prog): $@";

       }
       }

+      $cust_pkg->setfield('setup',$time);
+      $cust_pkg_mod_flag=1; 

     }
 
     #bill recurring fee
     }
 
     #bill recurring fee


@@ -632,43 +907,58 @@ sub bill {
          ( $cust_pkg->getfield('bill') || 0 ) < $time
     ) {
       my $recur_prog = $part_pkg->getfield('recur');
          ( $cust_pkg->getfield('bill') || 0 ) < $time
     ) {
       my $recur_prog = $part_pkg->getfield('recur');

-      $recur_prog =~ /^(.*)$/ #presumably trusted
-        or die "Illegal recur for package ". $cust_pkg->pkgnum. ": $recur_prog";
+      $recur_prog =~ /^(.*)$/ or do {
+        $dbh->rollback if $oldAutoCommit;
+        return "Illegal recur for pkgpart ". $part_pkg->pkgpart.
+               ": $recur_prog";
+      };

       $recur_prog = $1;
       $recur_prog = $1;

-      my $cpt = new Safe;
-      #$cpt->permit(); #what is necessary?
-      $cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
-      $recur = $cpt->reval($recur_prog);
+
+        #my $cpt = new Safe;
+        ##$cpt->permit(); #what is necessary?
+        #$cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
+        #$recur = $cpt->reval($recur_prog);
+      $recur = eval $recur_prog;

       unless ( defined($recur) ) {
       unless ( defined($recur) ) {

-        warn "Error reval-ing part_pkg->recur pkgpart ",
-             $part_pkg->pkgpart, ": $@";
-      } else {
-        #change this bit to use Date::Manip? CAREFUL with timezones (see
-        # mailing list archive)
-        #$sdate=$cust_pkg->bill || time;
-        #$sdate=$cust_pkg->bill || $time;
-        $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
-        my ($sec,$min,$hour,$mday,$mon,$year) =
-          (localtime($sdate) )[0,1,2,3,4,5];
-        $mon += $part_pkg->getfield('freq');
-        until ( $mon < 12 ) { $mon -= 12; $year++; }
-        $cust_pkg->setfield('bill',
-          timelocal($sec,$min,$hour,$mday,$mon,$year));
-        $cust_pkg_mod_flag = 1; 
+        $dbh->rollback if $oldAutoCommit;
+        return "Error eval-ing part_pkg->recur pkgpart ".  $part_pkg->pkgpart.
+               "(expression $recur_prog): $@";

       }
       }

+      #change this bit to use Date::Manip? CAREFUL with timezones (see
+      # mailing list archive)
+      #$sdate=$cust_pkg->bill || time;
+      #$sdate=$cust_pkg->bill || $time;
+      $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
+      my ($sec,$min,$hour,$mday,$mon,$year) =
+        (localtime($sdate) )[0,1,2,3,4,5];
+      $mon += $part_pkg->getfield('freq');
+      until ( $mon < 12 ) { $mon -= 12; $year++; }
+      $cust_pkg->setfield('bill',
+        timelocal($sec,$min,$hour,$mday,$mon,$year));
+      $cust_pkg_mod_flag = 1; 

     }
 
     }
 

-    warn "setup is undefined" unless defined($setup);
-    warn "recur is undefined" unless defined($recur);
-    warn "cust_pkg bill is undefined" unless defined($cust_pkg->bill);
+    warn "\$setup is undefined" unless defined($setup);
+    warn "\$recur is undefined" unless defined($recur);
+    warn "\$cust_pkg->bill is undefined" unless defined($cust_pkg->bill);

 
     if ( $cust_pkg_mod_flag ) {
       $error=$cust_pkg->replace($old_cust_pkg);
       if ( $error ) { #just in case
 
     if ( $cust_pkg_mod_flag ) {
       $error=$cust_pkg->replace($old_cust_pkg);
       if ( $error ) { #just in case

-        warn "Error modifying pkgnum ", $cust_pkg->pkgnum, ": $error";
-      } else {
-        $setup = sprintf( "%.2f", $setup );
-        $recur = sprintf( "%.2f", $recur );
+        $dbh->rollback if $oldAutoCommit;
+        return "Error modifying pkgnum ". $cust_pkg->pkgnum. ": $error";
+      }
+      $setup = sprintf( "%.2f", $setup );
+      $recur = sprintf( "%.2f", $recur );
+      if ( $setup < 0 ) {
+        $dbh->rollback if $oldAutoCommit;
+        return "negative setup $setup for pkgnum ". $cust_pkg->pkgnum;
+      }
+      if ( $recur < 0 ) {
+        $dbh->rollback if $oldAutoCommit;
+        return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum;
+      }
+      if ( $setup > 0 || $recur > 0 ) {

         my $cust_bill_pkg = new FS::cust_bill_pkg ({
           'pkgnum' => $cust_pkg->pkgnum,
           'setup'  => $setup,
         my $cust_bill_pkg = new FS::cust_bill_pkg ({
           'pkgnum' => $cust_pkg->pkgnum,
           'setup'  => $setup,


@@ -679,61 +969,72 @@ sub bill {
         push @cust_bill_pkg, $cust_bill_pkg;
         $total_setup += $setup;
         $total_recur += $recur;
         push @cust_bill_pkg, $cust_bill_pkg;
         $total_setup += $setup;
         $total_recur += $recur;

+        $taxable_setup += $setup
+          unless $part_pkg->dbdef_table->column('setuptax')
+                 || $part_pkg->setuptax =~ /^Y$/i;
+        $taxable_recur += $recur
+          unless $part_pkg->dbdef_table->column('recurtax')
+                 || $part_pkg->recurtax =~ /^Y$/i;

       }
     }
 
   }
 
   my $charged = sprintf( "%.2f", $total_setup + $total_recur );
       }
     }
 
   }
 
   my $charged = sprintf( "%.2f", $total_setup + $total_recur );

+  my $taxable_charged = sprintf( "%.2f", $taxable_setup + $taxable_recur );

 
   unless ( @cust_bill_pkg ) {
     $dbh->commit or die $dbh->errstr if $oldAutoCommit;
     return '';
 
   unless ( @cust_bill_pkg ) {
     $dbh->commit or die $dbh->errstr if $oldAutoCommit;
     return '';

-  }
+  } 

 
 

-  unless ( $self->getfield('tax') =~ /Y/i
-           || $self->getfield('payby') eq 'COMP'
-  ) {
+  unless ( $self->tax =~ /Y/i
+           || $self->payby eq 'COMP'
+           || $taxable_charged == 0 ) {

     my $cust_main_county = qsearchs('cust_main_county',{
         'state'   => $self->state,
         'county'  => $self->county,
         'country' => $self->country,
     } );
     my $tax = sprintf( "%.2f",
     my $cust_main_county = qsearchs('cust_main_county',{
         'state'   => $self->state,
         'county'  => $self->county,
         'country' => $self->country,
     } );
     my $tax = sprintf( "%.2f",

-      $charged * ( $cust_main_county->getfield('tax') / 100 )
+      $taxable_charged * ( $cust_main_county->getfield('tax') / 100 )

     );
     );

-    $charged = sprintf( "%.2f", $charged+$tax );
-
-    my $cust_bill_pkg = new FS::cust_bill_pkg ({
-      'pkgnum' => 0,
-      'setup'  => $tax,
-      'recur'  => 0,
-      'sdate'  => '',
-      'edate'  => '',
-    });
-    push @cust_bill_pkg, $cust_bill_pkg;
+
+    if ( $tax > 0 ) {
+      $charged = sprintf( "%.2f", $charged+$tax );
+
+      my $cust_bill_pkg = new FS::cust_bill_pkg ({
+        'pkgnum' => 0,
+        'setup'  => $tax,
+        'recur'  => 0,
+        'sdate'  => '',
+        'edate'  => '',
+      });
+      push @cust_bill_pkg, $cust_bill_pkg;
+    }

   }
 
   my $cust_bill = new FS::cust_bill ( {
   }
 
   my $cust_bill = new FS::cust_bill ( {

-    'custnum' => $self->getfield('custnum'),
-    '_date' => $time,
+    'custnum' => $self->custnum,
+    '_date'   => $time,

     'charged' => $charged,
   } );
   $error = $cust_bill->insert;
   if ( $error ) {
     $dbh->rollback if $oldAutoCommit;
     'charged' => $charged,
   } );
   $error = $cust_bill->insert;
   if ( $error ) {
     $dbh->rollback if $oldAutoCommit;

-    return "$error for customer #". $self->custnum;
+    return "can't create invoice for customer #". $self->custnum. ": $error";

   }
 
   my $invnum = $cust_bill->invnum;
   my $cust_bill_pkg;
   foreach $cust_bill_pkg ( @cust_bill_pkg ) {
   }
 
   my $invnum = $cust_bill->invnum;
   my $cust_bill_pkg;
   foreach $cust_bill_pkg ( @cust_bill_pkg ) {

-    $cust_bill_pkg->setfield( 'invnum', $invnum );
+    #warn $invnum;
+    $cust_bill_pkg->invnum($invnum);

     $error = $cust_bill_pkg->insert;
     $error = $cust_bill_pkg->insert;

-    #shouldn't happen, but how else tohandle this?

     if ( $error ) {
       $dbh->rollback if $oldAutoCommit;
     if ( $error ) {
       $dbh->rollback if $oldAutoCommit;

-      return "$error for customer #". $self->custnum;
+      return "can't create invoice line item for customer #". $self->custnum.
+             ": $error";

     }
   }
   
     }
   }
   


@@ -751,13 +1052,15 @@ a credit card (`CARD'), or just add any necessary (pseudo-)payment (`COMP').
 
 If there is an error, returns the error, otherwise returns false.
 
 
 If there is an error, returns the error, otherwise returns false.
 

+Options are passed as name-value pairs.
+

 Currently available options are:
 
 invoice_time - Use this time when deciding when to print invoices and
 late notices on those invoices.  The default is now.  It is specified as a UNIX timestamp; see L<perlfunc/"time">).  Also see L<Time::Local> and L<Date::Parse>
 for conversion functions.
 
 Currently available options are:
 
 invoice_time - Use this time when deciding when to print invoices and
 late notices on those invoices.  The default is now.  It is specified as a UNIX timestamp; see L<perlfunc/"time">).  Also see L<Time::Local> and L<Date::Parse>
 for conversion functions.
 

-batch_card - Set this true to batch cards (see L<cust_pay_batch>).  By
+batch_card - Set this true to batch cards (see L<FS::cust_pay_batch>).  By

 default, cards are processed immediately, which will generate an error if
 CyberCash is not installed.
 
 default, cards are processed immediately, which will generate an error if
 CyberCash is not installed.
 


@@ -782,10 +1085,10 @@ sub collect {
   local $FS::UID::AutoCommit = 0;
   my $dbh = dbh;
 
   local $FS::UID::AutoCommit = 0;
   my $dbh = dbh;
 

-  my $total_owed = $self->balance;
-  warn "collect: total owed $total_owed " if $Debug;
-  unless ( $total_owed > 0 ) { #redundant?????
-    $dbh->rollback if $oldAutoCommit;
+  my $balance = $self->balance;
+  warn "collect: balance $balance" if $Debug;
+  unless ( $balance > 0 ) { #redundant?????
+    $dbh->rollback if $oldAutoCommit; #hmm

     return '';
   }
 
     return '';
   }
 


@@ -794,17 +1097,18 @@ sub collect {
   ) {
 
     #this has to be before next's
   ) {
 
     #this has to be before next's

-    my $amount = sprintf( "%.2f", $total_owed < $cust_bill->owed
-                                  ? $total_owed
+    my $amount = sprintf( "%.2f", $balance < $cust_bill->owed
+                                  ? $balance

                                   : $cust_bill->owed
     );
                                   : $cust_bill->owed
     );

-    $total_owed = sprintf( "%.2f", $total_owed - $amount );
+    $balance = sprintf( "%.2f", $balance - $amount );

 
     next unless $cust_bill->owed > 0;
 
 
     next unless $cust_bill->owed > 0;
 

+    # 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 } );
 
     next if qsearchs( 'cust_pay_batch', { 'invnum' => $cust_bill->invnum } );
 

-    warn "invnum ". $cust_bill->invnum. " (owed ". $cust_bill->owed. ", amount $amount, total_owed $total_owed)" if $Debug;
+    warn "invnum ". $cust_bill->invnum. " (owed ". $cust_bill->owed. ", amount $amount, balance $balance)" if $Debug;

 
     next unless $amount > 0;
 
 
     next unless $amount > 0;
 


@@ -877,7 +1181,15 @@ sub collect {
           return "Real time card processing not enabled!";
         }
 
           return "Real time card processing not enabled!";
         }
 

-        if ( $processor =~ /^cybercash/ ) {
+        my $address = $self->address1;
+        $address .= ", ". $self->address2 if $self->address2;
+
+        #fix exp. date
+        #$self->paydate =~ /^(\d+)\/\d*(\d{2})$/;
+        $self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
+        my $exp = "$2/$1";
+
+        if ( $processor eq 'cybercash3.2' ) {

 
           #fix exp. date for cybercash
           #$self->paydate =~ /^(\d+)\/\d*(\d{2})$/;
 
           #fix exp. date for cybercash
           #$self->paydate =~ /^(\d+)\/\d*(\d{2})$/;


@@ -890,10 +1202,8 @@ sub collect {
           my $payname = $self->payname ||
                         $self->getfield('first'). ' '. $self->getfield('last');
 
           my $payname = $self->payname ||
                         $self->getfield('first'). ' '. $self->getfield('last');
 

-          my $address = $self->address1;
-          $address .= ", ". $self->address2 if $self->address2;

 
 

-          my $country = 'USA' if $self->country eq 'US';
+          my $country = $self->country eq 'US' ? 'USA' : $self->country;

 
           my @full_xaction = ( $xaction,
             'Order-ID'     => $paybatch,
 
           my @full_xaction = ( $xaction,
             'Order-ID'     => $paybatch,


@@ -909,16 +1219,7 @@ sub collect {
           );
 
           my %result;
           );
 
           my %result;

-          if ( $processor eq 'cybercash2' ) {
-            $^W=0; #CCLib isn't -w safe, ugh!
-            %result = &CCLib::sendmserver(@full_xaction);
-            $^W=1;
-          } elsif ( $processor eq 'cybercash3.2' ) {
-            %result = &CCMckDirectLib3_2::SendCC2_1Server(@full_xaction);
-          } else {
-            $dbh->rollback if $oldAutoCommit;
-            return "Unknown real-time processor $processor";
-          }
+          %result = &CCMckDirectLib3_2::SendCC2_1Server(@full_xaction);

          
           #if ( $result{'MActionCode'} == 7 ) { #cybercash smps v.1.1.3
           #if ( $result{'action-code'} == 7 ) { #cybercash smps v.2.1
          
           #if ( $result{'MActionCode'} == 7 ) { #cybercash smps v.1.1.3
           #if ( $result{'action-code'} == 7 ) { #cybercash smps v.2.1


@@ -951,6 +1252,119 @@ sub collect {
             return '';
           }
 
             return '';
           }
 

+        } elsif ( $processor =~ /^Business::OnlinePayment::(.*)$/ ) {
+
+          my $bop_processor = $1;
+
+          my($payname, $payfirst, $paylast);
+          if ( $self->payname ) {
+            $payname = $self->payname;
+            $payname =~ /^\s*([\w \,\.\-\']*\w)?\s+([\w\,\.\-\']+)$/
+              or do {
+                      $dbh->rollback if $oldAutoCommit;
+                      return "Illegal payname $payname";
+                    };
+            ($payfirst, $paylast) = ($1, $2);
+          } else {
+            $payfirst = $self->getfield('first');
+            $paylast = $self->getfield('first');
+            $payname =  "$payfirst $paylast";
+          }
+
+          my @invoicing_list = grep { $_ ne 'POST' } $self->invoicing_list;
+          if ( $conf->exists('emailinvoiceauto')
+               || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
+            push @invoicing_list, $self->default_invoicing_list;
+          }
+          my $email = $invoicing_list[0];
+
+          my( $action1, $action2 ) = split(/\s*\,\s*/, $bop_action );
+        
+          my $transaction =
+            new Business::OnlinePayment( $bop_processor, @bop_options );
+          $transaction->content(
+            'type'           => 'CC',
+            'login'          => $bop_login,
+            'password'       => $bop_password,
+            'action'         => $action1,
+            'description'    => 'Internet Services',
+            'amount'         => $amount,
+            'invoice_number' => $cust_bill->invnum,
+            'customer_id'    => $self->custnum,
+            'last_name'      => $paylast,
+            'first_name'     => $payfirst,
+            'name'           => $payname,
+            'address'        => $address,
+            'city'           => $self->city,
+            'state'          => $self->state,
+            'zip'            => $self->zip,
+            'country'        => $self->country,
+            'card_number'    => $self->payinfo,
+            'expiration'     => $exp,
+            'referer'        => 'http://cleanwhisker.420.am/',
+            'email'          => $email,
+          );
+          $transaction->submit();
+
+          if ( $transaction->is_success() && $action2 ) {
+            my $auth = $transaction->authorization;
+            my $ordernum = $transaction->order_number;
+            #warn "********* $auth ***********\n";
+            #warn "********* $ordernum ***********\n";
+            my $capture =
+              new Business::OnlinePayment( $bop_processor, @bop_options );
+
+            $capture->content(
+              action         => $action2,
+              login          => $bop_login,
+              password       => $bop_password,
+              order_number   => $ordernum,
+              amount         => $amount,
+              authorization  => $auth,
+              description    => 'Internet Services',
+            );
+
+            $capture->submit();
+
+            unless ( $capture->is_success ) {
+              my $e = "Authorization sucessful but capture failed, invnum #".
+                      $cust_bill->invnum. ': '.  $capture->result_code.
+                      ": ". $capture->error_message;
+              warn $e;
+              return $e;
+            }
+
+          }
+
+          if ( $transaction->is_success() ) {
+
+            my $cust_pay = new FS::cust_pay ( {
+               'invnum'   => $cust_bill->invnum,
+               'paid'     => $amount,
+               '_date'     => '',
+               'payby'    => 'CARD',
+               'payinfo'  => $self->payinfo,
+               'paybatch' => "$processor:". $transaction->authorization,
+            } );
+            my $error = $cust_pay->insert;
+            if ( $error ) {
+              # gah, even with transactions.
+              $dbh->commit if $oldAutoCommit; #well.
+              my $e = 'WARNING: Card debited but database not updated - '.
+                      'error applying payment, invnum #' . $cust_bill->invnum.
+                      " ($processor): $error";
+              warn $e;
+              return $e;
+            }
+          } elsif ( $options{'report_badcard'} ) {
+            $dbh->commit if $oldAutoCommit;
+            return "$processor error, invnum #". $cust_bill->invnum. ': '.
+                   $transaction->result_code. ": ". $transaction->error_message;
+          } else {
+            $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+            #return '';
+          }
+

         } else {
           $dbh->rollback if $oldAutoCommit;
           return "Unknown real-time processor $processor\n";
         } else {
           $dbh->rollback if $oldAutoCommit;
           return "Unknown real-time processor $processor\n";


@@ -997,24 +1411,140 @@ sub collect {
 =item total_owed
 
 Returns the total owed for this customer on all invoices
 =item total_owed
 
 Returns the total owed for this customer on all invoices

-(see L<FS::cust_bill>).
+(see L<FS::cust_bill/owed>).

 
 =cut
 
 sub total_owed {
   my $self = shift;
 
 =cut
 
 sub total_owed {
   my $self = shift;

+  $self->total_owed_date(2145859200); #12/31/2037
+}
+
+=item total_owed_date TIME
+
+Returns the total owed for this customer on all invoices with date earlier than
+TIME.  TIME is specified as a UNIX timestamp; see L<perlfunc/"time">).  Also
+see L<Time::Local> and L<Date::Parse> for conversion functions.
+
+=cut
+
+sub total_owed_date {
+  my $self = shift;
+  my $time = shift;

   my $total_bill = 0;
   my $total_bill = 0;

-  foreach my $cust_bill ( qsearch('cust_bill', {
-    'custnum' => $self->custnum,
-  } ) ) {
+  foreach my $cust_bill (
+    grep { $_->_date <= $time }
+      qsearch('cust_bill', { 'custnum' => $self->custnum, } )
+  ) {

     $total_bill += $cust_bill->owed;
   }
   sprintf( "%.2f", $total_bill );
 }
 
     $total_bill += $cust_bill->owed;
   }
   sprintf( "%.2f", $total_bill );
 }
 

+=item apply_credits
+
+Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
+to outstanding invoice balances in chronological order and returns the value
+of any remaining unapplied credits available for refund
+(see L<FS::cust_refund>).
+
+=cut
+
+sub apply_credits {
+  my $self = shift;
+
+  return 0 unless $self->total_credited;
+
+  my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
+      qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
+
+  my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
+      qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
+
+  my $credit;
+
+  foreach my $cust_bill ( @invoices ) {
+    my $amount;
+
+    if ( !defined($credit) || $credit->credited == 0) {
+      $credit = pop @credits or last;
+    }
+
+    if ($cust_bill->owed >= $credit->credited) {
+      $amount=$credit->credited;
+    }else{
+      $amount=$cust_bill->owed;
+    }
+    
+    my $cust_credit_bill = new FS::cust_credit_bill ( {
+      'crednum' => $credit->crednum,
+      'invnum'  => $cust_bill->invnum,
+      'amount'  => $amount,
+    } );
+    my $error = $cust_credit_bill->insert;
+    die $error if $error;
+    
+    redo if ($cust_bill->owed > 0);
+
+  }
+
+  return $self->total_credited;
+}
+
+=item apply_payments
+
+Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
+to outstanding invoice balances in chronological order.
+
+ #and returns the value of any remaining unapplied payments.
+
+=cut
+
+sub apply_payments {
+  my $self = shift;
+
+  #return 0 unless
+
+  my @payments = sort { $b->_date <=> $a->_date } ( grep { $_->unapplied > 0 }
+      qsearch('cust_pay', { 'custnum' => $self->custnum } ) );
+
+  my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
+      qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
+
+  my $payment;
+
+  foreach my $cust_bill ( @invoices ) {
+    my $amount;
+
+    if ( !defined($payment) || $payment->unapplied == 0 ) {
+      $payment = pop @payments or last;
+    }
+
+    if ( $cust_bill->owed >= $payment->unapplied ) {
+      $amount = $payment->unapplied;
+    } else {
+      $amount = $cust_bill->owed;
+    }
+
+    my $cust_bill_pay = new FS::cust_bill_pay ( {
+      'paynum' => $payment->paynum,
+      'invnum' => $cust_bill->invnum,
+      'amount' => $amount,
+    } );
+    my $error = $cust_bill_pay->insert;
+    die $error if $error;
+
+    redo if ( $cust_bill->owed > 0);
+
+  }
+
+  return $self->total_unapplied_payments;
+}
+

 =item total_credited
 
 =item total_credited
 

-Returns the total credits (see L<FS::cust_credit>) for this customer.
+Returns the total outstanding credit (see L<FS::cust_credit>) for this
+customer.  See L<FS::cust_credit/credited>.

 
 =cut
 
 
 =cut
 


@@ -1029,15 +1559,56 @@ sub total_credited {
   sprintf( "%.2f", $total_credit );
 }
 
   sprintf( "%.2f", $total_credit );
 }
 

+=item total_unapplied_payments
+
+Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
+See L<FS::cust_pay/unapplied>.
+
+=cut
+
+sub total_unapplied_payments {
+  my $self = shift;
+  my $total_unapplied = 0;
+  foreach my $cust_pay ( qsearch('cust_pay', {
+    'custnum' => $self->custnum,
+  } ) ) {
+    $total_unapplied += $cust_pay->unapplied;
+  }
+  sprintf( "%.2f", $total_unapplied );
+}
+

 =item balance
 
 =item balance
 

-Returns the balance for this customer (total owed minus total credited).
+Returns the balance for this customer (total_owed minus total_credited
+minus total_unapplied_payments).

 
 =cut
 
 sub balance {
   my $self = shift;
 
 =cut
 
 sub balance {
   my $self = shift;

-  sprintf( "%.2f", $self->total_owed - $self->total_credited );
+  sprintf( "%.2f",
+    $self->total_owed - $self->total_credited - $self->total_unapplied_payments
+  );
+}
+
+=item balance_date TIME
+
+Returns the balance for this customer, only considering invoices with date
+earlier than TIME (total_owed_date minus total_credited minus
+total_unapplied_payments).  TIME is specified as a UNIX timestamp; see
+L<perlfunc/"time">).  Also see L<Time::Local> and L<Date::Parse> for conversion
+functions.
+
+=cut
+
+sub balance_date {
+  my $self = shift;
+  my $time = shift;
+  sprintf( "%.2f",
+    $self->total_owed_date($time)
+      - $self->total_credited
+      - $self->total_unapplied_payments
+  );

 }
 
 =item invoicing_list [ ARRAYREF ]
 }
 
 =item invoicing_list [ ARRAYREF ]


@@ -1079,15 +1650,17 @@ sub invoicing_list {
     } else {
       @cust_main_invoice = ();
     }
     } else {
       @cust_main_invoice = ();
     }

+    my %seen = map { $_->address => 1 } @cust_main_invoice;

     foreach my $address ( @{$arrayref} ) {
     foreach my $address ( @{$arrayref} ) {

-      unless ( grep { $address eq $_->address } @cust_main_invoice ) {
-        my $cust_main_invoice = new FS::cust_main_invoice ( {
-          'custnum' => $self->custnum,
-          'dest'    => $address,
-        } );
-        my $error = $cust_main_invoice->insert;
-        warn $error if $error;
-      } 
+      #unless ( grep { $address eq $_->address } @cust_main_invoice ) {
+      next if exists $seen{$address} && $seen{$address};
+      $seen{$address} = 1;
+      my $cust_main_invoice = new FS::cust_main_invoice ( {
+        'custnum' => $self->custnum,
+        'dest'    => $address,
+      } );
+      my $error = $cust_main_invoice->insert;
+      warn $error if $error;

     }
   }
   if ( $self->custnum ) {
     }
   }
   if ( $self->custnum ) {


@@ -1121,11 +1694,253 @@ sub check_invoicing_list {
   '';
 }
 
   '';
 }
 

+=item default_invoicing_list
+
+Returns the email addresses of any 
+
+=cut
+
+sub default_invoicing_list {
+  my $self = shift;
+  my @list = ();
+  foreach my $cust_pkg ( $self->all_pkgs ) {
+    my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
+    my @svc_acct =
+      map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
+        grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
+          @cust_svc;
+    push @list, map { $_->email } @svc_acct;
+  }
+  $self->invoicing_list(\@list);
+}
+
+=item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
+
+Returns an array of customers referred by this customer (referral_custnum set
+to this custnum).  If DEPTH is given, recurses up to the given depth, returning
+customers referred by customers referred by this customer and so on, inclusive.
+The default behavior is DEPTH 1 (no recursion).
+
+=cut
+
+sub referral_cust_main {
+  my $self = shift;
+  my $depth = @_ ? shift : 1;
+  my $exclude = @_ ? shift : {};
+
+  my @cust_main =
+    map { $exclude->{$_->custnum}++; $_; }
+      grep { ! $exclude->{ $_->custnum } }
+        qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
+
+  if ( $depth > 1 ) {
+    push @cust_main,
+      map { $_->referral_cust_main($depth-1, $exclude) }
+        @cust_main;
+  }
+
+  @cust_main;
+}
+
+=item referral_cust_pkg [ DEPTH ]
+
+Like referral_cust_main, except returns a flat list of all unsuspended packages
+for each customer.  The number of items in this list may be useful for
+comission calculations (perhaps after a grep).
+
+=cut
+
+sub referral_cust_pkg {
+  my $self = shift;
+  my $depth = @_ ? shift : 1;
+
+  map { $_->unsuspended_pkgs }
+    grep { $_->unsuspended_pkgs }
+      $self->referral_cust_main($depth);
+}
+
+=item credit AMOUNT, REASON
+
+Applies a credit to this customer.  If there is an error, returns the error,
+otherwise returns false.
+
+=cut
+
+sub credit {
+  my( $self, $amount, $reason ) = @_;
+  my $cust_credit = new FS::cust_credit {
+    'custnum' => $self->custnum,
+    'amount'  => $amount,
+    'reason'  => $reason,
+  };
+  $cust_credit->insert;
+}
+
+=item charge AMOUNT PKG COMMENT
+
+Creates a one-time charge for this customer.  If there is an error, returns
+the error, otherwise returns false.
+
+=cut
+
+sub charge {
+  my ( $self, $amount, $pkg, $comment ) = @_;
+
+  my $part_pkg = new FS::part_pkg ( {
+    'pkg'      => $pkg || 'One-time charge',
+    'comment'  => $comment,
+    'setup'    => $amount,
+    'freq'     => 0,
+    'recur'    => '0',
+    'disabled' => 'Y',
+  } );
+
+  $part_pkg->insert;
+
+}
+

 =back
 
 =back
 

+=head1 SUBROUTINES
+
+=over 4
+
+=item check_and_rebuild_fuzzyfiles
+
+=cut
+
+sub check_and_rebuild_fuzzyfiles {
+  my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
+  -e "$dir/cust_main.last" && -e "$dir/cust_main.company"
+    or &rebuild_fuzzyfiles;
+}
+
+=item rebuild_fuzzyfiles
+
+=cut
+
+sub rebuild_fuzzyfiles {
+
+  use Fcntl qw(:flock);
+
+  my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
+
+  #last
+
+  open(LASTLOCK,">>$dir/cust_main.last")
+    or die "can't open $dir/cust_main.last: $!";
+  flock(LASTLOCK,LOCK_EX)
+    or die "can't lock $dir/cust_main.last: $!";
+
+  my @all_last = map $_->getfield('last'), qsearch('cust_main', {});
+  push @all_last,
+                 grep $_, map $_->getfield('ship_last'), qsearch('cust_main',{})
+    if defined dbdef->table('cust_main')->column('ship_last');
+
+  open (LASTCACHE,">$dir/cust_main.last.tmp")
+    or die "can't open $dir/cust_main.last.tmp: $!";
+  print LASTCACHE join("\n", @all_last), "\n";
+  close LASTCACHE or die "can't close $dir/cust_main.last.tmp: $!";
+
+  rename "$dir/cust_main.last.tmp", "$dir/cust_main.last";
+  close LASTLOCK;
+
+  #company
+
+  open(COMPANYLOCK,">>$dir/cust_main.company")
+    or die "can't open $dir/cust_main.company: $!";
+  flock(COMPANYLOCK,LOCK_EX)
+    or die "can't lock $dir/cust_main.company: $!";
+
+  my @all_company = grep $_ ne '', map $_->company, qsearch('cust_main',{});
+  push @all_company,
+       grep $_ ne '', map $_->ship_company, qsearch('cust_main', {})
+    if defined dbdef->table('cust_main')->column('ship_last');
+
+  open (COMPANYCACHE,">$dir/cust_main.company.tmp")
+    or die "can't open $dir/cust_main.company.tmp: $!";
+  print COMPANYCACHE join("\n", @all_company), "\n";
+  close COMPANYCACHE or die "can't close $dir/cust_main.company.tmp: $!";
+
+  rename "$dir/cust_main.company.tmp", "$dir/cust_main.company";
+  close COMPANYLOCK;
+
+}
+
+=item all_last
+
+=cut
+
+sub all_last {
+  my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
+  open(LASTCACHE,"<$dir/cust_main.last")
+    or die "can't open $dir/cust_main.last: $!";
+  my @array = map { chomp; $_; } <LASTCACHE>;
+  close LASTCACHE;
+  \@array;
+}
+
+=item all_company
+
+=cut
+
+sub all_company {
+  my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
+  open(COMPANYCACHE,"<$dir/cust_main.company")
+    or die "can't open $dir/cust_main.last: $!";
+  my @array = map { chomp; $_; } <COMPANYCACHE>;
+  close COMPANYCACHE;
+  \@array;
+}
+
+=item append_fuzzyfiles LASTNAME COMPANY
+
+=cut
+
+sub append_fuzzyfiles {
+  my( $last, $company ) = @_;
+
+  &check_and_rebuild_fuzzyfiles;
+
+  use Fcntl qw(:flock);
+
+  my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
+
+  if ( $last ) {
+
+    open(LAST,">>$dir/cust_main.last")
+      or die "can't open $dir/cust_main.last: $!";
+    flock(LAST,LOCK_EX)
+      or die "can't lock $dir/cust_main.last: $!";
+
+    print LAST "$last\n";
+
+    flock(LAST,LOCK_UN)
+      or die "can't unlock $dir/cust_main.last: $!";
+    close LAST;
+  }
+
+  if ( $company ) {
+
+    open(COMPANY,">>$dir/cust_main.company")
+      or die "can't open $dir/cust_main.company: $!";
+    flock(COMPANY,LOCK_EX)
+      or die "can't lock $dir/cust_main.company: $!";
+
+    print COMPANY "$company\n";
+
+    flock(COMPANY,LOCK_UN)
+      or die "can't unlock $dir/cust_main.company: $!";
+
+    close COMPANY;
+  }
+
+  1;
+}
+

 =head1 VERSION
 
 =head1 VERSION
 

-$Id: cust_main.pm,v 1.14 2001-06-03 10:51:54 ivan Exp $
+$Id: cust_main.pm,v 1.52 2001-12-28 14:40:35 ivan Exp $

 
 =head1 BUGS
 
 
 =head1 BUGS
 


@@ -1142,8 +1957,6 @@ CyberCash v2 forces us to define some variables in package main.
 There should probably be a configuration file with a list of allowed credit
 card types.
 
 There should probably be a configuration file with a list of allowed credit
 card types.
 

-CyberCash is the only processor.
-

 No multiple currency support (probably a larger project than just this module).
 
 =head1 SEE ALSO
 No multiple currency support (probably a larger project than just this module).
 
 =head1 SEE ALSO