package FS::cust_credit;
+use base qw( FS::otaker_Mixin FS::cust_main_Mixin FS::reason_Mixin
+ FS::Record );
use strict;
-use base qw( FS::otaker_Mixin FS::cust_main_Mixin FS::Record );
use vars qw( $conf $unsuspendauto $me $DEBUG
$otaker_upgrade_kludge $ignore_empty_reasonnum
);
use FS::Misc qw(send_email);
use FS::Record qw( qsearch qsearchs dbdef );
use FS::CurrentUser;
-use FS::cust_main;
use FS::cust_pkg;
use FS::cust_refund;
use FS::cust_credit_bill;
use FS::agent;
use FS::sales;
use FS::cust_credit_void;
+use FS::cust_bill_pkg;
use FS::upgrade_journal;
$me = '[ FS::cust_credit ]';
=cut
sub table { 'cust_credit'; }
-sub cust_linked { $_[0]->cust_main_custnum; }
+sub cust_linked { $_[0]->cust_main_custnum || $_[0]->custnum }
sub cust_unlinked_msg {
my $self = shift;
"WARNING: can't find cust_main.custnum ". $self->custnum.
' (cust_credit.crednum '. $self->crednum. ')';
}
-=item insert
+=item insert [ OPTION => VALUE ... ]
Adds this credit to the database ("Posts" the credit). If there is an error,
returns the error, otherwise returns false.
+Ooptions are passed as a list of keys and values. Available options:
+
+=over 4
+
+=item reason_type
+
+L<FS::reason_type|Reason> type for newly-inserted reason
+
+=item cust_credit_source_bill_pkg
+
+An arrayref of
+L<FS::cust_credit_source_bill_pkg|FS::cust_credit_source_bilL_pkg> objects.
+They will have their crednum set and will be inserted along with this credit.
+
+=back
+
=cut
sub insert {
my $cust_main = qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
my $old_balance = $cust_main->balance;
- unless ($self->reasonnum) {
- my $result = $self->reason( $self->getfield('reason'),
- exists($options{ 'reason_type' })
- ? ('reason_type' => $options{ 'reason_type' })
- : (),
- );
- unless($result) {
+ if (!$self->reasonnum) {
+ my $reason_text = $self->get('reason')
+ or return "reason text or existing reason required";
+ my $reason_type = $options{'reason_type'}
+ or return "reason type required";
+
+ local $@;
+ my $reason = FS::reason->new_or_existing(
+ reason => $reason_text,
+ type => $reason_type,
+ class => 'R',
+ );
+ if ($@) {
$dbh->rollback if $oldAutoCommit;
- return "failed to set reason for $me"; #: ". $dbh->errstr;
+ return "failed to set credit reason: $@";
}
+ $self->set('reasonnum', $reason->reasonnum);
}
$self->setfield('reason', '');
return "error inserting $self: $error";
}
+ if ( $options{'cust_credit_source_bill_pkg'} ) {
+ foreach my $ccsbr ( @{ $options{'cust_credit_source_bill_pkg'} } ) {
+ $ccsbr->crednum( $self->crednum );
+ $error = $ccsbr->insert;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "error inserting $ccsbr: $error";
+ }
+ }
+ }
+
$dbh->commit or die $dbh->errstr if $oldAutoCommit;
#false laziness w/ cust_pay::insert
my $cust_main = $self->cust_main;
my $error = send_email(
- 'from' => $conf->config('invoice_from', $self->cust_main->agentnum),
+ 'from' => $conf->invoice_from_full($self->cust_main->agentnum),
#invoice_from??? well as good as any
'to' => $conf->config('deletecredits'),
'subject' => 'FREESIDE NOTIFICATION: Credit deleted',
=cut
-# yes, false laziness with cust_pay and cust_bill
-# but frankly I don't have time to fix it now
-
sub void {
my $self = shift;
my $reason = shift;
+ unless (ref($reason) || !$reason) {
+ $reason = FS::reason->new_or_existing(
+ 'class' => 'X',
+ 'type' => 'Void credit',
+ 'reason' => $reason
+ );
+ }
+
local $SIG{HUP} = 'IGNORE';
local $SIG{INT} = 'IGNORE';
local $SIG{QUIT} = 'IGNORE';
my $cust_credit_void = new FS::cust_credit_void ( {
map { $_ => $self->get($_) } $self->fields
} );
- $cust_credit_void->set('void_reason', $reason);
+ $cust_credit_void->set('void_reasonnum', $reason->reasonnum);
my $error = $cust_credit_void->insert;
if ( $error ) {
$dbh->rollback if $oldAutoCommit;
=cut
-sub cust_main {
- my $self = shift;
- qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
-}
-
-
-=item reason
-
-Returns the text of the associated reason (see L<FS::reason>) for this credit.
-
-=cut
-
-sub reason {
- my ($self, $value, %options) = @_;
- my $dbh = dbh;
- my $reason;
- my $typenum = $options{'reason_type'};
-
- my $oldAutoCommit = $FS::UID::AutoCommit; # this should already be in
- local $FS::UID::AutoCommit = 0; # a transaction if it matters
-
- if ( defined( $value ) ) {
- my $hashref = { 'reason' => $value };
- $hashref->{'reason_type'} = $typenum if $typenum;
- my $addl_from = "LEFT JOIN reason_type ON ( reason_type = typenum ) ";
- my $extra_sql = " AND reason_type.class='R'";
-
- $reason = qsearchs( { 'table' => 'reason',
- 'hashref' => $hashref,
- 'addl_from' => $addl_from,
- 'extra_sql' => $extra_sql,
- } );
-
- if (!$reason && $typenum) {
- $reason = new FS::reason( { 'reason_type' => $typenum,
- 'reason' => $value,
- 'disabled' => 'Y',
- } );
- my $error = $reason->insert;
- if ( $error ) {
- warn "error inserting reason: $error\n";
- $reason = undef;
- }
- }
-
- $self->reasonnum($reason ? $reason->reasonnum : '') ;
- warn "$me reason used in set mode with non-existant reason -- clearing"
- unless $reason;
- }
- $reason = qsearchs( 'reason', { 'reasonnum' => $self->reasonnum } );
-
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
-
- ( $reason ? $reason->reason : '' ).
- ( $self->addlinfo ? ' '.$self->addlinfo : '' );
-}
-
# _upgrade_data
#
# Used by FS::Upgrade to migrate to a new database.
warn "$me upgrading $class\n" if $DEBUG;
- if (defined dbdef->table($class->table)->column('reason')) {
-
- warn "$me Checking for unmigrated reasons\n" if $DEBUG;
-
- my @cust_credits = qsearch({ 'table' => $class->table,
- 'hashref' => {},
- 'extra_sql' => 'WHERE reason IS NOT NULL',
- });
-
- if (scalar(grep { $_->getfield('reason') =~ /\S/ } @cust_credits)) {
- warn "$me Found unmigrated reasons\n" if $DEBUG;
- my $hashref = { 'class' => 'R', 'type' => 'Legacy' };
- my $reason_type = qsearchs( 'reason_type', $hashref );
- unless ($reason_type) {
- $reason_type = new FS::reason_type( $hashref );
- my $error = $reason_type->insert();
- die "$class had error inserting FS::reason_type into database: $error\n"
- if $error;
- }
-
- $hashref = { 'reason_type' => $reason_type->typenum,
- 'reason' => '(none)'
- };
- my $noreason = qsearchs( 'reason', $hashref );
- unless ($noreason) {
- $hashref->{'disabled'} = 'Y';
- $noreason = new FS::reason( $hashref );
- my $error = $noreason->insert();
- die "can't insert legacy reason '(none)' into database: $error\n"
- if $error;
- }
+ $class->_upgrade_reasonnum(%opts);
- foreach my $cust_credit ( @cust_credits ) {
- my $reason = $cust_credit->getfield('reason');
- warn "Contemplating reason $reason\n" if $DEBUG > 1;
- if ($reason =~ /\S/) {
- $cust_credit->reason($reason, 'reason_type' => $reason_type->typenum)
- or die "can't insert legacy reason $reason into database\n";
- }else{
- $cust_credit->reasonnum($noreason->reasonnum);
- }
-
- $cust_credit->setfield('reason', '');
- my $error = $cust_credit->replace;
-
- warn "*** WARNING: error replacing reason in $class ".
- $cust_credit->crednum. ": $error ***\n"
- if $error;
- }
- }
+ if (defined dbdef->table($class->table)->column('reason')) {
warn "$me Ensuring existance of auto reasons\n" if $DEBUG;
$class->_upgrade_otaker(%opts);
if ( !FS::upgrade_journal->is_done('cust_credit__tax_link')
- and !$conf->exists('enable_taxproducts') ) {
+ and !$conf->config('tax_data_vendor') ) {
# RT#25458: fix credit line item applications that should refer to a
# specific tax allocation
my @cust_credit_bill_pkg = qsearch({
'apply' => 1, #0 leaves the credit unapplied
#the credit
- 'newreasonnum' => scalar($cgi->param('newreasonnum')),
- 'newreasonnum_type' => scalar($cgi->param('newreasonnumT')),
map { $_ => scalar($cgi->param($_)) }
#fields('cust_credit')
- qw( custnum _date amount reason reasonnum addlinfo ), #pkgnum eventnum
+ qw( custnum _date amount reasonnum addlinfo ), #pkgnum eventnum
);
=cut
#maybe i should just be an insert with extra args instead of a class method
-use FS::cust_bill_pkg;
sub credit_lineitems {
my( $class, %arg ) = @_;
my $curuser = $FS::CurrentUser::CurrentUser;
#});
my $error = '';
- if ($arg{reasonnum} == -1) {
-
- $error = 'Enter a new reason (or select an existing one)'
- unless $arg{newreasonnum} !~ /^\s*$/;
- my $reason = new FS::reason {
- 'reason' => $arg{newreasonnum},
- 'reason_type' => $arg{newreasonnum_type},
- };
- $error ||= $reason->insert;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "Error inserting reason: $error";
- }
- $arg{reasonnum} = $reason->reasonnum;
- }
my $cust_credit = new FS::cust_credit ( {
map { $_ => $arg{$_} }
#fields('cust_credit')
- qw( custnum _date amount reason reasonnum addlinfo ), #pkgnum eventnum
+ qw( custnum _date amount reasonnum addlinfo ), #pkgnum eventnum
} );
$error = $cust_credit->insert;
if ( $error ) {
# recalculate taxes with new amounts
$taxlisthash{$invnum} ||= {};
- my $part_pkg = $cust_bill_pkg->part_pkg;
- $cust_main->_handle_taxes( $part_pkg,
- $taxlisthash{$invnum},
- $cust_bill_pkg,
- $cust_bill_pkg->cust_pkg,
- $cust_bill_pkg->cust_bill->_date, #invoice time
- $cust_bill_pkg->cust_pkg->pkgpart,
- );
+ if ( $cust_bill_pkg->pkgnum or $cust_bill_pkg->feepart ) {
+ $cust_main->_handle_taxes( $taxlisthash{$invnum}, $cust_bill_pkg );
+ } # otherwise the item itself is a tax, and assume the caller knows
+ # what they're doing
}
###
foreach my $invnum ( sort { $a <=> $b } keys %cust_credit_bill ) {
- my $arrayref_or_error =
- $cust_main->calculate_taxes(
+ local $@;
+ my $arrayref_or_error = eval { $cust_main->calculate_taxes(
$cust_bill_pkg{$invnum}, # list of taxable items that we're crediting
$taxlisthash{$invnum}, # list of tax-item bindings
$cust_bill_pkg{$invnum}->[0]->cust_bill->_date, # invoice time
- );
+ ) };
- unless ( ref( $arrayref_or_error ) ) {
+ if ( $@ ) {
$dbh->rollback if $oldAutoCommit;
- return "Error calculating taxes: $arrayref_or_error";
+ return "Error calculating taxes: $@";
}
my %tax_links; # {tax billpkgnum}{nontax billpkgnum}
# we still have to deal with the possibility that the tax links don't
# cover the whole amount of tax because of an incomplete upgrade...
- if ($amount > 0) {
+ if ($amount > 0.005) {
$cust_credit_bill{$invnum} += $amount;
push @{ $cust_credit_bill_pkg{$invnum} },
new FS::cust_credit_bill_pkg {
'billpkgnum' => $tax_item->billpkgnum,
- 'amount' => $amount,
+ 'amount' => sprintf('%.2f', $amount),
'setuprecur' => 'setup',
};
=back
+=head1 SUBROUTINES
+
+=over 4
+
+=item process_batch_import
+
+=cut
+
+use List::Util qw( min );
+use FS::cust_bill;
+use FS::cust_credit_bill;
+sub process_batch_import {
+ my $job = shift;
+
+ my $opt = { 'table' => 'cust_credit',
+ 'params' => [ '_date', 'credbatch' ],
+ 'formats' => { 'simple' =>
+ [ 'custnum', 'amount', 'reasonnum', 'invnum' ],
+ },
+ 'default_csv' => 1,
+ 'postinsert_callback' => sub {
+ my $cust_credit = shift; #my ($cust_credit, $param ) = @_;
+
+ if ( $cust_credit->invnum ) {
+
+ my $cust_bill = qsearchs('cust_bill', { invnum=>$cust_credit->invnum } );
+ my $amount = min( $cust_credit->credited, $cust_bill->owed );
+
+ my $cust_credit_bill = new FS::cust_credit_bill ( {
+ 'crednum' => $cust_credit->crednum,
+ 'invnum' => $cust_bill->invnum,
+ 'amount' => $amount,
+ } );
+ my $error = $cust_credit_bill->insert;
+ return '' unless $error;
+
+ }
+
+ #apply_payments_and_credits ?
+ $cust_credit->cust_main->apply_credits;
+
+ return '';
+
+ },
+ };
+
+ FS::Record::process_batch_import( $job, $opt, @_ );
+
+}
+
+=back
+
=head1 BUGS
The delete method. The replace method.
projects / freeside.git / blobdiff