package FS::cust_main;
use strict;
-use vars qw( @ISA $conf $Debug $import );
+use vars qw( @ISA $conf $DEBUG $import );
use Safe;
use Carp;
BEGIN {
eval "use Time::Local;";
- die "Time::Local version 1.05 required with Perl versions before 5.6"
+ die "Time::Local minimum version 1.05 required with Perl versions before 5.6"
if $] < 5.006 && !defined($Time::Local::VERSION);
eval "use Time::Local qw(timelocal timelocal_nocheck);";
}
use Business::CreditCard;
use FS::UID qw( getotaker dbh );
use FS::Record qw( qsearchs qsearch dbdef );
-use FS::Misc qw( send_email );
use FS::cust_pkg;
use FS::cust_bill;
use FS::cust_bill_pkg;
use FS::cust_pay;
use FS::cust_credit;
+use FS::cust_refund;
use FS::part_referral;
use FS::cust_main_county;
use FS::agent;
@ISA = qw( FS::Record );
-$Debug = 1;
-#$Debug = 1;
+$DEBUG = 0;
+#$DEBUG = 1;
$import = 0;
#ask FS::UID to run this stuff for us later
-#$FS::UID::callback{'FS::cust_main'} = sub {
-install_callback FS::UID sub {
+$FS::UID::callback{'FS::cust_main'} = sub {
$conf = new FS::Conf;
#yes, need it for stuff below (prolly should be cached)
};
=item ship_fax - phone (optional)
-=item payby - I<CARD> (credit card - automatic), I<DCRD> (credit card - on-demand), I<CHEK> (electronic check - automatic), I<DCHK> (electronic check - on-demand), I<LECB> (Phone bill billing), I<BILL> (billing), I<COMP> (free), or I<PREPAY> (special billing type: applies a credit - see L<FS::prepay_credit> and sets billing type to I<BILL>)
+=item payby - `CARD' (credit cards), `CHEK' (electronic check), `LECB' (Phone bill billing), `BILL' (billing), `COMP' (free), or `PREPAY' (special billing type: applies a credit - see L<FS::prepay_credit> and sets billing type to BILL)
=item payinfo - card number, P.O., comp issuer (4-8 lowercase alphanumerics; think username) or prepayment identifier (see L<FS::prepay_credit>)
=item comments - comments (optional)
-=item referral_custnum - referring customer number
-
=back
=head1 METHODS
sub table { 'cust_main'; }
-=item insert [ CUST_PKG_HASHREF [ , INVOICING_LIST_ARYREF ] ]
+=item insert [ CUST_PKG_HASHREF [ , INVOICING_LIST_ARYREF ] [ , OPTION => VALUE ... ] ]
Adds this customer to the database. If there is an error, returns the error,
otherwise returns false.
$cust_main->insert( {}, [ $email, 'POST' ] );
+Currently available options are: I<depend_jobnum> and I<noexport>.
+
+If I<depend_jobnum> is set, all provisioning jobs will have a dependancy
+on the supplied jobnum (they will not run until the specific job completes).
+This can be used to defer provisioning until some action completes (such
+as running the customer's credit card sucessfully).
+
+The I<noexport> option is deprecated. If I<noexport> is set true, no
+provisioning jobs (exports) are scheduled. (You can schedule them later with
+the B<reexport> method.)
+
=cut
sub insert {
my $self = shift;
my $cust_pkgs = @_ ? shift : {};
my $invoicing_list = @_ ? shift : '';
+ my %options = @_;
+ warn "FS::cust_main::insert called with options ".
+ join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
+ if $DEBUG;
local $SIG{HUP} = 'IGNORE';
local $SIG{INT} = 'IGNORE';
}
# packages
- $error = $self->order_pkgs($cust_pkgs, \$seconds);
+ $error = $self->order_pkgs($cust_pkgs, \$seconds, %options);
if ( $error ) {
$dbh->rollback if $oldAutoCommit;
return $error;
}
-=item order_pkgs
+=item order_pkgs HASHREF, [ SECONDSREF, [ , OPTION => VALUE ... ] ]
+
+Like the insert method on an existing record, this method orders a package
+and included services atomicaly. Pass a Tie::RefHash data structure to this
+method containing FS::cust_pkg and FS::svc_I<tablename> objects. There should
+be a better explanation of this, but until then, here's an example:
+
+ use Tie::RefHash;
+ tie %hash, 'Tie::RefHash'; #this part is important
+ %hash = (
+ $cust_pkg => [ $svc_acct ],
+ ...
+ );
+ $cust_main->order_pkgs( \%hash, \'0', 'noexport'=>1 );
+
+Currently available options are: I<depend_jobnum> and I<noexport>.
-document me. like ->insert(%cust_pkg) on an existing record
+If I<depend_jobnum> is set, all provisioning jobs will have a dependancy
+on the supplied jobnum (they will not run until the specific job completes).
+This can be used to defer provisioning until some action completes (such
+as running the customer's credit card sucessfully).
+
+The I<noexport> option is deprecated. If I<noexport> is set true, no
+provisioning jobs (exports) are scheduled. (You can schedule them later with
+the B<reexport> method for each cust_pkg object. Using the B<reexport> method
+on the cust_main object is not recommended, as existing services will also be
+reexported.)
=cut
my $self = shift;
my $cust_pkgs = shift;
my $seconds = shift;
+ my %options = @_;
+ my %svc_options = ();
+ $svc_options{'depend_jobnum'} = $options{'depend_jobnum'}
+ if exists $options{'depend_jobnum'};
+ warn "FS::cust_main::order_pkgs called with options ".
+ join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
+ if $DEBUG;
local $SIG{HUP} = 'IGNORE';
local $SIG{INT} = 'IGNORE';
local $FS::UID::AutoCommit = 0;
my $dbh = dbh;
+ local $FS::svc_Common::noexport_hack = 1 if $options{'noexport'};
+
foreach my $cust_pkg ( keys %$cust_pkgs ) {
$cust_pkg->custnum( $self->custnum );
my $error = $cust_pkg->insert;
$svc_something->seconds( $svc_something->seconds + $$seconds );
$$seconds = 0;
}
- $error = $svc_something->insert;
+ $error = $svc_something->insert(%svc_options);
if ( $error ) {
$dbh->rollback if $oldAutoCommit;
#return "inserting svc_ (transaction rolled back): $error";
''; #no error
}
+=item reexport
+
+This method is deprecated. See the I<depend_jobnum> option to the insert and
+order_pkgs methods for a better way to defer provisioning.
+
+Re-schedules all exports by calling the B<reexport> method of all associated
+packages (see L<FS::cust_pkg>). If there is an error, returns the error;
+otherwise returns false.
+
+=cut
+
+sub reexport {
+ my $self = shift;
+
+ carp "warning: FS::cust_main::reexport is deprectated; ".
+ "use the depend_jobnum option to insert or order_pkgs to delay export";
+
+ local $SIG{HUP} = 'IGNORE';
+ local $SIG{INT} = 'IGNORE';
+ local $SIG{QUIT} = 'IGNORE';
+ local $SIG{TERM} = 'IGNORE';
+ local $SIG{TSTP} = 'IGNORE';
+ local $SIG{PIPE} = 'IGNORE';
+
+ my $oldAutoCommit = $FS::UID::AutoCommit;
+ local $FS::UID::AutoCommit = 0;
+ my $dbh = dbh;
+
+ foreach my $cust_pkg ( $self->ncancelled_pkgs ) {
+ my $error = $cust_pkg->reexport;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+ }
+
+ $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+ '';
+
+}
+
=item delete NEW_CUSTNUM
This deletes the customer. If there is an error, returns the error, otherwise
This will completely remove all traces of the customer record. This is not
what you want when a customer cancels service; for that, cancel all of the
-customer's packages (see L<FS::cust_pkg/cancel>).
+customer's packages (see L</cancel>).
If the customer has any uncancelled packages, you need to pass a new (valid)
customer number for those packages to be transferred to. Cancelled packages
local $FS::UID::AutoCommit = 0;
my $dbh = dbh;
- if ( qsearch( 'cust_bill', { 'custnum' => $self->custnum } ) ) {
+ if ( $self->cust_bill ) {
$dbh->rollback if $oldAutoCommit;
return "Can't delete a customer with invoices";
}
- if ( qsearch( 'cust_credit', { 'custnum' => $self->custnum } ) ) {
+ if ( $self->cust_credit ) {
$dbh->rollback if $oldAutoCommit;
return "Can't delete a customer with credits";
}
- if ( qsearch( 'cust_pay', { 'custnum' => $self->custnum } ) ) {
+ if ( $self->cust_pay ) {
$dbh->rollback if $oldAutoCommit;
return "Can't delete a customer with payments";
}
- if ( qsearch( 'cust_refund', { 'custnum' => $self->custnum } ) ) {
+ if ( $self->cust_refund ) {
$dbh->rollback if $oldAutoCommit;
return "Can't delete a customer with refunds";
}
local $SIG{TSTP} = 'IGNORE';
local $SIG{PIPE} = 'IGNORE';
+ if ( $self->payby eq 'COMP' && $self->payby ne $old->payby
+ && $conf->config('users-allow_comp') ) {
+ return "You are not permitted to create complimentary accounts."
+ unless grep { $_ eq getotaker } $conf->config('users-allow_comp');
+ }
+
my $oldAutoCommit = $FS::UID::AutoCommit;
local $FS::UID::AutoCommit = 0;
my $dbh = dbh;
|| $self->ut_numbern('referral_custnum')
;
#barf. need message catalogs. i18n. etc.
- $error .= "Please select a advertising source."
+ $error .= "Please select an advertising source."
if $error =~ /^Illegal or empty \(numeric\) refnum: /;
return $error if $error;
}
}
- $self->payby =~ /^(CARD|DCRD|CHEK|DCHK|LECB|BILL|COMP|PREPAY)$/
+ $self->payby =~ /^(CARD|CHEK|LECB|BILL|COMP|PREPAY)$/
or return "Illegal payby: ". $self->payby;
$self->payby($1);
- if ( $self->payby eq 'CARD' || $self->payby eq 'DCRD' ) {
+ if ( $self->payby eq 'CARD' ) {
my $payinfo = $self->payinfo;
$payinfo =~ s/\D//g;
or return gettext('invalid_card'); # . ": ". $self->payinfo;
return gettext('unknown_card_type')
if cardtype($self->payinfo) eq "Unknown";
+ if ( defined $self->dbdef_table->column('paycvv') ) {
+ if ( length($self->paycvv) ) {
+ if ( cardtype($self->payinfo) eq 'American Express card' ) {
+ $self->paycvv =~ /^(\d{4})$/
+ or return "CVV2 (CID) for American Express cards is four digits.";
+ $self->paycvv($1);
+ } else {
+ $self->paycvv =~ /^(\d{3})$/
+ or return "CVV2 (CVC2/CID) is three digits.";
+ $self->paycvv($1);
+ }
+ } else {
+ $self->paycvv('');
+ }
+ }
- } elsif ( $self->payby eq 'CHEK' || $self->payby eq 'DCHK' ) {
+ } elsif ( $self->payby eq 'CHEK' ) {
my $payinfo = $self->payinfo;
$payinfo =~ s/[^\d\@]//g;
$payinfo =~ /^(\d+)\@(\d{9})$/ or return 'invalid echeck account@aba';
$payinfo = "$1\@$2";
$self->payinfo($payinfo);
+ $self->paycvv('') if $self->dbdef_table->column('paycvv');
} elsif ( $self->payby eq 'LECB' ) {
$payinfo =~ /^1?(\d{10})$/ or return 'invalid btn billing telephone number';
$payinfo = $1;
$self->payinfo($payinfo);
+ $self->paycvv('') if $self->dbdef_table->column('paycvv');
} elsif ( $self->payby eq 'BILL' ) {
$error = $self->ut_textn('payinfo');
return "Illegal P.O. number: ". $self->payinfo if $error;
+ $self->paycvv('') if $self->dbdef_table->column('paycvv');
} elsif ( $self->payby eq 'COMP' ) {
+ if ( !$self->custnum && $conf->config('users-allow_comp') ) {
+ return "You are not permitted to create complimentary accounts."
+ unless grep { $_ eq getotaker } $conf->config('users-allow_comp');
+ }
+
$error = $self->ut_textn('payinfo');
return "Illegal comp account issuer: ". $self->payinfo if $error;
+ $self->paycvv('') if $self->dbdef_table->column('paycvv');
} elsif ( $self->payby eq 'PREPAY' ) {
return "Illegal prepayment identifier: ". $self->payinfo if $error;
return "Unknown prepayment identifier"
unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } );
+ $self->paycvv('') if $self->dbdef_table->column('paycvv');
}
unless $self->payby =~ /^(BILL|PREPAY|CHEK|LECB)$/;
$self->paydate('');
} else {
- my( $m, $y );
- if ( $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/ ) {
- ( $m, $y ) = ( $1, length($2) == 4 ? $2 : "20$2" );
- } elsif ( $self->paydate =~ /^(20)?(\d{2})[\/\-](\d{2})[\/\-]\d+$/ ) {
- ( $m, $y ) = ( $3, "20$2" );
- } else {
- return "Illegal expiration date: ". $self->paydate;
- }
- $self->paydate("$y-$m-01");
+ $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/
+ or return "Illegal expiration date: ". $self->paydate;
+ my $y = length($2) == 4 ? $2 : "20$2";
+ $self->paydate("$y-$1-01");
my($nowm,$nowy)=(localtime(time))[4,5]; $nowm++; $nowy+=1900;
return gettext('expired_card')
if !$import && ( $y<$nowy || ( $y==$nowy && $1<$nowm ) );
}
if ( $self->payname eq '' && $self->payby ne 'CHEK' &&
- ( ! $conf->exists('require_cardname')
- || $self->payby !~ /^(CARD|DCRD)$/ )
- ) {
+ ( ! $conf->exists('require_cardname') || $self->payby ne 'CARD' ) ) {
$self->payname( $self->first. " ". $self->getfield('last') );
} else {
$self->payname =~ /^([\w \,\.\-\']+)$/
$self->tax =~ /^(Y?)$/ or return "Illegal tax: ". $self->tax;
$self->tax($1);
- $self->otaker(getotaker);
+ $self->otaker(getotaker) unless $self->otaker;
#warn "AFTER: \n". $self->_dump;
grep { $_->suspend } $self->unsuspended_pkgs;
}
-=item cancel
+=item suspend_if_pkgpart PKGPART [ , PKGPART ... ]
+
+Suspends all unsuspended packages (see L<FS::cust_pkg>) matching the listed
+PKGPARTs (see L<FS::part_pkg>). Always returns a list: an empty list on
+success or a list of errors.
+
+=cut
+
+sub suspend_if_pkgpart {
+ my $self = shift;
+ my @pkgparts = @_;
+ grep { $_->suspend }
+ grep { my $pkgpart = $_->pkgpart; grep { $pkgpart eq $_ } @pkgparts }
+ $self->unsuspended_pkgs;
+}
+
+=item suspend_unless_pkgpart PKGPART [ , PKGPART ... ]
+
+Suspends all unsuspended packages (see L<FS::cust_pkg>) unless they match the
+listed PKGPARTs (see L<FS::part_pkg>). Always returns a list: an empty list
+on success or a list of errors.
+
+=cut
+
+sub suspend_unless_pkgpart {
+ my $self = shift;
+ my @pkgparts = @_;
+ grep { $_->suspend }
+ grep { my $pkgpart = $_->pkgpart; ! grep { $pkgpart eq $_ } @pkgparts }
+ $self->unsuspended_pkgs;
+}
+
+=item cancel [ OPTION => VALUE ... ]
Cancels all uncancelled packages (see L<FS::cust_pkg>) for this customer.
+
+Available options are: I<quiet>
+
+I<quiet> can be set true to supress email cancellation notices.
+
Always returns a list: an empty list on success or a list of errors.
=cut
sub cancel {
my $self = shift;
- grep { $_->cancel } $self->ncancelled_pkgs;
+ grep { $_ } map { $_->cancel(@_) } $self->ncancelled_pkgs;
}
=item agent
Options are passed as name-value pairs.
-The only currently available option is `time', which bills the customer as if
-it were that time. It is specified as a UNIX timestamp; see
-L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion
-functions. For example:
+Currently available options are:
+
+resetup - if set true, re-charges setup fees.
+
+time - bills the customer as if it were that time. Specified as a UNIX
+timestamp; see L<perlfunc/"time">). Also see L<Time::Local> and
+L<Date::Parse> for conversion functions. For example:
use Date::Parse;
...
$cust_main->bill( 'time' => str2time('April 20th, 2001') );
+
If there is an error, returns the error, otherwise returns false.
=cut
sub bill {
my( $self, %options ) = @_;
+ return '' if $self->payby eq 'COMP';
my $time = $options{'time'} || time;
my $error;
local $FS::UID::AutoCommit = 0;
my $dbh = dbh;
+ $self->select_for_update; #mutex
+
# find the packages which are due for billing, find out how much they are
# & generate invoice database.
my %hash = $cust_pkg->hash;
my $old_cust_pkg = new FS::cust_pkg \%hash;
- my @details = ();
-
# bill setup
my $setup = 0;
- unless ( $cust_pkg->setup ) {
+ if ( !$cust_pkg->setup || $options{'resetup'} ) {
my $setup_prog = $part_pkg->getfield('setup');
$setup_prog =~ /^(.*)$/ or do {
$dbh->rollback if $oldAutoCommit;
return "Error eval-ing part_pkg->setup pkgpart ". $part_pkg->pkgpart.
"(expression $setup_prog): $@";
}
- $cust_pkg->setfield('setup',$time);
+ $cust_pkg->setfield('setup', $time) unless $cust_pkg->setup;
$cust_pkg_mod_flag=1;
}
#bill recurring fee
my $recur = 0;
my $sdate;
- if ( $part_pkg->getfield('freq') > 0 &&
+ if ( $part_pkg->getfield('freq') ne '0' &&
! $cust_pkg->getfield('susp') &&
( $cust_pkg->getfield('bill') || 0 ) <= $time
) {
$cust_pkg->last_bill($sdate)
if $cust_pkg->dbdef_table->column('last_bill');
- $mon += $part_pkg->freq;
- until ( $mon < 12 ) { $mon -= 12; $year++; }
+ if ( $part_pkg->freq =~ /^\d+$/ ) {
+ $mon += $part_pkg->freq;
+ until ( $mon < 12 ) { $mon -= 12; $year++; }
+ } elsif ( $part_pkg->freq =~ /^(\d+)w$/ ) {
+ my $weeks = $1;
+ $mday += $weeks * 7;
+ } elsif ( $part_pkg->freq =~ /^(\d+)d$/ ) {
+ my $days = $1;
+ $mday += $days;
+ } else {
+ $dbh->rollback if $oldAutoCommit;
+ return "unparsable frequency: ". $part_pkg->freq;
+ }
$cust_pkg->setfield('bill',
timelocal_nocheck($sec,$min,$hour,$mday,$mon,$year));
$cust_pkg_mod_flag = 1;
warn "\$recur is undefined" unless defined($recur);
warn "\$cust_pkg->bill is undefined" unless defined($cust_pkg->bill);
- my $taxable_charged = 0;
if ( $cust_pkg_mod_flag ) {
$error=$cust_pkg->replace($old_cust_pkg);
if ( $error ) { #just in case
}
$setup = sprintf( "%.2f", $setup );
$recur = sprintf( "%.2f", $recur );
- if ( $setup < 0 ) {
+ if ( $setup < 0 && ! $conf->exists('allow_negative_charges') ) {
$dbh->rollback if $oldAutoCommit;
return "negative setup $setup for pkgnum ". $cust_pkg->pkgnum;
}
- if ( $recur < 0 ) {
+ if ( $recur < 0 && ! $conf->exists('allow_negative_charges') ) {
$dbh->rollback if $oldAutoCommit;
return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum;
}
- if ( $setup > 0 || $recur > 0 ) {
+ if ( $setup != 0 || $recur != 0 ) {
my $cust_bill_pkg = new FS::cust_bill_pkg ({
- 'pkgnum' => $cust_pkg->pkgnum,
- 'setup' => $setup,
- 'recur' => $recur,
- 'sdate' => $sdate,
- 'edate' => $cust_pkg->bill,
- 'details' => \@details,
+ 'pkgnum' => $cust_pkg->pkgnum,
+ 'setup' => $setup,
+ 'recur' => $recur,
+ 'sdate' => $sdate,
+ 'edate' => $cust_pkg->bill,
});
push @cust_bill_pkg, $cust_bill_pkg;
$total_setup += $setup;
$total_recur += $recur;
- $taxable_charged += $setup
- unless $part_pkg->setuptax =~ /^Y$/i;
- $taxable_charged += $recur
- unless $part_pkg->recurtax =~ /^Y$/i;
-
- unless ( $self->tax =~ /Y/i
- || $self->payby eq 'COMP'
- || $taxable_charged == 0 ) {
-
- my $cust_main_county = qsearchs('cust_main_county',{
- 'state' => $self->state,
- 'county' => $self->county,
- 'country' => $self->country,
- 'taxclass' => $part_pkg->taxclass,
- } );
- $cust_main_county ||= qsearchs('cust_main_county',{
- 'state' => $self->state,
- 'county' => $self->county,
- 'country' => $self->country,
- 'taxclass' => '',
- } );
- unless ( $cust_main_county ) {
+
+ unless ( $self->tax =~ /Y/i || $self->payby eq 'COMP' ) {
+
+ my @taxes = qsearch( 'cust_main_county', {
+ 'state' => $self->state,
+ 'county' => $self->county,
+ 'country' => $self->country,
+ 'taxclass' => $part_pkg->taxclass,
+ } );
+ unless ( @taxes ) {
+ @taxes = qsearch( 'cust_main_county', {
+ 'state' => $self->state,
+ 'county' => $self->county,
+ 'country' => $self->country,
+ 'taxclass' => '',
+ } );
+ }
+
+ #one more try at a whole-country tax rate
+ unless ( @taxes ) {
+ @taxes = qsearch( 'cust_main_county', {
+ 'state' => '',
+ 'county' => '',
+ 'country' => $self->country,
+ 'taxclass' => '',
+ } );
+ }
+
+ # maybe eliminate this entirely, along with all the 0% records
+ unless ( @taxes ) {
$dbh->rollback if $oldAutoCommit;
return
"fatal: can't find tax rate for state/county/country/taxclass ".
$part_pkg->taxclass ). "\n";
}
- if ( $cust_main_county->exempt_amount ) {
- my ($mon,$year) = (localtime($sdate) )[4,5];
- $mon++;
- my $freq = $part_pkg->freq || 1;
- my $taxable_per_month = sprintf("%.2f", $taxable_charged / $freq );
- foreach my $which_month ( 1 .. $freq ) {
- my %hash = (
- 'custnum' => $self->custnum,
- 'taxnum' => $cust_main_county->taxnum,
- 'year' => 1900+$year,
- 'month' => $mon++,
- );
- #until ( $mon < 12 ) { $mon -= 12; $year++; }
- until ( $mon < 13 ) { $mon -= 12; $year++; }
- my $cust_tax_exempt =
- qsearchs('cust_tax_exempt', \%hash)
- || new FS::cust_tax_exempt( { %hash, 'amount' => 0 } );
- my $remaining_exemption = sprintf("%.2f",
- $cust_main_county->exempt_amount - $cust_tax_exempt->amount );
- if ( $remaining_exemption > 0 ) {
- my $addl = $remaining_exemption > $taxable_per_month
- ? $taxable_per_month
- : $remaining_exemption;
- $taxable_charged -= $addl;
- my $new_cust_tax_exempt = new FS::cust_tax_exempt ( {
- $cust_tax_exempt->hash,
- 'amount' => sprintf("%.2f", $cust_tax_exempt->amount + $addl),
- } );
- $error = $new_cust_tax_exempt->exemptnum
- ? $new_cust_tax_exempt->replace($cust_tax_exempt)
- : $new_cust_tax_exempt->insert;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "fatal: can't update cust_tax_exempt: $error";
- }
-
- } # if $remaining_exemption > 0
-
- } #foreach $which_month
-
- } #if $cust_main_county->exempt_amount
-
- $taxable_charged = sprintf( "%.2f", $taxable_charged);
-
- #$tax += $taxable_charged * $cust_main_county->tax / 100
- $tax{ $cust_main_county->taxname || 'Tax' } +=
- $taxable_charged * $cust_main_county->tax / 100
-
- } #unless $self->tax =~ /Y/i
- # || $self->payby eq 'COMP'
- # || $taxable_charged == 0
-
- } #if $setup > 0 || $recur > 0
+ foreach my $tax ( @taxes ) {
+
+ my $taxable_charged = 0;
+ $taxable_charged += $setup
+ unless $part_pkg->setuptax =~ /^Y$/i
+ || $tax->setuptax =~ /^Y$/i;
+ $taxable_charged += $recur
+ unless $part_pkg->recurtax =~ /^Y$/i
+ || $tax->recurtax =~ /^Y$/i;
+ next unless $taxable_charged;
+
+ if ( $tax->exempt_amount > 0 ) {
+ my ($mon,$year) = (localtime($sdate) )[4,5];
+ $mon++;
+ my $freq = $part_pkg->freq || 1;
+ if ( $freq !~ /(\d+)$/ ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "daily/weekly package definitions not (yet?)".
+ " compatible with monthly tax exemptions";
+ }
+ my $taxable_per_month = sprintf("%.2f", $taxable_charged / $freq );
+ foreach my $which_month ( 1 .. $freq ) {
+ my %hash = (
+ 'custnum' => $self->custnum,
+ 'taxnum' => $tax->taxnum,
+ 'year' => 1900+$year,
+ 'month' => $mon++,
+ );
+ #until ( $mon < 12 ) { $mon -= 12; $year++; }
+ until ( $mon < 13 ) { $mon -= 12; $year++; }
+ my $cust_tax_exempt =
+ qsearchs('cust_tax_exempt', \%hash)
+ || new FS::cust_tax_exempt( { %hash, 'amount' => 0 } );
+ my $remaining_exemption = sprintf("%.2f",
+ $tax->exempt_amount - $cust_tax_exempt->amount );
+ if ( $remaining_exemption > 0 ) {
+ my $addl = $remaining_exemption > $taxable_per_month
+ ? $taxable_per_month
+ : $remaining_exemption;
+ $taxable_charged -= $addl;
+ my $new_cust_tax_exempt = new FS::cust_tax_exempt ( {
+ $cust_tax_exempt->hash,
+ 'amount' =>
+ sprintf("%.2f", $cust_tax_exempt->amount + $addl),
+ } );
+ $error = $new_cust_tax_exempt->exemptnum
+ ? $new_cust_tax_exempt->replace($cust_tax_exempt)
+ : $new_cust_tax_exempt->insert;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "fatal: can't update cust_tax_exempt: $error";
+ }
+
+ } # if $remaining_exemption > 0
+
+ } #foreach $which_month
+
+ } #if $tax->exempt_amount
+
+ $taxable_charged = sprintf( "%.2f", $taxable_charged);
+
+ #$tax += $taxable_charged * $cust_main_county->tax / 100
+ $tax{ $tax->taxname || 'Tax' } +=
+ $taxable_charged * $tax->tax / 100
+
+ } #foreach my $tax ( @taxes )
+
+ } #unless $self->tax =~ /Y/i || $self->payby eq 'COMP'
+
+ } #if $setup != 0 || $recur != 0
} #if $cust_pkg_mod_flag
# $taxable_charged * ( $cust_main_county->getfield('tax') / 100 )
# );
- foreach my $taxname ( grep { $tax{$_} > 0 } keys %tax ) {
- my $tax = sprintf("%.2f", $tax{$taxname} );
- $charged = sprintf( "%.2f", $charged+$tax );
-
- my $cust_bill_pkg = new FS::cust_bill_pkg ({
- 'pkgnum' => 0,
- 'setup' => $tax,
- 'recur' => 0,
- 'sdate' => '',
- 'edate' => '',
- 'itemdesc' => $taxname,
- });
- push @cust_bill_pkg, $cust_bill_pkg;
+ if ( dbdef->table('cust_bill_pkg')->column('itemdesc') ) { #1.5 schema
+
+ foreach my $taxname ( grep { $tax{$_} > 0 } keys %tax ) {
+ my $tax = sprintf("%.2f", $tax{$taxname} );
+ $charged = sprintf( "%.2f", $charged+$tax );
+
+ my $cust_bill_pkg = new FS::cust_bill_pkg ({
+ 'pkgnum' => 0,
+ 'setup' => $tax,
+ 'recur' => 0,
+ 'sdate' => '',
+ 'edate' => '',
+ 'itemdesc' => $taxname,
+ });
+ push @cust_bill_pkg, $cust_bill_pkg;
+ }
+
+ } else { #1.4 schema
+
+ my $tax = 0;
+ foreach ( values %tax ) { $tax += $_ };
+ $tax = sprintf("%.2f", $tax);
+ if ( $tax > 0 ) {
+ $charged = sprintf( "%.2f", $charged+$tax );
+
+ my $cust_bill_pkg = new FS::cust_bill_pkg ({
+ 'pkgnum' => 0,
+ 'setup' => $tax,
+ 'recur' => 0,
+ 'sdate' => '',
+ 'edate' => '',
+ });
+ push @cust_bill_pkg, $cust_bill_pkg;
+ }
+
}
-# }
my $cust_bill = new FS::cust_bill ( {
'custnum' => $self->custnum,
(Attempt to) collect money for this customer's outstanding invoices (see
L<FS::cust_bill>). Usually used after the bill method.
-Depending on the value of `payby', this may print or email an invoice (I<BILL>,
-I<DCRD>, or I<DCHK>), charge a credit card (I<CARD>), charge via electronic
-check/ACH (I<CHEK>), or just add any necessary (pseudo-)payment (I<COMP>).
+Depending on the value of `payby', this may print an invoice (`BILL'), charge
+a credit card (`CARD'), or just add any necessary (pseudo-)payment (`COMP').
Most actions are now triggered by invoice events; see L<FS::part_bill_event>
and the invoice events web interface.
force_print - This option is deprecated; see the invoice events web interface.
+quiet - set true to surpress email card/ACH decline notices.
+
=cut
sub collect {
local $FS::UID::AutoCommit = 0;
my $dbh = dbh;
+ $self->select_for_update; #mutex
+
my $balance = $self->balance;
- warn "collect customer". $self->custnum. ": balance $balance" if $Debug;
+ warn "collect customer". $self->custnum. ": balance $balance" if $DEBUG;
unless ( $balance > 0 ) { #redundant?????
$dbh->rollback if $oldAutoCommit; #hmm
return '';
}
}
- foreach my $cust_bill ( $self->cust_bill ) {
-
- #this has to be before next's
- my $amount = sprintf( "%.2f", $balance < $cust_bill->owed
- ? $balance
- : $cust_bill->owed
- );
- $balance = sprintf( "%.2f", $balance - $amount );
-
- next unless $cust_bill->owed > 0;
+ foreach my $cust_bill ( $self->open_cust_bill ) {
# don't try to charge for the same invoice if it's already in a batch
#next if qsearchs( 'cust_pay_batch', { 'invnum' => $cust_bill->invnum } );
- warn "invnum ". $cust_bill->invnum. " (owed ". $cust_bill->owed. ", amount $amount, balance $balance)" if $Debug;
-
- next unless $amount > 0;
+ last if $self->balance <= 0;
+ warn "invnum ". $cust_bill->invnum. " (owed ". $cust_bill->owed. ")"
+ if $DEBUG;
foreach my $part_bill_event (
sort { $a->seconds <=> $b->seconds
|| $a->weight <=> $b->weight
|| $a->eventpart <=> $b->eventpart }
grep { $_->seconds <= ( $invoice_time - $cust_bill->_date )
- && ! qsearchs( 'cust_bill_event', {
+ && ! qsearch( 'cust_bill_event', {
'invnum' => $cust_bill->invnum,
'eventpart' => $_->eventpart,
'status' => 'done',
'disabled' => '', } )
) {
- last unless $cust_bill->owed > 0; #don't run subsequent events if owed=0
+ last if $cust_bill->owed <= 0 # don't run subsequent events if owed<=0
+ || $self->balance <= 0; # or if balance<=0
warn "calling invoice event (". $part_bill_event->eventcode. ")\n"
- if $Debug;
+ if $DEBUG;
my $cust_main = $self; #for callback
- my $error = eval $part_bill_event->eventcode;
+
+ my $error;
+ {
+ #supress "used only once" warning
+ $FS::cust_bill::realtime_bop_decline_quiet += 0;
+ local $FS::cust_bill::realtime_bop_decline_quiet = 1
+ if $options{'quiet'};
+ $error = eval $part_bill_event->eventcode;
+ }
my $status = '';
my $statustext = '';
grep {
#$_->part_bill_event->plan eq 'realtime-card'
$_->part_bill_event->eventcode =~
- /\$cust_bill\->realtime_(card|ach|lec)$/
+ /\$cust_bill\->realtime_(card|ach|lec)/
&& $_->status eq 'done'
&& $_->statustext
}
}
-=item realtime_bop METHOD AMOUNT [ OPTION => VALUE ... ]
-
-Runs a realtime credit card, ACH (electronic check) or phone bill transaction
-via a Business::OnlinePayment realtime gateway. See
-L<http://420.am/business-onlinepayment> for supported gateways.
-
-Available methods are: I<CC>, I<ECHECK> and I<LEC>
-
-Available options are: I<description>, I<invnum>, I<quiet>
-
-The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
-I<zip>, I<payinfo> and I<paydate> are also available. Any of these options,
-if set, will override the value from the customer record.
-
-I<description> is a free-text field passed to the gateway. It defaults to
-"Internet services".
-
-If an I<invnum> is specified, this payment (if sucessful) is applied to the
-specified invoice. If you don't specify an I<invnum> you might want to
-call the B<apply_payments> method.
-
-I<quiet> can be set true to surpress email decline notices.
-
-(moved from cust_bill) (probably should get realtime_{card,ach,lec} here too)
-
-=cut
-
-sub realtime_bop {
- my( $self, $method, $amount, %options ) = @_;
- if ( $Debug ) {
- warn "$self $method $amount\n";
- warn " $_ => $options{$_}\n" foreach keys %options;
- }
-
- $options{'description'} ||= 'Internet services';
-
- #pre-requisites
- die "Real-time processing not enabled\n"
- unless $conf->exists('business-onlinepayment');
- eval "use Business::OnlinePayment";
- die $@ if $@;
-
- #overrides
- $self->set( $_ => $options{$_} )
- foreach grep { exists($options{$_}) }
- qw( payname address1 address2 city state zip payinfo paydate );
-
- #load up config
- my $bop_config = 'business-onlinepayment';
- $bop_config .= '-ach'
- if $method eq 'ECHECK' && $conf->exists($bop_config. '-ach');
- my ( $processor, $login, $password, $action, @bop_options ) =
- $conf->config($bop_config);
- $action ||= 'normal authorization';
- pop @bop_options if scalar(@bop_options) % 2 && $bop_options[-1] =~ /^\s*$/;
-
- #massage data
-
- my $address = $self->address1;
- $address .= ", ". $self->address2 if $self->address2;
-
- my($payname, $payfirst, $paylast);
- if ( $self->payname && $method ne 'ECHECK' ) {
- $payname = $self->payname;
- $payname =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
- or return "Illegal payname $payname";
- ($payfirst, $paylast) = ($1, $2);
- } else {
- $payfirst = $self->getfield('first');
- $paylast = $self->getfield('last');
- $payname = "$payfirst $paylast";
- }
-
- my @invoicing_list = grep { $_ ne 'POST' } $self->invoicing_list;
- if ( $conf->exists('emailinvoiceauto')
- || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
- push @invoicing_list, $self->all_emails;
- }
- my $email = $invoicing_list[0];
-
- my %content;
- if ( $method eq 'CC' ) {
- $content{card_number} = $self->payinfo;
- $self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
- $content{expiration} = "$2/$1";
- } elsif ( $method eq 'ECHECK' ) {
- my($account_number,$routing_code) = $self->payinfo;
- ( $content{account_number}, $content{routing_code} ) =
- split('@', $self->payinfo);
- $content{bank_name} = $self->payname;
- $content{account_type} = 'CHECKING';
- $content{account_name} = $payname;
- $content{customer_org} = $self->company ? 'B' : 'I';
- $content{customer_ssn} = $self->ss;
- } elsif ( $method eq 'LEC' ) {
- $content{phone} = $self->payinfo;
- }
-
- #transaction(s)
-
- my( $action1, $action2 ) = split(/\s*\,\s*/, $action );
-
- my $transaction =
- new Business::OnlinePayment( $processor, @bop_options );
- $transaction->content(
- 'type' => $method,
- 'login' => $login,
- 'password' => $password,
- 'action' => $action1,
- 'description' => $options{'description'},
- 'amount' => $amount,
- 'invoice_number' => $options{'invnum'},
- 'customer_id' => $self->custnum,
- 'last_name' => $paylast,
- 'first_name' => $payfirst,
- 'name' => $payname,
- 'address' => $address,
- 'city' => $self->city,
- 'state' => $self->state,
- 'zip' => $self->zip,
- 'country' => $self->country,
- 'referer' => 'http://cleanwhisker.420.am/',
- 'email' => $email,
- 'phone' => $self->daytime || $self->night,
- %content, #after
- );
- $transaction->submit();
-
- if ( $transaction->is_success() && $action2 ) {
- my $auth = $transaction->authorization;
- my $ordernum = $transaction->can('order_number')
- ? $transaction->order_number
- : '';
-
- my $capture =
- new Business::OnlinePayment( $processor, @bop_options );
-
- my %capture = (
- %content,
- type => $method,
- action => $action2,
- login => $login,
- password => $password,
- order_number => $ordernum,
- amount => $amount,
- authorization => $auth,
- description => $options{'description'},
- );
-
- foreach my $field (qw( authorization_source_code returned_ACI transaction_identifier validation_code
- transaction_sequence_num local_transaction_date
- local_transaction_time AVS_result_code )) {
- $capture{$field} = $transaction->$field() if $transaction->can($field);
- }
-
- $capture->content( %capture );
-
- $capture->submit();
-
- unless ( $capture->is_success ) {
- my $e = "Authorization sucessful but capture failed, custnum #".
- $self->custnum. ': '. $capture->result_code.
- ": ". $capture->error_message;
- warn $e;
- return $e;
- }
-
- }
-
- #result handling
- if ( $transaction->is_success() ) {
-
- my %method2payby = (
- 'CC' => 'CARD',
- 'ECHECK' => 'CHEK',
- 'LEC' => 'LECB',
- );
-
- my $cust_pay = new FS::cust_pay ( {
- 'custnum' => $self->custnum,
- 'invnum' => $options{'invnum'},
- 'paid' => $amount,
- '_date' => '',
- 'payby' => $method2payby{$method},
- 'payinfo' => $self->payinfo,
- 'paybatch' => "$processor:". $transaction->authorization,
- } );
- my $error = $cust_pay->insert;
- if ( $error ) {
- # gah, even with transactions.
- my $e = 'WARNING: Card/ACH debited but database not updated - '.
- 'error applying payment, invnum #' . $self->invnum.
- " ($processor): $error";
- warn $e;
- return $e;
- } else {
- return '';
- }
-
- } else {
-
- my $perror = "$processor error: ". $transaction->error_message;
-
- if ( !$options{'quiet'} && $conf->exists('emaildecline')
- && grep { $_ ne 'POST' } $self->invoicing_list
- ) {
- my @templ = $conf->config('declinetemplate');
- my $template = new Text::Template (
- TYPE => 'ARRAY',
- SOURCE => [ map "$_\n", @templ ],
- ) or return "($perror) can't create template: $Text::Template::ERROR";
- $template->compile()
- or return "($perror) can't compile template: $Text::Template::ERROR";
-
- my $templ_hash = { error => $transaction->error_message };
-
- my $error = send_email(
- 'from' => $conf->config('invoice_from'),
- 'to' => [ grep { $_ ne 'POST' } $self->invoicing_list ],
- 'subject' => 'Your payment could not be processed',
- 'body' => [ $template->fill_in(HASH => $templ_hash) ],
- );
-
- $perror .= " (also received error sending decline notification: $error)"
- if $error;
-
- }
-
- return $perror;
- }
-
-}
-
=item total_owed
Returns the total owed for this customer on all invoices
grep { $_->owed > 0 } $self->cust_bill;
}
+=item cust_credit
+
+Returns all the credits (see L<FS::cust_credit>) for this customer.
+
+=cut
+
+sub cust_credit {
+ my $self = shift;
+ sort { $a->_date <=> $b->_date }
+ qsearch( 'cust_credit', { 'custnum' => $self->custnum } )
+}
+
+=item cust_pay
+
+Returns all the payments (see L<FS::cust_pay>) for this customer.
+
+=cut
+
+sub cust_pay {
+ my $self = shift;
+ sort { $a->_date <=> $b->_date }
+ qsearch( 'cust_pay', { 'custnum' => $self->custnum } )
+}
+
+=item cust_refund
+
+Returns all the refunds (see L<FS::cust_refund>) for this customer.
+
+=cut
+
+sub cust_refund {
+ my $self = shift;
+ sort { $a->_date <=> $b->_date }
+ qsearch( 'cust_refund', { 'custnum' => $self->custnum } )
+}
+
+=item select_for_update
+
+Selects this record with the SQL "FOR UPDATE" command. This can be useful as
+a mutex.
+
+=cut
+
+sub select_for_update {
+ my $self = shift;
+ qsearch('cust_main', { 'custnum' => $self->custnum }, '*', 'FOR UPDATE' );
+}
+
=back
=head1 SUBROUTINES
my %cust_main = (
agentnum => $agentnum,
refnum => $refnum,
- country => 'US', #default
+ country => $conf->config('countrydefault') || 'US',
payby => 'BILL', #default
paydate => '12/2037', #default
);