4 use vars qw( @ISA $conf $lpr $processor $xaction $E_NoErr $invoice_from
5 $smtpmachine $Debug $bop_processor $bop_login $bop_password
6 $bop_action @bop_options);
14 use Business::CreditCard;
15 use FS::UID qw( getotaker dbh );
16 use FS::Record qw( qsearchs qsearch dbdef );
19 use FS::cust_bill_pkg;
22 use FS::cust_pay_batch;
23 use FS::part_referral;
24 use FS::cust_main_county;
26 use FS::cust_main_invoice;
27 use FS::cust_credit_bill;
28 use FS::cust_bill_pay;
29 use FS::prepay_credit;
32 @ISA = qw( FS::Record );
37 #ask FS::UID to run this stuff for us later
38 $FS::UID::callback{'FS::cust_main'} = sub {
40 $lpr = $conf->config('lpr');
41 $invoice_from = $conf->config('invoice_from');
42 $smtpmachine = $conf->config('smtpmachine');
44 if ( $conf->exists('cybercash3.2') ) {
46 #qw($MCKversion %Config InitConfig CCError CCDebug CCDebug2);
47 require CCMckDirectLib3_2;
49 require CCMckErrno3_2;
50 #qw(MCKGetErrorMessage $E_NoErr);
51 import CCMckErrno3_2 qw($E_NoErr);
54 ($merchant_conf,$xaction)= $conf->config('cybercash3.2');
55 my $status = &CCMckLib3_2::InitConfig($merchant_conf);
56 if ( $status != $E_NoErr ) {
57 warn "CCMckLib3_2::InitConfig error:\n";
58 foreach my $key (keys %CCMckLib3_2::Config) {
59 warn " $key => $CCMckLib3_2::Config{$key}\n"
61 my($errmsg) = &CCMckErrno3_2::MCKGetErrorMessage($status);
62 die "CCMckLib3_2::InitConfig fatal error: $errmsg\n";
64 $processor='cybercash3.2';
65 } elsif ( $conf->exists('business-onlinepayment') ) {
71 ) = $conf->config('business-onlinepayment');
72 $bop_action ||= 'normal authorization';
73 eval "use Business::OnlinePayment";
74 $processor="Business::OnlinePayment::$bop_processor";
80 FS::cust_main - Object methods for cust_main records
86 $record = new FS::cust_main \%hash;
87 $record = new FS::cust_main { 'column' => 'value' };
89 $error = $record->insert;
91 $error = $new_record->replace($old_record);
93 $error = $record->delete;
95 $error = $record->check;
97 @cust_pkg = $record->all_pkgs;
99 @cust_pkg = $record->ncancelled_pkgs;
101 $error = $record->bill;
102 $error = $record->bill %options;
103 $error = $record->bill 'time' => $time;
105 $error = $record->collect;
106 $error = $record->collect %options;
107 $error = $record->collect 'invoice_time' => $time,
108 'batch_card' => 'yes',
109 'report_badcard' => 'yes',
114 An FS::cust_main object represents a customer. FS::cust_main inherits from
115 FS::Record. The following fields are currently supported:
119 =item custnum - primary key (assigned automatically for new customers)
121 =item agentnum - agent (see L<FS::agent>)
123 =item refnum - referral (see L<FS::part_referral>)
129 =item ss - social security number (optional)
131 =item company - (optional)
135 =item address2 - (optional)
139 =item county - (optional, see L<FS::cust_main_county>)
141 =item state - (see L<FS::cust_main_county>)
145 =item country - (see L<FS::cust_main_county>)
147 =item daytime - phone (optional)
149 =item night - phone (optional)
151 =item fax - phone (optional)
153 =item ship_first - name
155 =item ship_last - name
157 =item ship_company - (optional)
161 =item ship_address2 - (optional)
165 =item ship_county - (optional, see L<FS::cust_main_county>)
167 =item ship_state - (see L<FS::cust_main_county>)
171 =item ship_country - (see L<FS::cust_main_county>)
173 =item ship_daytime - phone (optional)
175 =item ship_night - phone (optional)
177 =item ship_fax - phone (optional)
179 =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)
181 =item payinfo - card number, P.O., comp issuer (4-8 lowercase alphanumerics; think username) or prepayment identifier (see L<FS::prepay_credit>)
183 =item paydate - expiration date, mm/yyyy, m/yyyy, mm/yy or m/yy
185 =item payname - name on card or billing name
187 =item tax - tax exempt, empty or `Y'
189 =item otaker - order taker (assigned automatically, see L<FS::UID>)
191 =item comments - comments (optional)
201 Creates a new customer. To add the customer to the database, see L<"insert">.
203 Note that this stores the hash reference, not a distinct copy of the hash it
204 points to. You can ask the object for a copy with the I<hash> method.
208 sub table { 'cust_main'; }
210 =item insert [ CUST_PKG_HASHREF [ , INVOICING_LIST_ARYREF ] ]
212 Adds this customer to the database. If there is an error, returns the error,
213 otherwise returns false.
215 CUST_PKG_HASHREF: If you pass a Tie::RefHash data structure to the insert
216 method containing FS::cust_pkg and FS::svc_I<tablename> objects, all records
217 are inserted atomicly, or the transaction is rolled back (this requries a
218 transactional database). Passing an empty hash reference is equivalent to
219 not supplying this parameter. There should be a better explanation of this,
220 but until then, here's an example:
223 tie %hash, 'Tie::RefHash'; #this part is important
225 $cust_pkg => [ $svc_acct ],
228 $cust_main->insert( \%hash );
230 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
231 be set as the invoicing list (see L<"invoicing_list">). Errors return as
232 expected and rollback the entire transaction; it is not necessary to call
233 check_invoicing_list first. The invoicing_list is set after the records in the
234 CUST_PKG_HASHREF above are inserted, so it is now possible set set an
235 invoicing_list destination to the newly-created svc_acct. Here's an example:
237 $cust_main->insert( {}, [ $email, 'POST' ] );
245 local $SIG{HUP} = 'IGNORE';
246 local $SIG{INT} = 'IGNORE';
247 local $SIG{QUIT} = 'IGNORE';
248 local $SIG{TERM} = 'IGNORE';
249 local $SIG{TSTP} = 'IGNORE';
250 local $SIG{PIPE} = 'IGNORE';
252 my $oldAutoCommit = $FS::UID::AutoCommit;
253 local $FS::UID::AutoCommit = 0;
258 if ( $self->payby eq 'PREPAY' ) {
259 $self->payby('BILL');
260 my $prepay_credit = qsearchs(
262 { 'identifier' => $self->payinfo },
266 warn "WARNING: can't find pre-found prepay_credit: ". $self->payinfo
267 unless $prepay_credit;
268 $amount = $prepay_credit->amount;
269 $seconds = $prepay_credit->seconds;
270 my $error = $prepay_credit->delete;
272 $dbh->rollback if $oldAutoCommit;
273 return "removing prepay_credit (transaction rolled back): $error";
277 my $error = $self->SUPER::insert;
279 $dbh->rollback if $oldAutoCommit;
280 return "inserting cust_main record (transaction rolled back): $error";
283 if ( @param ) { # CUST_PKG_HASHREF
284 my $cust_pkgs = shift @param;
285 foreach my $cust_pkg ( keys %$cust_pkgs ) {
286 $cust_pkg->custnum( $self->custnum );
287 $error = $cust_pkg->insert;
289 $dbh->rollback if $oldAutoCommit;
290 return "inserting cust_pkg (transaction rolled back): $error";
292 foreach my $svc_something ( @{$cust_pkgs->{$cust_pkg}} ) {
293 $svc_something->pkgnum( $cust_pkg->pkgnum );
294 if ( $seconds && $svc_something->isa('FS::svc_acct') ) {
295 $svc_something->seconds( $svc_something->seconds + $seconds );
298 $error = $svc_something->insert;
300 $dbh->rollback if $oldAutoCommit;
301 return "inserting svc_ (transaction rolled back): $error";
308 $dbh->rollback if $oldAutoCommit;
309 return "No svc_acct record to apply pre-paid time";
312 if ( @param ) { # INVOICING_LIST_ARYREF
313 my $invoicing_list = shift @param;
314 $error = $self->check_invoicing_list( $invoicing_list );
316 $dbh->rollback if $oldAutoCommit;
317 return "checking invoicing_list (transaction rolled back): $error";
319 $self->invoicing_list( $invoicing_list );
323 my $cust_credit = new FS::cust_credit {
324 'custnum' => $self->custnum,
327 $error = $cust_credit->insert;
329 $dbh->rollback if $oldAutoCommit;
330 return "inserting credit (transaction rolled back): $error";
334 my $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
335 $error = $queue->insert($self->getfield('last'), $self->company);
337 $dbh->rollback if $oldAutoCommit;
338 return "queueing job (transaction rolled back): $error";
341 if ( defined $self->dbdef_table->column('ship_last') && $self->ship_last ) {
342 $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
343 $error = $queue->insert($self->getfield('last'), $self->company);
345 $dbh->rollback if $oldAutoCommit;
346 return "queueing job (transaction rolled back): $error";
350 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
355 =item delete NEW_CUSTNUM
357 This deletes the customer. If there is an error, returns the error, otherwise
360 This will completely remove all traces of the customer record. This is not
361 what you want when a customer cancels service; for that, cancel all of the
362 customer's packages (see L<FS::cust_pkg/cancel>).
364 If the customer has any packages, you need to pass a new (valid) customer
365 number for those packages to be transferred to.
367 You can't delete a customer with invoices (see L<FS::cust_bill>),
368 or credits (see L<FS::cust_credit>).
375 local $SIG{HUP} = 'IGNORE';
376 local $SIG{INT} = 'IGNORE';
377 local $SIG{QUIT} = 'IGNORE';
378 local $SIG{TERM} = 'IGNORE';
379 local $SIG{TSTP} = 'IGNORE';
380 local $SIG{PIPE} = 'IGNORE';
382 my $oldAutoCommit = $FS::UID::AutoCommit;
383 local $FS::UID::AutoCommit = 0;
386 if ( qsearch( 'cust_bill', { 'custnum' => $self->custnum } ) ) {
387 $dbh->rollback if $oldAutoCommit;
388 return "Can't delete a customer with invoices";
390 if ( qsearch( 'cust_credit', { 'custnum' => $self->custnum } ) ) {
391 $dbh->rollback if $oldAutoCommit;
392 return "Can't delete a customer with credits";
395 my @cust_pkg = qsearch( 'cust_pkg', { 'custnum' => $self->custnum } );
397 my $new_custnum = shift;
398 unless ( qsearchs( 'cust_main', { 'custnum' => $new_custnum } ) ) {
399 $dbh->rollback if $oldAutoCommit;
400 return "Invalid new customer number: $new_custnum";
402 foreach my $cust_pkg ( @cust_pkg ) {
403 my %hash = $cust_pkg->hash;
404 $hash{'custnum'} = $new_custnum;
405 my $new_cust_pkg = new FS::cust_pkg ( \%hash );
406 my $error = $new_cust_pkg->replace($cust_pkg);
408 $dbh->rollback if $oldAutoCommit;
413 foreach my $cust_main_invoice (
414 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } )
416 my $error = $cust_main_invoice->delete;
418 $dbh->rollback if $oldAutoCommit;
423 my $error = $self->SUPER::delete;
425 $dbh->rollback if $oldAutoCommit;
429 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
434 =item replace OLD_RECORD [ INVOICING_LIST_ARYREF ]
436 Replaces the OLD_RECORD with this one in the database. If there is an error,
437 returns the error, otherwise returns false.
439 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
440 be set as the invoicing list (see L<"invoicing_list">). Errors return as
441 expected and rollback the entire transaction; it is not necessary to call
442 check_invoicing_list first. Here's an example:
444 $new_cust_main->replace( $old_cust_main, [ $email, 'POST' ] );
453 local $SIG{HUP} = 'IGNORE';
454 local $SIG{INT} = 'IGNORE';
455 local $SIG{QUIT} = 'IGNORE';
456 local $SIG{TERM} = 'IGNORE';
457 local $SIG{TSTP} = 'IGNORE';
458 local $SIG{PIPE} = 'IGNORE';
460 my $oldAutoCommit = $FS::UID::AutoCommit;
461 local $FS::UID::AutoCommit = 0;
464 my $error = $self->SUPER::replace($old);
467 $dbh->rollback if $oldAutoCommit;
471 if ( @param ) { # INVOICING_LIST_ARYREF
472 my $invoicing_list = shift @param;
473 $error = $self->check_invoicing_list( $invoicing_list );
475 $dbh->rollback if $oldAutoCommit;
478 $self->invoicing_list( $invoicing_list );
481 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
488 Checks all fields to make sure this is a valid customer record. If there is
489 an error, returns the error, otherwise returns false. Called by the insert
498 $self->ut_numbern('custnum')
499 || $self->ut_number('agentnum')
500 || $self->ut_number('refnum')
501 || $self->ut_name('last')
502 || $self->ut_name('first')
503 || $self->ut_textn('company')
504 || $self->ut_text('address1')
505 || $self->ut_textn('address2')
506 || $self->ut_text('city')
507 || $self->ut_textn('county')
508 || $self->ut_textn('state')
509 || $self->ut_country('country')
510 || $self->ut_anything('comments')
511 || $self->ut_numbern('referral_custnum')
513 #barf. need message catalogs. i18n. etc.
514 $error .= "Please select a referral."
515 if $error =~ /^Illegal or empty \(numeric\) refnum: /;
516 return $error if $error;
518 return "Unknown agent"
519 unless qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
521 return "Unknown referral"
522 unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } );
524 return "Unknown referring custnum ". $self->referral_custnum
525 unless ! $self->referral_custnum
526 || qsearchs( 'cust_main', { 'custnum' => $self->referral_custnum } );
528 if ( $self->ss eq '' ) {
533 $ss =~ /^(\d{3})(\d{2})(\d{4})$/
534 or return "Illegal social security number: ". $self->ss;
535 $self->ss("$1-$2-$3");
538 unless ( qsearchs('cust_main_county', {
539 'country' => $self->country,
542 return "Unknown state/county/country: ".
543 $self->state. "/". $self->county. "/". $self->country
544 unless qsearchs('cust_main_county',{
545 'state' => $self->state,
546 'county' => $self->county,
547 'country' => $self->country,
552 $self->ut_phonen('daytime', $self->country)
553 || $self->ut_phonen('night', $self->country)
554 || $self->ut_phonen('fax', $self->country)
555 || $self->ut_zip('zip', $self->country)
557 return $error if $error;
560 last first company address1 address2 city county state zip
561 country daytime night fax
564 if ( defined $self->dbdef_table->column('ship_last') ) {
565 if ( grep { $self->getfield($_) ne $self->getfield("ship_$_") } @addfields
566 && grep $self->getfield("ship_$_"), grep $_ ne 'state', @addfields
570 $self->ut_name('ship_last')
571 || $self->ut_name('ship_first')
572 || $self->ut_textn('ship_company')
573 || $self->ut_text('ship_address1')
574 || $self->ut_textn('ship_address2')
575 || $self->ut_text('ship_city')
576 || $self->ut_textn('ship_county')
577 || $self->ut_textn('ship_state')
578 || $self->ut_country('ship_country')
580 return $error if $error;
582 #false laziness with above
583 unless ( qsearchs('cust_main_county', {
584 'country' => $self->ship_country,
587 return "Unknown ship_state/ship_county/ship_country: ".
588 $self->ship_state. "/". $self->ship_county. "/". $self->ship_country
589 unless qsearchs('cust_main_county',{
590 'state' => $self->ship_state,
591 'county' => $self->ship_county,
592 'country' => $self->ship_country,
598 $self->ut_phonen('ship_daytime', $self->ship_country)
599 || $self->ut_phonen('ship_night', $self->ship_country)
600 || $self->ut_phonen('ship_fax', $self->ship_country)
601 || $self->ut_zip('ship_zip', $self->ship_country)
603 return $error if $error;
605 } else { # ship_ info eq billing info, so don't store dup info in database
606 $self->setfield("ship_$_", '')
607 foreach qw( last first company address1 address2 city county state zip
608 country daytime night fax );
612 $self->payby =~ /^(CARD|BILL|COMP|PREPAY)$/
613 or return "Illegal payby: ". $self->payby;
616 if ( $self->payby eq 'CARD' ) {
618 my $payinfo = $self->payinfo;
620 $payinfo =~ /^(\d{13,16})$/
621 or return "Illegal credit card number: ". $self->payinfo;
623 $self->payinfo($payinfo);
625 or return "Illegal credit card number: ". $self->payinfo;
626 return "Unknown card type" if cardtype($self->payinfo) eq "Unknown";
628 } elsif ( $self->payby eq 'BILL' ) {
630 $error = $self->ut_textn('payinfo');
631 return "Illegal P.O. number: ". $self->payinfo if $error;
633 } elsif ( $self->payby eq 'COMP' ) {
635 $error = $self->ut_textn('payinfo');
636 return "Illegal comp account issuer: ". $self->payinfo if $error;
638 } elsif ( $self->payby eq 'PREPAY' ) {
640 my $payinfo = $self->payinfo;
641 $payinfo =~ s/\W//g; #anything else would just confuse things
642 $self->payinfo($payinfo);
643 $error = $self->ut_alpha('payinfo');
644 return "Illegal prepayment identifier: ". $self->payinfo if $error;
645 return "Unknown prepayment identifier"
646 unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } );
650 if ( $self->paydate eq '' || $self->paydate eq '-' ) {
651 return "Expriation date required"
652 unless $self->payby eq 'BILL' || $self->payby eq 'PREPAY';
655 $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/
656 or return "Illegal expiration date: ". $self->paydate;
657 if ( length($2) == 4 ) {
658 $self->paydate("$2-$1-01");
660 $self->paydate("20$2-$1-01");
664 if ( $self->payname eq '' ) {
665 $self->payname( $self->first. " ". $self->getfield('last') );
667 $self->payname =~ /^([\w \,\.\-\']+)$/
668 or return "Illegal billing name: ". $self->payname;
672 $self->tax =~ /^(Y?)$/ or return "Illegal tax: ". $self->tax;
675 $self->otaker(getotaker);
682 Returns all packages (see L<FS::cust_pkg>) for this customer.
688 qsearch( 'cust_pkg', { 'custnum' => $self->custnum });
691 =item ncancelled_pkgs
693 Returns all non-cancelled packages (see L<FS::cust_pkg>) for this customer.
697 sub ncancelled_pkgs {
699 @{ [ # force list context
700 qsearch( 'cust_pkg', {
701 'custnum' => $self->custnum,
704 qsearch( 'cust_pkg', {
705 'custnum' => $self->custnum,
713 Generates invoices (see L<FS::cust_bill>) for this customer. Usually used in
714 conjunction with the collect method.
716 Options are passed as name-value pairs.
718 The only currently available option is `time', which bills the customer as if
719 it were that time. It is specified as a UNIX timestamp; see
720 L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion
721 functions. For example:
725 $cust_main->bill( 'time' => str2time('April 20th, 2001') );
727 If there is an error, returns the error, otherwise returns false.
732 my( $self, %options ) = @_;
733 my $time = $options{'time'} || time;
738 local $SIG{HUP} = 'IGNORE';
739 local $SIG{INT} = 'IGNORE';
740 local $SIG{QUIT} = 'IGNORE';
741 local $SIG{TERM} = 'IGNORE';
742 local $SIG{TSTP} = 'IGNORE';
743 local $SIG{PIPE} = 'IGNORE';
745 my $oldAutoCommit = $FS::UID::AutoCommit;
746 local $FS::UID::AutoCommit = 0;
749 # find the packages which are due for billing, find out how much they are
750 # & generate invoice database.
752 my( $total_setup, $total_recur ) = ( 0, 0 );
753 my @cust_bill_pkg = ();
755 foreach my $cust_pkg (
756 qsearch('cust_pkg',{'custnum'=> $self->getfield('custnum') } )
759 next if $cust_pkg->getfield('cancel');
761 #? to avoid use of uninitialized value errors... ?
762 $cust_pkg->setfield('bill', '')
763 unless defined($cust_pkg->bill);
765 my $part_pkg = qsearchs( 'part_pkg', { 'pkgpart' => $cust_pkg->pkgpart } );
767 #so we don't modify cust_pkg record unnecessarily
768 my $cust_pkg_mod_flag = 0;
769 my %hash = $cust_pkg->hash;
770 my $old_cust_pkg = new FS::cust_pkg \%hash;
774 unless ( $cust_pkg->setup ) {
775 my $setup_prog = $part_pkg->getfield('setup');
776 $setup_prog =~ /^(.*)$/ or do {
777 $dbh->rollback if $oldAutoCommit;
778 return "Illegal setup for pkgpart ". $part_pkg->pkgpart.
784 #$cpt->permit(); #what is necessary?
785 $cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
786 $setup = $cpt->reval($setup_prog);
787 unless ( defined($setup) ) {
788 $dbh->rollback if $oldAutoCommit;
789 return "Error reval-ing part_pkg->setup pkgpart ". $part_pkg->pkgpart.
792 $cust_pkg->setfield('setup',$time);
793 $cust_pkg_mod_flag=1;
799 if ( $part_pkg->getfield('freq') > 0 &&
800 ! $cust_pkg->getfield('susp') &&
801 ( $cust_pkg->getfield('bill') || 0 ) < $time
803 my $recur_prog = $part_pkg->getfield('recur');
804 $recur_prog =~ /^(.*)$/ or do {
805 $dbh->rollback if $oldAutoCommit;
806 return "Illegal recur for pkgpart ". $part_pkg->pkgpart.
812 #$cpt->permit(); #what is necessary?
813 $cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
814 $recur = $cpt->reval($recur_prog);
815 unless ( defined($recur) ) {
816 $dbh->rollback if $oldAutoCommit;
817 return "Error reval-ing part_pkg->recur pkgpart ".
818 $part_pkg->pkgpart. ": $@";
820 #change this bit to use Date::Manip? CAREFUL with timezones (see
821 # mailing list archive)
822 #$sdate=$cust_pkg->bill || time;
823 #$sdate=$cust_pkg->bill || $time;
824 $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
825 my ($sec,$min,$hour,$mday,$mon,$year) =
826 (localtime($sdate) )[0,1,2,3,4,5];
827 $mon += $part_pkg->getfield('freq');
828 until ( $mon < 12 ) { $mon -= 12; $year++; }
829 $cust_pkg->setfield('bill',
830 timelocal($sec,$min,$hour,$mday,$mon,$year));
831 $cust_pkg_mod_flag = 1;
834 warn "\$setup is undefined" unless defined($setup);
835 warn "\$recur is undefined" unless defined($recur);
836 warn "\$cust_pkg->bill is undefined" unless defined($cust_pkg->bill);
838 if ( $cust_pkg_mod_flag ) {
839 $error=$cust_pkg->replace($old_cust_pkg);
840 if ( $error ) { #just in case
841 $dbh->rollback if $oldAutoCommit;
842 return "Error modifying pkgnum ". $cust_pkg->pkgnum. ": $error";
844 $setup = sprintf( "%.2f", $setup );
845 $recur = sprintf( "%.2f", $recur );
847 $dbh->rollback if $oldAutoCommit;
848 return "negative setup $setup for pkgnum ". $cust_pkg->pkgnum;
851 $dbh->rollback if $oldAutoCommit;
852 return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum;
854 if ( $setup > 0 || $recur > 0 ) {
855 my $cust_bill_pkg = new FS::cust_bill_pkg ({
856 'pkgnum' => $cust_pkg->pkgnum,
860 'edate' => $cust_pkg->bill,
862 push @cust_bill_pkg, $cust_bill_pkg;
863 $total_setup += $setup;
864 $total_recur += $recur;
870 my $charged = sprintf( "%.2f", $total_setup + $total_recur );
872 unless ( @cust_bill_pkg ) {
873 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
877 unless ( $self->tax =~ /Y/i || $self->payby eq 'COMP' ) {
878 my $cust_main_county = qsearchs('cust_main_county',{
879 'state' => $self->state,
880 'county' => $self->county,
881 'country' => $self->country,
883 my $tax = sprintf( "%.2f",
884 $charged * ( $cust_main_county->getfield('tax') / 100 )
886 $charged = sprintf( "%.2f", $charged+$tax );
888 my $cust_bill_pkg = new FS::cust_bill_pkg ({
895 push @cust_bill_pkg, $cust_bill_pkg;
898 my $cust_bill = new FS::cust_bill ( {
899 'custnum' => $self->custnum,
901 'charged' => $charged,
903 $error = $cust_bill->insert;
905 $dbh->rollback if $oldAutoCommit;
906 return "can't create invoice for customer #". $self->custnum. ": $error";
909 my $invnum = $cust_bill->invnum;
911 foreach $cust_bill_pkg ( @cust_bill_pkg ) {
912 warn $cust_bill_pkg->invnum($invnum);
913 $error = $cust_bill_pkg->insert;
915 $dbh->rollback if $oldAutoCommit;
916 return "can't create invoice line item for customer #". $self->custnum.
921 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
925 =item collect OPTIONS
927 (Attempt to) collect money for this customer's outstanding invoices (see
928 L<FS::cust_bill>). Usually used after the bill method.
930 Depending on the value of `payby', this may print an invoice (`BILL'), charge
931 a credit card (`CARD'), or just add any necessary (pseudo-)payment (`COMP').
933 If there is an error, returns the error, otherwise returns false.
935 Options are passed as name-value pairs.
937 Currently available options are:
939 invoice_time - Use this time when deciding when to print invoices and
940 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>
941 for conversion functions.
943 batch_card - Set this true to batch cards (see L<cust_pay_batch>). By
944 default, cards are processed immediately, which will generate an error if
945 CyberCash is not installed.
947 report_badcard - Set this true if you want bad card transactions to
948 return an error. By default, they don't.
953 my( $self, %options ) = @_;
954 my $invoice_time = $options{'invoice_time'} || time;
957 local $SIG{HUP} = 'IGNORE';
958 local $SIG{INT} = 'IGNORE';
959 local $SIG{QUIT} = 'IGNORE';
960 local $SIG{TERM} = 'IGNORE';
961 local $SIG{TSTP} = 'IGNORE';
962 local $SIG{PIPE} = 'IGNORE';
964 my $oldAutoCommit = $FS::UID::AutoCommit;
965 local $FS::UID::AutoCommit = 0;
968 my $balance = $self->balance;
969 warn "collect: balance $balance" if $Debug;
970 unless ( $balance > 0 ) { #redundant?????
971 $dbh->rollback if $oldAutoCommit; #hmm
975 foreach my $cust_bill (
976 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
979 #this has to be before next's
980 my $amount = sprintf( "%.2f", $balance < $cust_bill->owed
984 $balance = sprintf( "%.2f", $balance - $amount );
986 next unless $cust_bill->owed > 0;
988 # don't try to charge for the same invoice if it's already in a batch
989 next if qsearchs( 'cust_pay_batch', { 'invnum' => $cust_bill->invnum } );
991 warn "invnum ". $cust_bill->invnum. " (owed ". $cust_bill->owed. ", amount $amount, balance $balance)" if $Debug;
993 next unless $amount > 0;
995 if ( $self->payby eq 'BILL' ) {
998 my $since = $invoice_time - ( $cust_bill->_date || 0 );
999 #warn "$invoice_time ", $cust_bill->_date, " $since";
1000 if ( $since >= 0 #don't print future invoices
1001 && ( $cust_bill->printed * 2592000 ) <= $since
1004 #my @print_text = $cust_bill->print_text; #( date )
1005 my @invoicing_list = $self->invoicing_list;
1006 if ( grep { $_ ne 'POST' } @invoicing_list ) { #email invoice
1007 $ENV{SMTPHOSTS} = $smtpmachine;
1008 $ENV{MAILADDRESS} = $invoice_from;
1009 my $header = new Mail::Header ( [
1010 "From: $invoice_from",
1011 "To: ". join(', ', grep { $_ ne 'POST' } @invoicing_list ),
1012 "Sender: $invoice_from",
1013 "Reply-To: $invoice_from",
1014 "Date: ". time2str("%a, %d %b %Y %X %z", time),
1017 my $message = new Mail::Internet (
1018 'Header' => $header,
1019 'Body' => [ $cust_bill->print_text ], #( date)
1021 $message->smtpsend or die "Can't send invoice email!"; #die? warn?
1023 } elsif ( ! @invoicing_list || grep { $_ eq 'POST' } @invoicing_list ) {
1024 open(LPR, "|$lpr") or die "Can't open pipe to $lpr: $!";
1025 print LPR $cust_bill->print_text; #( date )
1027 or die $! ? "Error closing $lpr: $!"
1028 : "Exit status $? from $lpr";
1031 my %hash = $cust_bill->hash;
1033 my $new_cust_bill = new FS::cust_bill(\%hash);
1034 my $error = $new_cust_bill->replace($cust_bill);
1035 warn "Error updating $cust_bill->printed: $error" if $error;
1039 } elsif ( $self->payby eq 'COMP' ) {
1040 my $cust_pay = new FS::cust_pay ( {
1041 'invnum' => $cust_bill->invnum,
1045 'payinfo' => $self->payinfo,
1048 my $error = $cust_pay->insert;
1050 $dbh->rollback if $oldAutoCommit;
1051 return 'Error COMPing invnum #'. $cust_bill->invnum. ": $error";
1055 } elsif ( $self->payby eq 'CARD' ) {
1057 if ( $options{'batch_card'} ne 'yes' ) {
1059 unless ( $processor ) {
1060 $dbh->rollback if $oldAutoCommit;
1061 return "Real time card processing not enabled!";
1064 my $address = $self->address1;
1065 $address .= ", ". $self->address2 if $self->address2;
1068 #$self->paydate =~ /^(\d+)\/\d*(\d{2})$/;
1069 $self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
1072 if ( $processor eq 'cybercash3.2' ) {
1074 #fix exp. date for cybercash
1075 #$self->paydate =~ /^(\d+)\/\d*(\d{2})$/;
1076 $self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
1079 my $paybatch = $cust_bill->invnum.
1080 '-' . time2str("%y%m%d%H%M%S", time);
1082 my $payname = $self->payname ||
1083 $self->getfield('first'). ' '. $self->getfield('last');
1086 my $country = $self->country eq 'US' ? 'USA' : $self->country;
1088 my @full_xaction = ( $xaction,
1089 'Order-ID' => $paybatch,
1090 'Amount' => "usd $amount",
1091 'Card-Number' => $self->getfield('payinfo'),
1092 'Card-Name' => $payname,
1093 'Card-Address' => $address,
1094 'Card-City' => $self->getfield('city'),
1095 'Card-State' => $self->getfield('state'),
1096 'Card-Zip' => $self->getfield('zip'),
1097 'Card-Country' => $country,
1102 %result = &CCMckDirectLib3_2::SendCC2_1Server(@full_xaction);
1104 #if ( $result{'MActionCode'} == 7 ) { #cybercash smps v.1.1.3
1105 #if ( $result{'action-code'} == 7 ) { #cybercash smps v.2.1
1106 if ( $result{'MStatus'} eq 'success' ) { #cybercash smps v.2 or 3
1107 my $cust_pay = new FS::cust_pay ( {
1108 'invnum' => $cust_bill->invnum,
1112 'payinfo' => $self->payinfo,
1113 'paybatch' => "$processor:$paybatch",
1115 my $error = $cust_pay->insert;
1117 # gah, even with transactions.
1118 $dbh->commit if $oldAutoCommit; #well.
1119 my $e = 'WARNING: Card debited but database not updated - '.
1120 'error applying payment, invnum #' . $cust_bill->invnum.
1121 " (CyberCash Order-ID $paybatch): $error";
1125 } elsif ( $result{'Mstatus'} ne 'failure-bad-money'
1126 || $options{'report_badcard'} ) {
1127 $dbh->commit if $oldAutoCommit;
1128 return 'Cybercash error, invnum #' .
1129 $cust_bill->invnum. ':'. $result{'MErrMsg'};
1131 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1135 } elsif ( $processor =~ /^Business::OnlinePayment::(.*)$/ ) {
1137 my $bop_processor = $1;
1139 my($payname, $payfirst, $paylast);
1140 if ( $self->payname ) {
1141 $payname = $self->payname;
1142 $payname =~ /^\s*([\w \,\.\-\']*\w)?\s+([\w\,\.\-\']+)$/
1144 $dbh->rollback if $oldAutoCommit;
1145 return "Illegal payname $payname";
1147 ($payfirst, $paylast) = ($1, $2);
1149 $payfirst = $self->getfield('first');
1150 $paylast = $self->getfield('first');
1151 $payname = "$payfirst $paylast";
1155 new Business::OnlinePayment( $bop_processor, @bop_options );
1156 $transaction->content(
1158 'login' => $bop_login,
1159 'password' => $bop_password,
1160 'action' => $bop_action,
1161 'amount' => $amount,
1162 'invoice_number' => $cust_bill->invnum,
1163 'customer_id' => $self->custnum,
1164 'last_name' => $paylast,
1165 'first_name' => $payfirst,
1167 'address' => $address,
1168 'city' => $self->city,
1169 'state' => $self->state,
1170 'zip' => $self->zip,
1171 'country' => $self->country,
1172 'card_number' => $self->payinfo,
1173 'expiration' => $exp,
1175 $transaction->submit();
1177 if ( $transaction->is_success()) {
1178 my $cust_pay = new FS::cust_pay ( {
1179 'invnum' => $cust_bill->invnum,
1183 'payinfo' => $self->payinfo,
1184 'paybatch' => "$processor:". $transaction->authorization,
1186 my $error = $cust_pay->insert;
1188 # gah, even with transactions.
1189 $dbh->commit if $oldAutoCommit; #well.
1190 my $e = 'WARNING: Card debited but database not updated - '.
1191 'error applying payment, invnum #' . $cust_bill->invnum.
1192 " ($processor): $error";
1196 } elsif ( $options{'report_badcard'} ) {
1197 $dbh->commit if $oldAutoCommit;
1198 return "$processor error, invnum #". $cust_bill->invnum. ': '.
1199 $transaction->result_code. ": ". $transaction->error_message;
1201 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1206 $dbh->rollback if $oldAutoCommit;
1207 return "Unknown real-time processor $processor\n";
1210 } else { #batch card
1212 my $cust_pay_batch = new FS::cust_pay_batch ( {
1213 'invnum' => $cust_bill->getfield('invnum'),
1214 'custnum' => $self->getfield('custnum'),
1215 'last' => $self->getfield('last'),
1216 'first' => $self->getfield('first'),
1217 'address1' => $self->getfield('address1'),
1218 'address2' => $self->getfield('address2'),
1219 'city' => $self->getfield('city'),
1220 'state' => $self->getfield('state'),
1221 'zip' => $self->getfield('zip'),
1222 'country' => $self->getfield('country'),
1224 'cardnum' => $self->getfield('payinfo'),
1225 'exp' => $self->getfield('paydate'),
1226 'payname' => $self->getfield('payname'),
1227 'amount' => $amount,
1229 my $error = $cust_pay_batch->insert;
1231 $dbh->rollback if $oldAutoCommit;
1232 return "Error adding to cust_pay_batch: $error";
1238 $dbh->rollback if $oldAutoCommit;
1239 return "Unknown payment type ". $self->payby;
1243 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1250 Returns the total owed for this customer on all invoices
1251 (see L<FS::cust_bill/owed>).
1258 foreach my $cust_bill ( qsearch('cust_bill', {
1259 'custnum' => $self->custnum,
1261 $total_bill += $cust_bill->owed;
1263 sprintf( "%.2f", $total_bill );
1268 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
1269 to outstanding invoice balances in chronological order and returns the value
1270 of any remaining unapplied credits available for refund
1271 (see L<FS::cust_refund>).
1278 return 0 unless $self->total_credited;
1280 my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
1281 qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
1283 my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
1284 qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
1288 foreach my $cust_bill ( @invoices ) {
1291 if ( !defined($credit) || $credit->credited == 0) {
1292 $credit = pop @credits or last;
1295 if ($cust_bill->owed >= $credit->credited) {
1296 $amount=$credit->credited;
1298 $amount=$cust_bill->owed;
1301 my $cust_credit_bill = new FS::cust_credit_bill ( {
1302 'crednum' => $credit->crednum,
1303 'invnum' => $cust_bill->invnum,
1304 'amount' => $amount,
1306 my $error = $cust_credit_bill->insert;
1307 die $error if $error;
1309 redo if ($cust_bill->owed > 0);
1313 return $self->total_credited;
1316 =item apply_payments
1318 Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
1319 to outstanding invoice balances in chronological order.
1321 #and returns the value of any remaining unapplied payments.
1325 sub apply_payments {
1330 my @payments = sort { $b->_date <=> $a->_date } ( grep { $_->unapplied > 0 }
1331 qsearch('cust_pay', { 'custnum' => $self->custnum } ) );
1333 my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
1334 qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
1338 foreach my $cust_bill ( @invoices ) {
1341 if ( !defined($payment) || $payment->unapplied == 0 ) {
1342 $payment = pop @payments or last;
1345 if ( $cust_bill->owed >= $payment->unapplied ) {
1346 $amount = $payment->unapplied;
1348 $amount = $cust_bill->owed;
1351 my $cust_bill_pay = new FS::cust_bill_pay ( {
1352 'paynum' => $payment->paynum,
1353 'invnum' => $cust_bill->invnum,
1354 'amount' => $amount,
1356 my $error = $cust_bill_pay->insert;
1357 die $error if $error;
1359 redo if ( $cust_bill->owed > 0);
1366 =item total_credited
1368 Returns the total outstanding credit (see L<FS::cust_credit>) for this
1369 customer. See L<FS::cust_credit/credited>.
1373 sub total_credited {
1375 my $total_credit = 0;
1376 foreach my $cust_credit ( qsearch('cust_credit', {
1377 'custnum' => $self->custnum,
1379 $total_credit += $cust_credit->credited;
1381 sprintf( "%.2f", $total_credit );
1384 =item total_unapplied_payments
1386 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
1387 See L<FS::cust_pay/unapplied>.
1391 sub total_unapplied_payments {
1393 my $total_unapplied = 0;
1394 foreach my $cust_pay ( qsearch('cust_pay', {
1395 'custnum' => $self->custnum,
1397 $total_unapplied += $cust_pay->unapplied;
1399 sprintf( "%.2f", $total_unapplied );
1404 Returns the balance for this customer (total_owed minus total_credited
1405 minus total_unapplied_payments).
1412 $self->total_owed - $self->total_credited - $self->total_unapplied_payments
1416 =item invoicing_list [ ARRAYREF ]
1418 If an arguement is given, sets these email addresses as invoice recipients
1419 (see L<FS::cust_main_invoice>). Errors are not fatal and are not reported
1420 (except as warnings), so use check_invoicing_list first.
1422 Returns a list of email addresses (with svcnum entries expanded).
1424 Note: You can clear the invoicing list by passing an empty ARRAYREF. You can
1425 check it without disturbing anything by passing nothing.
1427 This interface may change in the future.
1431 sub invoicing_list {
1432 my( $self, $arrayref ) = @_;
1434 my @cust_main_invoice;
1435 if ( $self->custnum ) {
1436 @cust_main_invoice =
1437 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1439 @cust_main_invoice = ();
1441 foreach my $cust_main_invoice ( @cust_main_invoice ) {
1442 #warn $cust_main_invoice->destnum;
1443 unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
1444 #warn $cust_main_invoice->destnum;
1445 my $error = $cust_main_invoice->delete;
1446 warn $error if $error;
1449 if ( $self->custnum ) {
1450 @cust_main_invoice =
1451 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1453 @cust_main_invoice = ();
1455 foreach my $address ( @{$arrayref} ) {
1456 unless ( grep { $address eq $_->address } @cust_main_invoice ) {
1457 my $cust_main_invoice = new FS::cust_main_invoice ( {
1458 'custnum' => $self->custnum,
1461 my $error = $cust_main_invoice->insert;
1462 warn $error if $error;
1466 if ( $self->custnum ) {
1468 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1474 =item check_invoicing_list ARRAYREF
1476 Checks these arguements as valid input for the invoicing_list method. If there
1477 is an error, returns the error, otherwise returns false.
1481 sub check_invoicing_list {
1482 my( $self, $arrayref ) = @_;
1483 foreach my $address ( @{$arrayref} ) {
1484 my $cust_main_invoice = new FS::cust_main_invoice ( {
1485 'custnum' => $self->custnum,
1488 my $error = $self->custnum
1489 ? $cust_main_invoice->check
1490 : $cust_main_invoice->checkdest
1492 return $error if $error;
1497 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
1499 Returns an array of customers referred by this customer (referral_custnum set
1500 to this custnum). If DEPTH is given, recurses up to the given depth, returning
1501 customers referred by customers referred by this customer and so on, inclusive.
1502 The default behavior is DEPTH 1 (no recursion).
1506 sub referral_cust_main {
1508 my $depth = @_ ? shift : 1;
1509 my $exclude = @_ ? shift : {};
1512 map { $exclude->{$_->custnum}++; $_; }
1513 grep { ! $exclude->{ $_->custnum } }
1514 qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
1518 map { $_->referral_cust_main($depth-1, $exclude) }
1531 =item check_and_rebuild_fuzzyfiles
1535 sub check_and_rebuild_fuzzyfiles {
1536 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1537 -e "$dir/cust_main.last" && -e "$dir/cust_main.company"
1538 or &rebuild_fuzzyfiles;
1541 =item rebuild_fuzzyfiles
1545 sub rebuild_fuzzyfiles {
1547 use Fcntl qw(:flock);
1549 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1553 open(LASTLOCK,">>$dir/cust_main.last")
1554 or die "can't open $dir/cust_main.last: $!";
1555 flock(LASTLOCK,LOCK_EX)
1556 or die "can't lock $dir/cust_main.last: $!";
1558 my @all_last = map $_->getfield('last'), qsearch('cust_main', {});
1560 grep $_, map $_->getfield('ship_last'), qsearch('cust_main',{})
1561 if defined dbdef->table('cust_main')->column('ship_last');
1563 open (LASTCACHE,">$dir/cust_main.last.tmp")
1564 or die "can't open $dir/cust_main.last.tmp: $!";
1565 print LASTCACHE join("\n", @all_last), "\n";
1566 close LASTCACHE or die "can't close $dir/cust_main.last.tmp: $!";
1568 rename "$dir/cust_main.last.tmp", "$dir/cust_main.last";
1573 open(COMPANYLOCK,">>$dir/cust_main.company")
1574 or die "can't open $dir/cust_main.company: $!";
1575 flock(COMPANYLOCK,LOCK_EX)
1576 or die "can't lock $dir/cust_main.company: $!";
1578 my @all_company = grep $_ ne '', map $_->company, qsearch('cust_main',{});
1580 grep $_ ne '', map $_->ship_company, qsearch('cust_main', {})
1581 if defined dbdef->table('cust_main')->column('ship_last');
1583 open (COMPANYCACHE,">$dir/cust_main.company.tmp")
1584 or die "can't open $dir/cust_main.company.tmp: $!";
1585 print COMPANYCACHE join("\n", @all_company), "\n";
1586 close COMPANYCACHE or die "can't close $dir/cust_main.company.tmp: $!";
1588 rename "$dir/cust_main.company.tmp", "$dir/cust_main.company";
1598 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1599 open(LASTCACHE,"<$dir/cust_main.last")
1600 or die "can't open $dir/cust_main.last: $!";
1601 my @array = split(/\n/, <LASTCACHE> );
1611 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1612 open(COMPANYCACHE,"<$dir/cust_main.company")
1613 or die "can't open $dir/cust_main.last: $!";
1614 my @array = split(/\n/, <COMPANYCACHE> );
1619 =item append_fuzzyfiles LASTNAME COMPANY
1623 sub append_fuzzyfiles {
1624 my( $last, $company ) = @_;
1626 &check_and_rebuild_fuzzyfiles;
1628 use Fcntl qw(:flock);
1630 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1634 open(LAST,">>$dir/cust_main.last")
1635 or die "can't open $dir/cust_main.last: $!";
1637 or die "can't lock $dir/cust_main.last: $!";
1639 print LAST "$last\n";
1642 or die "can't unlock $dir/cust_main.last: $!";
1648 open(COMPANY,">>$dir/cust_main.company")
1649 or die "can't open $dir/cust_main.company: $!";
1650 flock(COMPANY,LOCK_EX)
1651 or die "can't lock $dir/cust_main.company: $!";
1653 print COMPANY "$company\n";
1655 flock(COMPANY,LOCK_UN)
1656 or die "can't unlock $dir/cust_main.company: $!";
1666 $Id: cust_main.pm,v 1.32 2001-09-11 12:10:56 ivan Exp $
1672 The delete method should possibly take an FS::cust_main object reference
1673 instead of a scalar customer number.
1675 Bill and collect options should probably be passed as references instead of a
1678 CyberCash v2 forces us to define some variables in package main.
1680 There should probably be a configuration file with a list of allowed credit
1683 No multiple currency support (probably a larger project than just this module).
1687 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
1688 L<FS::cust_pay_batch>, L<FS::agent>, L<FS::part_referral>,
1689 L<FS::cust_main_county>, L<FS::cust_main_invoice>,
1690 L<FS::UID>, schema.html from the base documentation.