X-Git-Url: http://git.freeside.biz/gitweb/?p=freeside.git;a=blobdiff_plain;f=FS%2FFS%2Fcust_bill_ApplicationCommon.pm;h=75d2647cb27f67faef502eda009f72140379b295;hp=30243e2109544a55b3773cae9c171293e43721a9;hb=ff27c3f36240aee48ed50153dd5d8fe3ac3f2443;hpb=8fccb0da9d9b2213cc1409d7d7bf94ecc68a66f6

diff --git a/FS/FS/cust_bill_ApplicationCommon.pm b/FS/FS/cust_bill_ApplicationCommon.pm
index 30243e210..75d2647cb 100644
--- a/FS/FS/cust_bill_ApplicationCommon.pm
+++ b/FS/FS/cust_bill_ApplicationCommon.pm
@@ -1,10 +1,17 @@
 package FS::cust_bill_ApplicationCommon;
 
 use strict;
-use vars qw( @ISA $DEBUG $me $skip_apply_to_lineitems_hack );
+use vars qw( @ISA $DEBUG $me $skip_apply_to_lineitems_hack $date_format );
 use List::Util qw(min);
+use Date::Format;
 use FS::Schema qw( dbdef );
+use FS::UID;
 use FS::Record qw( qsearch qsearchs dbh );
+use FS::cust_pkg;
+use FS::cust_svc;
+use FS::cust_bill_pkg;
+use FS::part_svc;
+use FS::part_export;
 
 @ISA = qw( FS::Record );
 
@@ -13,6 +20,11 @@ $me = '[FS::cust_bill_ApplicationCommon]';
 
 $skip_apply_to_lineitems_hack = 0;
 
+FS::UID->install_callback( sub { 
+  my $conf = new FS::Conf;
+  $date_format = $conf->config('date_format') || '%x'; #/YY
+} );
+
 =head1 NAME
 
 FS::cust_bill_ApplicationCommon - Base class for bill application classes
@@ -154,7 +166,10 @@ sub calculate_applications {
        $self->cust_bill->invnum. ": ". join(', ', @open). "\n"
     if $DEBUG;
   my $total = 0;
-  $total += $_->owed_setup + $_->owed_recur foreach @open;
+  foreach (@open) {
+    $total += $_->owed_setup if $_->setup;
+    $total += $_->owed_recur if $_->recur;
+  }
   $total = sprintf('%.2f', $total);
 
   if ( $self->amount > $total ) {
@@ -172,7 +187,8 @@ sub calculate_applications {
       if $DEBUG;
 
     #@apply = map { [ $_, $_->amount ]; } @open;
-    @apply = map { [ $_, $_->owed_setup + 0 || $_->owed_recur + 0 ]; } @open;
+    #@apply = map { [ $_, $_->owed_setup + 0 || $_->owed_recur + 0 ]; } @open;
+    @apply = map { [ $_, $_->setup ? $_->owed_setup : $_->owed_recur ]; } @open;
 
   } else {
 
@@ -180,8 +196,8 @@ sub calculate_applications {
     # - amount exactly and uniquely matches a single open lineitem
     #   (you must be trying to pay or credit that item, then)
 
-    my @same = grep {    $_->owed_setup == $self->amount
-                      || $_->owed_recur == $self->amount
+    my @same = grep {    ( $_->setup && $_->owed_setup == $self->amount )
+                      || ( $_->recur && $_->owed_recur == $self->amount )
                     }
                     @open;
     if ( scalar(@same) == 1 ) {
@@ -216,7 +232,7 @@ sub calculate_applications {
     my %saw = ();
     my @weights = sort { $b <=> $a }     # highest weight first
                   grep { ! $saw{$_}++ }  # want a list of unique weights
-		  map  { $_->[1] }
+        	  map  { $_->[1] }
                        @openweight;
   
     my $remaining_amount = $self->amount;
@@ -226,7 +242,10 @@ sub calculate_applications {
       my @items = map { $_->[0] } grep { $weight == $_->[1] } @openweight;
 
       my $itemtotal = 0;
-      foreach my $item (@items) { $itemtotal += $item->owed_setup + 0 || $item->owed_recur + 0; }
+      foreach my $item (@items) {
+        $itemtotal += $item->owed_setup if $item->setup;
+        $itemtotal += $item->owed_recur if $item->recur;
+      }
       my $applytotal = min( $itemtotal, $remaining_amount );
       $remaining_amount -= $applytotal;
 
@@ -237,81 +256,83 @@ sub calculate_applications {
       #if some items are less than applytotal/num_items, then apply then in full
       my $lessflag;
       do {
-	$lessflag = 0;
+        $lessflag = 0;
 
-	#no, not sprintf("%.2f",
-	# we want this rounded DOWN for purposes of checking for line items
-	# less than it, we don't want .66666 becoming .67 and causing this
-	# to trigger when it shouldn't
+        #no, not sprintf("%.2f",
+        # we want this rounded DOWN for purposes of checking for line items
+        # less than it, we don't want .66666 becoming .67 and causing this
+        # to trigger when it shouldn't
         my $applyeach = int( 100 * $applytotal / scalar(@items) ) / 100;
 
-	my @newitems = ();
-	foreach my $item ( @items ) {
-	  my $itemamount = $item->owed_setup + 0 || $item->owed_recur + 0;
+        my @newitems = ();
+        foreach my $item ( @items ) {
+          my $itemamount = $item->setup ? $item->owed_setup : $item->owed_recur;
           if ( $itemamount < $applyeach ) {
-	    warn "$me applying full $itemamount".
-	         " to small line item (cust_bill_pkg ". $item->billpkgnum. ")\n"
-	      if $DEBUG;
-	    push @apply, [ $item, $itemamount ];
-	    $applytotal -= $itemamount;
+            warn "$me applying full $itemamount".
+                 " to small line item (cust_bill_pkg ". $item->billpkgnum. ")\n"
+              if $DEBUG;
+            push @apply, [ $item, $itemamount ];
+            $applytotal -= $itemamount;
             $lessflag=1;
-	  } else {
-	    push @newitems, $item;
-	  }
-	}
-	@items = @newitems;
-
-      } while ( $lessflag );
-
-      #and now that we've fallen out of the loop, distribute the rest equally...
-
-      # should cust_bill_pay_pkg and cust_credit_bill_pkg amount columns
-      # become real instead of numeric(10,2) ???  no..
-      my $applyeach = sprintf("%.2f", $applytotal / scalar(@items) );
-
-      my @equi_apply = map { [ $_, $applyeach ] } @items;
-
-      # or should we futz with pennies instead?  yes, bah!
-      my $diff =
-        sprintf('%.0f', 100 * ( $applytotal - $applyeach * scalar(@items) ) );
-      $diff = 0 if $diff eq '-0'; #yay ieee fp
-      if ( abs($diff) > scalar(@items) ) {
-        #we must have done something really wrong, the difference is more than
-	#a penny an item
-	return 'Error distributing pennies applying '. $self->_app_source_name.
-	       " - can't distribute difference of $diff pennies".
-	       ' among '. scalar(@items). ' line items';
-      }
+          } else {
+            push @newitems, $item;
+          }
+        }
+        @items = @newitems;
+
+      } while ( $lessflag && @items );
+
+      if ( @items ) {
+
+        #and now that we've fallen out of the loop, distribute the rest equally
+
+        # should cust_bill_pay_pkg and cust_credit_bill_pkg amount columns
+        # become real instead of numeric(10,2) ???  no..
+        my $applyeach = sprintf("%.2f", $applytotal / scalar(@items) );
+
+        my @equi_apply = map { [ $_, $applyeach ] } @items;
+
+        # or should we futz with pennies instead?  yes, bah!
+        my $diff =
+          sprintf('%.0f', 100 * ( $applytotal - $applyeach * scalar(@items) ) );
+        $diff = 0 if $diff eq '-0'; #yay ieee fp
+        if ( abs($diff) > scalar(@items) ) {
+          #we must have done something really wrong, the difference is more than
+          #a penny an item
+          return 'Error distributing pennies applying '.$self->_app_source_name.
+                 " - can't distribute difference of $diff pennies".
+                 ' among '. scalar(@items). ' line items';
+        }
+
+        warn "$me futzing with $diff pennies difference\n"
+          if $DEBUG && $diff;
+
+        my $futz = 0;
+        while ( $diff != 0 && $futz < scalar(@equi_apply) ) {
+          if ( $diff > 0 ) { 
+            $equi_apply[$futz++]->[1] += .01;
+            $diff -= 1;
+          } elsif ( $diff < 0 ) {
+            $equi_apply[$futz++]->[1] -= .01;
+            $diff += 1;
+          } else {
+            die "guru exception #5 (in fortran tongue the answer)";
+          }
+        }
+
+        if ( sprintf('%.0f', $diff ) ) {
+          return "couldn't futz with pennies enough: still $diff left";
+        }
+
+        if ( $DEBUG ) {
+          warn "$me applying ". $_->[1].
+               " to line item (cust_bill_pkg ". $_->[0]->billpkgnum. ")\n"
+            foreach @equi_apply;
+        }
+        push @apply, @equi_apply;
 
-      warn "$me futzing with $diff pennies difference\n"
-        if $DEBUG && $diff;
-
-      my $futz = 0;
-      while ( $diff != 0 && $futz < scalar(@equi_apply) ) {
-        if ( $diff > 0 ) { 
-	  $equi_apply[$futz++]->[1] += .01;
-	  $diff -= 1;
-	} elsif ( $diff < 0 ) {
-	  $equi_apply[$futz++]->[1] -= .01;
-	  $diff += 1;
-	} else {
-	  die "guru exception #5 (in fortran tongue the answer)";
-	}
       }
 
-      if ( sprintf('%.0f', $diff ) ) {
-	return "couldn't futz with pennies enough: still $diff left";
-      }
-
-      if ( $DEBUG ) {
-        warn "$me applying ". $_->[1].
-	     " to line item (cust_bill_pkg ". $_->[0]->billpkgnum. ")\n"
-	  foreach @equi_apply;
-      }
-
-
-      push @apply, @equi_apply;
-
       #$remaining_amount -= $applytotal;
       last unless $remaining_amount;
 
@@ -323,6 +344,7 @@ sub calculate_applications {
   # could expand @open above, instead, for a slightly different magic effect
   my @result = ();
   foreach my $apply ( @apply ) {
+    # $apply = [ FS::cust_bill_pkg_tax_location record, amount ]
     my @sub_lines = $apply->[0]->cust_bill_pkg_tax_Xlocation;
     my $amount = $apply->[1];
     warn "applying ". $apply->[1]. " to ". $apply->[0]->desc
@@ -332,6 +354,10 @@ sub calculate_applications {
       my $owed = $subline->owed;
       push @result, [ $apply->[0],
                       sprintf('%.2f', min($amount, $owed) ),
+                      # $subline->primary_key is "billpkgtaxlocationnum"
+                      # or "billpkgtaxratelocationnum"
+                      # This is the ONLY place either of those fields will 
+                      # be set.
                       { $subline->primary_key => $subline->get($subline->primary_key) },
                     ];
       $amount -= $owed;
@@ -353,8 +379,6 @@ sub apply_to_lineitems {
 
   return '' if $skip_apply_to_lineitems_hack;
 
-
-
   my $conf = new FS::Conf;
 
   local $SIG{HUP} = 'IGNORE';
@@ -397,8 +421,43 @@ sub apply_to_lineitems {
       $dbh->rollback if $oldAutoCommit;
       return $error;
     }
+
+    # trigger export_insert_on_payment
+    if ( $conf->exists('trigger_export_insert_on_payment')
+      && $cust_bill_pkg->pkgnum > 0 )
+    {
+      if ( my $cust_pkg = $cust_bill_pkg->cust_pkg ) {
+
+        foreach my $cust_svc ( $cust_pkg->cust_svc ) {
+          my $svc_x = $cust_svc->svc_x;
+          my @part_export = grep { $_->can('_export_insert_on_payment') }
+                                 $cust_svc->part_svc->part_export;
+      
+          foreach my $part_export ( @part_export ) {
+            $error = $part_export->_export_insert_on_payment($svc_x);
+            if ( $error ) {
+              $dbh->rollback if $oldAutoCommit;
+              return $error;
+            }
+          }
+        }
+      }
+    }
+    # done trigger export_insert_on_payment
+
   }
 
+  # unset promised payment date if there is one
+  my $cust_bill = $self->cust_bill;
+  if ( $cust_bill->promised_date and $cust_bill->owed <= 0 ) {
+    $cust_bill->set('promised_date', '');
+    my $error = $cust_bill->replace;
+    if ( $error ) {
+      $dbh->rollback if $oldAutoCommit;
+      return $error;
+    }
+  }
+  
   #everything should always be applied to line items in full now... sanity check
   $applied = sprintf('%.2f', $applied);
   unless ( $applied == $self->amount ) {
@@ -444,11 +503,40 @@ sub cust_bill {
 Returns a string representing the invoice (see L<FS::cust_bill>), for example:
 "applied to Invoice #54 (3/20/2008)"
 
+Intended for back-end context, with regard to translation and date formatting.
+
 =cut
 
 sub applied_to_invoice {
   my $self = shift;
-  'applied to '. $self->cust_bill->invnum_date_pretty;
+  my $string = 'applied to '. $self->cust_bill->invnum_date_pretty;
+
+  #show application date if over 24 hours after (or before) payment/credit date
+  $string .= ' on '. $self->_date_pretty
+    if abs( $self->_date - $self->_app_source_object->_date ) > 86400;
+
+  $string;
+}
+
+=item _app_source_object 
+
+=cut
+
+sub _app_source_object {
+  my $self = shift;
+  my $source_table = $self->_app_source_table;
+  $self->$source_table();
+}
+
+=item _date_pretty
+
+Returns a string with the application date, for example: "3/20/2008"
+
+=cut
+
+sub _date_pretty {
+  my $self = shift;
+  time2str($date_format, $self->_date);
 }
 
 =item lineitem_breakdown_table