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 foreach my $billpkgnum ( @{$arg{billpkgnums}} ) {
721 my $setuprecur = shift @{$arg{setuprecurs}};
722 my $amount = shift @{$arg{amounts}};
724 my $cust_bill_pkg = qsearchs({
725 'table' => 'cust_bill_pkg',
726 'hashref' => { 'billpkgnum' => $billpkgnum },
727 'addl_from' => 'LEFT JOIN cust_bill USING (invnum)',
728 'extra_sql' => 'AND custnum = '. $cust_main->custnum,
729 }) or die "unknown billpkgnum $billpkgnum";
731 my $invnum = $cust_bill_pkg->invnum;
733 if ( $setuprecur eq 'setup' ) {
734 $cust_bill_pkg->setup($amount);
735 $cust_bill_pkg->recur(0);
736 $cust_bill_pkg->unitrecur(0);
737 $cust_bill_pkg->type('');
739 $setuprecur = 'recur'; #in case its a usage classnum?
740 $cust_bill_pkg->recur($amount);
741 $cust_bill_pkg->setup(0);
742 $cust_bill_pkg->unitsetup(0);
745 push @{$cust_bill_pkg{$invnum}}, $cust_bill_pkg;
747 my %unapplied_payments; # billpaynum => amount
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{$cust_bill_pay_pkg->billpaynum}
756 += $cust_bill_pay_pkg->amount;
758 # also unapply that amount from the invoice so it doesn't screw up
759 # application of the credit
760 foreach my $billpaynum (keys %unapplied_payments) {
761 my $cust_bill_pay = FS::cust_bill_pay->by_key($billpaynum)
762 or die "broken payment application $billpaynum";
763 $cust_bill_pay->set('amount',
765 $cust_bill_pay->get('amount') - $unapplied_payments{$billpaynum})
767 if ( $cust_bill_pay->amount >= 0.005 ) {
768 $error = $cust_bill_pay->replace;
770 $error = $cust_bill_pay->delete;
773 $dbh->rollback if $oldAutoCommit;
774 return "Error unapplying payment: $error";
778 #$subtotal += $amount;
779 $cust_credit_bill{$invnum} += $amount;
780 push @{ $cust_credit_bill_pkg{$invnum} },
781 new FS::cust_credit_bill_pkg {
782 'billpkgnum' => $cust_bill_pkg->billpkgnum,
783 'amount' => sprintf('%.2f',$amount),
784 'setuprecur' => $setuprecur,
785 'sdate' => $cust_bill_pkg->sdate,
786 'edate' => $cust_bill_pkg->edate,
789 $taxlisthash{$invnum} ||= {};
790 my $part_pkg = $cust_bill_pkg->part_pkg;
791 $cust_main->_handle_taxes( $part_pkg,
792 $taxlisthash{$invnum},
794 $cust_bill_pkg->cust_pkg,
795 $cust_bill_pkg->cust_bill->_date,
796 $cust_bill_pkg->cust_pkg->pkgpart,
801 # now loop through %cust_credit_bill and insert those
804 # (hack to prevent cust_credit_bill_pkg insertion)
805 local($FS::cust_bill_ApplicationCommon::skip_apply_to_lineitems_hack) = 1;
807 foreach my $invnum ( sort { $a <=> $b } keys %cust_credit_bill ) {
811 if ( @{ $cust_bill_pkg{$invnum} } ) {
813 my $listref_or_error =
814 $cust_main->calculate_taxes(
815 $cust_bill_pkg{$invnum},
816 $taxlisthash{$invnum},
817 $cust_bill_pkg{$invnum}->[0]->cust_bill->_date
820 unless ( ref( $listref_or_error ) ) {
821 $dbh->rollback if $oldAutoCommit;
822 return "Error calculating taxes: $listref_or_error";
825 # so, loop through the taxlines, apply just that amount to the tax line
826 # item (save for later insert) & add to $
830 foreach my $taxline ( @$listref_or_error ) {
832 my $amount = $taxline->setup;
834 #find equivalent tax line items on the existing invoice
835 my $tax_cust_bill_pkg = qsearchs('cust_bill_pkg', {
837 'pkgnum' => 0, #$taxline->invnum
838 'itemdesc' => $taxline->desc,
840 if (!$tax_cust_bill_pkg) {
841 # Very debatable. We expected the credit to include tax and
842 # the tax is not on the invoice. Perhaps we should just bail
844 #die "missing tax line item for invnum $invnum, description ".
845 # $taxline->desc."\n";
846 $cust_credit->set('amount',
848 $cust_credit->get('amount') - $amount)
850 my $error = $cust_credit->replace;
851 die "error correcting credit for missing tax line: $error\n"
857 # The existing tax_Xlocation records may not have the same pkgnum as
858 # the line item we're crediting. If there's another line item on
859 # this invoice with the same taxnum (tax table line) as this tax,
860 # then they may have its pkgnum instead. Under 2.3 there is no
861 # way to exactly find the taxes associated with a taxable item.
862 # Even if the record DOES have the same pkgnum, it may include taxes
863 # from _other_ line items, and we only want to credit the amount
864 # that's due to the selected line item.
866 # Index the tax_Xlocation records by calculate_taxes "tax identifier".
869 ( $tax_cust_bill_pkg->cust_bill_pkg_tax_Xlocation )
871 my $taxid = $old_loc->taxtype . ' ' . $old_loc->taxnum;
872 warn "DUPLICATE TAX BREAKDOWN RECORD inv#$invnum $taxid\n"
873 if defined($xlocation_map{$taxid});
875 $xlocation_map{$taxid} = $old_loc;
878 #now loop over the calculated taxes
880 ( @{ $taxline->get('cust_bill_pkg_tax_location') },
881 @{ $taxline->get('cust_bill_pkg_tax_rate_location') } )
883 my $taxid = $new_loc->taxtype . ' ' . $new_loc->taxnum;
885 my $old_loc = $xlocation_map{$taxid};
887 # then apply the amount of $new_loc to it
889 #support partial credits: use $amount if smaller
890 # (so just distribute to the first location? perhaps should
892 my $loc_amount = min( $amount, $new_loc->amount);
894 $amount -= $loc_amount;
896 $cust_credit_bill{$invnum} += $loc_amount;
897 push @{ $cust_credit_bill_pkg{$invnum} },
898 new FS::cust_credit_bill_pkg {
899 'billpkgnum' => $tax_cust_bill_pkg->billpkgnum,
900 'amount' => $loc_amount,
901 'setuprecur' => 'setup',
902 'billpkgtaxlocationnum' => $old_loc->billpkgtaxlocationnum,
903 'billpkgtaxratelocationnum' => $old_loc->billpkgtaxratelocationnum,
906 # do nothing, and apply the leftover amount nonspecifically
908 } #foreach my $new_loc
911 #$taxtotal += $amount;
913 # [ $taxline->itemdesc. ' (default)', sprintf('%.2f', $amount), '', '' ];
915 $cust_credit_bill{$invnum} += $amount;
916 push @{ $cust_credit_bill_pkg{$invnum} },
917 new FS::cust_credit_bill_pkg {
918 'billpkgnum' => $tax_cust_bill_pkg->billpkgnum,
920 'setuprecur' => 'setup',
926 } # if @{ $cust_bill_pkg{$invnum} }
928 #insert cust_credit_bill
930 my $cust_credit_bill = new FS::cust_credit_bill {
931 'crednum' => $cust_credit->crednum,
933 'amount' => sprintf('%.2f', $cust_credit_bill{$invnum}),
935 $error = $cust_credit_bill->insert;
937 $dbh->rollback if $oldAutoCommit;
938 return "Error applying credit of $cust_credit_bill{$invnum} ".
939 " to invoice $invnum: $error";
942 #and then insert cust_credit_bill_pkg for each cust_bill_pkg
943 foreach my $cust_credit_bill_pkg ( @{$cust_credit_bill_pkg{$invnum}} ) {
944 $cust_credit_bill_pkg->creditbillnum( $cust_credit_bill->creditbillnum );
945 $error = $cust_credit_bill_pkg->insert;
947 $dbh->rollback if $oldAutoCommit;
948 return "Error applying credit to line item: $error";
954 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
963 The delete method. The replace method.
965 B<credited> and B<credited_sql> are now called B<unapplied> and
966 B<unapplied_sql>. The old method names should start to give warnings.
970 L<FS::Record>, L<FS::cust_credit_refund>, L<FS::cust_refund>,
971 L<FS::cust_credit_bill> L<FS::cust_bill>, schema.html from the base