1 package FS::cust_credit;
4 use base qw( FS::otaker_Mixin FS::cust_main_Mixin FS::Record );
5 use vars qw( $conf $unsuspendauto $me $DEBUG
6 $otaker_upgrade_kludge $ignore_empty_reasonnum
8 use List::Util qw( min );
10 use FS::UID qw( dbh getotaker );
11 use FS::Misc qw(send_email);
12 use FS::Record qw( qsearch qsearchs dbdef );
17 use FS::cust_credit_bill;
23 $me = '[ FS::cust_credit ]';
26 $otaker_upgrade_kludge = 0;
27 $ignore_empty_reasonnum = 0;
29 #ask FS::UID to run this stuff for us later
30 $FS::UID::callback{'FS::cust_credit'} = sub {
33 $unsuspendauto = $conf->exists('unsuspendauto');
37 our %reasontype_map = ( 'referral_credit_type' => 'Referral Credit',
38 'cancel_credit_type' => 'Cancellation Credit',
39 'signup_credit_type' => 'Self-Service Credit',
44 FS::cust_credit - Object methods for cust_credit records
50 $record = new FS::cust_credit \%hash;
51 $record = new FS::cust_credit { 'column' => 'value' };
53 $error = $record->insert;
55 $error = $new_record->replace($old_record);
57 $error = $record->delete;
59 $error = $record->check;
63 An FS::cust_credit object represents a credit; the equivalent of a negative
64 B<cust_bill> record (see L<FS::cust_bill>). FS::cust_credit inherits from
65 FS::Record. The following fields are currently supported:
71 Primary key (assigned automatically for new credits)
75 Customer (see L<FS::cust_main>)
83 Specified as a UNIX timestamp; see L<perlfunc/"time">. Also see
84 L<Time::Local> and L<Date::Parse> for conversion functions.
88 Order taker (see L<FS::access_user>)
96 Reason (see L<FS::reason>)
104 Books closed flag, empty or `Y'
108 Desired pkgnum when using experimental package balances.
118 Creates a new credit. To add the credit to the database, see L<"insert">.
122 sub table { 'cust_credit'; }
123 sub cust_linked { $_[0]->cust_main_custnum; }
124 sub cust_unlinked_msg {
126 "WARNING: can't find cust_main.custnum ". $self->custnum.
127 ' (cust_credit.crednum '. $self->crednum. ')';
132 Adds this credit to the database ("Posts" the credit). If there is an error,
133 returns the error, otherwise returns false.
138 my ($self, %options) = @_;
140 local $SIG{HUP} = 'IGNORE';
141 local $SIG{INT} = 'IGNORE';
142 local $SIG{QUIT} = 'IGNORE';
143 local $SIG{TERM} = 'IGNORE';
144 local $SIG{TSTP} = 'IGNORE';
145 local $SIG{PIPE} = 'IGNORE';
147 my $oldAutoCommit = $FS::UID::AutoCommit;
148 local $FS::UID::AutoCommit = 0;
151 my $cust_main = qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
152 my $old_balance = $cust_main->balance;
154 unless ($self->reasonnum) {
155 my $result = $self->reason( $self->getfield('reason'),
156 exists($options{ 'reason_type' })
157 ? ('reason_type' => $options{ 'reason_type' })
161 $dbh->rollback if $oldAutoCommit;
162 return "failed to set reason for $me"; #: ". $dbh->errstr;
166 $self->setfield('reason', '');
168 my $error = $self->SUPER::insert;
170 $dbh->rollback if $oldAutoCommit;
171 return "error inserting $self: $error";
174 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
176 #false laziness w/ cust_pay::insert
177 if ( $unsuspendauto && $old_balance && $cust_main->balance <= 0 ) {
178 my @errors = $cust_main->unsuspend;
180 # side-fx with nested transactions? upstack rolls back?
181 warn "WARNING:Errors unsuspending customer ". $cust_main->custnum. ": ".
187 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
195 Unless the closed flag is set, deletes this credit and all associated
196 applications (see L<FS::cust_credit_bill>). In most cases, you want to use
197 the void method instead to leave a record of the deleted credit.
201 # very similar to FS::cust_pay::delete
204 return "Can't delete closed credit" if $self->closed =~ /^Y/i;
206 local $SIG{HUP} = 'IGNORE';
207 local $SIG{INT} = 'IGNORE';
208 local $SIG{QUIT} = 'IGNORE';
209 local $SIG{TERM} = 'IGNORE';
210 local $SIG{TSTP} = 'IGNORE';
211 local $SIG{PIPE} = 'IGNORE';
213 my $oldAutoCommit = $FS::UID::AutoCommit;
214 local $FS::UID::AutoCommit = 0;
217 foreach my $cust_credit_bill ( $self->cust_credit_bill ) {
218 my $error = $cust_credit_bill->delete;
220 $dbh->rollback if $oldAutoCommit;
225 foreach my $cust_credit_refund ( $self->cust_credit_refund ) {
226 my $error = $cust_credit_refund->delete;
228 $dbh->rollback if $oldAutoCommit;
233 my $error = $self->SUPER::delete(@_);
235 $dbh->rollback if $oldAutoCommit;
239 if ( $conf->config('deletecredits') ne '' ) {
241 my $cust_main = $self->cust_main;
243 my $error = send_email(
244 'from' => $conf->config('invoice_from', $self->cust_main->agentnum),
245 #invoice_from??? well as good as any
246 'to' => $conf->config('deletecredits'),
247 'subject' => 'FREESIDE NOTIFICATION: Credit deleted',
249 "This is an automatic message from your Freeside installation\n",
250 "informing you that the following credit has been deleted:\n",
252 'crednum: '. $self->crednum. "\n",
253 'custnum: '. $self->custnum.
254 " (". $cust_main->last. ", ". $cust_main->first. ")\n",
255 'amount: $'. sprintf("%.2f", $self->amount). "\n",
256 'date: '. time2str("%a %b %e %T %Y", $self->_date). "\n",
257 'reason: '. $self->reason. "\n",
262 $dbh->rollback if $oldAutoCommit;
263 return "can't send credit deletion notification: $error";
268 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
274 =item replace [ OLD_RECORD ]
276 You can, but probably shouldn't modify credits...
278 Replaces the OLD_RECORD with this one in the database, or, if OLD_RECORD is not
279 supplied, replaces this record. If there is an error, returns the error,
280 otherwise returns false.
286 return "Can't modify closed credit" if $self->closed =~ /^Y/i;
287 $self->SUPER::replace(@_);
292 Checks all fields to make sure this is a valid credit. If there is an error,
293 returns the error, otherwise returns false. Called by the insert and replace
301 $self->usernum($FS::CurrentUser::CurrentUser->usernum) unless $self->usernum;
304 $self->ut_numbern('crednum')
305 || $self->ut_number('custnum')
306 || $self->ut_numbern('_date')
307 || $self->ut_money('amount')
308 || $self->ut_alphan('otaker')
309 || $self->ut_textn('reason')
310 || $self->ut_textn('addlinfo')
311 || $self->ut_enum('closed', [ '', 'Y' ])
312 || $self->ut_foreign_keyn('pkgnum', 'cust_pkg', 'pkgnum')
313 || $self->ut_foreign_keyn('eventnum', 'cust_event', 'eventnum')
315 return $error if $error;
317 my $method = $ignore_empty_reasonnum ? 'ut_foreign_keyn' : 'ut_foreign_key';
318 $error = $self->$method('reasonnum', 'reason', 'reasonnum');
319 return $error if $error;
321 return "amount must be > 0 " if $self->amount <= 0;
323 return "amount must be greater or equal to amount applied"
324 if $self->unapplied < 0 && ! $otaker_upgrade_kludge;
326 return "Unknown customer"
327 unless qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
329 $self->_date(time) unless $self->_date;
334 =item cust_credit_refund
336 Returns all refund applications (see L<FS::cust_credit_refund>) for this credit.
340 sub cust_credit_refund {
342 map { $_ } #return $self->num_cust_credit_refund unless wantarray;
343 sort { $a->_date <=> $b->_date }
344 qsearch( 'cust_credit_refund', { 'crednum' => $self->crednum } )
348 =item cust_credit_bill
350 Returns all application to invoices (see L<FS::cust_credit_bill>) for this
355 sub cust_credit_bill {
357 map { $_ } #return $self->num_cust_credit_bill unless wantarray;
358 sort { $a->_date <=> $b->_date }
359 qsearch( 'cust_credit_bill', { 'crednum' => $self->crednum } )
365 Returns the amount of this credit that is still unapplied/outstanding;
366 amount minus all refund applications (see L<FS::cust_credit_refund>) and
367 applications to invoices (see L<FS::cust_credit_bill>).
373 my $amount = $self->amount;
374 $amount -= $_->amount foreach ( $self->cust_credit_refund );
375 $amount -= $_->amount foreach ( $self->cust_credit_bill );
376 sprintf( "%.2f", $amount );
381 Deprecated name for the unapplied method.
387 #carp "cust_credit->credited deprecated; use ->unapplied";
388 $self->unapplied(@_);
393 Returns the customer (see L<FS::cust_main>) for this credit.
399 qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
405 Returns the text of the associated reason (see L<FS::reason>) for this credit.
410 my ($self, $value, %options) = @_;
413 my $typenum = $options{'reason_type'};
415 my $oldAutoCommit = $FS::UID::AutoCommit; # this should already be in
416 local $FS::UID::AutoCommit = 0; # a transaction if it matters
418 if ( defined( $value ) ) {
419 my $hashref = { 'reason' => $value };
420 $hashref->{'reason_type'} = $typenum if $typenum;
421 my $addl_from = "LEFT JOIN reason_type ON ( reason_type = typenum ) ";
422 my $extra_sql = " AND reason_type.class='R'";
424 $reason = qsearchs( { 'table' => 'reason',
425 'hashref' => $hashref,
426 'addl_from' => $addl_from,
427 'extra_sql' => $extra_sql,
430 if (!$reason && $typenum) {
431 $reason = new FS::reason( { 'reason_type' => $typenum,
435 my $error = $reason->insert;
437 warn "error inserting reason: $error\n";
442 $self->reasonnum($reason ? $reason->reasonnum : '') ;
443 warn "$me reason used in set mode with non-existant reason -- clearing"
446 $reason = qsearchs( 'reason', { 'reasonnum' => $self->reasonnum } );
448 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
450 ( $reason ? $reason->reason : '' ).
451 ( $self->addlinfo ? ' '.$self->addlinfo : '' );
456 # Used by FS::Upgrade to migrate to a new database.
458 sub _upgrade_data { # class method
459 my ($class, %opts) = @_;
461 warn "$me upgrading $class\n" if $DEBUG;
463 if (defined dbdef->table($class->table)->column('reason')) {
465 warn "$me Checking for unmigrated reasons\n" if $DEBUG;
467 my @cust_credits = qsearch({ 'table' => $class->table,
469 'extra_sql' => 'WHERE reason IS NOT NULL',
472 if (scalar(grep { $_->getfield('reason') =~ /\S/ } @cust_credits)) {
473 warn "$me Found unmigrated reasons\n" if $DEBUG;
474 my $hashref = { 'class' => 'R', 'type' => 'Legacy' };
475 my $reason_type = qsearchs( 'reason_type', $hashref );
476 unless ($reason_type) {
477 $reason_type = new FS::reason_type( $hashref );
478 my $error = $reason_type->insert();
479 die "$class had error inserting FS::reason_type into database: $error\n"
483 $hashref = { 'reason_type' => $reason_type->typenum,
486 my $noreason = qsearchs( 'reason', $hashref );
488 $hashref->{'disabled'} = 'Y';
489 $noreason = new FS::reason( $hashref );
490 my $error = $noreason->insert();
491 die "can't insert legacy reason '(none)' into database: $error\n"
495 foreach my $cust_credit ( @cust_credits ) {
496 my $reason = $cust_credit->getfield('reason');
497 warn "Contemplating reason $reason\n" if $DEBUG > 1;
498 if ($reason =~ /\S/) {
499 $cust_credit->reason($reason, 'reason_type' => $reason_type->typenum)
500 or die "can't insert legacy reason $reason into database\n";
502 $cust_credit->reasonnum($noreason->reasonnum);
505 $cust_credit->setfield('reason', '');
506 my $error = $cust_credit->replace;
508 warn "*** WARNING: error replacing reason in $class ".
509 $cust_credit->crednum. ": $error ***\n"
514 warn "$me Ensuring existance of auto reasons\n" if $DEBUG;
516 foreach ( keys %reasontype_map ) {
517 unless ($conf->config($_)) { # hmmmm
518 # warn "$me Found $_ reason type lacking\n" if $DEBUG;
519 # my $hashref = { 'class' => 'R', 'type' => $reasontype_map{$_} };
520 my $hashref = { 'class' => 'R', 'type' => 'Legacy' };
521 my $reason_type = qsearchs( 'reason_type', $hashref );
522 unless ($reason_type) {
523 $reason_type = new FS::reason_type( $hashref );
524 my $error = $reason_type->insert();
525 die "$class had error inserting FS::reason_type into database: $error\n"
528 $conf->set($_, $reason_type->typenum);
532 warn "$me Ensuring commission packages have a reason type\n" if $DEBUG;
534 my $hashref = { 'class' => 'R', 'type' => 'Legacy' };
535 my $reason_type = qsearchs( 'reason_type', $hashref );
536 unless ($reason_type) {
537 $reason_type = new FS::reason_type( $hashref );
538 my $error = $reason_type->insert();
539 die "$class had error inserting FS::reason_type into database: $error\n"
543 my @plans = qw( flat_comission flat_comission_cust flat_comission_pkg );
544 foreach my $plan ( @plans ) {
545 foreach my $pkg ( qsearch('part_pkg', { 'plan' => $plan } ) ) {
546 unless ($pkg->option('reason_type', 1) ) {
547 my $plandata = $pkg->plandata.
548 "reason_type=". $reason_type->typenum. "\n";
549 $pkg->plandata($plandata);
551 $pkg->replace( undef,
552 'pkg_svc' => { map { $_->svcpart => $_->quantity }
555 'primary_svc' => $pkg->svcpart,
557 die "failed setting reason_type option: $error"
564 local($otaker_upgrade_kludge) = 1;
565 local($ignore_empty_reasonnum) = 1;
566 $class->_upgrade_otaker(%opts);
578 Returns an SQL fragment to retreive the unapplied amount.
583 my ($class, $start, $end) = @_;
585 my $bill_start = $start ? "AND cust_credit_bill._date <= $start" : '';
586 my $bill_end = $end ? "AND cust_credit_bill._date > $end" : '';
587 my $refund_start = $start ? "AND cust_credit_refund._date <= $start" : '';
588 my $refund_end = $end ? "AND cust_credit_refund._date > $end" : '';
592 ( SELECT SUM(amount) FROM cust_credit_refund
593 WHERE cust_credit.crednum = cust_credit_refund.crednum
594 $refund_start $refund_end )
598 ( SELECT SUM(amount) FROM cust_credit_bill
599 WHERE cust_credit.crednum = cust_credit_bill.crednum
600 $bill_start $bill_end )
609 Deprecated name for the unapplied_sql method.
616 #carp "cust_credit->credited_sql deprecated; use ->unapplied_sql";
618 #$class->unapplied_sql(@_);
622 =item credit_lineitems
626 my $error = FS::cust_credit->credit_lineitems(
628 #the lineitems to credit
629 'billpkgnums' => \@billpkgnums,
630 'setuprecurs' => \@setuprecurs,
631 'amounts' => \@amounts,
632 'apply' => 1, #0 leaves the credit unapplied
635 'newreasonnum' => scalar($cgi->param('newreasonnum')),
636 'newreasonnum_type' => scalar($cgi->param('newreasonnumT')),
637 map { $_ => scalar($cgi->param($_)) }
638 #fields('cust_credit')
639 qw( custnum _date amount reason reasonnum addlinfo ), #pkgnum eventnum
645 #maybe i should just be an insert with extra args instead of a class method
646 use FS::cust_bill_pkg;
647 sub credit_lineitems {
648 my( $class, %arg ) = @_;
649 my $curuser = $FS::CurrentUser::CurrentUser;
651 #some false laziness w/misc/xmlhttp-cust_bill_pkg-calculate_taxes.html
653 my $cust_main = qsearchs({
654 'table' => 'cust_main',
655 'hashref' => { 'custnum' => $arg{custnum} },
656 'extra_sql' => ' AND '. $curuser->agentnums_sql,
657 }) or return 'unknown customer';
660 local $SIG{HUP} = 'IGNORE';
661 local $SIG{INT} = 'IGNORE';
662 local $SIG{QUIT} = 'IGNORE';
663 local $SIG{TERM} = 'IGNORE';
664 local $SIG{TSTP} = 'IGNORE';
665 local $SIG{PIPE} = 'IGNORE';
667 my $oldAutoCommit = $FS::UID::AutoCommit;
668 local $FS::UID::AutoCommit = 0;
671 #my @cust_bill_pkg = qsearch({
672 # 'select' => 'cust_bill_pkg.*',
673 # 'table' => 'cust_bill_pkg',
674 # 'addl_from' => ' LEFT JOIN cust_bill USING (invnum) '.
675 # ' LEFT JOIN cust_main USING (custnum) ',
676 # 'extra_sql' => ' WHERE custnum = $custnum AND billpkgnum IN ('.
677 # join( ',', @{$arg{billpkgnums}} ). ')',
678 # 'order_by' => 'ORDER BY invnum ASC, billpkgnum ASC',
682 if ($arg{reasonnum} == -1) {
684 $error = 'Enter a new reason (or select an existing one)'
685 unless $arg{newreasonnum} !~ /^\s*$/;
686 my $reason = new FS::reason {
687 'reason' => $arg{newreasonnum},
688 'reason_type' => $arg{newreasonnum_type},
690 $error ||= $reason->insert;
692 $dbh->rollback if $oldAutoCommit;
693 return "Error inserting reason: $error";
695 $arg{reasonnum} = $reason->reasonnum;
698 my $cust_credit = new FS::cust_credit ( {
699 map { $_ => $arg{$_} }
700 #fields('cust_credit')
701 qw( custnum _date amount reason reasonnum addlinfo ), #pkgnum eventnum
703 $error = $cust_credit->insert;
705 $dbh->rollback if $oldAutoCommit;
706 return "Error inserting credit: $error";
709 unless ( $arg{'apply'} ) {
710 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
715 # keys in all of these are invoice numbers
716 my %taxlisthash = ();
717 my %cust_credit_bill = ();
718 my %cust_bill_pkg = ();
719 my %cust_credit_bill_pkg = ();
720 my %unapplied_payments = (); #invoice numbers, and then billpaynums
721 foreach my $billpkgnum ( @{$arg{billpkgnums}} ) {
722 my $setuprecur = shift @{$arg{setuprecurs}};
723 my $amount = shift @{$arg{amounts}};
725 my $cust_bill_pkg = qsearchs({
726 'table' => 'cust_bill_pkg',
727 'hashref' => { 'billpkgnum' => $billpkgnum },
728 'addl_from' => 'LEFT JOIN cust_bill USING (invnum)',
729 'extra_sql' => 'AND custnum = '. $cust_main->custnum,
730 }) or die "unknown billpkgnum $billpkgnum";
732 my $invnum = $cust_bill_pkg->invnum;
734 if ( $setuprecur eq 'setup' ) {
735 $cust_bill_pkg->setup($amount);
736 $cust_bill_pkg->recur(0);
737 $cust_bill_pkg->unitrecur(0);
738 $cust_bill_pkg->type('');
740 $setuprecur = 'recur'; #in case its a usage classnum?
741 $cust_bill_pkg->recur($amount);
742 $cust_bill_pkg->setup(0);
743 $cust_bill_pkg->unitsetup(0);
746 push @{$cust_bill_pkg{$invnum}}, $cust_bill_pkg;
748 #unapply any payments applied to this line item (other credits too?)
749 foreach my $cust_bill_pay_pkg ( $cust_bill_pkg->cust_bill_pay_pkg($setuprecur) ) {
750 $error = $cust_bill_pay_pkg->delete;
752 $dbh->rollback if $oldAutoCommit;
753 return "Error unapplying payment: $error";
755 $unapplied_payments{$invnum}{$cust_bill_pay_pkg->billpaynum}
756 += $cust_bill_pay_pkg->amount;
759 #$subtotal += $amount;
760 $cust_credit_bill{$invnum} += $amount;
761 push @{ $cust_credit_bill_pkg{$invnum} },
762 new FS::cust_credit_bill_pkg {
763 'billpkgnum' => $cust_bill_pkg->billpkgnum,
764 'amount' => sprintf('%.2f',$amount),
765 'setuprecur' => $setuprecur,
766 'sdate' => $cust_bill_pkg->sdate,
767 'edate' => $cust_bill_pkg->edate,
770 $taxlisthash{$invnum} ||= {};
771 my $part_pkg = $cust_bill_pkg->part_pkg;
772 $cust_main->_handle_taxes( $part_pkg,
773 $taxlisthash{$invnum},
775 $cust_bill_pkg->cust_pkg,
776 $cust_bill_pkg->cust_bill->_date,
777 $cust_bill_pkg->cust_pkg->pkgpart,
782 # now loop through %cust_credit_bill and insert those
785 # (hack to prevent cust_credit_bill_pkg insertion)
786 local($FS::cust_bill_ApplicationCommon::skip_apply_to_lineitems_hack) = 1;
788 foreach my $invnum ( sort { $a <=> $b } keys %cust_credit_bill ) {
792 if ( @{ $cust_bill_pkg{$invnum} } ) {
794 my $listref_or_error =
795 $cust_main->calculate_taxes(
796 $cust_bill_pkg{$invnum},
797 $taxlisthash{$invnum},
798 $cust_bill_pkg{$invnum}->[0]->cust_bill->_date
801 unless ( ref( $listref_or_error ) ) {
802 $dbh->rollback if $oldAutoCommit;
803 return "Error calculating taxes: $listref_or_error";
806 # so, loop through the taxlines, apply just that amount to the tax line
807 # item (save for later insert) & add to $
811 foreach my $taxline ( @$listref_or_error ) {
813 my $amount = $taxline->setup;
815 #find equivalent tax line items on the existing invoice
816 my $tax_cust_bill_pkg = qsearchs('cust_bill_pkg', {
818 'pkgnum' => 0, #$taxline->invnum
819 'itemdesc' => $taxline->desc,
821 if (!$tax_cust_bill_pkg) {
822 # Very debatable. We expected the credit to include tax and
823 # the tax is not on the invoice. Perhaps we should just bail
825 #die "missing tax line item for invnum $invnum, description ".
826 # $taxline->desc."\n";
827 $cust_credit->set('amount',
829 $cust_credit->get('amount') - $amount)
831 my $error = $cust_credit->replace;
832 die "error correcting credit for missing tax line: $error\n"
838 # The existing tax_Xlocation records may not have the same pkgnum as
839 # the line item we're crediting. If there's another line item on
840 # this invoice with the same taxnum (tax table line) as this tax,
841 # then they may have its pkgnum instead. Under 2.3 there is no
842 # way to exactly find the taxes associated with a taxable item.
843 # Even if the record DOES have the same pkgnum, it may include taxes
844 # from _other_ line items, and we only want to credit the amount
845 # that's due to the selected line item.
847 # Index the tax_Xlocation records by calculate_taxes "tax identifier".
850 ( $tax_cust_bill_pkg->cust_bill_pkg_tax_Xlocation )
852 my $taxid = $old_loc->taxtype . ' ' . $old_loc->taxnum;
853 warn "DUPLICATE TAX BREAKDOWN RECORD inv#$invnum $taxid\n"
854 if defined($xlocation_map{$taxid});
856 $xlocation_map{$taxid} = $old_loc;
859 #now loop over the calculated taxes
861 ( @{ $taxline->get('cust_bill_pkg_tax_location') },
862 @{ $taxline->get('cust_bill_pkg_tax_rate_location') } )
864 my $taxid = $new_loc->taxtype . ' ' . $new_loc->taxnum;
866 my $old_loc = $xlocation_map{$taxid};
868 # then apply the amount of $new_loc to it
870 #support partial credits: use $amount if smaller
871 # (so just distribute to the first location? perhaps should
873 my $loc_amount = min( $amount, $new_loc->amount);
875 $amount -= $loc_amount;
877 $cust_credit_bill{$invnum} += $loc_amount;
878 push @{ $cust_credit_bill_pkg{$invnum} },
879 new FS::cust_credit_bill_pkg {
880 'billpkgnum' => $tax_cust_bill_pkg->billpkgnum,
881 'amount' => $loc_amount,
882 'setuprecur' => 'setup',
883 'billpkgtaxlocationnum' => $old_loc->billpkgtaxlocationnum,
884 'billpkgtaxratelocationnum' => $old_loc->billpkgtaxratelocationnum,
887 # do nothing, and apply the leftover amount nonspecifically
889 } #foreach my $new_loc
892 #$taxtotal += $amount;
894 # [ $taxline->itemdesc. ' (default)', sprintf('%.2f', $amount), '', '' ];
896 $cust_credit_bill{$invnum} += $amount;
897 push @{ $cust_credit_bill_pkg{$invnum} },
898 new FS::cust_credit_bill_pkg {
899 'billpkgnum' => $tax_cust_bill_pkg->billpkgnum,
901 'setuprecur' => 'setup',
906 #unapply any payments applied to the tax
907 foreach my $cust_bill_pay_pkg
908 ( $tax_cust_bill_pkg->cust_bill_pay_pkg('setup') )
910 $error = $cust_bill_pay_pkg->delete;
912 $dbh->rollback if $oldAutoCommit;
913 return "Error unapplying payment: $error";
915 $unapplied_payments{$invnum}{$cust_bill_pay_pkg->billpaynum}
916 += $cust_bill_pay_pkg->amount;
920 } # if @{ $cust_bill_pkg{$invnum} }
922 # if we unapplied any payments from line items, also unapply that
923 # amount from the invoice
924 foreach my $billpaynum (keys %{$unapplied_payments{$invnum}}) {
925 my $cust_bill_pay = FS::cust_bill_pay->by_key($billpaynum)
926 or die "broken payment application $billpaynum";
927 my @subapps = $cust_bill_pay->lineitem_applications;
928 $error = $cust_bill_pay->delete; # can't replace
930 my $new_cust_bill_pay = FS::cust_bill_pay->new({
931 $cust_bill_pay->hash,
933 amount => sprintf('%.2f',
934 $cust_bill_pay->get('amount')
935 - $unapplied_payments{$invnum}{$billpaynum})
938 if ( $new_cust_bill_pay->amount > 0 ) {
939 $error ||= $new_cust_bill_pay->insert;
940 # Also reapply it to everything it was applied to before.
941 # Note that we've already deleted cust_bill_pay_pkg records for the
942 # items we're crediting, so they aren't on this list.
943 foreach my $cust_bill_pay_pkg (@subapps) {
944 $cust_bill_pay_pkg->billpaypkgnum('');
945 $cust_bill_pay_pkg->billpaynum($new_cust_bill_pay->billpaynum);
946 $error ||= $cust_bill_pay_pkg->insert;
950 $dbh->rollback if $oldAutoCommit;
951 return "Error unapplying payment: $error";
955 #NOW insert cust_credit_bill
957 my $cust_credit_bill = new FS::cust_credit_bill {
958 'crednum' => $cust_credit->crednum,
960 'amount' => sprintf('%.2f', $cust_credit_bill{$invnum}),
962 $error = $cust_credit_bill->insert;
964 $dbh->rollback if $oldAutoCommit;
965 return "Error applying credit of $cust_credit_bill{$invnum} ".
966 " to invoice $invnum: $error";
969 #and then insert cust_credit_bill_pkg for each cust_bill_pkg
970 foreach my $cust_credit_bill_pkg ( @{$cust_credit_bill_pkg{$invnum}} ) {
971 $cust_credit_bill_pkg->creditbillnum( $cust_credit_bill->creditbillnum );
972 $error = $cust_credit_bill_pkg->insert;
974 $dbh->rollback if $oldAutoCommit;
975 return "Error applying credit to line item: $error";
981 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
990 The delete method. The replace method.
992 B<credited> and B<credited_sql> are now called B<unapplied> and
993 B<unapplied_sql>. The old method names should start to give warnings.
997 L<FS::Record>, L<FS::cust_credit_refund>, L<FS::cust_refund>,
998 L<FS::cust_credit_bill> L<FS::cust_bill>, schema.html from the base