FS/FS/cust_bill_ApplicationCommon.pm

   1 package FS::cust_bill_ApplicationCommon;
   2
   3 use strict;
   4 use vars qw( @ISA $DEBUG );
   5 use FS::Schema qw( dbdef );
   6 use FS::Record qw( qsearch qsearchs dbh );
   7
   8 @ISA = qw( FS::Record );
   9
  10 $DEBUG = 1;
  11
  12 =head1 NAME
  13
  14 FS::cust_bill_ApplicationCommon - Base class for bill application classes
  15
  16 =head1 SYNOPSIS
  17
  18 use FS::cust_bill_ApplicationCommon;
  19
  20 @ISA = qw( FS::cust_bill_ApplicationCommon );
  21
  22 sub _app_source_name  { 'payment'; }
  23 sub _app_source_table { 'cust_pay'; }
  24 sub _app_lineitem_breakdown_table { 'cust_bill_pay_pkg'; }
  25
  26 =head1 DESCRIPTION
  27
  28 FS::cust_bill_ApplicationCommon is intended as a base class for classes which
  29 represent application of things to invoices, currently payments
  30 (see L<FS::cust_bill_pay>) or credits (see L<FS::cust_credit_bill>).
  31
  32 =head1 METHODS
  33
  34 =item insert
  35
  36 =cut
  37
  38 sub insert {
  39   my $self = shift;
  40
  41   local $SIG{HUP} = 'IGNORE';
  42   local $SIG{INT} = 'IGNORE';
  43   local $SIG{QUIT} = 'IGNORE';
  44   local $SIG{TERM} = 'IGNORE';
  45   local $SIG{TSTP} = 'IGNORE';
  46   local $SIG{PIPE} = 'IGNORE';
  47
  48   my $oldAutoCommit = $FS::UID::AutoCommit;
  49   local $FS::UID::AutoCommit = 0;
  50   my $dbh = dbh;
  51
  52   my $error =    $self->SUPER::insert(@_)
  53               || $self->apply_to_lineitems;
  54   if ( $error ) {
  55     $dbh->rollback if $oldAutoCommit;
  56     return $error;
  57   }
  58
  59   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
  60
  61   '';
  62
  63 }
  64
  65 =item delete
  66
  67 =cut
  68
  69 sub delete {
  70   my $self = shift;
  71
  72   local $SIG{HUP} = 'IGNORE';
  73   local $SIG{INT} = 'IGNORE';
  74   local $SIG{QUIT} = 'IGNORE';
  75   local $SIG{TERM} = 'IGNORE';
  76   local $SIG{TSTP} = 'IGNORE';
  77   local $SIG{PIPE} = 'IGNORE';
  78
  79   my $oldAutoCommit = $FS::UID::AutoCommit;
  80   local $FS::UID::AutoCommit = 0;
  81   my $dbh = dbh;
  82
  83   foreach my $app ( $self->lineitem_applications ) {
  84     my $error = $app->delete;
  85     if ( $error ) {
  86       $dbh->rollback if $oldAutoCommit;
  87       return $error;
  88     }
  89   }
  90
  91   my $error = $self->SUPER::delete(@_);
  92   if ( $error ) {
  93     $dbh->rollback if $oldAutoCommit;
  94     return $error;
  95   }
  96
  97   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
  98
  99   '';
 100
 101 }
 102
 103 =item apply_to_lineitems
 104
 105 Auto-applies this invoice application to specific line items, if possible.
 106
 107 =cut
 108
 109 sub apply_to_lineitems {
 110   my $self = shift;
 111
 112   my @apply = ();
 113
 114   local $SIG{HUP} = 'IGNORE';
 115   local $SIG{INT} = 'IGNORE';
 116   local $SIG{QUIT} = 'IGNORE';
 117   local $SIG{TERM} = 'IGNORE';
 118   local $SIG{TSTP} = 'IGNORE';
 119   local $SIG{PIPE} = 'IGNORE';
 120
 121   my $oldAutoCommit = $FS::UID::AutoCommit;
 122   local $FS::UID::AutoCommit = 0;
 123   my $dbh = dbh;
 124
 125   my @open = $self->cust_bill->open_cust_bill_pkg; #FOR UPDATE...?
 126   warn scalar(@open). " open line items for invoice ".
 127        $self->cust_bill->invnum. "\n"
 128     if $DEBUG;
 129   my $total = 0;
 130   $total += $_->setup + $_->recur foreach @open;
 131   $total = sprintf('%.2f', $total);
 132
 133   if ( $self->amount > $total ) {
 134     dbh->rollback if $oldAutoCommit;
 135     return "Can't apply a ". $self->_app_source_name. ' of $'. $self->amount.
 136            " greater than the remaining owed on line items (\$$total)";
 137   }
 138
 139   #easy cases:
 140   # - one lineitem (a simple special case of:)
 141   # - amount is for whole invoice (well, all of remaining lineitem links)
 142   if ( $self->amount == $total ) {
 143
 144     #@apply = map { [ $_, $_->amount ]; } @open;
 145     @apply = map { [ $_, $_->setup || $_->recur ]; } @open;
 146
 147   } else {
 148
 149     #slightly magic case:
 150     # - amount exactly and uniquely matches a single open lineitem
 151     #   (you must be trying to pay or credit that item, then)
 152
 153     my @same = grep {    $_->setup == $self->amount
 154                       || $_->recur == $self->amount
 155                     }
 156                     @open;
 157     @apply = map { [ $_, $self->amount ]; } @same
 158       if scalar(@same) == 1;
 159
 160   }
 161
 162   #and the rest:
 163   # - leave unapplied, for now
 164   # - eventually, auto-apply?  sequentially?  pro-rated against total remaining?
 165
 166   # do the applicaiton(s)
 167   my $table = $self->lineitem_breakdown_table;
 168   my $source_key = dbdef->table($self->table)->primary_key;
 169   foreach my $apply ( @apply ) {
 170     my ( $cust_bill_pkg, $amount ) = @$apply;
 171     my $application = "FS::$table"->new( {
 172       $source_key  => $self->$source_key(),
 173       'billpkgnum' => $cust_bill_pkg->billpkgnum,
 174       'amount'     => $amount,
 175       'setuprecur' => ( $cust_bill_pkg->setup > 0 ? 'setup' : 'recur' ),
 176     });
 177     my $error = $application->insert;
 178     if ( $error ) {
 179       dbh->rollbck if $oldAutoCommit;
 180       return $error;
 181     }
 182   }
 183
 184   '';
 185
 186 }
 187
 188 =item lineitem_applications
 189
 190 Returns all the specific line item applications for this invoice application.
 191
 192 =cut
 193
 194 sub lineitem_applications {
 195   my $self = shift;
 196   my $primary_key = dbdef->table($self->table)->primary_key;
 197   qsearchs({
 198     'table'   => $self->lineitem_breakdown_table,
 199     'hashref' => { $primary_key => $self->$primary_key() },
 200   });
 201
 202 }
 203
 204 =item cust_bill
 205
 206 Returns the invoice (see L<FS::cust_bill>)
 207
 208 =cut
 209
 210 sub cust_bill {
 211   my $self = shift;
 212   qsearchs( 'cust_bill', { 'invnum' => $self->invnum } );
 213 }
 214
 215 =item lineitem_breakdown_table
 216
 217 =cut
 218
 219 sub lineitem_breakdown_table {
 220   my $self = shift;
 221   $self->_load_table($self->_app_lineitem_breakdown_table);
 222 }
 223
 224 sub _load_table {
 225   my( $self, $table ) = @_;
 226   eval "use FS::$table";
 227   die $@ if $@;
 228   $table;
 229 }
 230
 231 =back
 232
 233 =head1 BUGS
 234
 235 =head1 SEE ALSO
 236
 237 L<FS::cust_bill_pay> and L<FS::cust_bill_pay_pkg>,
 238 L<FS::cust_credit_bill> and L<FS::cust_credit_bill_pkg>
 239
 240 =cut
 241
 242 1;
 243