1 #this is so kludgy i'd be embarassed if it wasn't cybercash's fault
3 use vars qw($paymentserversecret $paymentserverport $paymentserverhost);
8 use vars qw( @ISA $conf $lpr $processor $xaction $E_NoErr $invoice_from
9 $smtpmachine $Debug $bop_processor $bop_login $bop_password
10 $bop_action @bop_options);
18 use Business::CreditCard;
19 use FS::UID qw( getotaker dbh );
20 use FS::Record qw( qsearchs qsearch dbdef );
23 use FS::cust_bill_pkg;
26 use FS::cust_pay_batch;
27 use FS::part_referral;
28 use FS::cust_main_county;
30 use FS::cust_main_invoice;
31 use FS::cust_credit_bill;
32 use FS::prepay_credit;
34 @ISA = qw( FS::Record );
39 #ask FS::UID to run this stuff for us later
40 $FS::UID::callback{'FS::cust_main'} = sub {
42 $lpr = $conf->config('lpr');
43 $invoice_from = $conf->config('invoice_from');
44 $smtpmachine = $conf->config('smtpmachine');
46 if ( $conf->exists('cybercash3.2') ) {
48 #qw($MCKversion %Config InitConfig CCError CCDebug CCDebug2);
49 require CCMckDirectLib3_2;
51 require CCMckErrno3_2;
52 #qw(MCKGetErrorMessage $E_NoErr);
53 import CCMckErrno3_2 qw($E_NoErr);
56 ($merchant_conf,$xaction)= $conf->config('cybercash3.2');
57 my $status = &CCMckLib3_2::InitConfig($merchant_conf);
58 if ( $status != $E_NoErr ) {
59 warn "CCMckLib3_2::InitConfig error:\n";
60 foreach my $key (keys %CCMckLib3_2::Config) {
61 warn " $key => $CCMckLib3_2::Config{$key}\n"
63 my($errmsg) = &CCMckErrno3_2::MCKGetErrorMessage($status);
64 die "CCMckLib3_2::InitConfig fatal error: $errmsg\n";
66 $processor='cybercash3.2';
67 } elsif ( $conf->exists('cybercash2') ) {
70 ( $main::paymentserverhost,
71 $main::paymentserverport,
72 $main::paymentserversecret,
74 ) = $conf->config('cybercash2');
75 $processor='cybercash2';
76 } elsif ( $conf->exists('business-onlinepayment') ) {
82 ) = $conf->config('business-onlinepayment');
83 $bop_action ||= 'normal authorization';
84 eval "use Business::OnlinePayment";
85 $processor="Business::OnlinePayment::$bop_processor";
91 FS::cust_main - Object methods for cust_main records
97 $record = new FS::cust_main \%hash;
98 $record = new FS::cust_main { 'column' => 'value' };
100 $error = $record->insert;
102 $error = $new_record->replace($old_record);
104 $error = $record->delete;
106 $error = $record->check;
108 @cust_pkg = $record->all_pkgs;
110 @cust_pkg = $record->ncancelled_pkgs;
112 $error = $record->bill;
113 $error = $record->bill %options;
114 $error = $record->bill 'time' => $time;
116 $error = $record->collect;
117 $error = $record->collect %options;
118 $error = $record->collect 'invoice_time' => $time,
119 'batch_card' => 'yes',
120 'report_badcard' => 'yes',
125 An FS::cust_main object represents a customer. FS::cust_main inherits from
126 FS::Record. The following fields are currently supported:
130 =item custnum - primary key (assigned automatically for new customers)
132 =item agentnum - agent (see L<FS::agent>)
134 =item refnum - referral (see L<FS::part_referral>)
140 =item ss - social security number (optional)
142 =item company - (optional)
146 =item address2 - (optional)
150 =item county - (optional, see L<FS::cust_main_county>)
152 =item state - (see L<FS::cust_main_county>)
156 =item country - (see L<FS::cust_main_county>)
158 =item daytime - phone (optional)
160 =item night - phone (optional)
162 =item fax - phone (optional)
164 =item ship_first - name
166 =item ship_last - name
168 =item ship_company - (optional)
172 =item ship_address2 - (optional)
176 =item ship_county - (optional, see L<FS::cust_main_county>)
178 =item ship_state - (see L<FS::cust_main_county>)
182 =item ship_country - (see L<FS::cust_main_county>)
184 =item ship_daytime - phone (optional)
186 =item ship_night - phone (optional)
188 =item ship_fax - phone (optional)
190 =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)
192 =item payinfo - card number, P.O., comp issuer (4-8 lowercase alphanumerics; think username) or prepayment identifier (see L<FS::prepay_credit>)
194 =item paydate - expiration date, mm/yyyy, m/yyyy, mm/yy or m/yy
196 =item payname - name on card or billing name
198 =item tax - tax exempt, empty or `Y'
200 =item otaker - order taker (assigned automatically, see L<FS::UID>)
202 =item comments - comments (optional)
212 Creates a new customer. To add the customer to the database, see L<"insert">.
214 Note that this stores the hash reference, not a distinct copy of the hash it
215 points to. You can ask the object for a copy with the I<hash> method.
219 sub table { 'cust_main'; }
221 =item insert [ CUST_PKG_HASHREF [ , INVOICING_LIST_ARYREF ] ]
223 Adds this customer to the database. If there is an error, returns the error,
224 otherwise returns false.
226 CUST_PKG_HASHREF: If you pass a Tie::RefHash data structure to the insert
227 method containing FS::cust_pkg and FS::svc_I<tablename> objects, all records
228 are inserted atomicly, or the transaction is rolled back (this requries a
229 transactional database). Passing an empty hash reference is equivalent to
230 not supplying this parameter. There should be a better explanation of this,
231 but until then, here's an example:
234 tie %hash, 'Tie::RefHash'; #this part is important
236 $cust_pkg => [ $svc_acct ],
239 $cust_main->insert( \%hash );
241 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
242 be set as the invoicing list (see L<"invoicing_list">). Errors return as
243 expected and rollback the entire transaction; it is not necessary to call
244 check_invoicing_list first. The invoicing_list is set after the records in the
245 CUST_PKG_HASHREF above are inserted, so it is now possible set set an
246 invoicing_list destination to the newly-created svc_acct. Here's an example:
248 $cust_main->insert( {}, [ $email, 'POST' ] );
256 local $SIG{HUP} = 'IGNORE';
257 local $SIG{INT} = 'IGNORE';
258 local $SIG{QUIT} = 'IGNORE';
259 local $SIG{TERM} = 'IGNORE';
260 local $SIG{TSTP} = 'IGNORE';
261 local $SIG{PIPE} = 'IGNORE';
263 my $oldAutoCommit = $FS::UID::AutoCommit;
264 local $FS::UID::AutoCommit = 0;
269 if ( $self->payby eq 'PREPAY' ) {
270 $self->payby('BILL');
271 my $prepay_credit = qsearchs(
273 { 'identifier' => $self->payinfo },
277 warn "WARNING: can't find pre-found prepay_credit: ". $self->payinfo
278 unless $prepay_credit;
279 $amount = $prepay_credit->amount;
280 $seconds = $prepay_credit->seconds;
281 my $error = $prepay_credit->delete;
283 $dbh->rollback if $oldAutoCommit;
284 return "removing prepay_credit (transaction rolled back): $error";
288 my $error = $self->SUPER::insert;
290 $dbh->rollback if $oldAutoCommit;
291 return "inserting cust_main record (transaction rolled back): $error";
294 if ( @param ) { # CUST_PKG_HASHREF
295 my $cust_pkgs = shift @param;
296 foreach my $cust_pkg ( keys %$cust_pkgs ) {
297 $cust_pkg->custnum( $self->custnum );
298 $error = $cust_pkg->insert;
300 $dbh->rollback if $oldAutoCommit;
301 return "inserting cust_pkg (transaction rolled back): $error";
303 foreach my $svc_something ( @{$cust_pkgs->{$cust_pkg}} ) {
304 $svc_something->pkgnum( $cust_pkg->pkgnum );
305 if ( $seconds && $svc_something->isa('FS::svc_acct') ) {
306 $svc_something->seconds( $svc_something->seconds + $seconds );
309 $error = $svc_something->insert;
311 $dbh->rollback if $oldAutoCommit;
312 return "inserting svc_ (transaction rolled back): $error";
319 $dbh->rollback if $oldAutoCommit;
320 return "No svc_acct record to apply pre-paid time";
323 if ( @param ) { # INVOICING_LIST_ARYREF
324 my $invoicing_list = shift @param;
325 $error = $self->check_invoicing_list( $invoicing_list );
327 $dbh->rollback if $oldAutoCommit;
328 return "checking invoicing_list (transaction rolled back): $error";
330 $self->invoicing_list( $invoicing_list );
334 my $cust_credit = new FS::cust_credit {
335 'custnum' => $self->custnum,
338 $error = $cust_credit->insert;
340 $dbh->rollback if $oldAutoCommit;
341 return "inserting credit (transaction rolled back): $error";
345 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
350 =item delete NEW_CUSTNUM
352 This deletes the customer. If there is an error, returns the error, otherwise
355 This will completely remove all traces of the customer record. This is not
356 what you want when a customer cancels service; for that, cancel all of the
357 customer's packages (see L<FS::cust_pkg/cancel>).
359 If the customer has any packages, you need to pass a new (valid) customer
360 number for those packages to be transferred to.
362 You can't delete a customer with invoices (see L<FS::cust_bill>),
363 or credits (see L<FS::cust_credit>).
370 local $SIG{HUP} = 'IGNORE';
371 local $SIG{INT} = 'IGNORE';
372 local $SIG{QUIT} = 'IGNORE';
373 local $SIG{TERM} = 'IGNORE';
374 local $SIG{TSTP} = 'IGNORE';
375 local $SIG{PIPE} = 'IGNORE';
377 my $oldAutoCommit = $FS::UID::AutoCommit;
378 local $FS::UID::AutoCommit = 0;
381 if ( qsearch( 'cust_bill', { 'custnum' => $self->custnum } ) ) {
382 $dbh->rollback if $oldAutoCommit;
383 return "Can't delete a customer with invoices";
385 if ( qsearch( 'cust_credit', { 'custnum' => $self->custnum } ) ) {
386 $dbh->rollback if $oldAutoCommit;
387 return "Can't delete a customer with credits";
390 my @cust_pkg = qsearch( 'cust_pkg', { 'custnum' => $self->custnum } );
392 my $new_custnum = shift;
393 unless ( qsearchs( 'cust_main', { 'custnum' => $new_custnum } ) ) {
394 $dbh->rollback if $oldAutoCommit;
395 return "Invalid new customer number: $new_custnum";
397 foreach my $cust_pkg ( @cust_pkg ) {
398 my %hash = $cust_pkg->hash;
399 $hash{'custnum'} = $new_custnum;
400 my $new_cust_pkg = new FS::cust_pkg ( \%hash );
401 my $error = $new_cust_pkg->replace($cust_pkg);
403 $dbh->rollback if $oldAutoCommit;
408 foreach my $cust_main_invoice (
409 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } )
411 my $error = $cust_main_invoice->delete;
413 $dbh->rollback if $oldAutoCommit;
418 my $error = $self->SUPER::delete;
420 $dbh->rollback if $oldAutoCommit;
424 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
429 =item replace OLD_RECORD [ INVOICING_LIST_ARYREF ]
431 Replaces the OLD_RECORD with this one in the database. If there is an error,
432 returns the error, otherwise returns false.
434 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
435 be set as the invoicing list (see L<"invoicing_list">). Errors return as
436 expected and rollback the entire transaction; it is not necessary to call
437 check_invoicing_list first. Here's an example:
439 $new_cust_main->replace( $old_cust_main, [ $email, 'POST' ] );
448 local $SIG{HUP} = 'IGNORE';
449 local $SIG{INT} = 'IGNORE';
450 local $SIG{QUIT} = 'IGNORE';
451 local $SIG{TERM} = 'IGNORE';
452 local $SIG{TSTP} = 'IGNORE';
453 local $SIG{PIPE} = 'IGNORE';
455 my $oldAutoCommit = $FS::UID::AutoCommit;
456 local $FS::UID::AutoCommit = 0;
459 my $error = $self->SUPER::replace($old);
462 $dbh->rollback if $oldAutoCommit;
466 if ( @param ) { # INVOICING_LIST_ARYREF
467 my $invoicing_list = shift @param;
468 $error = $self->check_invoicing_list( $invoicing_list );
470 $dbh->rollback if $oldAutoCommit;
473 $self->invoicing_list( $invoicing_list );
476 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
483 Checks all fields to make sure this is a valid customer record. If there is
484 an error, returns the error, otherwise returns false. Called by the insert
493 $self->ut_numbern('custnum')
494 || $self->ut_number('agentnum')
495 || $self->ut_number('refnum')
496 || $self->ut_name('last')
497 || $self->ut_name('first')
498 || $self->ut_textn('company')
499 || $self->ut_text('address1')
500 || $self->ut_textn('address2')
501 || $self->ut_text('city')
502 || $self->ut_textn('county')
503 || $self->ut_textn('state')
504 || $self->ut_country('country')
505 || $self->ut_anything('comments')
506 || $self->ut_numbern('referral_custnum')
508 #barf. need message catalogs. i18n. etc.
509 $error .= "Please select a referral."
510 if $error =~ /^Illegal or empty \(numeric\) refnum: /;
511 return $error if $error;
513 return "Unknown agent"
514 unless qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
516 return "Unknown referral"
517 unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } );
519 return "Unknown referring custnum ". $self->referral_custnum
520 unless ! $self->referral_custnum
521 || qsearchs( 'cust_main', { 'custnum' => $self->referral_custnum } );
523 if ( $self->ss eq '' ) {
528 $ss =~ /^(\d{3})(\d{2})(\d{4})$/
529 or return "Illegal social security number: ". $self->ss;
530 $self->ss("$1-$2-$3");
533 unless ( qsearchs('cust_main_county', {
534 'country' => $self->country,
537 return "Unknown state/county/country: ".
538 $self->state. "/". $self->county. "/". $self->country
539 unless qsearchs('cust_main_county',{
540 'state' => $self->state,
541 'county' => $self->county,
542 'country' => $self->country,
547 $self->ut_phonen('daytime', $self->country)
548 || $self->ut_phonen('night', $self->country)
549 || $self->ut_phonen('fax', $self->country)
550 || $self->ut_zip('zip', $self->country)
552 return $error if $error;
555 last first company address1 address2 city county state zip
556 country daytime night fax
559 if ( defined $self->dbdef_table->column('ship_last') ) {
560 if ( grep { $self->getfield($_) ne $self->getfield("ship_$_") } @addfields
561 && grep $self->getfield("ship_$_"), grep $_ ne 'state', @addfields
565 $self->ut_name('ship_last')
566 || $self->ut_name('ship_first')
567 || $self->ut_textn('ship_company')
568 || $self->ut_text('ship_address1')
569 || $self->ut_textn('ship_address2')
570 || $self->ut_text('ship_city')
571 || $self->ut_textn('ship_county')
572 || $self->ut_textn('ship_state')
573 || $self->ut_country('ship_country')
575 return $error if $error;
577 #false laziness with above
578 unless ( qsearchs('cust_main_county', {
579 'country' => $self->ship_country,
582 return "Unknown ship_state/ship_county/ship_country: ".
583 $self->ship_state. "/". $self->ship_county. "/". $self->ship_country
584 unless qsearchs('cust_main_county',{
585 'state' => $self->ship_state,
586 'county' => $self->ship_county,
587 'country' => $self->ship_country,
593 $self->ut_phonen('ship_daytime', $self->ship_country)
594 || $self->ut_phonen('ship_night', $self->ship_country)
595 || $self->ut_phonen('ship_fax', $self->ship_country)
596 || $self->ut_zip('ship_zip', $self->ship_country)
598 return $error if $error;
600 } else { # ship_ info eq billing info, so don't store dup info in database
601 $self->setfield("ship_$_", '')
602 foreach qw( last first company address1 address2 city county state zip
603 country daytime night fax );
607 $self->payby =~ /^(CARD|BILL|COMP|PREPAY)$/
608 or return "Illegal payby: ". $self->payby;
611 if ( $self->payby eq 'CARD' ) {
613 my $payinfo = $self->payinfo;
615 $payinfo =~ /^(\d{13,16})$/
616 or return "Illegal credit card number: ". $self->payinfo;
618 $self->payinfo($payinfo);
620 or return "Illegal credit card number: ". $self->payinfo;
621 return "Unknown card type" if cardtype($self->payinfo) eq "Unknown";
623 } elsif ( $self->payby eq 'BILL' ) {
625 $error = $self->ut_textn('payinfo');
626 return "Illegal P.O. number: ". $self->payinfo if $error;
628 } elsif ( $self->payby eq 'COMP' ) {
630 $error = $self->ut_textn('payinfo');
631 return "Illegal comp account issuer: ". $self->payinfo if $error;
633 } elsif ( $self->payby eq 'PREPAY' ) {
635 my $payinfo = $self->payinfo;
636 $payinfo =~ s/\W//g; #anything else would just confuse things
637 $self->payinfo($payinfo);
638 $error = $self->ut_alpha('payinfo');
639 return "Illegal prepayment identifier: ". $self->payinfo if $error;
640 return "Unknown prepayment identifier"
641 unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } );
645 if ( $self->paydate eq '' || $self->paydate eq '-' ) {
646 return "Expriation date required"
647 unless $self->payby eq 'BILL' || $self->payby eq 'PREPAY';
650 $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/
651 or return "Illegal expiration date: ". $self->paydate;
652 if ( length($2) == 4 ) {
653 $self->paydate("$2-$1-01");
655 $self->paydate("20$2-$1-01");
659 if ( $self->payname eq '' ) {
660 $self->payname( $self->first. " ". $self->getfield('last') );
662 $self->payname =~ /^([\w \,\.\-\']+)$/
663 or return "Illegal billing name: ". $self->payname;
667 $self->tax =~ /^(Y?)$/ or return "Illegal tax: ". $self->tax;
670 $self->otaker(getotaker);
677 Returns all packages (see L<FS::cust_pkg>) for this customer.
683 qsearch( 'cust_pkg', { 'custnum' => $self->custnum });
686 =item ncancelled_pkgs
688 Returns all non-cancelled packages (see L<FS::cust_pkg>) for this customer.
692 sub ncancelled_pkgs {
694 @{ [ # force list context
695 qsearch( 'cust_pkg', {
696 'custnum' => $self->custnum,
699 qsearch( 'cust_pkg', {
700 'custnum' => $self->custnum,
708 Generates invoices (see L<FS::cust_bill>) for this customer. Usually used in
709 conjunction with the collect method.
711 The only currently available option is `time', which bills the customer as if
712 it were that time. It is specified as a UNIX timestamp; see
713 L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion
716 If there is an error, returns the error, otherwise returns false.
721 my( $self, %options ) = @_;
722 my $time = $options{'time'} || time;
727 local $SIG{HUP} = 'IGNORE';
728 local $SIG{INT} = 'IGNORE';
729 local $SIG{QUIT} = 'IGNORE';
730 local $SIG{TERM} = 'IGNORE';
731 local $SIG{TSTP} = 'IGNORE';
732 local $SIG{PIPE} = 'IGNORE';
734 my $oldAutoCommit = $FS::UID::AutoCommit;
735 local $FS::UID::AutoCommit = 0;
738 # find the packages which are due for billing, find out how much they are
739 # & generate invoice database.
741 my( $total_setup, $total_recur ) = ( 0, 0 );
744 foreach my $cust_pkg (
745 qsearch('cust_pkg',{'custnum'=> $self->getfield('custnum') } )
748 next if $cust_pkg->getfield('cancel');
750 #? to avoid use of uninitialized value errors... ?
751 $cust_pkg->setfield('bill', '')
752 unless defined($cust_pkg->bill);
754 my $part_pkg = qsearchs( 'part_pkg', { 'pkgpart' => $cust_pkg->pkgpart } );
756 #so we don't modify cust_pkg record unnecessarily
757 my $cust_pkg_mod_flag = 0;
758 my %hash = $cust_pkg->hash;
759 my $old_cust_pkg = new FS::cust_pkg \%hash;
763 unless ( $cust_pkg->setup ) {
764 my $setup_prog = $part_pkg->getfield('setup');
765 $setup_prog =~ /^(.*)$/ #presumably trusted
766 or die "Illegal setup for package ". $cust_pkg->pkgnum. ": $setup_prog";
769 #$cpt->permit(); #what is necessary?
770 $cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
771 $setup = $cpt->reval($setup_prog);
772 unless ( defined($setup) ) {
773 warn "Error reval-ing part_pkg->setup pkgpart ",
774 $part_pkg->pkgpart, ": $@";
776 $cust_pkg->setfield('setup',$time);
777 $cust_pkg_mod_flag=1;
784 if ( $part_pkg->getfield('freq') > 0 &&
785 ! $cust_pkg->getfield('susp') &&
786 ( $cust_pkg->getfield('bill') || 0 ) < $time
788 my $recur_prog = $part_pkg->getfield('recur');
789 $recur_prog =~ /^(.*)$/ #presumably trusted
790 or die "Illegal recur for package ". $cust_pkg->pkgnum. ": $recur_prog";
793 #$cpt->permit(); #what is necessary?
794 $cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
795 $recur = $cpt->reval($recur_prog);
796 unless ( defined($recur) ) {
797 warn "Error reval-ing part_pkg->recur pkgpart ",
798 $part_pkg->pkgpart, ": $@";
800 #change this bit to use Date::Manip? CAREFUL with timezones (see
801 # mailing list archive)
802 #$sdate=$cust_pkg->bill || time;
803 #$sdate=$cust_pkg->bill || $time;
804 $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
805 my ($sec,$min,$hour,$mday,$mon,$year) =
806 (localtime($sdate) )[0,1,2,3,4,5];
807 $mon += $part_pkg->getfield('freq');
808 until ( $mon < 12 ) { $mon -= 12; $year++; }
809 $cust_pkg->setfield('bill',
810 timelocal($sec,$min,$hour,$mday,$mon,$year));
811 $cust_pkg_mod_flag = 1;
815 warn "setup is undefined" unless defined($setup);
816 warn "recur is undefined" unless defined($recur);
817 warn "cust_pkg bill is undefined" unless defined($cust_pkg->bill);
819 if ( $cust_pkg_mod_flag ) {
820 $error=$cust_pkg->replace($old_cust_pkg);
821 if ( $error ) { #just in case
822 warn "Error modifying pkgnum ", $cust_pkg->pkgnum, ": $error";
824 $setup = sprintf( "%.2f", $setup );
825 $recur = sprintf( "%.2f", $recur );
826 my $cust_bill_pkg = new FS::cust_bill_pkg ({
827 'pkgnum' => $cust_pkg->pkgnum,
831 'edate' => $cust_pkg->bill,
833 push @cust_bill_pkg, $cust_bill_pkg;
834 $total_setup += $setup;
835 $total_recur += $recur;
841 my $charged = sprintf( "%.2f", $total_setup + $total_recur );
843 unless ( @cust_bill_pkg ) {
844 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
848 unless ( $self->getfield('tax') =~ /Y/i
849 || $self->getfield('payby') eq 'COMP'
851 my $cust_main_county = qsearchs('cust_main_county',{
852 'state' => $self->state,
853 'county' => $self->county,
854 'country' => $self->country,
856 my $tax = sprintf( "%.2f",
857 $charged * ( $cust_main_county->getfield('tax') / 100 )
859 $charged = sprintf( "%.2f", $charged+$tax );
861 my $cust_bill_pkg = new FS::cust_bill_pkg ({
868 push @cust_bill_pkg, $cust_bill_pkg;
871 my $cust_bill = new FS::cust_bill ( {
872 'custnum' => $self->getfield('custnum'),
874 'charged' => $charged,
876 $error = $cust_bill->insert;
878 $dbh->rollback if $oldAutoCommit;
879 return "$error for customer #". $self->custnum;
882 my $invnum = $cust_bill->invnum;
884 foreach $cust_bill_pkg ( @cust_bill_pkg ) {
885 $cust_bill_pkg->setfield( 'invnum', $invnum );
886 $error = $cust_bill_pkg->insert;
887 #shouldn't happen, but how else tohandle this?
889 $dbh->rollback if $oldAutoCommit;
890 return "$error for customer #". $self->custnum;
894 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
898 =item collect OPTIONS
900 (Attempt to) collect money for this customer's outstanding invoices (see
901 L<FS::cust_bill>). Usually used after the bill method.
903 Depending on the value of `payby', this may print an invoice (`BILL'), charge
904 a credit card (`CARD'), or just add any necessary (pseudo-)payment (`COMP').
906 If there is an error, returns the error, otherwise returns false.
908 Currently available options are:
910 invoice_time - Use this time when deciding when to print invoices and
911 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>
912 for conversion functions.
914 batch_card - Set this true to batch cards (see L<cust_pay_batch>). By
915 default, cards are processed immediately, which will generate an error if
916 CyberCash is not installed.
918 report_badcard - Set this true if you want bad card transactions to
919 return an error. By default, they don't.
924 my( $self, %options ) = @_;
925 my $invoice_time = $options{'invoice_time'} || time;
928 local $SIG{HUP} = 'IGNORE';
929 local $SIG{INT} = 'IGNORE';
930 local $SIG{QUIT} = 'IGNORE';
931 local $SIG{TERM} = 'IGNORE';
932 local $SIG{TSTP} = 'IGNORE';
933 local $SIG{PIPE} = 'IGNORE';
935 my $oldAutoCommit = $FS::UID::AutoCommit;
936 local $FS::UID::AutoCommit = 0;
939 my $total_owed = $self->balance;
940 warn "collect: total owed $total_owed " if $Debug;
941 unless ( $total_owed > 0 ) { #redundant?????
942 $dbh->rollback if $oldAutoCommit;
946 foreach my $cust_bill (
947 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
950 #this has to be before next's
951 my $amount = sprintf( "%.2f", $total_owed < $cust_bill->owed
955 $total_owed = sprintf( "%.2f", $total_owed - $amount );
957 next unless $cust_bill->owed > 0;
959 next if qsearchs( 'cust_pay_batch', { 'invnum' => $cust_bill->invnum } );
961 warn "invnum ". $cust_bill->invnum. " (owed ". $cust_bill->owed. ", amount $amount, total_owed $total_owed)" if $Debug;
963 next unless $amount > 0;
965 if ( $self->payby eq 'BILL' ) {
968 my $since = $invoice_time - ( $cust_bill->_date || 0 );
969 #warn "$invoice_time ", $cust_bill->_date, " $since";
970 if ( $since >= 0 #don't print future invoices
971 && ( $cust_bill->printed * 2592000 ) <= $since
974 #my @print_text = $cust_bill->print_text; #( date )
975 my @invoicing_list = $self->invoicing_list;
976 if ( grep { $_ ne 'POST' } @invoicing_list ) { #email invoice
977 $ENV{SMTPHOSTS} = $smtpmachine;
978 $ENV{MAILADDRESS} = $invoice_from;
979 my $header = new Mail::Header ( [
980 "From: $invoice_from",
981 "To: ". join(', ', grep { $_ ne 'POST' } @invoicing_list ),
982 "Sender: $invoice_from",
983 "Reply-To: $invoice_from",
984 "Date: ". time2str("%a, %d %b %Y %X %z", time),
987 my $message = new Mail::Internet (
989 'Body' => [ $cust_bill->print_text ], #( date)
991 $message->smtpsend or die "Can't send invoice email!"; #die? warn?
993 } elsif ( ! @invoicing_list || grep { $_ eq 'POST' } @invoicing_list ) {
994 open(LPR, "|$lpr") or die "Can't open pipe to $lpr: $!";
995 print LPR $cust_bill->print_text; #( date )
997 or die $! ? "Error closing $lpr: $!"
998 : "Exit status $? from $lpr";
1001 my %hash = $cust_bill->hash;
1003 my $new_cust_bill = new FS::cust_bill(\%hash);
1004 my $error = $new_cust_bill->replace($cust_bill);
1005 warn "Error updating $cust_bill->printed: $error" if $error;
1009 } elsif ( $self->payby eq 'COMP' ) {
1010 my $cust_pay = new FS::cust_pay ( {
1011 'invnum' => $cust_bill->invnum,
1015 'payinfo' => $self->payinfo,
1018 my $error = $cust_pay->insert;
1020 $dbh->rollback if $oldAutoCommit;
1021 return 'Error COMPing invnum #'. $cust_bill->invnum. ": $error";
1025 } elsif ( $self->payby eq 'CARD' ) {
1027 if ( $options{'batch_card'} ne 'yes' ) {
1029 unless ( $processor ) {
1030 $dbh->rollback if $oldAutoCommit;
1031 return "Real time card processing not enabled!";
1034 my $address = $self->address1;
1035 $address .= ", ". $self->address2 if $self->address2;
1038 #$self->paydate =~ /^(\d+)\/\d*(\d{2})$/;
1039 $self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
1042 if ( $processor =~ /^cybercash/ ) {
1044 #fix exp. date for cybercash
1045 #$self->paydate =~ /^(\d+)\/\d*(\d{2})$/;
1046 $self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
1049 my $paybatch = $cust_bill->invnum.
1050 '-' . time2str("%y%m%d%H%M%S", time);
1052 my $payname = $self->payname ||
1053 $self->getfield('first'). ' '. $self->getfield('last');
1056 my $country = $self->country eq 'US' ? 'USA' : $self->country;
1058 my @full_xaction = ( $xaction,
1059 'Order-ID' => $paybatch,
1060 'Amount' => "usd $amount",
1061 'Card-Number' => $self->getfield('payinfo'),
1062 'Card-Name' => $payname,
1063 'Card-Address' => $address,
1064 'Card-City' => $self->getfield('city'),
1065 'Card-State' => $self->getfield('state'),
1066 'Card-Zip' => $self->getfield('zip'),
1067 'Card-Country' => $country,
1072 if ( $processor eq 'cybercash2' ) {
1073 $^W=0; #CCLib isn't -w safe, ugh!
1074 %result = &CCLib::sendmserver(@full_xaction);
1076 } elsif ( $processor eq 'cybercash3.2' ) {
1077 %result = &CCMckDirectLib3_2::SendCC2_1Server(@full_xaction);
1079 $dbh->rollback if $oldAutoCommit;
1080 return "Unknown real-time processor $processor";
1083 #if ( $result{'MActionCode'} == 7 ) { #cybercash smps v.1.1.3
1084 #if ( $result{'action-code'} == 7 ) { #cybercash smps v.2.1
1085 if ( $result{'MStatus'} eq 'success' ) { #cybercash smps v.2 or 3
1086 my $cust_pay = new FS::cust_pay ( {
1087 'invnum' => $cust_bill->invnum,
1091 'payinfo' => $self->payinfo,
1092 'paybatch' => "$processor:$paybatch",
1094 my $error = $cust_pay->insert;
1096 # gah, even with transactions.
1097 $dbh->commit if $oldAutoCommit; #well.
1098 my $e = 'WARNING: Card debited but database not updated - '.
1099 'error applying payment, invnum #' . $cust_bill->invnum.
1100 " (CyberCash Order-ID $paybatch): $error";
1104 } elsif ( $result{'Mstatus'} ne 'failure-bad-money'
1105 || $options{'report_badcard'} ) {
1106 $dbh->commit if $oldAutoCommit;
1107 return 'Cybercash error, invnum #' .
1108 $cust_bill->invnum. ':'. $result{'MErrMsg'};
1110 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1114 } elsif ( $processor =~ /^Business::OnlinePayment::(.*)$/ ) {
1116 my($payname, $payfirst, $paylast);
1117 if ( $self->payname ) {
1118 $payname = $self->payname;
1119 $payname =~ /^\s*([\w \,\.\-\']*\w)?\s+([\w\,\.\-\']+)$/
1121 $dbh->rollback if $oldAutoCommit;
1122 return "Illegal payname $payname";
1124 ($payfirst, $paylast) = ($1, $2);
1126 $payfirst = $self->getfield('first');
1127 $paylast = $self->getfield('first');
1128 $payname = "$payfirst $paylast";
1131 my $transaction = new Business::OnlinePayment( $1, @bop_options );
1132 $transaction->content(
1134 'login' => $bop_login,
1135 'password' => $bop_password,
1136 'action' => $bop_action,
1137 'amount' => $amount,
1138 'invoice_number' => $cust_bill->invnum,
1139 'customer_id' => $self->custnum,
1140 'last_name' => $paylast,
1141 'first_name' => $payfirst,
1143 'address' => $address,
1144 'city' => $self->city,
1145 'state' => $self->state,
1146 'zip' => $self->zip,
1147 'country' => $self->country,
1148 'card_number' => $self->payinfo,
1149 'expiration' => $exp,
1151 $transaction->submit();
1153 if ( $transaction->is_success()) {
1154 my $cust_pay = new FS::cust_pay ( {
1155 'invnum' => $cust_bill->invnum,
1159 'payinfo' => $self->payinfo,
1160 'paybatch' => "$processor:". $transaction->authorization,
1162 my $error = $cust_pay->insert;
1164 # gah, even with transactions.
1165 $dbh->commit if $oldAutoCommit; #well.
1166 my $e = 'WARNING: Card debited but database not updated - '.
1167 'error applying payment, invnum #' . $cust_bill->invnum.
1168 " ($processor): $error";
1172 } elsif ( $options{'report_badcard'} ) {
1173 $dbh->commit if $oldAutoCommit;
1174 return "$processor error, invnum #". $cust_bill->invnum. ': '.
1175 $transaction->result_code. ": ". $transaction->error_message;
1177 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1182 $dbh->rollback if $oldAutoCommit;
1183 return "Unknown real-time processor $processor\n";
1186 } else { #batch card
1188 my $cust_pay_batch = new FS::cust_pay_batch ( {
1189 'invnum' => $cust_bill->getfield('invnum'),
1190 'custnum' => $self->getfield('custnum'),
1191 'last' => $self->getfield('last'),
1192 'first' => $self->getfield('first'),
1193 'address1' => $self->getfield('address1'),
1194 'address2' => $self->getfield('address2'),
1195 'city' => $self->getfield('city'),
1196 'state' => $self->getfield('state'),
1197 'zip' => $self->getfield('zip'),
1198 'country' => $self->getfield('country'),
1200 'cardnum' => $self->getfield('payinfo'),
1201 'exp' => $self->getfield('paydate'),
1202 'payname' => $self->getfield('payname'),
1203 'amount' => $amount,
1205 my $error = $cust_pay_batch->insert;
1207 $dbh->rollback if $oldAutoCommit;
1208 return "Error adding to cust_pay_batch: $error";
1214 $dbh->rollback if $oldAutoCommit;
1215 return "Unknown payment type ". $self->payby;
1219 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1226 Returns the total owed for this customer on all invoices
1227 (see L<FS::cust_bill>).
1234 foreach my $cust_bill ( qsearch('cust_bill', {
1235 'custnum' => $self->custnum,
1237 $total_bill += $cust_bill->owed;
1239 sprintf( "%.2f", $total_bill );
1244 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)to outstanding invoice balances in cronological order and returns the value
1245 of any remaining unapplied credits available for refund (see L<FS::cust_refund>).
1252 return 0 unless $self->total_credited;
1254 my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
1255 qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
1257 my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
1258 qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
1262 foreach my $cust_bill ( @invoices ) {
1265 if (!(defined $credit) || $credit->credited == 0) {
1266 $credit = pop @credits;
1267 last unless defined $credit;
1270 if ($cust_bill->owed >= $credit->credited) {
1271 $amount=$credit->credited;
1273 $amount=$cust_bill->owed;
1276 my $cust_credit_bill = new FS::cust_credit_bill ( {
1277 'crednum' => $credit->crednum,
1278 'invnum' => $cust_bill->invnum,
1279 'amount' => $amount,
1282 my $error = $cust_credit_bill->insert;
1283 die $error if $error;
1285 redo if ($cust_bill->owed > 0);
1289 return $self->total_credited;
1293 =item total_credited
1295 Returns the total credits (see L<FS::cust_credit>) for this customer.
1299 sub total_credited {
1301 my $total_credit = 0;
1302 foreach my $cust_credit ( qsearch('cust_credit', {
1303 'custnum' => $self->custnum,
1305 $total_credit += $cust_credit->credited;
1307 sprintf( "%.2f", $total_credit );
1312 Returns the balance for this customer (total owed minus total credited).
1318 sprintf( "%.2f", $self->total_owed - $self->total_credited );
1321 =item invoicing_list [ ARRAYREF ]
1323 If an arguement is given, sets these email addresses as invoice recipients
1324 (see L<FS::cust_main_invoice>). Errors are not fatal and are not reported
1325 (except as warnings), so use check_invoicing_list first.
1327 Returns a list of email addresses (with svcnum entries expanded).
1329 Note: You can clear the invoicing list by passing an empty ARRAYREF. You can
1330 check it without disturbing anything by passing nothing.
1332 This interface may change in the future.
1336 sub invoicing_list {
1337 my( $self, $arrayref ) = @_;
1339 my @cust_main_invoice;
1340 if ( $self->custnum ) {
1341 @cust_main_invoice =
1342 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1344 @cust_main_invoice = ();
1346 foreach my $cust_main_invoice ( @cust_main_invoice ) {
1347 #warn $cust_main_invoice->destnum;
1348 unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
1349 #warn $cust_main_invoice->destnum;
1350 my $error = $cust_main_invoice->delete;
1351 warn $error if $error;
1354 if ( $self->custnum ) {
1355 @cust_main_invoice =
1356 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1358 @cust_main_invoice = ();
1360 foreach my $address ( @{$arrayref} ) {
1361 unless ( grep { $address eq $_->address } @cust_main_invoice ) {
1362 my $cust_main_invoice = new FS::cust_main_invoice ( {
1363 'custnum' => $self->custnum,
1366 my $error = $cust_main_invoice->insert;
1367 warn $error if $error;
1371 if ( $self->custnum ) {
1373 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1379 =item check_invoicing_list ARRAYREF
1381 Checks these arguements as valid input for the invoicing_list method. If there
1382 is an error, returns the error, otherwise returns false.
1386 sub check_invoicing_list {
1387 my( $self, $arrayref ) = @_;
1388 foreach my $address ( @{$arrayref} ) {
1389 my $cust_main_invoice = new FS::cust_main_invoice ( {
1390 'custnum' => $self->custnum,
1393 my $error = $self->custnum
1394 ? $cust_main_invoice->check
1395 : $cust_main_invoice->checkdest
1397 return $error if $error;
1402 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
1404 Returns an array of customers referred by this customer (referral_custnum set
1405 to this custnum). If DEPTH is given, recurses up to the given depth, returning
1406 customers referred by customers referred by this customer and so on, inclusive.
1407 The default behavior is DEPTH 1 (no recursion).
1411 sub referral_cust_main {
1413 my $depth = @_ ? shift : 1;
1414 my $exclude = @_ ? shift : {};
1417 map { $exclude->{$_->custnum}++; $_; }
1418 grep { ! $exclude->{ $_->custnum } }
1419 qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
1423 map { $_->referral_cust_main($depth-1, $exclude) }
1436 =item rebuild_fuzzyfile
1440 sub rebuild_fuzzyfiles {
1441 my @all_last = map $_->getfield('last'), qsearch('cust_main', {});
1443 grep $_, map $_->getfield('ship_last'), qsearch('cust_main',{})
1444 if defined dbdef->table('cust_main')->column('ship_last');
1453 $Id: cust_main.pm,v 1.25 2001-09-01 22:28:51 jeff Exp $
1459 The delete method should possibly take an FS::cust_main object reference
1460 instead of a scalar customer number.
1462 Bill and collect options should probably be passed as references instead of a
1465 CyberCash v2 forces us to define some variables in package main.
1467 There should probably be a configuration file with a list of allowed credit
1470 No multiple currency support (probably a larger project than just this module).
1474 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
1475 L<FS::cust_pay_batch>, L<FS::agent>, L<FS::part_referral>,
1476 L<FS::cust_main_county>, L<FS::cust_main_invoice>,
1477 L<FS::UID>, schema.html from the base documentation.