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 {
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 = 0;
-#$Debug = 1;
+$DEBUG = 0;
+#$DEBUG = 1;
$import = 0;
$cust_main->insert( {}, [ $email, 'POST' ] );
-Currently available options are: I<noexport>
+Currently available options are: I<depend_jobnum> and I<noexport>.
-If I<noexport> is set true, no provisioning jobs (exports) are scheduled.
-(You can schedule them later with the B<reexport> method.)
+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
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
- local $FS::svc_Common::noexport_hack = 1 if $options{'noexport'};
- foreach my $cust_pkg ( keys %$cust_pkgs ) {
- $cust_pkg->custnum( $self->custnum );
- $error = $cust_pkg->insert;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "inserting cust_pkg (transaction rolled back): $error";
- }
- foreach my $svc_something ( @{$cust_pkgs->{$cust_pkg}} ) {
- $svc_something->pkgnum( $cust_pkg->pkgnum );
- if ( $seconds && $svc_something->isa('FS::svc_acct') ) {
- $svc_something->seconds( $svc_something->seconds + $seconds );
- $seconds = 0;
- }
- $error = $svc_something->insert;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- #return "inserting svc_ (transaction rolled back): $error";
- return $error;
- }
- }
+ $error = $self->order_pkgs($cust_pkgs, \$seconds, %options);
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
}
if ( $seconds ) {
}
+=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>.
+
+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
+
+sub order_pkgs {
+ 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 $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;
+
+ 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;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "inserting cust_pkg (transaction rolled back): $error";
+ }
+ foreach my $svc_something ( @{$cust_pkgs->{$cust_pkg}} ) {
+ $svc_something->pkgnum( $cust_pkg->pkgnum );
+ if ( $seconds && $$seconds && $svc_something->isa('FS::svc_acct') ) {
+ $svc_something->seconds( $svc_something->seconds + $$seconds );
+ $$seconds = 0;
+ }
+ $error = $svc_something->insert(%svc_options);
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ #return "inserting svc_ (transaction rolled back): $error";
+ return $error;
+ }
+ }
+ }
+
+ $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+ ''; #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
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";
}
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' ) {
$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' ) {
$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');
}
$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 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.
sub cancel {
my $self = shift;
- grep { $_->cancel(@_) } $self->ncancelled_pkgs;
+ grep { $_ } map { $_->cancel(@_) } $self->ncancelled_pkgs;
}
=item agent
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.
}
$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,
} );
}
+ #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;
} #unless $self->tax =~ /Y/i || $self->payby eq 'COMP'
- } #if $setup > 0 || $recur > 0
+ } #if $setup != 0 || $recur != 0
} #if $cust_pkg_mod_flag
''; #no error
}
-=item reexport
-
-document me. 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;
-
- 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 collect OPTIONS
(Attempt to) collect money for this customer's outstanding invoices (see
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;
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
);
projects / freeside.git / blobdiff