update fuzzy cache files on customer replace.

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

diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm
index 0b37a35..1a9d43e 100644 (file)
--- a/FS/FS/cust_main.pm
+++ b/FS/FS/cust_main.pm
@@ -3,7 +3,7 @@ package FS::cust_main;
 use strict;
 use vars qw( @ISA $conf $lpr $processor $xaction $E_NoErr $invoice_from
              $smtpmachine $Debug $bop_processor $bop_login $bop_password
 use strict;
 use vars qw( @ISA $conf $lpr $processor $xaction $E_NoErr $invoice_from
              $smtpmachine $Debug $bop_processor $bop_login $bop_password

-             $bop_action @bop_options);
+             $bop_action @bop_options $import );

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


@@ -28,12 +28,15 @@ use FS::cust_credit_bill;
 use FS::cust_bill_pay;
 use FS::prepay_credit;
 use FS::queue;
 use FS::cust_bill_pay;
 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;


@@ -75,6 +78,18 @@ $FS::UID::callback{'FS::cust_main'} = sub {
   }
 };
 
   }
 };
 

+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


@@ -98,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;


@@ -214,10 +231,9 @@ otherwise returns false.
 
 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
 
 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 (this requries a 
-transactional database).  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:
+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


@@ -231,7 +247,7 @@ 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
 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 set set an
+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' ] );
 invoicing_list destination to the newly-created svc_acct.  Here's an example:
 
   $cust_main->insert( {}, [ $email, 'POST' ] );


@@ -331,6 +347,7 @@ sub insert {
     }
   }
 
     }
   }
 

+  #false laziness with sub replace

   my $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
   $error = $queue->insert($self->getfield('last'), $self->company);
   if ( $error ) {
   my $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
   $error = $queue->insert($self->getfield('last'), $self->company);
   if ( $error ) {


@@ -346,6 +363,7 @@ sub insert {
       return "queueing job (transaction rolled back): $error";
     }
   }
       return "queueing job (transaction rolled back): $error";
     }
   }

+  #eslaf

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


@@ -361,11 +379,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
 


@@ -391,8 +411,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 } ) ) {


@@ -410,6 +434,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 } )
   ) {


@@ -478,6 +511,24 @@ sub replace {
     $self->invoicing_list( $invoicing_list );
   }
 
     $self->invoicing_list( $invoicing_list );
   }
 

+  #false laziness with sub insert
+  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";
+    }
+  }
+  #eslaf
+

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


@@ -535,17 +586,19 @@ sub check {
     $self->ss("$1-$2-$3");
   }
 
     $self->ss("$1-$2-$3");
   }
 

-  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 =
   }
 
   $error =


@@ -685,7 +738,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


@@ -696,16 +753,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


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

+  my( $taxable_setup, $taxable_recur ) = ( 0, 0 );

   my @cust_bill_pkg = ();
 
   foreach my $cust_pkg (
   my @cust_bill_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... ?


@@ -780,14 +905,15 @@ sub bill {
       };
       $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) ) {
         $dbh->rollback if $oldAutoCommit;
       unless ( defined($setup) ) {
         $dbh->rollback if $oldAutoCommit;

-        return "Error reval-ing part_pkg->setup pkgpart ". $part_pkg->pkgpart.
-               ": $@";
+        return "Error eval-ing part_pkg->setup pkgpart ". $part_pkg->pkgpart.
+               "(expression $setup_prog): $@";

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


@@ -808,14 +934,15 @@ sub bill {
       };
       $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) ) {
         $dbh->rollback if $oldAutoCommit;
       unless ( defined($recur) ) {
         $dbh->rollback if $oldAutoCommit;

-        return "Error reval-ing part_pkg->recur pkgpart ".
-               $part_pkg->pkgpart. ": $@";
+        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)
       }
       #change this bit to use Date::Manip? CAREFUL with timezones (see
       # mailing list archive)


@@ -862,37 +989,49 @@ 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->tax =~ /Y/i || $self->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 ( {


@@ -909,7 +1048,8 @@ sub bill {
   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 ) {

-    warn $cust_bill_pkg->invnum($invnum);
+    #warn $invnum;
+    $cust_bill_pkg->invnum($invnum);

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


@@ -940,13 +1080,16 @@ 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.
 
 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.
 
 report_badcard - Set this true if you want bad card transactions to
 return an error.  By default, they don't.
 
 default, cards are processed immediately, which will generate an error if
 CyberCash is not installed.
 
 report_badcard - Set this true if you want bad card transactions to
 return an error.  By default, they don't.
 

+force_print - force printing even if invoice has been printed more than once
+every 30 days, and don't increment the `printed' field.
+

 =cut
 
 sub collect {
 =cut
 
 sub collect {


@@ -998,7 +1141,8 @@ sub collect {
       my $since = $invoice_time - ( $cust_bill->_date || 0 );
       #warn "$invoice_time ", $cust_bill->_date, " $since";
       if ( $since >= 0 #don't print future invoices
       my $since = $invoice_time - ( $cust_bill->_date || 0 );
       #warn "$invoice_time ", $cust_bill->_date, " $since";
       if ( $since >= 0 #don't print future invoices

-           && ( $cust_bill->printed * 2592000 ) <= $since
+           && ( ( $cust_bill->printed * 2592000 ) <= $since
+                || $options{'force_print'} )

       ) {
 
         #my @print_text = $cust_bill->print_text; #( date )
       ) {
 
         #my @print_text = $cust_bill->print_text; #( date )


@@ -1028,11 +1172,13 @@ sub collect {
                          : "Exit status $? from $lpr";
         }
 
                          : "Exit status $? from $lpr";
         }
 

-        my %hash = $cust_bill->hash;
-        $hash{'printed'}++;
-        my $new_cust_bill = new FS::cust_bill(\%hash);
-        my $error = $new_cust_bill->replace($cust_bill);
-        warn "Error updating $cust_bill->printed: $error" if $error;
+        unless ( $options{'force_print'} ) {
+          my %hash = $cust_bill->hash;
+          $hash{'printed'}++;
+          my $new_cust_bill = new FS::cust_bill(\%hash);
+          my $error = $new_cust_bill->replace($cust_bill);
+          warn "Error updating $cust_bill->printed: $error" if $error;
+        }

 
       }
 
 
       }
 


@@ -1150,6 +1296,15 @@ sub collect {
             $paylast = $self->getfield('first');
             $payname =  "$payfirst $paylast";
           }
             $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 );
         
           my $transaction =
             new Business::OnlinePayment( $bop_processor, @bop_options );


@@ -1157,7 +1312,8 @@ sub collect {
             'type'           => 'CC',
             'login'          => $bop_login,
             'password'       => $bop_password,
             'type'           => 'CC',
             'login'          => $bop_login,
             'password'       => $bop_password,

-            'action'         => $bop_action,
+            'action'         => $action1,
+            'description'    => 'Internet Services',

             'amount'         => $amount,
             'invoice_number' => $cust_bill->invnum,
             'customer_id'    => $self->custnum,
             'amount'         => $amount,
             'invoice_number' => $cust_bill->invnum,
             'customer_id'    => $self->custnum,


@@ -1171,10 +1327,43 @@ sub collect {
             'country'        => $self->country,
             'card_number'    => $self->payinfo,
             'expiration'     => $exp,
             'country'        => $self->country,
             'card_number'    => $self->payinfo,
             'expiration'     => $exp,

+            'referer'        => 'http://cleanwhisker.420.am/',
+            'email'          => $email,

           );
           $transaction->submit();
 
           );
           $transaction->submit();
 

-          if ( $transaction->is_success()) {
+          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,
             my $cust_pay = new FS::cust_pay ( {
                'invnum'   => $cust_bill->invnum,
                'paid'     => $amount,


@@ -1254,10 +1443,25 @@ Returns the total owed for this customer on all invoices
 
 sub total_owed {
   my $self = shift;
 
 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 );


@@ -1360,7 +1564,7 @@ sub apply_payments {
 
   }
 
 
   }
 

-  # return 0; 
+  return $self->total_unapplied_payments;

 }
 
 =item total_credited
 }
 
 =item total_credited


@@ -1413,6 +1617,26 @@ sub balance {
   );
 }
 
   );
 }
 

+=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 ]
 
 If an arguement is given, sets these email addresses as invoice recipients
 =item invoicing_list [ ARRAYREF ]
 
 If an arguement is given, sets these email addresses as invoice recipients


@@ -1452,15 +1676,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 ) {


@@ -1494,6 +1720,26 @@ 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
 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
 
 Returns an array of customers referred by this customer (referral_custnum set


@@ -1522,6 +1768,63 @@ sub referral_cust_main {
   @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
 
 =head1 SUBROUTINES
 =back
 
 =head1 SUBROUTINES


@@ -1598,7 +1901,7 @@ 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 $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 = split(/\n/, <LASTCACHE> );
+  my @array = map { chomp; $_; } <LASTCACHE>;

   close LASTCACHE;
   \@array;
 }
   close LASTCACHE;
   \@array;
 }


@@ -1611,7 +1914,7 @@ 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 $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 = split(/\n/, <COMPANYCACHE> );
+  my @array = map { chomp; $_; } <COMPANYCACHE>;

   close COMPANYCACHE;
   \@array;
 }
   close COMPANYCACHE;
   \@array;
 }


@@ -1663,7 +1966,7 @@ sub append_fuzzyfiles {
 
 =head1 VERSION
 
 
 =head1 VERSION
 

-$Id: cust_main.pm,v 1.32 2001-09-11 12:10:56 ivan Exp $
+$Id: cust_main.pm,v 1.54 2002-01-09 13:29:33 ivan Exp $

 
 =head1 BUGS
 
 
 =head1 BUGS