[freeside-commits] freeside/FS/FS Schema.pm, 1.159, 1.160 Conf.pm, 1.305, 1.306 cust_pay.pm, 1.72, 1.73 cust_pay_pending.pm, 1.7, 1.8 cust_pay_void.pm, 1.6, 1.7 cust_credit.pm, 1.37, 1.38 cust_bill_pay.pm, 1.19, 1.20 cust_credit_bill.pm, 1.16, 1.17 cust_bill.pm, 1.249, 1.250 cust_bill_ApplicationCommon.pm, 1.10, 1.11 cust_pkg.pm, 1.134, 1.135 cust_main.pm, 1.446, 1.447

Ivan,,, ivan at wavetail.420.am
Wed Jul 29 23:42:34 PDT 2009


Update of /home/cvs/cvsroot/freeside/FS/FS
In directory wavetail.420.am:/tmp/cvs-serv30734/FS/FS

Modified Files:
	Schema.pm Conf.pm cust_pay.pm cust_pay_pending.pm 
	cust_pay_void.pm cust_credit.pm cust_bill_pay.pm 
	cust_credit_bill.pm cust_bill.pm 
	cust_bill_ApplicationCommon.pm cust_pkg.pm cust_main.pm 
Log Message:
experimental package balances, RT#4339

Index: cust_pay.pm
===================================================================
RCS file: /home/cvs/cvsroot/freeside/FS/FS/cust_pay.pm,v
retrieving revision 1.72
retrieving revision 1.73
diff -u -d -r1.72 -r1.73
--- cust_pay.pm	23 Jul 2009 19:46:05 -0000	1.72
+++ cust_pay.pm	30 Jul 2009 06:42:31 -0000	1.73
@@ -17,6 +17,7 @@
 use FS::cust_bill_pay;
 use FS::cust_pay_refund;
 use FS::cust_main;
+use FS::cust_pkg;
 use FS::cust_pay_void;
 
 @ISA = qw( FS::payinfo_transaction_Mixin FS::cust_main_Mixin FS::Record );
@@ -62,28 +63,54 @@
 
 =over 4
 
-=item paynum - primary key (assigned automatically for new payments)
+=item paynum
 
-=item custnum - customer (see L<FS::cust_main>)
+primary key (assigned automatically for new payments)
 
-=item _date - specified as a UNIX timestamp; see L<perlfunc/"time">.  Also see
+=item custnum
+
+customer (see L<FS::cust_main>)
+
+=item _date
+
+specified as a UNIX timestamp; see L<perlfunc/"time">.  Also see
 L<Time::Local> and L<Date::Parse> for conversion functions.
 
-=item paid - Amount of this payment
+=item paid
 
-=item otaker - order taker (assigned automatically, see L<FS::UID>)
+Amount of this payment
 
-=item payby - Payment Type (See L<FS::payinfo_Mixin> for valid payby values)
+=item otaker
 
-=item payinfo - Payment Information (See L<FS::payinfo_Mixin> for data format)
+order taker (assigned automatically, see L<FS::UID>)
 
-=item paymask - Masked payinfo (See L<FS::payinfo_Mixin> for how this works)
+=item payby
 
-=item paybatch - text field for tracking card processing or other batch grouping
+Payment Type (See L<FS::payinfo_Mixin> for valid payby values)
 
-=item payunique - Optional unique identifer to prevent duplicate transactions.
+=item payinfo
 
-=item closed - books closed flag, empty or `Y'
+Payment Information (See L<FS::payinfo_Mixin> for data format)
+
+=item paymask
+
+Masked payinfo (See L<FS::payinfo_Mixin> for how this works)
+
+=item paybatch
+
+text field for tracking card processing or other batch grouping
+
+=item payunique
+
+Optional unique identifer to prevent duplicate transactions.
+
+=item closed
+
+books closed flag, empty or `Y'
+
+=item pkgnum
+
+Desired pkgnum when using experimental package balances.
 
 =back
 
@@ -417,6 +444,7 @@
     || $self->ut_textn('paybatch')
     || $self->ut_textn('payunique')
     || $self->ut_enum('closed', [ '', 'Y' ])
+    || $self->ut_foreign_keyn('pkgnum', 'cust_pkg', 'pkgnum')
     || $self->payinfo_check()
   ;
   return $error if $error;

Index: cust_credit.pm
===================================================================
RCS file: /home/cvs/cvsroot/freeside/FS/FS/cust_credit.pm,v
retrieving revision 1.37
retrieving revision 1.38
diff -u -d -r1.37 -r1.38
--- cust_credit.pm	9 Feb 2009 14:05:30 -0000	1.37
+++ cust_credit.pm	30 Jul 2009 06:42:31 -0000	1.38
@@ -8,6 +8,7 @@
 use FS::Record qw( qsearch qsearchs dbdef );
 use FS::cust_main_Mixin;
 use FS::cust_main;
+use FS::cust_pkg;
 use FS::cust_refund;
 use FS::cust_credit_bill;
 use FS::part_pkg;
@@ -95,6 +96,10 @@
 
 Books closed flag, empty or `Y'
 
+=item pkgnum
+
+Desired pkgnum when using experimental package balances.
+
 =back
 
 =head1 METHODS
@@ -295,6 +300,7 @@
     || $self->ut_foreign_key('reasonnum', 'reason', 'reasonnum')
     || $self->ut_textn('addlinfo')
     || $self->ut_enum('closed', [ '', 'Y' ])
+    || $self->ut_foreign_keyn('pkgnum', 'cust_pkg', 'pkgnum')
   ;
   return $error if $error;
 

Index: cust_main.pm
===================================================================
RCS file: /home/cvs/cvsroot/freeside/FS/FS/cust_main.pm,v
retrieving revision 1.446
retrieving revision 1.447
diff -u -d -r1.446 -r1.447
--- cust_main.pm	28 Jul 2009 22:21:39 -0000	1.446
+++ cust_main.pm	30 Jul 2009 06:42:32 -0000	1.447
@@ -6110,32 +6110,52 @@
   @invoices = sort { $b->_date <=> $a->_date } @invoices
     if defined($opt{'order'}) && $opt{'order'} eq 'newest';
 
+  if ( $conf->exists('pkg-balances') ) {
+    # limit @credits to those w/ a pkgnum grepped from $self
+    my %pkgnums = ();
+    foreach my $i (@invoices) {
+      foreach my $li ( $i->cust_bill_pkg ) {
+        $pkgnums{$li->pkgnum} = 1;
+      }
+    }
+    @credits = grep { ! $_->pkgnum || $pkgnums{$_->pkgnum} } @credits;
+  }
+
   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 $owed;
+    if ( $conf->exists('pkg-balances') && $credit->pkgnum ) {
+      $owed = $cust_bill->owed_pkgnum($credit->pkgnum);
+    } else {
+      $owed = $cust_bill->owed;
     }
+    unless ( $owed > 0 ) {
+      push @credits, $credit;
+      next;
+    }
+
+    my $amount = min( $credit->credited, $owed );
     
     my $cust_credit_bill = new FS::cust_credit_bill ( {
       'crednum' => $credit->crednum,
       'invnum'  => $cust_bill->invnum,
       'amount'  => $amount,
     } );
+    $cust_credit_bill->pkgnum( $credit->pkgnum )
+      if $conf->exists('pkg-balances') && $credit->pkgnum;
     my $error = $cust_credit_bill->insert;
     if ( $error ) {
       $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
       die $error;
     }
     
-    redo if ($cust_bill->owed > 0);
+    redo if ($cust_bill->owed > 0) && ! $conf->exists('pkg-balances');
 
   }
 
@@ -6183,33 +6203,52 @@
                  grep { $_->owed > 0 }
                  $self->cust_bill;
 
+  if ( $conf->exists('pkg-balances') ) {
+    # limit @payments to those w/ a pkgnum grepped from $self
+    my %pkgnums = ();
+    foreach my $i (@invoices) {
+      foreach my $li ( $i->cust_bill_pkg ) {
+        $pkgnums{$li->pkgnum} = 1;
+      }
+    }
+    @payments = grep { ! $_->pkgnum || $pkgnums{$_->pkgnum} } @payments;
+  }
+
   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;
+    my $owed;
+    if ( $conf->exists('pkg-balances') && $payment->pkgnum ) {
+      $owed = $cust_bill->owed_pkgnum($payment->pkgnum);
     } else {
-      $amount = $cust_bill->owed;
+      $owed = $cust_bill->owed;
     }
+    unless ( $owed > 0 ) {
+      push @payments, $payment;
+      next;
+    }
+
+    my $amount = min( $payment->unapplied, $owed );
 
     my $cust_bill_pay = new FS::cust_bill_pay ( {
       'paynum' => $payment->paynum,
       'invnum' => $cust_bill->invnum,
       'amount' => $amount,
     } );
+    $cust_bill_pay->pkgnum( $payment->pkgnum )
+      if $conf->exists('pkg-balances') && $payment->pkgnum;
     my $error = $cust_bill_pay->insert;
     if ( $error ) {
       $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
       die $error;
     }
 
-    redo if ( $cust_bill->owed > 0);
+    redo if ( $cust_bill->owed > 0) && ! $conf->exists('pkg-balances');
 
   }
 
@@ -6270,6 +6309,41 @@
 
 }
 
+=item total_owed_pkgnum PKGNUM
+
+Returns the total owed on all invoices for this customer's specific package
+when using experimental package balances (see L<FS::cust_bill/owed_pkgnum>).
+
+=cut
+
+sub total_owed_pkgnum {
+  my( $self, $pkgnum ) = @_;
+  $self->total_owed_date_pkgnum(2145859200, $pkgnum); #12/31/2037
+}
+
+=item total_owed_date_pkgnum TIME PKGNUM
+
+Returns the total owed for this customer's specific package when using
+experimental package balances 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_pkgnum {
+  my( $self, $time, $pkgnum ) = @_;
+
+  my $total_bill = 0;
+  foreach my $cust_bill (
+    grep { $_->_date <= $time }
+      qsearch('cust_bill', { 'custnum' => $self->custnum, } )
+  ) {
+    $total_bill += $cust_bill->owed_pkgnum($pkgnum);
+  }
+  sprintf( "%.2f", $total_bill );
+
+}
+
 =item total_paid
 
 Returns the total amount of all payments.
@@ -6306,6 +6380,21 @@
   sprintf( "%.2f", $total_credit );
 }
 
+=item total_unapplied_credits_pkgnum PKGNUM
+
+Returns the total outstanding credit (see L<FS::cust_credit>) for this
+customer.  See L<FS::cust_credit/credited>.
+
+=cut
+
+sub total_unapplied_credits_pkgnum {
+  my( $self, $pkgnum ) = @_;
+  my $total_credit = 0;
+  $total_credit += $_->credited foreach $self->cust_credit_pkgnum($pkgnum);
+  sprintf( "%.2f", $total_credit );
+}
+
+
 =item total_unapplied_payments
 
 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
@@ -6320,6 +6409,22 @@
   sprintf( "%.2f", $total_unapplied );
 }
 
+=item total_unapplied_payments_pkgnum PKGNUM
+
+Returns the total unapplied payments (see L<FS::cust_pay>) for this customer's
+specific package when using experimental package balances.  See
+L<FS::cust_pay/unapplied>.
+
+=cut
+
+sub total_unapplied_payments_pkgnum {
+  my( $self, $pkgnum ) = @_;
+  my $total_unapplied = 0;
+  $total_unapplied += $_->unapplied foreach $self->cust_pay_pkgnum($pkgnum);
+  sprintf( "%.2f", $total_unapplied );
+}
+
+
 =item total_unapplied_refunds
 
 Returns the total unrefunded refunds (see L<FS::cust_refund>) for this
@@ -6372,6 +6477,26 @@
   );
 }
 
+=item balance_pkgnum PKGNUM
+
+Returns the balance for this customer's specific package when using
+experimental package balances (total_owed plus total_unrefunded, minus
+total_unapplied_credits minus total_unapplied_payments)
+
+=cut
+
+sub balance_pkgnum {
+  my( $self, $pkgnum ) = @_;
+
+  sprintf( "%.2f",
+      $self->total_owed_pkgnum($pkgnum)
+# n/a - refunds aren't part of pkg-balances since they don't apply to invoices
+#    + $self->total_unapplied_refunds_pkgnum($pkgnum)
+    - $self->total_unapplied_credits_pkgnum($pkgnum)
+    - $self->total_unapplied_payments_pkgnum($pkgnum)
+  );
+}
+
 =item in_transit_payments
 
 Returns the total of requests for payments for this customer pending in 
@@ -7001,6 +7126,22 @@
     qsearch( 'cust_credit', { 'custnum' => $self->custnum } )
 }
 
+=item cust_credit_pkgnum
+
+Returns all the credits (see L<FS::cust_credit>) for this customer's specific
+package when using experimental package balances.
+
+=cut
+
+sub cust_credit_pkgnum {
+  my( $self, $pkgnum ) = @_;
+  sort { $a->_date <=> $b->_date }
+    qsearch( 'cust_credit', { 'custnum' => $self->custnum,
+                              'pkgnum'  => $pkgnum,
+                            }
+    );
+}
+
 =item cust_pay
 
 Returns all the payments (see L<FS::cust_pay>) for this customer.
@@ -7013,6 +7154,22 @@
     qsearch( 'cust_pay', { 'custnum' => $self->custnum } )
 }
 
+=item cust_pay_pkgnum
+
+Returns all the payments (see L<FS::cust_pay>) for this customer's specific
+package when using experimental package balances.
+
+=cut
+
+sub cust_pay_pkgnum {
+  my( $self, $pkgnum ) = @_;
+  sort { $a->_date <=> $b->_date }
+    qsearch( 'cust_pay', { 'custnum' => $self->custnum,
+                           'pkgnum'  => $pkgnum,
+                         }
+    );
+}
+
 =item cust_pay_void
 
 Returns all voided payments (see L<FS::cust_pay_void>) for this customer.

Index: cust_pay_void.pm
===================================================================
RCS file: /home/cvs/cvsroot/freeside/FS/FS/cust_pay_void.pm,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -d -r1.6 -r1.7
--- cust_pay_void.pm	24 Dec 2006 01:28:37 -0000	1.6
+++ cust_pay_void.pm	30 Jul 2009 06:42:31 -0000	1.7
@@ -9,6 +9,7 @@
 #use FS::cust_bill_pay;
 #use FS::cust_pay_refund;
 #use FS::cust_main;
+use FS::cust_pkg;
 
 @ISA = qw( FS::Record FS::payinfo_Mixin );
 
@@ -40,24 +41,44 @@
 
 =over 4
 
-=item paynum - primary key (assigned automatically for new payments)
+=item paynum
 
-=item custnum - customer (see L<FS::cust_main>)
+primary key (assigned automatically for new payments)
 
-=item paid - Amount of this payment
+=item custnum
 
-=item _date - specified as a UNIX timestamp; see L<perlfunc/"time">.  Also see
+customer (see L<FS::cust_main>)
+
+=item paid
+
+Amount of this payment
+
+=item _date
+
+specified as a UNIX timestamp; see L<perlfunc/"time">.  Also see
 L<Time::Local> and L<Date::Parse> for conversion functions.
 
-=item payby - `CARD' (credit cards), `CHEK' (electronic check/ACH),
+=item payby
+
+`CARD' (credit cards), `CHEK' (electronic check/ACH),
 `LECB' (phone bill billing), `BILL' (billing), `CASH' (cash),
 `WEST' (Western Union), `MCRD' (Manual credit card), or `COMP' (free)
 
-=item payinfo - card number, check #, or comp issuer (4-8 lowercase alphanumerics; think username), respectively
+=item payinfo
 
-=item paybatch - text field for tracking card processing
+card number, check #, or comp issuer (4-8 lowercase alphanumerics; think username), respectively
 
-=item closed - books closed flag, empty or `Y'
+=item paybatch
+
+text field for tracking card processing
+
+=item closed
+
+books closed flag, empty or `Y'
+
+=item pkgnum
+
+Desired pkgnum when using experimental package balances.
 
 =item void_date
 
@@ -156,6 +177,7 @@
     || $self->ut_number('_date')
     || $self->ut_textn('paybatch')
     || $self->ut_enum('closed', [ '', 'Y' ])
+    || $self->ut_foreign_keyn('pkgnum', 'cust_pkg', 'pkgnum')
     || $self->ut_numbern('void_date')
     || $self->ut_textn('reason')
   ;

Index: cust_credit_bill.pm
===================================================================
RCS file: /home/cvs/cvsroot/freeside/FS/FS/cust_credit_bill.pm,v
retrieving revision 1.16
retrieving revision 1.17
diff -u -d -r1.16 -r1.17
--- cust_credit_bill.pm	14 Mar 2008 07:48:43 -0000	1.16
+++ cust_credit_bill.pm	30 Jul 2009 06:42:31 -0000	1.17
@@ -8,6 +8,7 @@
 use FS::cust_bill_ApplicationCommon;
 use FS::cust_bill;
 use FS::cust_credit;
+use FS::cust_pkg;
 
 @ISA = qw( FS::cust_main_Mixin FS::cust_bill_ApplicationCommon );
 
@@ -122,6 +123,7 @@
     || $self->ut_foreign_key('invnum', 'cust_bill', 'invnum' )
     || $self->ut_numbern('_date')
     || $self->ut_money('amount')
+    || $self->ut_foreign_keyn('pkgnum', 'cust_pkg', 'pkgnum')
   ;
   return $error if $error;
 

Index: Conf.pm
===================================================================
RCS file: /home/cvs/cvsroot/freeside/FS/FS/Conf.pm,v
retrieving revision 1.305
retrieving revision 1.306
diff -u -d -r1.305 -r1.306
--- Conf.pm	28 Jul 2009 22:21:39 -0000	1.305
+++ Conf.pm	30 Jul 2009 06:42:31 -0000	1.306
@@ -3009,6 +3009,13 @@
     'type'        => 'checkbox',
   },
 
+  {
+    'key'         => 'pkg-balances',
+    'section'     => 'billing',
+    'description' => 'Enable experimental package balances.  Not recommended for general use.',
+    'type'        => 'checkbox',
+  },
+
   { key => "apacheroot", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" },
   { key => "apachemachine", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" },
   { key => "apachemachines", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" },

Index: cust_pkg.pm
===================================================================
RCS file: /home/cvs/cvsroot/freeside/FS/FS/cust_pkg.pm,v
retrieving revision 1.134
retrieving revision 1.135
diff -u -d -r1.134 -r1.135
--- cust_pkg.pm	27 Jul 2009 03:26:46 -0000	1.134
+++ cust_pkg.pm	30 Jul 2009 06:42:31 -0000	1.135
@@ -1750,6 +1750,63 @@
   $statuscolor{$self->status};
 }
 
+=item pkg_label
+
+Returns a label for this package.  (Currently "pkgnum: pkg - comment" or
+"pkg-comment" depending on user preference).
+
+=cut
+
+sub pkg_label {
+  my $self = shift;
+  my $label = $self->part_pkg->pkg_comment( 'nopkgpart' => 1 );
+  $label = $self->pkgnum. ": $label"
+    if $FS::CurrentUser::CurrentUser->option('show_pkgnum');
+  $label;
+}
+
+=item pkg_label_long
+
+Returns a long label for this package, adding the primary service's label to
+pkg_label.
+
+=cut
+
+sub pkg_label_long {
+  my $self = shift;
+  my $label = $self->pkg_label;
+  my $cust_svc = $self->primary_cust_svc;
+  $label .= ' ('. ($cust_svc->label)[1]. ')' if $cust_svc;
+  $label;
+}
+
+=item primary_cust_svc
+
+Returns a primary service (as FS::cust_svc object) if one can be identified.
+
+=cut
+
+#for labeling purposes - might not 100% match up with part_pkg->svcpart's idea
+
+sub primary_cust_svc {
+  my $self = shift;
+
+  my @cust_svc = $self->cust_svc;
+
+  return '' unless @cust_svc; #no serivces - irrelevant then
+  
+  return $cust_svc[0] if scalar(@cust_svc) == 1; #always return a single service
+
+  # primary service as specified in the package definition
+  # or exactly one service definition with quantity one
+  my $svcpart = $self->part_pkg->svcpart;
+  @cust_svc = grep { $_->svcpart == $svcpart } @cust_svc;
+  return $cust_svc[0] if scalar(@cust_svc) == 1;
+
+  #couldn't identify one thing..
+  return '';
+}
+
 =item labels
 
 Returns a list of lists, calling the label method for all services

Index: cust_bill_ApplicationCommon.pm
===================================================================
RCS file: /home/cvs/cvsroot/freeside/FS/FS/cust_bill_ApplicationCommon.pm,v
retrieving revision 1.10
retrieving revision 1.11
diff -u -d -r1.10 -r1.11
--- cust_bill_ApplicationCommon.pm	4 Oct 2008 22:35:58 -0000	1.10
+++ cust_bill_ApplicationCommon.pm	30 Jul 2009 06:42:31 -0000	1.11
@@ -115,6 +115,8 @@
 
   my @apply = ();
 
+  my $conf = new FS::Conf;
+
   local $SIG{HUP} = 'IGNORE';
   local $SIG{INT} = 'IGNORE';
   local $SIG{QUIT} = 'IGNORE';
@@ -127,6 +129,8 @@
   my $dbh = dbh;
 
   my @open = $self->cust_bill->open_cust_bill_pkg; #FOR UPDATE...?
+  @open = grep { $_->pkgnum == $self->pkgnum } @open
+    if $conf->exists('pkg-balances') && $self->pkgnum;
   warn "$me ". scalar(@open). " open line items for invoice ".
        $self->cust_bill->invnum. ": ". join(', ', @open). "\n"
     if $DEBUG;

Index: cust_bill.pm
===================================================================
RCS file: /home/cvs/cvsroot/freeside/FS/FS/cust_bill.pm,v
retrieving revision 1.249
retrieving revision 1.250
diff -u -d -r1.249 -r1.250
--- cust_bill.pm	28 Jul 2009 22:21:39 -0000	1.249
+++ cust_bill.pm	30 Jul 2009 06:42:31 -0000	1.250
@@ -235,6 +235,25 @@
   );
 }
 
+=item cust_bill_pkg_pkgnum PKGNUM
+
+Returns the line items (see L<FS::cust_bill_pkg>) for this invoice and
+specified pkgnum.
+
+=cut
+
+sub cust_bill_pkg_pkgnum {
+  my( $self, $pkgnum ) = @_;
+  qsearch(
+    { 'table'    => 'cust_bill_pkg',
+      'hashref'  => { 'invnum' => $self->invnum,
+                      'pkgnum' => $pkgnum,
+                    },
+      'order_by' => 'ORDER BY billpkgnum',
+    }
+  );
+}
+
 =item cust_pkg
 
 Returns the packages (see L<FS::cust_pkg>) corresponding to the line items for
@@ -432,6 +451,38 @@
   ;
 }
 
+=item cust_bill_pay_pkgnum
+
+Returns all payment applications (see L<FS::cust_bill_pay>) for this invoice
+with matching pkgnum.
+
+=cut
+
+sub cust_bill_pay_pkgnum {
+  my( $self, $pkgnum ) = @_;
+  sort { $a->_date <=> $b->_date }
+    qsearch( 'cust_bill_pay', { 'invnum' => $self->invnum,
+                                'pkgnum' => $pkgnum,
+                              }
+           );
+}
+
+=item cust_credited_pkgnum
+
+Returns all applied credits (see L<FS::cust_credit_bill>) for this invoice
+with matching pkgnum.
+
+=cut
+
+sub cust_credited_pkgnum {
+  my( $self, $pkgnum ) = @_;
+  sort { $a->_date <=> $b->_date }
+    qsearch( 'cust_credit_bill', { 'invnum' => $self->invnum,
+                                   'pkgnum' => $pkgnum,
+                                 }
+           );
+}
+
 =item tax
 
 Returns the tax amount (see L<FS::cust_bill_pkg>) for this invoice.
@@ -465,6 +516,21 @@
   $balance;
 }
 
+sub owed_pkgnum {
+  my( $self, $pkgnum ) = @_;
+
+  #my $balance = $self->charged;
+  my $balance = 0;
+  $balance += $_->setup + $_->recur for $self->cust_bill_pkg_pkgnum($pkgnum);
+
+  $balance -= $_->amount            for $self->cust_bill_pay_pkgnum($pkgnum);
+  $balance -= $_->amount            for $self->cust_credited_pkgnum($pkgnum);
+
+  $balance = sprintf( "%.2f", $balance);
+  $balance =~ s/^\-0\.00$/0.00/; #yay ieee fp
+  $balance;
+}
+
 =item apply_payments_and_credits
 
 =cut
@@ -488,6 +554,13 @@
   my @payments = grep { $_->unapplied > 0 } $self->cust_main->cust_pay;
   my @credits  = grep { $_->credited > 0 } $self->cust_main->cust_credit;
 
+  if ( $conf->exists('pkg-balances') ) {
+    # limit @payments & @credits to those w/ a pkgnum grepped from $self
+    my %pkgnums = map { $_ => 1 } map $_->pkgnum, $self->cust_bill_pkg;
+    @payments = grep { ! $_->pkgnum || $pkgnums{$_->pkgnum} } @payments;
+    @credits  = grep { ! $_->pkgnum || $pkgnums{$_->pkgnum} } @credits;
+  }
+
   while ( $self->owed > 0 and ( @payments || @credits ) ) {
 
     my $app = '';
@@ -525,28 +598,39 @@
       die "guru meditation #12 and 35";
     }
 
+    my $unapp_amount;
     if ( $app eq 'pay' ) {
 
       my $payment = shift @payments;
-
-      $app = new FS::cust_bill_pay {
-        'paynum'  => $payment->paynum,
-	'amount'  => sprintf('%.2f', min( $payment->unapplied, $self->owed ) ),
-      };
+      $unapp_amount = $payment->unapplied;
+      $app = new FS::cust_bill_pay { 'paynum'  => $payment->paynum };
+      $app->pkgnum( $payment->pkgnum )
+        if $conf->exists('pkg-balances') && $payment->pkgnum;
 
     } elsif ( $app eq 'credit' ) {
 
       my $credit = shift @credits;
-
-      $app = new FS::cust_credit_bill {
-        'crednum' => $credit->crednum,
-	'amount'  => sprintf('%.2f', min( $credit->credited, $self->owed ) ),
-      };
+      $unapp_amount = $credit->credited;
+      $app = new FS::cust_credit_bill { 'crednum' => $credit->crednum };
+      $app->pkgnum( $credit->pkgnum )
+        if $conf->exists('pkg-balances') && $credit->pkgnum;
 
     } else {
       die "guru meditation #12 and 35";
     }
 
+    my $owed;
+    if ( $conf->exists('pkg-balances') && $app->pkgnum ) {
+      warn "owed_pkgnum ". $app->pkgnum;
+      $owed = $self->owed_pkgnum($app->pkgnum);
+    } else {
+      $owed = $self->owed;
+    }
+    next unless $owed > 0;
+
+    warn "min ( $unapp_amount, $owed )\n";
+    $app->amount( sprintf('%.2f', min( $unapp_amount, $owed ) ) );
+
     $app->invnum( $self->invnum );
 
     my $error = $app->insert;

Index: Schema.pm
===================================================================
RCS file: /home/cvs/cvsroot/freeside/FS/FS/Schema.pm,v
retrieving revision 1.159
retrieving revision 1.160
diff -u -d -r1.159 -r1.160
--- Schema.pm	28 Jul 2009 22:21:39 -0000	1.159
+++ Schema.pm	30 Jul 2009 06:42:31 -0000	1.160
@@ -598,6 +598,7 @@
         'reasonnum', 'int', 'NULL', '', '', '', 
         'addlinfo', 'text', 'NULL', '', '', '',
         'closed',    'char', 'NULL', 1, '', '', 
+        'pkgnum', 'int', 'NULL', '', '', '', #desired pkgnum for pkg-balances
       ],
       'primary_key' => 'crednum',
       'unique' => [],
@@ -611,6 +612,7 @@
         'invnum',  'int', '', '', '', '', 
         '_date',    @date_type, '', '', 
         'amount',   @money_type, '', '', 
+        'pkgnum', 'int', 'NULL', '', '', '', #desired pkgnum for pkg-balances
       ],
       'primary_key' => 'creditbillnum',
       'unique' => [],
@@ -941,6 +943,7 @@
         #'paybatch',     'varchar', 'NULL', $char_d, '', '', #for auditing purposes.
         'payunique',    'varchar', 'NULL', $char_d, '', '', #separate paybatch "unique" functions from current usage
 
+        'pkgnum', 'int', 'NULL', '', '', '', #desired pkgnum for pkg-balances
         'status',       'varchar',     '', $char_d, '', '', 
         'session_id',   'varchar', 'NULL', $char_d, '', '', #only need 32
         'statustext',   'text',    'NULL',  '', '', '', 
@@ -970,6 +973,7 @@
         'paybatch', 'varchar',   'NULL', $char_d, '', '', #for auditing purposes.
         'payunique', 'varchar', 'NULL', $char_d, '', '', #separate paybatch "unique" functions from current usage
         'closed',    'char', 'NULL', 1, '', '', 
+        'pkgnum', 'int', 'NULL', '', '', '', #desired pkgnum for pkg-balances
       ],
       'primary_key' => 'paynum',
       #i guess not now, with cust_pay_pending, if we actually make it here, we _do_ want to record it# 'unique' => [ [ 'payunique' ] ],
@@ -989,6 +993,7 @@
 	'paymask', 'varchar', 'NULL', $char_d, '', '', 
         'paybatch',  'varchar',   'NULL', $char_d, '', '', #for auditing purposes.
         'closed',    'char', 'NULL', 1, '', '', 
+        'pkgnum', 'int', 'NULL', '', '', '', #desired pkgnum for pkg-balances
         'void_date', @date_type, '', '', 
         'reason',    'varchar',   'NULL', $char_d, '', '', 
         'otaker',   'varchar', '', 32, '', '', 
@@ -1005,6 +1010,7 @@
         'paynum',  'int',     '',   '', '', '', 
         'amount',  @money_type, '', '', 
         '_date',   @date_type, '', '', 
+        'pkgnum', 'int', 'NULL', '', '', '', #desired pkgnum for pkg-balances
       ],
       'primary_key' => 'billpaynum',
       'unique' => [],

Index: cust_pay_pending.pm
===================================================================
RCS file: /home/cvs/cvsroot/freeside/FS/FS/cust_pay_pending.pm,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -d -r1.7 -r1.8
--- cust_pay_pending.pm	10 Mar 2009 16:14:09 -0000	1.7
+++ cust_pay_pending.pm	30 Jul 2009 06:42:31 -0000	1.8
@@ -6,6 +6,7 @@
 use FS::payinfo_transaction_Mixin;
 use FS::cust_main_Mixin;
 use FS::cust_main;
+use FS::cust_pkg;
 use FS::cust_pay;
 
 @ISA = qw( FS::payinfo_transaction_Mixin FS::cust_main_Mixin FS::Record );
@@ -77,6 +78,10 @@
 
 Unique identifer to prevent duplicate transactions.
 
+=item pkgnum
+
+Desired pkgnum when using experimental package balances.
+
 =item status
 
 Pending transaction status, one of the following:
@@ -193,6 +198,7 @@
     #|| $self->ut_money('cust_balance')
     || $self->ut_hexn('session_id')
     || $self->ut_foreign_keyn('paynum', 'cust_pay', 'paynum' )
+    || $self->ut_foreign_keyn('pkgnum', 'cust_pkg', 'pkgnum')
     || $self->payinfo_check() #payby/payinfo/paymask/paydate
   ;
   return $error if $error;

Index: cust_bill_pay.pm
===================================================================
RCS file: /home/cvs/cvsroot/freeside/FS/FS/cust_bill_pay.pm,v
retrieving revision 1.19
retrieving revision 1.20
diff -u -d -r1.19 -r1.20
--- cust_bill_pay.pm	19 May 2008 04:07:01 -0000	1.19
+++ cust_bill_pay.pm	30 Jul 2009 06:42:31 -0000	1.20
@@ -7,6 +7,7 @@
 use FS::cust_bill_ApplicationCommon;
 use FS::cust_bill;
 use FS::cust_pay;
+use FS::cust_pkg;
 
 @ISA = qw( FS::cust_main_Mixin FS::cust_bill_ApplicationCommon );
 
@@ -121,6 +122,7 @@
     || $self->ut_foreign_key('invnum', 'cust_bill', 'invnum' )
     || $self->ut_numbern('_date')
     || $self->ut_money('amount')
+    || $self->ut_foreign_keyn('pkgnum', 'cust_pkg', 'pkgnum')
   ;
   return $error if $error;
 



More information about the freeside-commits mailing list