-#this is so kludgy i'd be embarassed if it wasn't cybercash's fault
-package main;
-use vars qw($paymentserversecret $paymentserverport $paymentserverhost);
-
package FS::cust_main;
use strict;
-use vars qw( @ISA $conf $lpr $processor $xaction $E_NoErr $invoice_from
- $smtpmachine $Debug );
+use vars qw( @ISA $conf $Debug $import );
use Safe;
use Carp;
use Time::Local;
use Date::Format;
-use Date::Manip;
-use Mail::Internet;
-use Mail::Header;
+#use Date::Manip;
use Business::CreditCard;
-use FS::UID qw( getotaker );
-use FS::Record qw( qsearchs qsearch );
+use FS::UID qw( getotaker dbh );
+use FS::Record qw( qsearchs qsearch dbdef );
use FS::cust_pkg;
use FS::cust_bill;
use FS::cust_bill_pkg;
use FS::cust_pay;
use FS::cust_credit;
-use FS::cust_pay_batch;
use FS::part_referral;
use FS::cust_main_county;
use FS::agent;
use FS::cust_main_invoice;
+use FS::cust_credit_bill;
+use FS::cust_bill_pay;
+use FS::prepay_credit;
+use FS::queue;
+use FS::part_pkg;
+use FS::part_bill_event;
+use FS::cust_bill_event;
+use FS::cust_tax_exempt;
+use FS::type_pkgs;
+use FS::Msgcat qw(gettext);
@ISA = qw( FS::Record );
$Debug = 0;
#$Debug = 1;
+$import = 0;
+
#ask FS::UID to run this stuff for us later
$FS::UID::callback{'FS::cust_main'} = sub {
$conf = new FS::Conf;
- $lpr = $conf->config('lpr');
- $invoice_from = $conf->config('invoice_from');
- $smtpmachine = $conf->config('smtpmachine');
-
- if ( $conf->exists('cybercash3.2') ) {
- require CCMckLib3_2;
- #qw($MCKversion %Config InitConfig CCError CCDebug CCDebug2);
- require CCMckDirectLib3_2;
- #qw(SendCC2_1Server);
- require CCMckErrno3_2;
- #qw(MCKGetErrorMessage $E_NoErr);
- import CCMckErrno3_2 qw($E_NoErr);
-
- my $merchant_conf;
- ($merchant_conf,$xaction)= $conf->config('cybercash3.2');
- my $status = &CCMckLib3_2::InitConfig($merchant_conf);
- if ( $status != $E_NoErr ) {
- warn "CCMckLib3_2::InitConfig error:\n";
- foreach my $key (keys %CCMckLib3_2::Config) {
- warn " $key => $CCMckLib3_2::Config{$key}\n"
- }
- my($errmsg) = &CCMckErrno3_2::MCKGetErrorMessage($status);
- die "CCMckLib3_2::InitConfig fatal error: $errmsg\n";
- }
- $processor='cybercash3.2';
- } elsif ( $conf->exists('cybercash2') ) {
- require CCLib;
- #qw(sendmserver);
- ( $main::paymentserverhost,
- $main::paymentserverport,
- $main::paymentserversecret,
- $xaction,
- ) = $conf->config('cybercash2');
- $processor='cybercash2';
- }
+ #yes, need it for stuff below (prolly should be cached)
};
+sub _cache {
+ my $self = shift;
+ my ( $hashref, $cache ) = @_;
+ if ( exists $hashref->{'pkgnum'} ) {
+# #@{ $self->{'_pkgnum'} } = ();
+ my $subcache = $cache->subcache( 'pkgnum', 'cust_pkg', $hashref->{custnum});
+ $self->{'_pkgnum'} = $subcache;
+ #push @{ $self->{'_pkgnum'} },
+ FS::cust_pkg->new_or_cached($hashref, $subcache) if $hashref->{pkgnum};
+ }
+}
+
=head1 NAME
FS::cust_main - Object methods for cust_main records
@cust_pkg = $record->ncancelled_pkgs;
+ @cust_pkg = $record->suspended_pkgs;
+
$error = $record->bill;
$error = $record->bill %options;
$error = $record->bill 'time' => $time;
=item agentnum - agent (see L<FS::agent>)
-=item refnum - referral (see L<FS::part_referral>)
+=item refnum - Advertising source (see L<FS::part_referral>)
=item first - name
=item fax - phone (optional)
-=item payby - `CARD' (credit cards), `BILL' (billing), or `COMP' (free)
+=item ship_first - name
+
+=item ship_last - name
+
+=item ship_company - (optional)
+
+=item ship_address1
+
+=item ship_address2 - (optional)
+
+=item ship_city
+
+=item ship_county - (optional, see L<FS::cust_main_county>)
+
+=item ship_state - (see L<FS::cust_main_county>)
-=item payinfo - card number, P.O.#, or comp issuer (4-8 lowercase alphanumerics; think username)
+=item ship_zip
+
+=item ship_country - (see L<FS::cust_main_county>)
+
+=item ship_daytime - phone (optional)
+
+=item ship_night - phone (optional)
+
+=item ship_fax - phone (optional)
+
+=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 paydate - expiration date, mm/yyyy, m/yyyy, mm/yy or m/yy
=item otaker - order taker (assigned automatically, see L<FS::UID>)
+=item comments - comments (optional)
+
+=item referral_custnum - referring customer number
+
=back
=head1 METHODS
sub table { 'cust_main'; }
-=item insert
+=item insert [ CUST_PKG_HASHREF [ , INVOICING_LIST_ARYREF ] ]
Adds this customer to the database. If there is an error, returns the error,
otherwise returns false.
+CUST_PKG_HASHREF: If you pass a Tie::RefHash data structure to the insert
+method containing FS::cust_pkg and FS::svc_I<tablename> objects, all records
+are inserted atomicly, or the transaction is rolled back. Passing an empty
+hash reference is equivalent to not supplying this parameter. 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->insert( \%hash );
+
+INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
+be set as the invoicing list (see L<"invoicing_list">). Errors return as
+expected and rollback the entire transaction; it is not necessary to call
+check_invoicing_list first. The invoicing_list is set after the records in the
+CUST_PKG_HASHREF above are inserted, so it is now possible to set an
+invoicing_list destination to the newly-created svc_acct. Here's an example:
+
+ $cust_main->insert( {}, [ $email, 'POST' ] );
+
+=cut
+
+sub insert {
+ my $self = shift;
+ my $cust_pkgs = @_ ? shift : {};
+ my $invoicing_list = @_ ? 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;
+
+ my $amount = 0;
+ my $seconds = 0;
+ if ( $self->payby eq 'PREPAY' ) {
+ $self->payby('BILL');
+ my $prepay_credit = qsearchs(
+ 'prepay_credit',
+ { 'identifier' => $self->payinfo },
+ '',
+ 'FOR UPDATE'
+ );
+ warn "WARNING: can't find pre-found prepay_credit: ". $self->payinfo
+ unless $prepay_credit;
+ $amount = $prepay_credit->amount;
+ $seconds = $prepay_credit->seconds;
+ my $error = $prepay_credit->delete;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "removing prepay_credit (transaction rolled back): $error";
+ }
+ }
+
+ my $error = $self->SUPER::insert;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ #return "inserting cust_main record (transaction rolled back): $error";
+ return $error;
+ }
+
+ # invoicing list
+ if ( $invoicing_list ) {
+ $error = $self->check_invoicing_list( $invoicing_list );
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "checking invoicing_list (transaction rolled back): $error";
+ }
+ $self->invoicing_list( $invoicing_list );
+ }
+
+ # packages
+ 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;
+ }
+ }
+ }
+
+ if ( $seconds ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "No svc_acct record to apply pre-paid time";
+ }
+
+ if ( $amount ) {
+ my $cust_credit = new FS::cust_credit {
+ 'custnum' => $self->custnum,
+ 'amount' => $amount,
+ };
+ $error = $cust_credit->insert;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "inserting credit (transaction rolled back): $error";
+ }
+ }
+
+ #false laziness with sub replace
+ my $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
+ $error = $queue->insert($self->getfield('last'), $self->company);
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "queueing job (transaction rolled back): $error";
+ }
+
+ if ( defined $self->dbdef_table->column('ship_last') && $self->ship_last ) {
+ $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
+ $error = $queue->insert($self->getfield('last'), $self->company);
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "queueing job (transaction rolled back): $error";
+ }
+ }
+ #eslaf
+
+ $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
what you want when a customer cancels service; for that, cancel all of the
customer's packages (see L<FS::cust_pkg/cancel>).
-If the customer has any packages, you need to pass a new (valid) customer
-number for those packages to be transferred to.
+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
+will be deleted. Did I mention that this is NOT what you want when a customer
+cancels service and that you really should be looking see L<FS::cust_pkg/cancel>?
You can't delete a customer with invoices (see L<FS::cust_bill>),
-or credits (see L<FS::cust_credit>).
+or credits (see L<FS::cust_credit>), payments (see L<FS::cust_pay>) or
+refunds (see L<FS::cust_refund>).
=cut
sub delete {
my $self = shift;
- if ( qsearch( 'cust_bill', { 'custnum' => $self->custnum } ) ) {
- return "Can't delete a customer with invoices";
- }
- if ( qsearch( 'cust_credit', { 'custnum' => $self->custnum } ) ) {
- return "Can't delete a customer with credits";
- }
-
local $SIG{HUP} = 'IGNORE';
local $SIG{INT} = 'IGNORE';
local $SIG{QUIT} = 'IGNORE';
local $SIG{TSTP} = 'IGNORE';
local $SIG{PIPE} = 'IGNORE';
- my @cust_pkg = qsearch( 'cust_pkg', { 'custnum' => $self->custnum } );
+ my $oldAutoCommit = $FS::UID::AutoCommit;
+ local $FS::UID::AutoCommit = 0;
+ my $dbh = dbh;
+
+ if ( qsearch( 'cust_bill', { 'custnum' => $self->custnum } ) ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "Can't delete a customer with invoices";
+ }
+ if ( qsearch( 'cust_credit', { 'custnum' => $self->custnum } ) ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "Can't delete a customer with credits";
+ }
+ if ( qsearch( 'cust_pay', { 'custnum' => $self->custnum } ) ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "Can't delete a customer with payments";
+ }
+ if ( qsearch( 'cust_refund', { 'custnum' => $self->custnum } ) ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "Can't delete a customer with refunds";
+ }
+
+ my @cust_pkg = $self->ncancelled_pkgs;
if ( @cust_pkg ) {
my $new_custnum = shift;
- return "Invalid new customer number: $new_custnum"
- unless qsearchs( 'cust_main', { 'custnum' => $new_custnum } );
+ unless ( qsearchs( 'cust_main', { 'custnum' => $new_custnum } ) ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "Invalid new customer number: $new_custnum";
+ }
foreach my $cust_pkg ( @cust_pkg ) {
my %hash = $cust_pkg->hash;
$hash{'custnum'} = $new_custnum;
my $new_cust_pkg = new FS::cust_pkg ( \%hash );
my $error = $new_cust_pkg->replace($cust_pkg);
- return $error if $error;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+ }
+ }
+ my @cancelled_cust_pkg = $self->all_pkgs;
+ foreach my $cust_pkg ( @cancelled_cust_pkg ) {
+ my $error = $cust_pkg->delete;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
}
}
- foreach my $cust_main_invoice (
+
+ foreach my $cust_main_invoice ( #(email invoice destinations, not invoices)
qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } )
) {
my $error = $cust_main_invoice->delete;
- return $error if $error;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+ }
+
+ my $error = $self->SUPER::delete;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
}
- $self->SUPER::delete;
+ $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+ '';
+
}
-=item replace OLD_RECORD
+=item replace OLD_RECORD [ INVOICING_LIST_ARYREF ]
Replaces the OLD_RECORD with this one in the database. If there is an error,
returns the error, otherwise returns false.
+INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
+be set as the invoicing list (see L<"invoicing_list">). Errors return as
+expected and rollback the entire transaction; it is not necessary to call
+check_invoicing_list first. Here's an example:
+
+ $new_cust_main->replace( $old_cust_main, [ $email, 'POST' ] );
+
+=cut
+
+sub replace {
+ my $self = shift;
+ my $old = shift;
+ my @param = @_;
+
+ 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;
+
+ my $error = $self->SUPER::replace($old);
+
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+
+ if ( @param ) { # INVOICING_LIST_ARYREF
+ my $invoicing_list = shift @param;
+ $error = $self->check_invoicing_list( $invoicing_list );
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+ $self->invoicing_list( $invoicing_list );
+ }
+
+ if ( $self->payby =~ /^(CARD|CHEK|LECB)$/ &&
+ grep { $self->get($_) ne $old->get($_) } qw(payinfo paydate payname) ) {
+ # card/check info has changed, want to retry realtime_card invoice events
+ #false laziness w/collect
+ foreach my $cust_bill_event (
+ grep {
+ #$_->part_bill_event->plan eq 'realtime-card'
+ $_->part_bill_event->eventcode =~
+ /^\$cust_bill\->realtime_(card|ach|lec)\(\);$/
+ && $_->status eq 'done'
+ && $_->statustext
+ }
+ map { $_->cust_bill_event }
+ grep { $_->cust_bill_event }
+ $self->open_cust_bill
+
+ ) {
+ my $error = $cust_bill_event->retry;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "error scheduling invoice events for retry: $error";
+ }
+ }
+ #eslaf
+
+ }
+
+ #false laziness with sub insert
+ my $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
+ $error = $queue->insert($self->getfield('last'), $self->company);
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "queueing job (transaction rolled back): $error";
+ }
+
+ if ( defined $self->dbdef_table->column('ship_last') && $self->ship_last ) {
+ $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
+ $error = $queue->insert($self->getfield('last'), $self->company);
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "queueing job (transaction rolled back): $error";
+ }
+ }
+ #eslaf
+
+ $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+ '';
+
+}
+
=item check
Checks all fields to make sure this is a valid customer record. If there is
sub check {
my $self = shift;
+ #warn "BEFORE: \n". $self->_dump;
+
my $error =
$self->ut_numbern('custnum')
|| $self->ut_number('agentnum')
|| $self->ut_number('refnum')
+ || $self->ut_name('last')
+ || $self->ut_name('first')
|| $self->ut_textn('company')
|| $self->ut_text('address1')
|| $self->ut_textn('address2')
|| $self->ut_text('city')
|| $self->ut_textn('county')
|| $self->ut_textn('state')
- || $self->ut_phonen('daytime')
- || $self->ut_phonen('night')
- || $self->ut_phonen('fax')
+ || $self->ut_country('country')
+ || $self->ut_anything('comments')
+ || $self->ut_numbern('referral_custnum')
;
+ #barf. need message catalogs. i18n. etc.
+ $error .= "Please select a advertising source."
+ if $error =~ /^Illegal or empty \(numeric\) refnum: /;
return $error if $error;
return "Unknown agent"
unless qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
- return "Unknown referral"
+ return "Unknown refnum"
unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } );
- $self->getfield('last') =~ /^([\w \,\.\-\']+)$/
- or return "Illegal last name: ". $self->getfield('last');
- $self->setfield('last',$1);
-
- $self->first =~ /^([\w \,\.\-\']+)$/
- or return "Illegal first name: ". $self->first;
- $self->first($1);
+ return "Unknown referring custnum ". $self->referral_custnum
+ unless ! $self->referral_custnum
+ || qsearchs( 'cust_main', { 'custnum' => $self->referral_custnum } );
if ( $self->ss eq '' ) {
$self->ss('');
$self->ss("$1-$2-$3");
}
- $self->country =~ /^(\w\w)$/ or return "Illegal country: ". $self->country;
- $self->country($1);
- unless ( qsearchs('cust_main_county', {
- 'country' => $self->country,
- 'state' => '',
- } ) ) {
- return "Unknown state/county/country: ".
- $self->state. "/". $self->county. "/". $self->country
- unless qsearchs('cust_main_county',{
- 'state' => $self->state,
- 'county' => $self->county,
- 'country' => $self->country,
- } );
- }
- $self->zip =~ /^\s*(\w[\w\-\s]{3,8}\w)\s*$/
- or return "Illegal zip: ". $self->zip;
- $self->zip($1);
+# bad idea to disable, causes billing to fail because of no tax rates later
+# unless ( $import ) {
+ unless ( qsearchs('cust_main_county', {
+ 'country' => $self->country,
+ 'state' => '',
+ } ) ) {
+ return "Unknown state/county/country: ".
+ $self->state. "/". $self->county. "/". $self->country
+ unless qsearchs('cust_main_county',{
+ 'state' => $self->state,
+ 'county' => $self->county,
+ 'country' => $self->country,
+ } );
+ }
+# }
+
+ $error =
+ $self->ut_phonen('daytime', $self->country)
+ || $self->ut_phonen('night', $self->country)
+ || $self->ut_phonen('fax', $self->country)
+ || $self->ut_zip('zip', $self->country)
+ ;
+ return $error if $error;
+
+ my @addfields = qw(
+ last first company address1 address2 city county state zip
+ country daytime night fax
+ );
+
+ if ( defined $self->dbdef_table->column('ship_last') ) {
+ if ( scalar ( grep { $self->getfield($_) ne $self->getfield("ship_$_") }
+ @addfields )
+ && scalar ( grep { $self->getfield("ship_$_") ne '' } @addfields )
+ )
+ {
+ my $error =
+ $self->ut_name('ship_last')
+ || $self->ut_name('ship_first')
+ || $self->ut_textn('ship_company')
+ || $self->ut_text('ship_address1')
+ || $self->ut_textn('ship_address2')
+ || $self->ut_text('ship_city')
+ || $self->ut_textn('ship_county')
+ || $self->ut_textn('ship_state')
+ || $self->ut_country('ship_country')
+ ;
+ return $error if $error;
+
+ #false laziness with above
+ unless ( qsearchs('cust_main_county', {
+ 'country' => $self->ship_country,
+ 'state' => '',
+ } ) ) {
+ return "Unknown ship_state/ship_county/ship_country: ".
+ $self->ship_state. "/". $self->ship_county. "/". $self->ship_country
+ unless qsearchs('cust_main_county',{
+ 'state' => $self->ship_state,
+ 'county' => $self->ship_county,
+ 'country' => $self->ship_country,
+ } );
+ }
+ #eofalse
+
+ $error =
+ $self->ut_phonen('ship_daytime', $self->ship_country)
+ || $self->ut_phonen('ship_night', $self->ship_country)
+ || $self->ut_phonen('ship_fax', $self->ship_country)
+ || $self->ut_zip('ship_zip', $self->ship_country)
+ ;
+ return $error if $error;
+
+ } else { # ship_ info eq billing info, so don't store dup info in database
+ $self->setfield("ship_$_", '')
+ foreach qw( last first company address1 address2 city county state zip
+ country daytime night fax );
+ }
+ }
- $self->payby =~ /^(CARD|BILL|COMP)$/
+ $self->payby =~ /^(CARD|CHEK|BILL|COMP|PREPAY)$/
or return "Illegal payby: ". $self->payby;
$self->payby($1);
my $payinfo = $self->payinfo;
$payinfo =~ s/\D//g;
$payinfo =~ /^(\d{13,16})$/
- or return "Illegal credit card number: ". $self->payinfo;
+ or return gettext('invalid_card'); # . ": ". $self->payinfo;
$payinfo = $1;
$self->payinfo($payinfo);
validate($payinfo)
- or return "Illegal credit card number: ". $self->payinfo;
- return "Unknown card type" if cardtype($self->payinfo) eq "Unknown";
+ or return gettext('invalid_card'); # . ": ". $self->payinfo;
+ return gettext('unknown_card_type')
+ if cardtype($self->payinfo) eq "Unknown";
+
+ } 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);
+
+ } elsif ( $self->payby eq 'LECB' ) {
+
+ my $payinfo = $self->payinfo;
+ $payinfo =~ s/\D//g;
+ $payinfo =~ /^1?(\d{10})$/ or return 'invalid btn billing telephone number';
+ $payinfo = $1;
+ $self->payinfo($payinfo);
} elsif ( $self->payby eq 'BILL' ) {
$error = $self->ut_textn('payinfo');
return "Illegal comp account issuer: ". $self->payinfo if $error;
+ } elsif ( $self->payby eq 'PREPAY' ) {
+
+ my $payinfo = $self->payinfo;
+ $payinfo =~ s/\W//g; #anything else would just confuse things
+ $self->payinfo($payinfo);
+ $error = $self->ut_alpha('payinfo');
+ return "Illegal prepayment identifier: ". $self->payinfo if $error;
+ return "Unknown prepayment identifier"
+ unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } );
+
}
- if ( $self->paydate eq '' ) {
- return "Expriation date required" unless $self->payby eq 'BILL';
+ if ( $self->paydate eq '' || $self->paydate eq '-' ) {
+ return "Expriation date required"
+ unless $self->payby =~ /^(BILL|PREPAY|CHEK|LECB)$/;
$self->paydate('');
} else {
$self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/
or return "Illegal expiration date: ". $self->paydate;
- if ( length($2) == 4 ) {
- $self->paydate("$2-$1-01");
- } elsif ( $2 > 97 ) { #should pry change to check for "this year"
- $self->paydate("19$2-$1-01");
- } else {
- $self->paydate("20$2-$1-01");
- }
+ 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 '' ) {
+ if ( $self->payname eq '' && $self->payby ne 'CHEK' &&
+ ( ! $conf->exists('require_cardname') || $self->payby ne 'CARD' ) ) {
$self->payname( $self->first. " ". $self->getfield('last') );
} else {
$self->payname =~ /^([\w \,\.\-\']+)$/
- or return "Illegal billing name: ". $self->payname;
+ or return gettext('illegal_name'). " payname: ". $self->payname;
$self->payname($1);
}
$self->otaker(getotaker);
+ #warn "AFTER: \n". $self->_dump;
+
''; #no error
}
sub all_pkgs {
my $self = shift;
- qsearch( 'cust_pkg', { 'custnum' => $self->custnum });
+ if ( $self->{'_pkgnum'} ) {
+ values %{ $self->{'_pkgnum'}->cache };
+ } else {
+ qsearch( 'cust_pkg', { 'custnum' => $self->custnum });
+ }
}
=item ncancelled_pkgs
sub ncancelled_pkgs {
my $self = shift;
- qsearch( 'cust_pkg', {
- 'custnum' => $self->custnum,
- 'cancel' => '',
- }),
- qsearch( 'cust_pkg', {
- 'custnum' => $self->custnum,
- 'cancel' => 0,
- }),
- ;
+ if ( $self->{'_pkgnum'} ) {
+ grep { ! $_->getfield('cancel') } values %{ $self->{'_pkgnum'}->cache };
+ } else {
+ @{ [ # force list context
+ qsearch( 'cust_pkg', {
+ 'custnum' => $self->custnum,
+ 'cancel' => '',
+ }),
+ qsearch( 'cust_pkg', {
+ 'custnum' => $self->custnum,
+ 'cancel' => 0,
+ }),
+ ] };
+ }
+}
+
+=item suspended_pkgs
+
+Returns all suspended packages (see L<FS::cust_pkg>) for this customer.
+
+=cut
+
+sub suspended_pkgs {
+ my $self = shift;
+ grep { $_->susp } $self->ncancelled_pkgs;
+}
+
+=item unflagged_suspended_pkgs
+
+Returns all unflagged suspended packages (see L<FS::cust_pkg>) for this
+customer (thouse packages without the `manual_flag' set).
+
+=cut
+
+sub unflagged_suspended_pkgs {
+ my $self = shift;
+ return $self->suspended_pkgs
+ unless dbdef->table('cust_pkg')->column('manual_flag');
+ grep { ! $_->manual_flag } $self->suspended_pkgs;
+}
+
+=item unsuspended_pkgs
+
+Returns all unsuspended (and uncancelled) packages (see L<FS::cust_pkg>) for
+this customer.
+
+=cut
+
+sub unsuspended_pkgs {
+ my $self = shift;
+ grep { ! $_->susp } $self->ncancelled_pkgs;
+}
+
+=item unsuspend
+
+Unsuspends all unflagged suspended packages (see L</unflagged_suspended_pkgs>
+and L<FS::cust_pkg>) for this customer. Always returns a list: an empty list
+on success or a list of errors.
+
+=cut
+
+sub unsuspend {
+ my $self = shift;
+ grep { $_->unsuspend } $self->suspended_pkgs;
+}
+
+=item suspend
+
+Suspends all unsuspended packages (see L<FS::cust_pkg>) for this customer.
+Always returns a list: an empty list on success or a list of errors.
+
+=cut
+
+sub suspend {
+ my $self = shift;
+ grep { $_->suspend } $self->unsuspended_pkgs;
+}
+
+=item cancel
+
+Cancels all uncancelled packages (see L<FS::cust_pkg>) for this customer.
+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;
+}
+
+=item agent
+
+Returns the agent (see L<FS::agent>) for this customer.
+
+=cut
+
+sub agent {
+ my $self = shift;
+ qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
}
=item bill OPTIONS
Generates invoices (see L<FS::cust_bill>) for this customer. Usually used in
conjunction with the collect method.
+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.
+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.
local $SIG{TSTP} = 'IGNORE';
local $SIG{PIPE} = 'IGNORE';
+ my $oldAutoCommit = $FS::UID::AutoCommit;
+ local $FS::UID::AutoCommit = 0;
+ my $dbh = dbh;
+
# find the packages which are due for billing, find out how much they are
# & generate invoice database.
my( $total_setup, $total_recur ) = ( 0, 0 );
- my @cust_bill_pkg;
+ #my( $taxable_setup, $taxable_recur ) = ( 0, 0 );
+ my @cust_bill_pkg = ();
+ #my $tax = 0;##
+ #my $taxable_charged = 0;##
+ #my $charged = 0;##
+
+ my %tax;
foreach my $cust_pkg (
- qsearch('cust_pkg',{'custnum'=> $self->getfield('custnum') } )
+ qsearch('cust_pkg', { 'custnum' => $self->custnum } )
) {
+ #NO!! next if $cust_pkg->cancel;
next if $cust_pkg->getfield('cancel');
#? to avoid use of uninitialized value errors... ?
$cust_pkg->setfield('bill', '')
unless defined($cust_pkg->bill);
- my $part_pkg = qsearchs( 'part_pkg', { 'pkgpart' => $cust_pkg->pkgpart } );
+ my $part_pkg = $cust_pkg->part_pkg;
#so we don't modify cust_pkg record unnecessarily
my $cust_pkg_mod_flag = 0;
my $setup = 0;
unless ( $cust_pkg->setup ) {
my $setup_prog = $part_pkg->getfield('setup');
- my $cpt = new Safe;
- #$cpt->permit(); #what is necessary?
- $cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
- $setup = $cpt->reval($setup_prog);
+ $setup_prog =~ /^(.*)$/ or do {
+ $dbh->rollback if $oldAutoCommit;
+ return "Illegal setup for pkgpart ". $part_pkg->pkgpart.
+ ": $setup_prog";
+ };
+ $setup_prog = $1;
+
+ #my $cpt = new Safe;
+ ##$cpt->permit(); #what is necessary?
+ #$cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
+ #$setup = $cpt->reval($setup_prog);
+ $setup = eval $setup_prog;
unless ( defined($setup) ) {
- warn "Error reval-ing part_pkg->setup pkgpart ",
- $part_pkg->pkgpart, ": $@";
- } else {
- $cust_pkg->setfield('setup',$time);
- $cust_pkg_mod_flag=1;
+ $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_mod_flag=1;
}
#bill recurring fee
( $cust_pkg->getfield('bill') || 0 ) < $time
) {
my $recur_prog = $part_pkg->getfield('recur');
- my $cpt = new Safe;
- #$cpt->permit(); #what is necessary?
- $cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
- $recur = $cpt->reval($recur_prog);
+ $recur_prog =~ /^(.*)$/ or do {
+ $dbh->rollback if $oldAutoCommit;
+ return "Illegal recur for pkgpart ". $part_pkg->pkgpart.
+ ": $recur_prog";
+ };
+ $recur_prog = $1;
+
+ # shared with $recur_prog
+ $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
+
+ #my $cpt = new Safe;
+ ##$cpt->permit(); #what is necessary?
+ #$cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
+ #$recur = $cpt->reval($recur_prog);
+ $recur = eval $recur_prog;
unless ( defined($recur) ) {
- warn "Error reval-ing part_pkg->recur pkgpart ",
- $part_pkg->pkgpart, ": $@";
- } else {
- #change this bit to use Date::Manip?
- #$sdate=$cust_pkg->bill || time;
- #$sdate=$cust_pkg->bill || $time;
- $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
- my ($sec,$min,$hour,$mday,$mon,$year) =
- (localtime($sdate) )[0,1,2,3,4,5];
- $mon += $part_pkg->getfield('freq');
- until ( $mon < 12 ) { $mon -= 12; $year++; }
- $cust_pkg->setfield('bill',
- timelocal($sec,$min,$hour,$mday,$mon,$year));
- $cust_pkg_mod_flag = 1;
+ $dbh->rollback if $oldAutoCommit;
+ return "Error eval-ing part_pkg->recur pkgpart ". $part_pkg->pkgpart.
+ "(expression $recur_prog): $@";
}
+ #change this bit to use Date::Manip? CAREFUL with timezones (see
+ # mailing list archive)
+ my ($sec,$min,$hour,$mday,$mon,$year) =
+ (localtime($sdate) )[0,1,2,3,4,5];
+
+ #pro-rating magic - if $recur_prog fiddles $sdate, want to use that
+ # only for figuring next bill date, nothing else, so, reset $sdate again
+ # here
+ $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
+
+ $mon += $part_pkg->freq;
+ until ( $mon < 12 ) { $mon -= 12; $year++; }
+ $cust_pkg->setfield('bill',
+ timelocal($sec,$min,$hour,$mday,$mon,$year));
+ $cust_pkg_mod_flag = 1;
}
- warn "setup is undefinded" unless defined($setup);
- warn "recur is undefinded" unless defined($recur);
- warn "cust_pkg bill is undefinded" unless defined($cust_pkg->bill);
+ warn "\$setup is undefined" unless defined($setup);
+ 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
- warn "Error modifying pkgnum ", $cust_pkg->pkgnum, ": $error";
- } else {
- $setup = sprintf( "%.2f", $setup );
- $recur = sprintf( "%.2f", $recur );
+ $dbh->rollback if $oldAutoCommit;
+ return "Error modifying pkgnum ". $cust_pkg->pkgnum. ": $error";
+ }
+ $setup = sprintf( "%.2f", $setup );
+ $recur = sprintf( "%.2f", $recur );
+ if ( $setup < 0 ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "negative setup $setup for pkgnum ". $cust_pkg->pkgnum;
+ }
+ if ( $recur < 0 ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum;
+ }
+ if ( $setup > 0 || $recur > 0 ) {
my $cust_bill_pkg = new FS::cust_bill_pkg ({
'pkgnum' => $cust_pkg->pkgnum,
'setup' => $setup,
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,
+ } )
+ or qsearchs('cust_main_county',{
+ 'state' => $self->state,
+ 'county' => $self->county,
+ 'country' => $self->country,
+ 'taxclass' => '',
+ } )
+ or do {
+ $dbh->rollback if $oldAutoCommit;
+ return
+ "fatal: can't find tax rate for state/county/country/taxclass ".
+ join('/', ( map $self->$_(), qw(state county country) ),
+ $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
+
+ } #if $cust_pkg_mod_flag
+
+ } #foreach my $cust_pkg
my $charged = sprintf( "%.2f", $total_setup + $total_recur );
-
- return '' if scalar(@cust_bill_pkg) == 0;
-
- unless ( $self->getfield('tax') =~ /Y/i
- || $self->getfield('payby') eq 'COMP'
- ) {
- my $cust_main_county = qsearchs('cust_main_county',{
- 'state' => $self->state,
- 'county' => $self->county,
- 'country' => $self->country,
- } );
- my $tax = sprintf( "%.2f",
- $charged * ( $cust_main_county->getfield('tax') / 100 )
- );
+# my $taxable_charged = sprintf( "%.2f", $taxable_setup + $taxable_recur );
+
+ unless ( @cust_bill_pkg ) { #don't create invoices with no line items
+ $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+ return '';
+ }
+
+# 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,
+# } ) or die "fatal: can't find tax rate for state/county/country ".
+# $self->state. "/". $self->county. "/". $self->country. "\n";
+# my $tax = sprintf( "%.2f",
+# $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' => '',
+ 'pkgnum' => 0,
+ 'setup' => $tax,
+ 'recur' => 0,
+ 'sdate' => '',
+ 'edate' => '',
+ 'itemdesc' => $taxname,
});
push @cust_bill_pkg, $cust_bill_pkg;
}
+# }
my $cust_bill = new FS::cust_bill ( {
- 'custnum' => $self->getfield('custnum'),
- '_date' => $time,
+ 'custnum' => $self->custnum,
+ '_date' => $time,
'charged' => $charged,
} );
$error = $cust_bill->insert;
- #shouldn't happen, but how else to handle this? (wrap me in eval, to catch
- # fatal errors)
- die "Error creating cust_bill record: $error!\n",
- "Check updated but unbilled packages for customer", $self->custnum, "\n"
- if $error;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "can't create invoice for customer #". $self->custnum. ": $error";
+ }
my $invnum = $cust_bill->invnum;
my $cust_bill_pkg;
foreach $cust_bill_pkg ( @cust_bill_pkg ) {
- $cust_bill_pkg->setfield( 'invnum', $invnum );
+ #warn $invnum;
+ $cust_bill_pkg->invnum($invnum);
$error = $cust_bill_pkg->insert;
- #shouldn't happen, but how else tohandle this?
- die "Error creating cust_bill_pkg record: $error!\n",
- "Check incomplete invoice ", $invnum, "\n"
- if $error;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "can't create invoice line item for customer #". $self->custnum.
+ ": $error";
+ }
}
+ $dbh->commit or die $dbh->errstr if $oldAutoCommit;
''; #no error
}
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.
+
If there is an error, returns the error, otherwise returns false.
+Options are passed as name-value pairs.
+
Currently available options are:
invoice_time - Use this time when deciding when to print invoices and
late notices on those invoices. The default is now. It is specified as a UNIX timestamp; see L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse>
for conversion functions.
-batch_card - Set this true to batch cards (see L<cust_pay_batch>). By
-default, cards are processed immediately, which will generate an error if
-CyberCash is not installed.
+retry_card - Retry cards even when not scheduled by invoice events.
+
+batch_card - This option is deprecated. See the invoice events web interface
+to control whether cards are batched or run against a realtime gateway.
+
+report_badcard - This option is deprecated.
-report_badcard - Set this true if you want bad card transactions to
-return an error. By default, they don't.
+force_print - This option is deprecated; see the invoice events web interface.
=cut
my( $self, %options ) = @_;
my $invoice_time = $options{'invoice_time'} || time;
- my $total_owed = $self->balance;
- warn "collect: total owed $total_owed " if $Debug;
- return '' unless $total_owed > 0; #redundant?????
-
#put below somehow?
local $SIG{HUP} = 'IGNORE';
local $SIG{INT} = 'IGNORE';
local $SIG{TSTP} = 'IGNORE';
local $SIG{PIPE} = 'IGNORE';
- foreach my $cust_bill (
- qsearch('cust_bill', { 'custnum' => $self->custnum, } )
- ) {
+ my $oldAutoCommit = $FS::UID::AutoCommit;
+ local $FS::UID::AutoCommit = 0;
+ my $dbh = dbh;
- #this has to be before next's
- my $amount = sprintf( "%.2f", $total_owed < $cust_bill->owed
- ? $total_owed
- : $cust_bill->owed
- );
- $total_owed = sprintf( "%.2f", $total_owed - $amount );
+ my $balance = $self->balance;
+ warn "collect customer". $self->custnum. ": balance $balance" if $Debug;
+ unless ( $balance > 0 ) { #redundant?????
+ $dbh->rollback if $oldAutoCommit; #hmm
+ return '';
+ }
- next unless $cust_bill->owed > 0;
-
- next if qsearchs( 'cust_pay_batch', { 'invnum' => $cust_bill->invnum } );
+ if ( exists($options{'retry_card'}) && $options{'retry_card'} ) {
+ #false laziness w/replace
+ foreach my $cust_bill_event (
+ grep {
+ #$_->part_bill_event->plan eq 'realtime-card'
+ $_->part_bill_event->eventcode eq '$cust_bill->realtime_card();'
+ && $_->status eq 'done'
+ && $_->statustext
+ }
+ map { $_->cust_bill_event }
+ grep { $_->cust_bill_event }
+ $self->open_cust_bill
+ ) {
+ my $error = $cust_bill_event->retry;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "error scheduling invoice events for retry: $error";
+ }
+ }
+ #eslaf
+ }
- warn "invnum ". $cust_bill->invnum. " (owed ". $cust_bill->owed. ", amount $amount, total_owed $total_owed)" if $Debug;
+ foreach my $cust_bill ( $self->cust_bill ) {
- next unless $amount > 0;
+ #this has to be before next's
+ my $amount = sprintf( "%.2f", $balance < $cust_bill->owed
+ ? $balance
+ : $cust_bill->owed
+ );
+ $balance = sprintf( "%.2f", $balance - $amount );
- if ( $self->payby eq 'BILL' ) {
-
- #30 days 2592000
- my $since = $invoice_time - ( $cust_bill->_date || 0 );
- #warn "$invoice_time ", $cust_bill->_date, " $since";
- if ( $since >= 0 #don't print future invoices
- && ( $cust_bill->printed * 2592000 ) <= $since
- ) {
-
- #my @print_text = $cust_bill->print_text; #( date )
- my @invoicing_list = $self->invoicing_list;
- if ( grep { $_ ne 'POST' } @invoicing_list ) { #email invoice
- $ENV{SMTPHOSTS} = $smtpmachine;
- $ENV{MAILADDRESS} = $invoice_from;
- my $header = new Mail::Header ( [
- "From: $invoice_from",
- "To: ". join(', ', grep { $_ ne 'POST' } @invoicing_list ),
- "Sender: $invoice_from",
- "Reply-To: $invoice_from",
- "Date: ". time2str("%a, %d %b %Y %X %z", time),
- "Subject: Invoice",
- ] );
- my $message = new Mail::Internet (
- 'Header' => $header,
- 'Body' => [ $cust_bill->print_text ], #( date)
- );
- $message->smtpsend or die "Can't send invoice email!"; #die? warn?
-
- } elsif ( ! @invoicing_list || grep { $_ eq 'POST' } @invoicing_list ) {
- open(LPR, "|$lpr") or die "Can't open pipe to $lpr: $!";
- print LPR $cust_bill->print_text; #( date )
- close LPR
- or die $! ? "Error closing $lpr: $!"
- : "Exit status $? from $lpr";
- }
+ next unless $cust_bill->owed > 0;
- my %hash = $cust_bill->hash;
- $hash{'printed'}++;
- my $new_cust_bill = new FS::cust_bill(\%hash);
- my $error = $new_cust_bill->replace($cust_bill);
- warn "Error updating $cust_bill->printed: $error" if $error;
+ # 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;
- } elsif ( $self->payby eq 'COMP' ) {
- my $cust_pay = new FS::cust_pay ( {
- 'invnum' => $cust_bill->invnum,
- 'paid' => $amount,
- '_date' => '',
- 'payby' => 'COMP',
- 'payinfo' => $self->payinfo,
- 'paybatch' => ''
- } );
- my $error = $cust_pay->insert;
- return 'Error COMPing invnum #' . $cust_bill->invnum .
- ':' . $error if $error;
-
- } elsif ( $self->payby eq 'CARD' ) {
-
- if ( $options{'batch_card'} ne 'yes' ) {
-
- return "Real time card processing not enabled!" unless $processor;
-
- if ( $processor =~ /^cybercash/ ) {
-
- #fix exp. date for cybercash
- #$self->paydate =~ /^(\d+)\/\d*(\d{2})$/;
- $self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
- my $exp = "$2/$1";
-
- my $paybatch = $cust_bill->invnum.
- '-' . time2str("%y%m%d%H%M%S", time);
-
- my $payname = $self->payname ||
- $self->getfield('first'). ' '. $self->getfield('last');
-
- my $address = $self->address1;
- $address .= ", ". $self->address2 if $self->address2;
-
- my $country = 'USA' if $self->country eq 'US';
-
- my @full_xaction = ( $xaction,
- 'Order-ID' => $paybatch,
- 'Amount' => "usd $amount",
- 'Card-Number' => $self->getfield('payinfo'),
- 'Card-Name' => $payname,
- 'Card-Address' => $address,
- 'Card-City' => $self->getfield('city'),
- 'Card-State' => $self->getfield('state'),
- 'Card-Zip' => $self->getfield('zip'),
- 'Card-Country' => $country,
- 'Card-Exp' => $exp,
- );
-
- my %result;
- if ( $processor eq 'cybercash2' ) {
- $^W=0; #CCLib isn't -w safe, ugh!
- %result = &CCLib::sendmserver(@full_xaction);
- $^W=1;
- } elsif ( $processor eq 'cybercash3.2' ) {
- %result = &CCMckDirectLib3_2::SendCC2_1Server(@full_xaction);
- } else {
- return "Unkonwn real-time processor $processor\n";
- }
-
- #if ( $result{'MActionCode'} == 7 ) { #cybercash smps v.1.1.3
- #if ( $result{'action-code'} == 7 ) { #cybercash smps v.2.1
- if ( $result{'MStatus'} eq 'success' ) { #cybercash smps v.2 or 3
- my $cust_pay = new FS::cust_pay ( {
- 'invnum' => $cust_bill->invnum,
- 'paid' => $amount,
- '_date' => '',
- 'payby' => 'CARD',
- 'payinfo' => $self->payinfo,
- 'paybatch' => "$processor:$paybatch",
- } );
- my $error = $cust_pay->insert;
- return 'Error applying payment, invnum #' .
- $cust_bill->invnum. ':'. $error if $error;
- } elsif ( $result{'Mstatus'} ne 'failure-bad-money'
- || $options{'report_badcard'} ) {
- return 'Cybercash error, invnum #' .
- $cust_bill->invnum. ':'. $result{'MErrMsg'};
- } else {
- return '';
- }
+ next unless $amount > 0;
- } else {
- return "Unkonwn real-time processor $processor\n";
- }
- } else { #batch card
-
- my $cust_pay_batch = new FS::cust_pay_batch ( {
- 'invnum' => $cust_bill->getfield('invnum'),
- 'custnum' => $self->getfield('custnum'),
- 'last' => $self->getfield('last'),
- 'first' => $self->getfield('first'),
- 'address1' => $self->getfield('address1'),
- 'address2' => $self->getfield('address2'),
- 'city' => $self->getfield('city'),
- 'state' => $self->getfield('state'),
- 'zip' => $self->getfield('zip'),
- 'country' => $self->getfield('country'),
- 'trancode' => 77,
- 'cardnum' => $self->getfield('payinfo'),
- 'exp' => $self->getfield('paydate'),
- 'payname' => $self->getfield('payname'),
- 'amount' => $amount,
- } );
- my $error = $cust_pay_batch->insert;
- return "Error adding to cust_pay_batch: $error" if $error;
+ 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', {
+ 'invnum' => $cust_bill->invnum,
+ 'eventpart' => $_->eventpart,
+ 'status' => 'done',
+ } )
+ }
+ qsearch('part_bill_event', { 'payby' => $self->payby,
+ 'disabled' => '', } )
+ ) {
+ last unless $cust_bill->owed > 0; #don't run subsequent events if owed=0
+
+ warn "calling invoice event (". $part_bill_event->eventcode. ")\n"
+ if $Debug;
+ my $cust_main = $self; #for callback
+ my $error = eval $part_bill_event->eventcode;
+
+ my $status = '';
+ my $statustext = '';
+ if ( $@ ) {
+ $status = 'failed';
+ $statustext = $@;
+ } elsif ( $error ) {
+ $status = 'done';
+ $statustext = $error;
+ } else {
+ $status = 'done'
}
- } else {
- return "Unknown payment type ". $self->payby;
- }
-
-
+ #add cust_bill_event
+ my $cust_bill_event = new FS::cust_bill_event {
+ 'invnum' => $cust_bill->invnum,
+ 'eventpart' => $part_bill_event->eventpart,
+ '_date' => $invoice_time,
+ 'status' => $status,
+ 'statustext' => $statustext,
+ };
+ $error = $cust_bill_event->insert;
+ if ( $error ) {
+ #$dbh->rollback if $oldAutoCommit;
+ #return "error: $error";
+
+ # gah, even with transactions.
+ $dbh->commit if $oldAutoCommit; #well.
+ my $e = 'WARNING: Event run but database not updated - '.
+ 'error inserting cust_bill_event, invnum #'. $cust_bill->invnum.
+ ', eventpart '. $part_bill_event->eventpart.
+ ": $error";
+ warn $e;
+ return $e;
+ }
+ }
}
+
+ $dbh->commit or die $dbh->errstr if $oldAutoCommit;
'';
}
=item total_owed
Returns the total owed for this customer on all invoices
-(see L<FS::cust_bill>).
+(see L<FS::cust_bill/owed>).
=cut
sub total_owed {
my $self = shift;
+ $self->total_owed_date(2145859200); #12/31/2037
+}
+
+=item total_owed_date TIME
+
+Returns the total owed for this customer on all invoices with date earlier than
+TIME. TIME is specified as a UNIX timestamp; see L<perlfunc/"time">). Also
+see L<Time::Local> and L<Date::Parse> for conversion functions.
+
+=cut
+
+sub total_owed_date {
+ my $self = shift;
+ my $time = shift;
my $total_bill = 0;
- foreach my $cust_bill ( qsearch('cust_bill', {
- 'custnum' => $self->custnum,
- } ) ) {
+ foreach my $cust_bill (
+ grep { $_->_date <= $time }
+ qsearch('cust_bill', { 'custnum' => $self->custnum, } )
+ ) {
$total_bill += $cust_bill->owed;
}
sprintf( "%.2f", $total_bill );
}
+=item apply_credits
+
+Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
+to outstanding invoice balances in chronological order and returns the value
+of any remaining unapplied credits available for refund
+(see L<FS::cust_refund>).
+
+=cut
+
+sub apply_credits {
+ my $self = shift;
+
+ return 0 unless $self->total_credited;
+
+ my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
+ qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
+
+ my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
+ qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
+
+ my $credit;
+
+ foreach my $cust_bill ( @invoices ) {
+ my $amount;
+
+ if ( !defined($credit) || $credit->credited == 0) {
+ $credit = pop @credits or last;
+ }
+
+ if ($cust_bill->owed >= $credit->credited) {
+ $amount=$credit->credited;
+ }else{
+ $amount=$cust_bill->owed;
+ }
+
+ my $cust_credit_bill = new FS::cust_credit_bill ( {
+ 'crednum' => $credit->crednum,
+ 'invnum' => $cust_bill->invnum,
+ 'amount' => $amount,
+ } );
+ my $error = $cust_credit_bill->insert;
+ die $error if $error;
+
+ redo if ($cust_bill->owed > 0);
+
+ }
+
+ return $self->total_credited;
+}
+
+=item apply_payments
+
+Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
+to outstanding invoice balances in chronological order.
+
+ #and returns the value of any remaining unapplied payments.
+
+=cut
+
+sub apply_payments {
+ my $self = shift;
+
+ #return 0 unless
+
+ my @payments = sort { $b->_date <=> $a->_date } ( grep { $_->unapplied > 0 }
+ qsearch('cust_pay', { 'custnum' => $self->custnum } ) );
+
+ my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
+ qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
+
+ my $payment;
+
+ foreach my $cust_bill ( @invoices ) {
+ my $amount;
+
+ if ( !defined($payment) || $payment->unapplied == 0 ) {
+ $payment = pop @payments or last;
+ }
+
+ if ( $cust_bill->owed >= $payment->unapplied ) {
+ $amount = $payment->unapplied;
+ } else {
+ $amount = $cust_bill->owed;
+ }
+
+ my $cust_bill_pay = new FS::cust_bill_pay ( {
+ 'paynum' => $payment->paynum,
+ 'invnum' => $cust_bill->invnum,
+ 'amount' => $amount,
+ } );
+ my $error = $cust_bill_pay->insert;
+ die $error if $error;
+
+ redo if ( $cust_bill->owed > 0);
+
+ }
+
+ return $self->total_unapplied_payments;
+}
+
=item total_credited
-Returns the total credits (see L<FS::cust_credit>) for this customer.
+Returns the total outstanding credit (see L<FS::cust_credit>) for this
+customer. See L<FS::cust_credit/credited>.
=cut
sprintf( "%.2f", $total_credit );
}
+=item total_unapplied_payments
+
+Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
+See L<FS::cust_pay/unapplied>.
+
+=cut
+
+sub total_unapplied_payments {
+ my $self = shift;
+ my $total_unapplied = 0;
+ foreach my $cust_pay ( qsearch('cust_pay', {
+ 'custnum' => $self->custnum,
+ } ) ) {
+ $total_unapplied += $cust_pay->unapplied;
+ }
+ sprintf( "%.2f", $total_unapplied );
+}
+
=item balance
-Returns the balance for this customer (total owed minus total credited).
+Returns the balance for this customer (total_owed minus total_credited
+minus total_unapplied_payments).
=cut
sub balance {
my $self = shift;
- sprintf( "%.2f", $self->total_owed - $self->total_credited );
+ sprintf( "%.2f",
+ $self->total_owed - $self->total_credited - $self->total_unapplied_payments
+ );
+}
+
+=item balance_date TIME
+
+Returns the balance for this customer, only considering invoices with date
+earlier than TIME (total_owed_date minus total_credited minus
+total_unapplied_payments). TIME is specified as a UNIX timestamp; see
+L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion
+functions.
+
+=cut
+
+sub balance_date {
+ my $self = shift;
+ my $time = shift;
+ sprintf( "%.2f",
+ $self->total_owed_date($time)
+ - $self->total_credited
+ - $self->total_unapplied_payments
+ );
}
=item invoicing_list [ ARRAYREF ]
} else {
@cust_main_invoice = ();
}
+ my %seen = map { $_->address => 1 } @cust_main_invoice;
foreach my $address ( @{$arrayref} ) {
- unless ( grep { $address eq $_->address } @cust_main_invoice ) {
- my $cust_main_invoice = new FS::cust_main_invoice ( {
- 'custnum' => $self->custnum,
- 'dest' => $address,
- } );
- my $error = $cust_main_invoice->insert;
- warn $error if $error;
- }
+ next if exists $seen{$address} && $seen{$address};
+ $seen{$address} = 1;
+ my $cust_main_invoice = new FS::cust_main_invoice ( {
+ 'custnum' => $self->custnum,
+ 'dest' => $address,
+ } );
+ my $error = $cust_main_invoice->insert;
+ warn $error if $error;
}
}
if ( $self->custnum ) {
'';
}
+=item set_default_invoicing_list
+
+Sets the invoicing list to all accounts associated with this customer,
+overwriting any previous invoicing list.
+
+=cut
+
+sub set_default_invoicing_list {
+ my $self = shift;
+ $self->invoicing_list($self->all_emails);
+}
+
+=item all_emails
+
+Returns the email addresses of all accounts provisioned for this customer.
+
+=cut
+
+sub all_emails {
+ my $self = shift;
+ my %list;
+ foreach my $cust_pkg ( $self->all_pkgs ) {
+ my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
+ my @svc_acct =
+ map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
+ grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
+ @cust_svc;
+ $list{$_}=1 foreach map { $_->email } @svc_acct;
+ }
+ keys %list;
+}
+
+=item invoicing_list_addpost
+
+Adds postal invoicing to this customer. If this customer is already configured
+to receive postal invoices, does nothing.
+
+=cut
+
+sub invoicing_list_addpost {
+ my $self = shift;
+ return if grep { $_ eq 'POST' } $self->invoicing_list;
+ my @invoicing_list = $self->invoicing_list;
+ push @invoicing_list, 'POST';
+ $self->invoicing_list(\@invoicing_list);
+}
+
+=item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
+
+Returns an array of customers referred by this customer (referral_custnum set
+to this custnum). If DEPTH is given, recurses up to the given depth, returning
+customers referred by customers referred by this customer and so on, inclusive.
+The default behavior is DEPTH 1 (no recursion).
+
+=cut
+
+sub referral_cust_main {
+ my $self = shift;
+ my $depth = @_ ? shift : 1;
+ my $exclude = @_ ? shift : {};
+
+ my @cust_main =
+ map { $exclude->{$_->custnum}++; $_; }
+ grep { ! $exclude->{ $_->custnum } }
+ qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
+
+ if ( $depth > 1 ) {
+ push @cust_main,
+ map { $_->referral_cust_main($depth-1, $exclude) }
+ @cust_main;
+ }
+
+ @cust_main;
+}
+
+=item referral_cust_main_ncancelled
+
+Same as referral_cust_main, except only returns customers with uncancelled
+packages.
+
+=cut
+
+sub referral_cust_main_ncancelled {
+ my $self = shift;
+ grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
+}
+
+=item referral_cust_pkg [ DEPTH ]
+
+Like referral_cust_main, except returns a flat list of all unsuspended (and
+uncancelled) packages for each customer. The number of items in this list may
+be useful for comission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
+
+=cut
+
+sub referral_cust_pkg {
+ my $self = shift;
+ my $depth = @_ ? shift : 1;
+
+ map { $_->unsuspended_pkgs }
+ grep { $_->unsuspended_pkgs }
+ $self->referral_cust_main($depth);
+}
+
+=item credit AMOUNT, REASON
+
+Applies a credit to this customer. If there is an error, returns the error,
+otherwise returns false.
+
+=cut
+
+sub credit {
+ my( $self, $amount, $reason ) = @_;
+ my $cust_credit = new FS::cust_credit {
+ 'custnum' => $self->custnum,
+ 'amount' => $amount,
+ 'reason' => $reason,
+ };
+ $cust_credit->insert;
+}
+
+=item charge AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
+
+Creates a one-time charge for this customer. If there is an error, returns
+the error, otherwise returns false.
+
+=cut
+
+sub charge {
+ my ( $self, $amount ) = ( shift, shift );
+ my $pkg = @_ ? shift : 'One-time charge';
+ my $comment = @_ ? shift : '$'. sprintf("%.2f",$amount);
+ my $taxclass = @_ ? 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;
+
+ my $part_pkg = new FS::part_pkg ( {
+ 'pkg' => $pkg,
+ 'comment' => $comment,
+ 'setup' => $amount,
+ 'freq' => 0,
+ 'recur' => '0',
+ 'disabled' => 'Y',
+ 'taxclass' => $taxclass,
+ } );
+
+ my $error = $part_pkg->insert;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+
+ my $pkgpart = $part_pkg->pkgpart;
+ my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
+ unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
+ my $type_pkgs = new FS::type_pkgs \%type_pkgs;
+ $error = $type_pkgs->insert;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+ }
+
+ my $cust_pkg = new FS::cust_pkg ( {
+ 'custnum' => $self->custnum,
+ 'pkgpart' => $pkgpart,
+ } );
+
+ $error = $cust_pkg->insert;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+
+ $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+ '';
+
+}
+
+=item cust_bill
+
+Returns all the invoices (see L<FS::cust_bill>) for this customer.
+
+=cut
+
+sub cust_bill {
+ my $self = shift;
+ sort { $a->_date <=> $b->_date }
+ qsearch('cust_bill', { 'custnum' => $self->custnum, } )
+}
+
+=item open_cust_bill
+
+Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
+customer.
+
+=cut
+
+sub open_cust_bill {
+ my $self = shift;
+ grep { $_->owed > 0 } $self->cust_bill;
+}
+
=back
-=head1 VERSION
+=head1 SUBROUTINES
+
+=over 4
+
+=item check_and_rebuild_fuzzyfiles
+
+=cut
+
+sub check_and_rebuild_fuzzyfiles {
+ my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
+ -e "$dir/cust_main.last" && -e "$dir/cust_main.company"
+ or &rebuild_fuzzyfiles;
+}
+
+=item rebuild_fuzzyfiles
+
+=cut
+
+sub rebuild_fuzzyfiles {
+
+ use Fcntl qw(:flock);
+
+ my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
+
+ #last
+
+ open(LASTLOCK,">>$dir/cust_main.last")
+ or die "can't open $dir/cust_main.last: $!";
+ flock(LASTLOCK,LOCK_EX)
+ or die "can't lock $dir/cust_main.last: $!";
+
+ my @all_last = map $_->getfield('last'), qsearch('cust_main', {});
+ push @all_last,
+ grep $_, map $_->getfield('ship_last'), qsearch('cust_main',{})
+ if defined dbdef->table('cust_main')->column('ship_last');
+
+ open (LASTCACHE,">$dir/cust_main.last.tmp")
+ or die "can't open $dir/cust_main.last.tmp: $!";
+ print LASTCACHE join("\n", @all_last), "\n";
+ close LASTCACHE or die "can't close $dir/cust_main.last.tmp: $!";
+
+ rename "$dir/cust_main.last.tmp", "$dir/cust_main.last";
+ close LASTLOCK;
+
+ #company
+
+ open(COMPANYLOCK,">>$dir/cust_main.company")
+ or die "can't open $dir/cust_main.company: $!";
+ flock(COMPANYLOCK,LOCK_EX)
+ or die "can't lock $dir/cust_main.company: $!";
+
+ my @all_company = grep $_ ne '', map $_->company, qsearch('cust_main',{});
+ push @all_company,
+ grep $_ ne '', map $_->ship_company, qsearch('cust_main', {})
+ if defined dbdef->table('cust_main')->column('ship_last');
+
+ open (COMPANYCACHE,">$dir/cust_main.company.tmp")
+ or die "can't open $dir/cust_main.company.tmp: $!";
+ print COMPANYCACHE join("\n", @all_company), "\n";
+ close COMPANYCACHE or die "can't close $dir/cust_main.company.tmp: $!";
+
+ rename "$dir/cust_main.company.tmp", "$dir/cust_main.company";
+ close COMPANYLOCK;
+
+}
+
+=item all_last
+
+=cut
+
+sub all_last {
+ my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
+ open(LASTCACHE,"<$dir/cust_main.last")
+ or die "can't open $dir/cust_main.last: $!";
+ my @array = map { chomp; $_; } <LASTCACHE>;
+ close LASTCACHE;
+ \@array;
+}
+
+=item all_company
+
+=cut
+
+sub all_company {
+ my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
+ open(COMPANYCACHE,"<$dir/cust_main.company")
+ or die "can't open $dir/cust_main.last: $!";
+ my @array = map { chomp; $_; } <COMPANYCACHE>;
+ close COMPANYCACHE;
+ \@array;
+}
+
+=item append_fuzzyfiles LASTNAME COMPANY
+
+=cut
+
+sub append_fuzzyfiles {
+ my( $last, $company ) = @_;
+
+ &check_and_rebuild_fuzzyfiles;
+
+ use Fcntl qw(:flock);
+
+ my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
+
+ if ( $last ) {
+
+ open(LAST,">>$dir/cust_main.last")
+ or die "can't open $dir/cust_main.last: $!";
+ flock(LAST,LOCK_EX)
+ or die "can't lock $dir/cust_main.last: $!";
+
+ print LAST "$last\n";
+
+ flock(LAST,LOCK_UN)
+ or die "can't unlock $dir/cust_main.last: $!";
+ close LAST;
+ }
+
+ if ( $company ) {
+
+ open(COMPANY,">>$dir/cust_main.company")
+ or die "can't open $dir/cust_main.company: $!";
+ flock(COMPANY,LOCK_EX)
+ or die "can't lock $dir/cust_main.company: $!";
-$Id: cust_main.pm,v 1.2 1999-08-12 04:16:01 ivan Exp $
+ print COMPANY "$company\n";
+
+ flock(COMPANY,LOCK_UN)
+ or die "can't unlock $dir/cust_main.company: $!";
+
+ close COMPANY;
+ }
+
+ 1;
+}
+
+=item batch_import
+
+=cut
+
+sub batch_import {
+ my $param = shift;
+ #warn join('-',keys %$param);
+ my $fh = $param->{filehandle};
+ my $agentnum = $param->{agentnum};
+ my $refnum = $param->{refnum};
+ my $pkgpart = $param->{pkgpart};
+ my @fields = @{$param->{fields}};
+
+ eval "use Date::Parse;";
+ die $@ if $@;
+ eval "use Text::CSV_XS;";
+ die $@ if $@;
+
+ my $csv = new Text::CSV_XS;
+ #warn $csv;
+ #warn $fh;
+
+ my $imported = 0;
+ #my $columns;
+
+ 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;
+
+ #while ( $columns = $csv->getline($fh) ) {
+ my $line;
+ while ( defined($line=<$fh>) ) {
+
+ $csv->parse($line) or do {
+ $dbh->rollback if $oldAutoCommit;
+ return "can't parse: ". $csv->error_input();
+ };
+
+ my @columns = $csv->fields();
+ #warn join('-',@columns);
+
+ my %cust_main = (
+ agentnum => $agentnum,
+ refnum => $refnum,
+ country => 'US', #default
+ payby => 'BILL', #default
+ paydate => '12/2037', #default
+ );
+ my $billtime = time;
+ my %cust_pkg = ( pkgpart => $pkgpart );
+ foreach my $field ( @fields ) {
+ if ( $field =~ /^cust_pkg\.(setup|bill|susp|expire|cancel)$/ ) {
+ #$cust_pkg{$1} = str2time( shift @$columns );
+ if ( $1 eq 'setup' ) {
+ $billtime = str2time(shift @columns);
+ } else {
+ $cust_pkg{$1} = str2time( shift @columns );
+ }
+ } else {
+ #$cust_main{$field} = shift @$columns;
+ $cust_main{$field} = shift @columns;
+ }
+ }
+
+ my $cust_pkg = new FS::cust_pkg ( \%cust_pkg ) if $pkgpart;
+ my $cust_main = new FS::cust_main ( \%cust_main );
+ use Tie::RefHash;
+ tie my %hash, 'Tie::RefHash'; #this part is important
+ $hash{$cust_pkg} = [] if $pkgpart;
+ my $error = $cust_main->insert( \%hash );
+
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "can't insert customer for $line: $error";
+ }
+
+ #false laziness w/bill.cgi
+ $error = $cust_main->bill( 'time' => $billtime );
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "can't bill customer for $line: $error";
+ }
+
+ $cust_main->apply_payments;
+ $cust_main->apply_credits;
+
+ $error = $cust_main->collect();
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "can't collect customer for $line: $error";
+ }
+
+ $imported++;
+ }
+
+ $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+
+ return "Empty file!" unless $imported;
+
+ ''; #no error
+
+}
+
+=item batch_charge
+
+=cut
+
+sub batch_charge {
+ my $param = shift;
+ #warn join('-',keys %$param);
+ my $fh = $param->{filehandle};
+ my @fields = @{$param->{fields}};
+
+ eval "use Date::Parse;";
+ die $@ if $@;
+ eval "use Text::CSV_XS;";
+ die $@ if $@;
+
+ my $csv = new Text::CSV_XS;
+ #warn $csv;
+ #warn $fh;
+
+ my $imported = 0;
+ #my $columns;
+
+ 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;
+
+ #while ( $columns = $csv->getline($fh) ) {
+ my $line;
+ while ( defined($line=<$fh>) ) {
+
+ $csv->parse($line) or do {
+ $dbh->rollback if $oldAutoCommit;
+ return "can't parse: ". $csv->error_input();
+ };
+
+ my @columns = $csv->fields();
+ #warn join('-',@columns);
+
+ my %row = ();
+ foreach my $field ( @fields ) {
+ $row{$field} = shift @columns;
+ }
+
+ my $cust_main = qsearchs('cust_main', { 'custnum' => $row{'custnum'} } );
+ unless ( $cust_main ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "unknown custnum $row{'custnum'}";
+ }
+
+ if ( $row{'amount'} > 0 ) {
+ my $error = $cust_main->charge($row{'amount'}, $row{'pkg'});
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+ $imported++;
+ } elsif ( $row{'amount'} < 0 ) {
+ my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ),
+ $row{'pkg'} );
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+ $imported++;
+ } else {
+ #hmm?
+ }
+
+ }
+
+ $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+
+ return "Empty file!" unless $imported;
+
+ ''; #no error
+
+}
+
+=back
=head1 BUGS
Bill and collect options should probably be passed as references instead of a
list.
-CyberCash v2 forces us to define some variables in package main.
-
There should probably be a configuration file with a list of allowed credit
card types.
-CyberCash is the only processor.
-
No multiple currency support (probably a larger project than just this module).
=head1 SEE ALSO
L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
-L<FS::cust_pay_batch>, L<FS::agent>, L<FS::part_referral>,
-L<FS::cust_main_county>, L<FS::cust_main_invoice>,
-L<FS::UID>, schema.html from the base documentation.
+L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
+L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.
=cut
projects / freeside.git / blobdiff