package FS::cust_main;
use strict;
-use vars qw( @ISA $conf $lpr $processor $xaction $E_NoErr $invoice_from
- $smtpmachine $Debug $bop_processor $bop_login $bop_password
- $bop_action @bop_options);
+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 Business::CreditCard;
use FS::UID qw( getotaker dbh );
use FS::Record qw( qsearchs qsearch dbdef );
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_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('business-onlinepayment') ) {
- ( $bop_processor,
- $bop_login,
- $bop_password,
- $bop_action,
- @bop_options
- ) = $conf->config('business-onlinepayment');
- $bop_action ||= 'normal authorization';
- eval "use Business::OnlinePayment";
- $processor="Business::OnlinePayment::$bop_processor";
- }
+ #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 ship_fax - phone (optional)
-=item payby - `CARD' (credit cards), `BILL' (billing), `COMP' (free), or `PREPAY' (special billing type: applies a credit - see L<FS::prepay_credit> and sets billing type to 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
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 (this requries a
-transactional database). 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:
+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
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 set set an
+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' ] );
sub insert {
my $self = shift;
- my @param = @_;
+ my $cust_pkgs = @_ ? shift : {};
+ my $invoicing_list = @_ ? shift : '';
local $SIG{HUP} = 'IGNORE';
local $SIG{INT} = 'IGNORE';
my $error = $self->SUPER::insert;
if ( $error ) {
$dbh->rollback if $oldAutoCommit;
- return "inserting cust_main record (transaction rolled back): $error";
+ #return "inserting cust_main record (transaction rolled back): $error";
+ return $error;
}
- if ( @param ) { # CUST_PKG_HASHREF
- my $cust_pkgs = shift @param;
- foreach my $cust_pkg ( keys %$cust_pkgs ) {
- $cust_pkg->custnum( $self->custnum );
- $error = $cust_pkg->insert;
+ # 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 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 "inserting svc_ (transaction rolled back): $error";
+ return $error;
}
}
}
return "No svc_acct record to apply pre-paid time";
}
- if ( @param ) { # INVOICING_LIST_ARYREF
- my $invoicing_list = shift @param;
- $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 );
- }
-
if ( $amount ) {
my $cust_credit = new FS::cust_credit {
'custnum' => $self->custnum,
}
}
+ #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 ) {
return "queueing job (transaction rolled back): $error";
}
}
+ #eslaf
$dbh->commit or die $dbh->errstr if $oldAutoCommit;
'';
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
$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 = qsearch( 'cust_pkg', { 'custnum' => $self->custnum } );
+ my @cust_pkg = $self->ncancelled_pkgs;
if ( @cust_pkg ) {
my $new_custnum = shift;
unless ( qsearchs( 'cust_main', { 'custnum' => $new_custnum } ) ) {
}
}
}
- foreach my $cust_main_invoice (
+ 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 ( #(email invoice destinations, not invoices)
qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } )
) {
my $error = $cust_main_invoice->delete;
$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;
'';
sub check {
my $self = shift;
+ #warn "BEFORE: \n". $self->_dump;
+
my $error =
$self->ut_numbern('custnum')
|| $self->ut_number('agentnum')
|| $self->ut_numbern('referral_custnum')
;
#barf. need message catalogs. i18n. etc.
- $error .= "Please select a referral."
+ $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 } );
return "Unknown referring custnum ". $self->referral_custnum
$self->ss("$1-$2-$3");
}
- 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,
- } );
- }
+
+# bad idea to disable, causes billing to fail because of no tax rates later
+# unless ( $import ) {
+ unless ( qsearch('cust_main_county', {
+ 'country' => $self->country,
+ 'state' => '',
+ } ) ) {
+ return "Unknown state/county/country: ".
+ $self->state. "/". $self->county. "/". $self->country
+ unless qsearch('cust_main_county',{
+ 'state' => $self->state,
+ 'county' => $self->county,
+ 'country' => $self->country,
+ } );
+ }
+# }
$error =
$self->ut_phonen('daytime', $self->country)
);
if ( defined $self->dbdef_table->column('ship_last') ) {
- if ( grep { $self->getfield($_) ne $self->getfield("ship_$_") } @addfields
- && grep $self->getfield("ship_$_"), grep $_ ne 'state', @addfields
+ if ( scalar ( grep { $self->getfield($_) ne $self->getfield("ship_$_") }
+ @addfields )
+ && scalar ( grep { $self->getfield("ship_$_") ne '' } @addfields )
)
{
my $error =
}
}
- $self->payby =~ /^(CARD|BILL|COMP|PREPAY)$/
+ $self->payby =~ /^(CARD|CHEK|LECB|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' ) {
if ( $self->paydate eq '' || $self->paydate eq '-' ) {
return "Expriation date required"
- unless $self->payby eq 'BILL' || $self->payby eq 'PREPAY';
+ 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");
- } 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;
- @{ [ # force list context
- 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
# & generate invoice database.
my( $total_setup, $total_recur ) = ( 0, 0 );
+ #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;
};
$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);
+ #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) ) {
$dbh->rollback if $oldAutoCommit;
- return "Error reval-ing part_pkg->setup pkgpart ". $part_pkg->pkgpart.
- ": $@";
+ return "Error eval-ing part_pkg->setup pkgpart ". $part_pkg->pkgpart.
+ "(expression $setup_prog): $@";
}
$cust_pkg->setfield('setup',$time);
$cust_pkg_mod_flag=1;
};
$recur_prog = $1;
- 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);
+ # 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) ) {
$dbh->rollback if $oldAutoCommit;
- return "Error reval-ing part_pkg->recur pkgpart ".
- $part_pkg->pkgpart. ": $@";
+ 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)
- #$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');
+
+ #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));
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
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 ) {
+ $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 );
+# my $taxable_charged = sprintf( "%.2f", $taxable_setup + $taxable_recur );
- unless ( @cust_bill_pkg ) {
+ 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' ) {
- 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 )
- );
+# 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->custnum,
my $invnum = $cust_bill->invnum;
my $cust_bill_pkg;
foreach $cust_bill_pkg ( @cust_bill_pkg ) {
- warn $cust_bill_pkg->invnum($invnum);
+ #warn $invnum;
+ $cust_bill_pkg->invnum($invnum);
$error = $cust_bill_pkg->insert;
if ( $error ) {
$dbh->rollback if $oldAutoCommit;
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.
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<FS::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.
-report_badcard - Set this true if you want bad card transactions to
-return an error. By default, they don't.
+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.
+
+force_print - This option is deprecated; see the invoice events web interface.
=cut
my $dbh = dbh;
my $balance = $self->balance;
- warn "collect: 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 (
- qsearch('cust_bill', { 'custnum' => $self->custnum, } )
- ) {
+ 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
+ }
+
+ foreach my $cust_bill ( $self->cust_bill ) {
#this has to be before next's
my $amount = sprintf( "%.2f", $balance < $cust_bill->owed
next unless $cust_bill->owed > 0;
# 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 } );
+ #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;
- 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";
- }
- 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;
+ 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'
}
- } 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;
+ #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 COMPing invnum #'. $cust_bill->invnum. ": $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;
}
- } elsif ( $self->payby eq 'CARD' ) {
-
- if ( $options{'batch_card'} ne 'yes' ) {
-
- unless ( $processor ) {
- $dbh->rollback if $oldAutoCommit;
- return "Real time card processing not enabled!";
- }
-
- my $address = $self->address1;
- $address .= ", ". $self->address2 if $self->address2;
-
- #fix exp. date
- #$self->paydate =~ /^(\d+)\/\d*(\d{2})$/;
- $self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
- my $exp = "$2/$1";
-
- if ( $processor eq 'cybercash3.2' ) {
-
- #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 $country = $self->country eq 'US' ? 'USA' : $self->country;
-
- 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;
- %result = &CCMckDirectLib3_2::SendCC2_1Server(@full_xaction);
-
- #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;
- if ( $error ) {
- # gah, even with transactions.
- $dbh->commit if $oldAutoCommit; #well.
- my $e = 'WARNING: Card debited but database not updated - '.
- 'error applying payment, invnum #' . $cust_bill->invnum.
- " (CyberCash Order-ID $paybatch): $error";
- warn $e;
- return $e;
- }
- } elsif ( $result{'Mstatus'} ne 'failure-bad-money'
- || $options{'report_badcard'} ) {
- $dbh->commit if $oldAutoCommit;
- return 'Cybercash error, invnum #' .
- $cust_bill->invnum. ':'. $result{'MErrMsg'};
- } else {
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
- return '';
- }
-
- } elsif ( $processor =~ /^Business::OnlinePayment::(.*)$/ ) {
-
- my $bop_processor = $1;
-
- my($payname, $payfirst, $paylast);
- if ( $self->payname ) {
- $payname = $self->payname;
- $payname =~ /^\s*([\w \,\.\-\']*\w)?\s+([\w\,\.\-\']+)$/
- or do {
- $dbh->rollback if $oldAutoCommit;
- return "Illegal payname $payname";
- };
- ($payfirst, $paylast) = ($1, $2);
- } else {
- $payfirst = $self->getfield('first');
- $paylast = $self->getfield('first');
- $payname = "$payfirst $paylast";
- }
-
- my @invoicing_list = grep { $_ ne 'POST' } $self->invoicing_list;
- if ( $conf->exists('emailinvoiceonly') ) {
- @invoicing_list = $self->default_invoicing_list
- unless @invoicing_list;
- }
- my $email = $invoicing_list[0];
-
- my( $action1, $action2 ) = split(/\s*\,\s*/, $bop_action );
-
- my $transaction =
- new Business::OnlinePayment( $bop_processor, @bop_options );
- $transaction->content(
- 'type' => 'CC',
- 'login' => $bop_login,
- 'password' => $bop_password,
- 'action' => $action1,
- 'description' => 'Internet Services',
- 'amount' => $amount,
- 'invoice_number' => $cust_bill->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,
- 'card_number' => $self->payinfo,
- 'expiration' => $exp,
- 'referer' => 'http://cleanwhisker.420.am/',
- 'email' => $email,
- );
- $transaction->submit();
-
- if ( $transaction->is_success() && $action2 ) {
- my $auth = $transaction->authorization;
- my $ordernum = $transaction->order_number;
- #warn "********* $auth ***********\n";
- #warn "********* $ordernum ***********\n";
- my $capture =
- new Business::OnlinePayment( $bop_processor, @bop_options );
-
- $capture->content(
- action => $action2,
- login => $bop_login,
- password => $bop_password,
- order_number => $ordernum,
- amount => $amount,
- authorization => $auth,
- description => 'Internet Services',
- );
-
- $capture->submit();
-
- unless ( $capture->is_success ) {
- my $e = "Authorization sucessful but capture failed, invnum #".
- $cust_bill->invnum. ': '. $capture->result_code.
- ": ". $capture->error_message;
- warn $e;
- return $e;
- }
-
- }
-
- if ( $transaction->is_success() ) {
-
- my $cust_pay = new FS::cust_pay ( {
- 'invnum' => $cust_bill->invnum,
- 'paid' => $amount,
- '_date' => '',
- 'payby' => 'CARD',
- 'payinfo' => $self->payinfo,
- 'paybatch' => "$processor:". $transaction->authorization,
- } );
- my $error = $cust_pay->insert;
- if ( $error ) {
- # gah, even with transactions.
- $dbh->commit if $oldAutoCommit; #well.
- my $e = 'WARNING: Card debited but database not updated - '.
- 'error applying payment, invnum #' . $cust_bill->invnum.
- " ($processor): $error";
- warn $e;
- return $e;
- }
- } elsif ( $options{'report_badcard'} ) {
- $dbh->commit if $oldAutoCommit;
- return "$processor error, invnum #". $cust_bill->invnum. ': '.
- $transaction->result_code. ": ". $transaction->error_message;
- } else {
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
- #return '';
- }
-
- } else {
- $dbh->rollback if $oldAutoCommit;
- return "Unknown 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;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "Error adding to cust_pay_batch: $error";
- }
-
- }
-
- } else {
- $dbh->rollback if $oldAutoCommit;
- return "Unknown payment type ". $self->payby;
}
}
+
$dbh->commit or die $dbh->errstr if $oldAutoCommit;
'';
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 );
}
- # return 0;
+ return $self->total_unapplied_payments;
}
=item total_credited
);
}
+=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 ]
If an arguement is given, sets these email addresses as invoice recipients
} 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 default_invoicing_list
+=item set_default_invoicing_list
+
+Sets the invoicing list to all accounts associated with this customer,
+overwriting any previous invoicing list.
=cut
-sub default_invoicing_list {
+sub set_default_invoicing_list {
my $self = shift;
- my @list = ();
+ $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;
- push @list, map { $_->email } @svc_acct;
+ $list{$_}=1 foreach map { $_->email } @svc_acct;
}
- $self->invoicing_list(\@list);
+ 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 ] ]
@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 SUBROUTINES
1;
}
-=head1 VERSION
+=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}};
-$Id: cust_main.pm,v 1.38 2001-09-26 09:17:06 ivan Exp $
+ 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.
=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