cust_refund and cust_pay get custnums
[freeside.git] / FS / FS / cust_main.pm
index c3a3e3f..c44c893 100644 (file)
@@ -17,7 +17,7 @@ use Mail::Internet;
 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;
@@ -28,6 +28,8 @@ use FS::part_referral;
 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;
 
 @ISA = qw( FS::Record );
@@ -280,14 +282,14 @@ sub insert {
     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;
-    return $error;
+    return "inserting cust_main record (transaction rolled back): $error";
   }
 
   if ( @param ) { # CUST_PKG_HASHREF
@@ -297,7 +299,7 @@ sub insert {
       $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 );
@@ -308,7 +310,7 @@ sub insert {
         $error = $svc_something->insert;
         if ( $error ) {
           $dbh->rollback if $oldAutoCommit;
-          return $error;
+          return "inserting svc_ (transaction rolled back): $error";
         }
       }
     }
@@ -324,7 +326,7 @@ sub insert {
     $error = $self->check_invoicing_list( $invoicing_list );
     if ( $error ) {
       $dbh->rollback if $oldAutoCommit;
-      return $error;
+      return "checking invoicing_list (transaction rolled back): $error";
     }
     $self->invoicing_list( $invoicing_list );
   }
@@ -337,7 +339,7 @@ sub insert {
     $error = $cust_credit->insert;
     if ( $error ) {
       $dbh->rollback if $oldAutoCommit;
-      return $error;
+      return "inserting credit (transaction rolled back): $error";
     }
   }
 
@@ -500,7 +502,9 @@ sub check {
     || $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."
@@ -513,6 +517,10 @@ sub check {
   return "Unknown referral"
     unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } );
 
+  return "Unknown referring custnum ". $self->referral_custnum
+    unless ! $self->referral_custnum 
+           || qsearchs( 'cust_main', { 'custnum' => $self->referral_custnum } );
+
   if ( $self->ss eq '' ) {
     $self->ss('');
   } else {
@@ -523,8 +531,6 @@ sub check {
     $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'   => '',
@@ -565,13 +571,11 @@ sub check {
         || $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
-      $self->ship_country =~ /^(\w\w)$/
-        or return "Illegal ship_country: ". $self->ship_country;
-      $self->ship_country($1);
       unless ( qsearchs('cust_main_county', {
         'country' => $self->ship_country,
         'state'   => '',
@@ -648,8 +652,6 @@ sub check {
       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");
     }
@@ -955,6 +957,7 @@ sub collect {
 
     next unless $cust_bill->owed > 0;
 
+    # ??????????
     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;
@@ -1238,6 +1241,106 @@ sub total_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 = $payment->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 0; 
+}
+
 =item total_credited
 
 Returns the total credits (see L<FS::cust_credit>) for this customer.
@@ -1347,11 +1450,58 @@ sub check_invoicing_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;
+}
+
+=back
+
+=head1 SUBROUTINES
+
+=over 4
+
+=item rebuild_fuzzyfile
+
+=cut
+
+sub rebuild_fuzzyfiles {
+  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(
+
+}
+
 =back
 
 =head1 VERSION
 
-$Id: cust_main.pm,v 1.18 2001-08-17 10:55:04 ivan Exp $
+$Id: cust_main.pm,v 1.27 2001-09-02 02:46:55 ivan Exp $
 
 =head1 BUGS
 
@@ -1368,8 +1518,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.
 
-CyberCash is the only processor.
-
 No multiple currency support (probably a larger project than just this module).
 
 =head1 SEE ALSO