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::prepay_credit;
33 @ISA = qw( FS::Record );
38 #ask FS::UID to run this stuff for us later
39 $FS::UID::callback{'FS::cust_main'} = sub {
41 $lpr = $conf->config('lpr');
42 $invoice_from = $conf->config('invoice_from');
43 $smtpmachine = $conf->config('smtpmachine');
45 if ( $conf->exists('cybercash3.2') ) {
47 #qw($MCKversion %Config InitConfig CCError CCDebug CCDebug2);
48 require CCMckDirectLib3_2;
50 require CCMckErrno3_2;
51 #qw(MCKGetErrorMessage $E_NoErr);
52 import CCMckErrno3_2 qw($E_NoErr);
55 ($merchant_conf,$xaction)= $conf->config('cybercash3.2');
56 my $status = &CCMckLib3_2::InitConfig($merchant_conf);
57 if ( $status != $E_NoErr ) {
58 warn "CCMckLib3_2::InitConfig error:\n";
59 foreach my $key (keys %CCMckLib3_2::Config) {
60 warn " $key => $CCMckLib3_2::Config{$key}\n"
62 my($errmsg) = &CCMckErrno3_2::MCKGetErrorMessage($status);
63 die "CCMckLib3_2::InitConfig fatal error: $errmsg\n";
65 $processor='cybercash3.2';
66 } elsif ( $conf->exists('cybercash2') ) {
69 ( $main::paymentserverhost,
70 $main::paymentserverport,
71 $main::paymentserversecret,
73 ) = $conf->config('cybercash2');
74 $processor='cybercash2';
75 } elsif ( $conf->exists('business-onlinepayment') ) {
81 ) = $conf->config('business-onlinepayment');
82 $bop_action ||= 'normal authorization';
83 eval "use Business::OnlinePayment";
84 $processor="Business::OnlinePayment::$bop_processor";
90 FS::cust_main - Object methods for cust_main records
96 $record = new FS::cust_main \%hash;
97 $record = new FS::cust_main { 'column' => 'value' };
99 $error = $record->insert;
101 $error = $new_record->replace($old_record);
103 $error = $record->delete;
105 $error = $record->check;
107 @cust_pkg = $record->all_pkgs;
109 @cust_pkg = $record->ncancelled_pkgs;
111 $error = $record->bill;
112 $error = $record->bill %options;
113 $error = $record->bill 'time' => $time;
115 $error = $record->collect;
116 $error = $record->collect %options;
117 $error = $record->collect 'invoice_time' => $time,
118 'batch_card' => 'yes',
119 'report_badcard' => 'yes',
124 An FS::cust_main object represents a customer. FS::cust_main inherits from
125 FS::Record. The following fields are currently supported:
129 =item custnum - primary key (assigned automatically for new customers)
131 =item agentnum - agent (see L<FS::agent>)
133 =item refnum - referral (see L<FS::part_referral>)
139 =item ss - social security number (optional)
141 =item company - (optional)
145 =item address2 - (optional)
149 =item county - (optional, see L<FS::cust_main_county>)
151 =item state - (see L<FS::cust_main_county>)
155 =item country - (see L<FS::cust_main_county>)
157 =item daytime - phone (optional)
159 =item night - phone (optional)
161 =item fax - phone (optional)
163 =item ship_first - name
165 =item ship_last - name
167 =item ship_company - (optional)
171 =item ship_address2 - (optional)
175 =item ship_county - (optional, see L<FS::cust_main_county>)
177 =item ship_state - (see L<FS::cust_main_county>)
181 =item ship_country - (see L<FS::cust_main_county>)
183 =item ship_daytime - phone (optional)
185 =item ship_night - phone (optional)
187 =item ship_fax - phone (optional)
189 =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)
191 =item payinfo - card number, P.O., comp issuer (4-8 lowercase alphanumerics; think username) or prepayment identifier (see L<FS::prepay_credit>)
193 =item paydate - expiration date, mm/yyyy, m/yyyy, mm/yy or m/yy
195 =item payname - name on card or billing name
197 =item tax - tax exempt, empty or `Y'
199 =item otaker - order taker (assigned automatically, see L<FS::UID>)
201 =item comments - comments (optional)
211 Creates a new customer. To add the customer to the database, see L<"insert">.
213 Note that this stores the hash reference, not a distinct copy of the hash it
214 points to. You can ask the object for a copy with the I<hash> method.
218 sub table { 'cust_main'; }
220 =item insert [ CUST_PKG_HASHREF [ , INVOICING_LIST_ARYREF ] ]
222 Adds this customer to the database. If there is an error, returns the error,
223 otherwise returns false.
225 CUST_PKG_HASHREF: If you pass a Tie::RefHash data structure to the insert
226 method containing FS::cust_pkg and FS::svc_I<tablename> objects, all records
227 are inserted atomicly, or the transaction is rolled back (this requries a
228 transactional database). Passing an empty hash reference is equivalent to
229 not supplying this parameter. There should be a better explanation of this,
230 but until then, here's an example:
233 tie %hash, 'Tie::RefHash'; #this part is important
235 $cust_pkg => [ $svc_acct ],
238 $cust_main->insert( \%hash );
240 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
241 be set as the invoicing list (see L<"invoicing_list">). Errors return as
242 expected and rollback the entire transaction; it is not necessary to call
243 check_invoicing_list first. The invoicing_list is set after the records in the
244 CUST_PKG_HASHREF above are inserted, so it is now possible set set an
245 invoicing_list destination to the newly-created svc_acct. Here's an example:
247 $cust_main->insert( {}, [ $email, 'POST' ] );
255 local $SIG{HUP} = 'IGNORE';
256 local $SIG{INT} = 'IGNORE';
257 local $SIG{QUIT} = 'IGNORE';
258 local $SIG{TERM} = 'IGNORE';
259 local $SIG{TSTP} = 'IGNORE';
260 local $SIG{PIPE} = 'IGNORE';
262 my $oldAutoCommit = $FS::UID::AutoCommit;
263 local $FS::UID::AutoCommit = 0;
268 if ( $self->payby eq 'PREPAY' ) {
269 $self->payby('BILL');
270 my $prepay_credit = qsearchs(
272 { 'identifier' => $self->payinfo },
276 warn "WARNING: can't find pre-found prepay_credit: ". $self->payinfo
277 unless $prepay_credit;
278 $amount = $prepay_credit->amount;
279 $seconds = $prepay_credit->seconds;
280 my $error = $prepay_credit->delete;
282 $dbh->rollback if $oldAutoCommit;
283 return "removing prepay_credit (transaction rolled back): $error";
287 my $error = $self->SUPER::insert;
289 $dbh->rollback if $oldAutoCommit;
290 return "inserting cust_main record (transaction rolled back): $error";
293 if ( @param ) { # CUST_PKG_HASHREF
294 my $cust_pkgs = shift @param;
295 foreach my $cust_pkg ( keys %$cust_pkgs ) {
296 $cust_pkg->custnum( $self->custnum );
297 $error = $cust_pkg->insert;
299 $dbh->rollback if $oldAutoCommit;
300 return "inserting cust_pkg (transaction rolled back): $error";
302 foreach my $svc_something ( @{$cust_pkgs->{$cust_pkg}} ) {
303 $svc_something->pkgnum( $cust_pkg->pkgnum );
304 if ( $seconds && $svc_something->isa('FS::svc_acct') ) {
305 $svc_something->seconds( $svc_something->seconds + $seconds );
308 $error = $svc_something->insert;
310 $dbh->rollback if $oldAutoCommit;
311 return "inserting svc_ (transaction rolled back): $error";
318 $dbh->rollback if $oldAutoCommit;
319 return "No svc_acct record to apply pre-paid time";
322 if ( @param ) { # INVOICING_LIST_ARYREF
323 my $invoicing_list = shift @param;
324 $error = $self->check_invoicing_list( $invoicing_list );
326 $dbh->rollback if $oldAutoCommit;
327 return "checking invoicing_list (transaction rolled back): $error";
329 $self->invoicing_list( $invoicing_list );
333 my $cust_credit = new FS::cust_credit {
334 'custnum' => $self->custnum,
337 $error = $cust_credit->insert;
339 $dbh->rollback if $oldAutoCommit;
340 return "inserting credit (transaction rolled back): $error";
344 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
349 =item delete NEW_CUSTNUM
351 This deletes the customer. If there is an error, returns the error, otherwise
354 This will completely remove all traces of the customer record. This is not
355 what you want when a customer cancels service; for that, cancel all of the
356 customer's packages (see L<FS::cust_pkg/cancel>).
358 If the customer has any packages, you need to pass a new (valid) customer
359 number for those packages to be transferred to.
361 You can't delete a customer with invoices (see L<FS::cust_bill>),
362 or credits (see L<FS::cust_credit>).
369 local $SIG{HUP} = 'IGNORE';
370 local $SIG{INT} = 'IGNORE';
371 local $SIG{QUIT} = 'IGNORE';
372 local $SIG{TERM} = 'IGNORE';
373 local $SIG{TSTP} = 'IGNORE';
374 local $SIG{PIPE} = 'IGNORE';
376 my $oldAutoCommit = $FS::UID::AutoCommit;
377 local $FS::UID::AutoCommit = 0;
380 if ( qsearch( 'cust_bill', { 'custnum' => $self->custnum } ) ) {
381 $dbh->rollback if $oldAutoCommit;
382 return "Can't delete a customer with invoices";
384 if ( qsearch( 'cust_credit', { 'custnum' => $self->custnum } ) ) {
385 $dbh->rollback if $oldAutoCommit;
386 return "Can't delete a customer with credits";
389 my @cust_pkg = qsearch( 'cust_pkg', { 'custnum' => $self->custnum } );
391 my $new_custnum = shift;
392 unless ( qsearchs( 'cust_main', { 'custnum' => $new_custnum } ) ) {
393 $dbh->rollback if $oldAutoCommit;
394 return "Invalid new customer number: $new_custnum";
396 foreach my $cust_pkg ( @cust_pkg ) {
397 my %hash = $cust_pkg->hash;
398 $hash{'custnum'} = $new_custnum;
399 my $new_cust_pkg = new FS::cust_pkg ( \%hash );
400 my $error = $new_cust_pkg->replace($cust_pkg);
402 $dbh->rollback if $oldAutoCommit;
407 foreach my $cust_main_invoice (
408 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } )
410 my $error = $cust_main_invoice->delete;
412 $dbh->rollback if $oldAutoCommit;
417 my $error = $self->SUPER::delete;
419 $dbh->rollback if $oldAutoCommit;
423 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
428 =item replace OLD_RECORD [ INVOICING_LIST_ARYREF ]
430 Replaces the OLD_RECORD with this one in the database. If there is an error,
431 returns the error, otherwise returns false.
433 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
434 be set as the invoicing list (see L<"invoicing_list">). Errors return as
435 expected and rollback the entire transaction; it is not necessary to call
436 check_invoicing_list first. Here's an example:
438 $new_cust_main->replace( $old_cust_main, [ $email, 'POST' ] );
447 local $SIG{HUP} = 'IGNORE';
448 local $SIG{INT} = 'IGNORE';
449 local $SIG{QUIT} = 'IGNORE';
450 local $SIG{TERM} = 'IGNORE';
451 local $SIG{TSTP} = 'IGNORE';
452 local $SIG{PIPE} = 'IGNORE';
454 my $oldAutoCommit = $FS::UID::AutoCommit;
455 local $FS::UID::AutoCommit = 0;
458 my $error = $self->SUPER::replace($old);
461 $dbh->rollback if $oldAutoCommit;
465 if ( @param ) { # INVOICING_LIST_ARYREF
466 my $invoicing_list = shift @param;
467 $error = $self->check_invoicing_list( $invoicing_list );
469 $dbh->rollback if $oldAutoCommit;
472 $self->invoicing_list( $invoicing_list );
475 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
482 Checks all fields to make sure this is a valid customer record. If there is
483 an error, returns the error, otherwise returns false. Called by the insert
492 $self->ut_numbern('custnum')
493 || $self->ut_number('agentnum')
494 || $self->ut_number('refnum')
495 || $self->ut_name('last')
496 || $self->ut_name('first')
497 || $self->ut_textn('company')
498 || $self->ut_text('address1')
499 || $self->ut_textn('address2')
500 || $self->ut_text('city')
501 || $self->ut_textn('county')
502 || $self->ut_textn('state')
503 || $self->ut_country('country')
504 || $self->ut_anything('comments')
505 || $self->ut_numbern('referral_custnum')
507 #barf. need message catalogs. i18n. etc.
508 $error .= "Please select a referral."
509 if $error =~ /^Illegal or empty \(numeric\) refnum: /;
510 return $error if $error;
512 return "Unknown agent"
513 unless qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
515 return "Unknown referral"
516 unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } );
518 return "Unknown referring custnum ". $self->referral_custnum
519 unless ! $self->referral_custnum
520 || qsearchs( 'cust_main', { 'custnum' => $self->referral_custnum } );
522 if ( $self->ss eq '' ) {
527 $ss =~ /^(\d{3})(\d{2})(\d{4})$/
528 or return "Illegal social security number: ". $self->ss;
529 $self->ss("$1-$2-$3");
532 unless ( qsearchs('cust_main_county', {
533 'country' => $self->country,
536 return "Unknown state/county/country: ".
537 $self->state. "/". $self->county. "/". $self->country
538 unless qsearchs('cust_main_county',{
539 'state' => $self->state,
540 'county' => $self->county,
541 'country' => $self->country,
546 $self->ut_phonen('daytime', $self->country)
547 || $self->ut_phonen('night', $self->country)
548 || $self->ut_phonen('fax', $self->country)
549 || $self->ut_zip('zip', $self->country)
551 return $error if $error;
554 last first company address1 address2 city county state zip
555 country daytime night fax
558 if ( defined $self->dbdef_table->column('ship_last') ) {
559 if ( grep { $self->getfield($_) ne $self->getfield("ship_$_") } @addfields
560 && grep $self->getfield("ship_$_"), grep $_ ne 'state', @addfields
564 $self->ut_name('ship_last')
565 || $self->ut_name('ship_first')
566 || $self->ut_textn('ship_company')
567 || $self->ut_text('ship_address1')
568 || $self->ut_textn('ship_address2')
569 || $self->ut_text('ship_city')
570 || $self->ut_textn('ship_county')
571 || $self->ut_textn('ship_state')
572 || $self->ut_country('ship_country')
574 return $error if $error;
576 #false laziness with above
577 unless ( qsearchs('cust_main_county', {
578 'country' => $self->ship_country,
581 return "Unknown ship_state/ship_county/ship_country: ".
582 $self->ship_state. "/". $self->ship_county. "/". $self->ship_country
583 unless qsearchs('cust_main_county',{
584 'state' => $self->ship_state,
585 'county' => $self->ship_county,
586 'country' => $self->ship_country,
592 $self->ut_phonen('ship_daytime', $self->ship_country)
593 || $self->ut_phonen('ship_night', $self->ship_country)
594 || $self->ut_phonen('ship_fax', $self->ship_country)
595 || $self->ut_zip('ship_zip', $self->ship_country)
597 return $error if $error;
599 } else { # ship_ info eq billing info, so don't store dup info in database
600 $self->setfield("ship_$_", '')
601 foreach qw( last first company address1 address2 city county state zip
602 country daytime night fax );
606 $self->payby =~ /^(CARD|BILL|COMP|PREPAY)$/
607 or return "Illegal payby: ". $self->payby;
610 if ( $self->payby eq 'CARD' ) {
612 my $payinfo = $self->payinfo;
614 $payinfo =~ /^(\d{13,16})$/
615 or return "Illegal credit card number: ". $self->payinfo;
617 $self->payinfo($payinfo);
619 or return "Illegal credit card number: ". $self->payinfo;
620 return "Unknown card type" if cardtype($self->payinfo) eq "Unknown";
622 } elsif ( $self->payby eq 'BILL' ) {
624 $error = $self->ut_textn('payinfo');
625 return "Illegal P.O. number: ". $self->payinfo if $error;
627 } elsif ( $self->payby eq 'COMP' ) {
629 $error = $self->ut_textn('payinfo');
630 return "Illegal comp account issuer: ". $self->payinfo if $error;
632 } elsif ( $self->payby eq 'PREPAY' ) {
634 my $payinfo = $self->payinfo;
635 $payinfo =~ s/\W//g; #anything else would just confuse things
636 $self->payinfo($payinfo);
637 $error = $self->ut_alpha('payinfo');
638 return "Illegal prepayment identifier: ". $self->payinfo if $error;
639 return "Unknown prepayment identifier"
640 unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } );
644 if ( $self->paydate eq '' || $self->paydate eq '-' ) {
645 return "Expriation date required"
646 unless $self->payby eq 'BILL' || $self->payby eq 'PREPAY';
649 $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/
650 or return "Illegal expiration date: ". $self->paydate;
651 if ( length($2) == 4 ) {
652 $self->paydate("$2-$1-01");
654 $self->paydate("20$2-$1-01");
658 if ( $self->payname eq '' ) {
659 $self->payname( $self->first. " ". $self->getfield('last') );
661 $self->payname =~ /^([\w \,\.\-\']+)$/
662 or return "Illegal billing name: ". $self->payname;
666 $self->tax =~ /^(Y?)$/ or return "Illegal tax: ". $self->tax;
669 $self->otaker(getotaker);
676 Returns all packages (see L<FS::cust_pkg>) for this customer.
682 qsearch( 'cust_pkg', { 'custnum' => $self->custnum });
685 =item ncancelled_pkgs
687 Returns all non-cancelled packages (see L<FS::cust_pkg>) for this customer.
691 sub ncancelled_pkgs {
693 @{ [ # force list context
694 qsearch( 'cust_pkg', {
695 'custnum' => $self->custnum,
698 qsearch( 'cust_pkg', {
699 'custnum' => $self->custnum,
707 Generates invoices (see L<FS::cust_bill>) for this customer. Usually used in
708 conjunction with the collect method.
710 The only currently available option is `time', which bills the customer as if
711 it were that time. It is specified as a UNIX timestamp; see
712 L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion
715 If there is an error, returns the error, otherwise returns false.
720 my( $self, %options ) = @_;
721 my $time = $options{'time'} || time;
726 local $SIG{HUP} = 'IGNORE';
727 local $SIG{INT} = 'IGNORE';
728 local $SIG{QUIT} = 'IGNORE';
729 local $SIG{TERM} = 'IGNORE';
730 local $SIG{TSTP} = 'IGNORE';
731 local $SIG{PIPE} = 'IGNORE';
733 my $oldAutoCommit = $FS::UID::AutoCommit;
734 local $FS::UID::AutoCommit = 0;
737 # find the packages which are due for billing, find out how much they are
738 # & generate invoice database.
740 my( $total_setup, $total_recur ) = ( 0, 0 );
743 foreach my $cust_pkg (
744 qsearch('cust_pkg',{'custnum'=> $self->getfield('custnum') } )
747 next if $cust_pkg->getfield('cancel');
749 #? to avoid use of uninitialized value errors... ?
750 $cust_pkg->setfield('bill', '')
751 unless defined($cust_pkg->bill);
753 my $part_pkg = qsearchs( 'part_pkg', { 'pkgpart' => $cust_pkg->pkgpart } );
755 #so we don't modify cust_pkg record unnecessarily
756 my $cust_pkg_mod_flag = 0;
757 my %hash = $cust_pkg->hash;
758 my $old_cust_pkg = new FS::cust_pkg \%hash;
762 unless ( $cust_pkg->setup ) {
763 my $setup_prog = $part_pkg->getfield('setup');
764 $setup_prog =~ /^(.*)$/ #presumably trusted
765 or die "Illegal setup for package ". $cust_pkg->pkgnum. ": $setup_prog";
768 #$cpt->permit(); #what is necessary?
769 $cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
770 $setup = $cpt->reval($setup_prog);
771 unless ( defined($setup) ) {
772 warn "Error reval-ing part_pkg->setup pkgpart ",
773 $part_pkg->pkgpart, ": $@";
775 $cust_pkg->setfield('setup',$time);
776 $cust_pkg_mod_flag=1;
783 if ( $part_pkg->getfield('freq') > 0 &&
784 ! $cust_pkg->getfield('susp') &&
785 ( $cust_pkg->getfield('bill') || 0 ) < $time
787 my $recur_prog = $part_pkg->getfield('recur');
788 $recur_prog =~ /^(.*)$/ #presumably trusted
789 or die "Illegal recur for package ". $cust_pkg->pkgnum. ": $recur_prog";
792 #$cpt->permit(); #what is necessary?
793 $cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
794 $recur = $cpt->reval($recur_prog);
795 unless ( defined($recur) ) {
796 warn "Error reval-ing part_pkg->recur pkgpart ",
797 $part_pkg->pkgpart, ": $@";
799 #change this bit to use Date::Manip? CAREFUL with timezones (see
800 # mailing list archive)
801 #$sdate=$cust_pkg->bill || time;
802 #$sdate=$cust_pkg->bill || $time;
803 $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
804 my ($sec,$min,$hour,$mday,$mon,$year) =
805 (localtime($sdate) )[0,1,2,3,4,5];
806 $mon += $part_pkg->getfield('freq');
807 until ( $mon < 12 ) { $mon -= 12; $year++; }
808 $cust_pkg->setfield('bill',
809 timelocal($sec,$min,$hour,$mday,$mon,$year));
810 $cust_pkg_mod_flag = 1;
814 warn "setup is undefined" unless defined($setup);
815 warn "recur is undefined" unless defined($recur);
816 warn "cust_pkg bill is undefined" unless defined($cust_pkg->bill);
818 if ( $cust_pkg_mod_flag ) {
819 $error=$cust_pkg->replace($old_cust_pkg);
820 if ( $error ) { #just in case
821 warn "Error modifying pkgnum ", $cust_pkg->pkgnum, ": $error";
823 $setup = sprintf( "%.2f", $setup );
824 $recur = sprintf( "%.2f", $recur );
825 my $cust_bill_pkg = new FS::cust_bill_pkg ({
826 'pkgnum' => $cust_pkg->pkgnum,
830 'edate' => $cust_pkg->bill,
832 push @cust_bill_pkg, $cust_bill_pkg;
833 $total_setup += $setup;
834 $total_recur += $recur;
840 my $charged = sprintf( "%.2f", $total_setup + $total_recur );
842 unless ( @cust_bill_pkg ) {
843 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
847 unless ( $self->getfield('tax') =~ /Y/i
848 || $self->getfield('payby') eq 'COMP'
850 my $cust_main_county = qsearchs('cust_main_county',{
851 'state' => $self->state,
852 'county' => $self->county,
853 'country' => $self->country,
855 my $tax = sprintf( "%.2f",
856 $charged * ( $cust_main_county->getfield('tax') / 100 )
858 $charged = sprintf( "%.2f", $charged+$tax );
860 my $cust_bill_pkg = new FS::cust_bill_pkg ({
867 push @cust_bill_pkg, $cust_bill_pkg;
870 my $cust_bill = new FS::cust_bill ( {
871 'custnum' => $self->getfield('custnum'),
873 'charged' => $charged,
875 $error = $cust_bill->insert;
877 $dbh->rollback if $oldAutoCommit;
878 return "$error for customer #". $self->custnum;
881 my $invnum = $cust_bill->invnum;
883 foreach $cust_bill_pkg ( @cust_bill_pkg ) {
884 $cust_bill_pkg->setfield( 'invnum', $invnum );
885 $error = $cust_bill_pkg->insert;
886 #shouldn't happen, but how else tohandle this?
888 $dbh->rollback if $oldAutoCommit;
889 return "$error for customer #". $self->custnum;
893 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
897 =item collect OPTIONS
899 (Attempt to) collect money for this customer's outstanding invoices (see
900 L<FS::cust_bill>). Usually used after the bill method.
902 Depending on the value of `payby', this may print an invoice (`BILL'), charge
903 a credit card (`CARD'), or just add any necessary (pseudo-)payment (`COMP').
905 If there is an error, returns the error, otherwise returns false.
907 Currently available options are:
909 invoice_time - Use this time when deciding when to print invoices and
910 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>
911 for conversion functions.
913 batch_card - Set this true to batch cards (see L<cust_pay_batch>). By
914 default, cards are processed immediately, which will generate an error if
915 CyberCash is not installed.
917 report_badcard - Set this true if you want bad card transactions to
918 return an error. By default, they don't.
923 my( $self, %options ) = @_;
924 my $invoice_time = $options{'invoice_time'} || time;
927 local $SIG{HUP} = 'IGNORE';
928 local $SIG{INT} = 'IGNORE';
929 local $SIG{QUIT} = 'IGNORE';
930 local $SIG{TERM} = 'IGNORE';
931 local $SIG{TSTP} = 'IGNORE';
932 local $SIG{PIPE} = 'IGNORE';
934 my $oldAutoCommit = $FS::UID::AutoCommit;
935 local $FS::UID::AutoCommit = 0;
938 my $total_owed = $self->balance;
939 warn "collect: total owed $total_owed " if $Debug;
940 unless ( $total_owed > 0 ) { #redundant?????
941 $dbh->rollback if $oldAutoCommit;
945 foreach my $cust_bill (
946 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
949 #this has to be before next's
950 my $amount = sprintf( "%.2f", $total_owed < $cust_bill->owed
954 $total_owed = sprintf( "%.2f", $total_owed - $amount );
956 next unless $cust_bill->owed > 0;
958 next if qsearchs( 'cust_pay_batch', { 'invnum' => $cust_bill->invnum } );
960 warn "invnum ". $cust_bill->invnum. " (owed ". $cust_bill->owed. ", amount $amount, total_owed $total_owed)" if $Debug;
962 next unless $amount > 0;
964 if ( $self->payby eq 'BILL' ) {
967 my $since = $invoice_time - ( $cust_bill->_date || 0 );
968 #warn "$invoice_time ", $cust_bill->_date, " $since";
969 if ( $since >= 0 #don't print future invoices
970 && ( $cust_bill->printed * 2592000 ) <= $since
973 #my @print_text = $cust_bill->print_text; #( date )
974 my @invoicing_list = $self->invoicing_list;
975 if ( grep { $_ ne 'POST' } @invoicing_list ) { #email invoice
976 $ENV{SMTPHOSTS} = $smtpmachine;
977 $ENV{MAILADDRESS} = $invoice_from;
978 my $header = new Mail::Header ( [
979 "From: $invoice_from",
980 "To: ". join(', ', grep { $_ ne 'POST' } @invoicing_list ),
981 "Sender: $invoice_from",
982 "Reply-To: $invoice_from",
983 "Date: ". time2str("%a, %d %b %Y %X %z", time),
986 my $message = new Mail::Internet (
988 'Body' => [ $cust_bill->print_text ], #( date)
990 $message->smtpsend or die "Can't send invoice email!"; #die? warn?
992 } elsif ( ! @invoicing_list || grep { $_ eq 'POST' } @invoicing_list ) {
993 open(LPR, "|$lpr") or die "Can't open pipe to $lpr: $!";
994 print LPR $cust_bill->print_text; #( date )
996 or die $! ? "Error closing $lpr: $!"
997 : "Exit status $? from $lpr";
1000 my %hash = $cust_bill->hash;
1002 my $new_cust_bill = new FS::cust_bill(\%hash);
1003 my $error = $new_cust_bill->replace($cust_bill);
1004 warn "Error updating $cust_bill->printed: $error" if $error;
1008 } elsif ( $self->payby eq 'COMP' ) {
1009 my $cust_pay = new FS::cust_pay ( {
1010 'invnum' => $cust_bill->invnum,
1014 'payinfo' => $self->payinfo,
1017 my $error = $cust_pay->insert;
1019 $dbh->rollback if $oldAutoCommit;
1020 return 'Error COMPing invnum #'. $cust_bill->invnum. ": $error";
1024 } elsif ( $self->payby eq 'CARD' ) {
1026 if ( $options{'batch_card'} ne 'yes' ) {
1028 unless ( $processor ) {
1029 $dbh->rollback if $oldAutoCommit;
1030 return "Real time card processing not enabled!";
1033 my $address = $self->address1;
1034 $address .= ", ". $self->address2 if $self->address2;
1037 #$self->paydate =~ /^(\d+)\/\d*(\d{2})$/;
1038 $self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
1041 if ( $processor =~ /^cybercash/ ) {
1043 #fix exp. date for cybercash
1044 #$self->paydate =~ /^(\d+)\/\d*(\d{2})$/;
1045 $self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
1048 my $paybatch = $cust_bill->invnum.
1049 '-' . time2str("%y%m%d%H%M%S", time);
1051 my $payname = $self->payname ||
1052 $self->getfield('first'). ' '. $self->getfield('last');
1055 my $country = $self->country eq 'US' ? 'USA' : $self->country;
1057 my @full_xaction = ( $xaction,
1058 'Order-ID' => $paybatch,
1059 'Amount' => "usd $amount",
1060 'Card-Number' => $self->getfield('payinfo'),
1061 'Card-Name' => $payname,
1062 'Card-Address' => $address,
1063 'Card-City' => $self->getfield('city'),
1064 'Card-State' => $self->getfield('state'),
1065 'Card-Zip' => $self->getfield('zip'),
1066 'Card-Country' => $country,
1071 if ( $processor eq 'cybercash2' ) {
1072 $^W=0; #CCLib isn't -w safe, ugh!
1073 %result = &CCLib::sendmserver(@full_xaction);
1075 } elsif ( $processor eq 'cybercash3.2' ) {
1076 %result = &CCMckDirectLib3_2::SendCC2_1Server(@full_xaction);
1078 $dbh->rollback if $oldAutoCommit;
1079 return "Unknown real-time processor $processor";
1082 #if ( $result{'MActionCode'} == 7 ) { #cybercash smps v.1.1.3
1083 #if ( $result{'action-code'} == 7 ) { #cybercash smps v.2.1
1084 if ( $result{'MStatus'} eq 'success' ) { #cybercash smps v.2 or 3
1085 my $cust_pay = new FS::cust_pay ( {
1086 'invnum' => $cust_bill->invnum,
1090 'payinfo' => $self->payinfo,
1091 'paybatch' => "$processor:$paybatch",
1093 my $error = $cust_pay->insert;
1095 # gah, even with transactions.
1096 $dbh->commit if $oldAutoCommit; #well.
1097 my $e = 'WARNING: Card debited but database not updated - '.
1098 'error applying payment, invnum #' . $cust_bill->invnum.
1099 " (CyberCash Order-ID $paybatch): $error";
1103 } elsif ( $result{'Mstatus'} ne 'failure-bad-money'
1104 || $options{'report_badcard'} ) {
1105 $dbh->commit if $oldAutoCommit;
1106 return 'Cybercash error, invnum #' .
1107 $cust_bill->invnum. ':'. $result{'MErrMsg'};
1109 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1113 } elsif ( $processor =~ /^Business::OnlinePayment::(.*)$/ ) {
1115 my($payname, $payfirst, $paylast);
1116 if ( $self->payname ) {
1117 $payname = $self->payname;
1118 $payname =~ /^\s*([\w \,\.\-\']*\w)?\s+([\w\,\.\-\']+)$/
1120 $dbh->rollback if $oldAutoCommit;
1121 return "Illegal payname $payname";
1123 ($payfirst, $paylast) = ($1, $2);
1125 $payfirst = $self->getfield('first');
1126 $paylast = $self->getfield('first');
1127 $payname = "$payfirst $paylast";
1130 my $transaction = new Business::OnlinePayment( $1, @bop_options );
1131 $transaction->content(
1133 'login' => $bop_login,
1134 'password' => $bop_password,
1135 'action' => $bop_action,
1136 'amount' => $amount,
1137 'invoice_number' => $cust_bill->invnum,
1138 'customer_id' => $self->custnum,
1139 'last_name' => $paylast,
1140 'first_name' => $payfirst,
1142 'address' => $address,
1143 'city' => $self->city,
1144 'state' => $self->state,
1145 'zip' => $self->zip,
1146 'country' => $self->country,
1147 'card_number' => $self->payinfo,
1148 'expiration' => $exp,
1150 $transaction->submit();
1152 if ( $transaction->is_success()) {
1153 my $cust_pay = new FS::cust_pay ( {
1154 'invnum' => $cust_bill->invnum,
1158 'payinfo' => $self->payinfo,
1159 'paybatch' => "$processor:". $transaction->authorization,
1161 my $error = $cust_pay->insert;
1163 # gah, even with transactions.
1164 $dbh->commit if $oldAutoCommit; #well.
1165 my $e = 'WARNING: Card debited but database not updated - '.
1166 'error applying payment, invnum #' . $cust_bill->invnum.
1167 " ($processor): $error";
1171 } elsif ( $options{'report_badcard'} ) {
1172 $dbh->commit if $oldAutoCommit;
1173 return "$processor error, invnum #". $cust_bill->invnum. ': '.
1174 $transaction->result_code. ": ". $transaction->error_message;
1176 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1181 $dbh->rollback if $oldAutoCommit;
1182 return "Unknown real-time processor $processor\n";
1185 } else { #batch card
1187 my $cust_pay_batch = new FS::cust_pay_batch ( {
1188 'invnum' => $cust_bill->getfield('invnum'),
1189 'custnum' => $self->getfield('custnum'),
1190 'last' => $self->getfield('last'),
1191 'first' => $self->getfield('first'),
1192 'address1' => $self->getfield('address1'),
1193 'address2' => $self->getfield('address2'),
1194 'city' => $self->getfield('city'),
1195 'state' => $self->getfield('state'),
1196 'zip' => $self->getfield('zip'),
1197 'country' => $self->getfield('country'),
1199 'cardnum' => $self->getfield('payinfo'),
1200 'exp' => $self->getfield('paydate'),
1201 'payname' => $self->getfield('payname'),
1202 'amount' => $amount,
1204 my $error = $cust_pay_batch->insert;
1206 $dbh->rollback if $oldAutoCommit;
1207 return "Error adding to cust_pay_batch: $error";
1213 $dbh->rollback if $oldAutoCommit;
1214 return "Unknown payment type ". $self->payby;
1218 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1225 Returns the total owed for this customer on all invoices
1226 (see L<FS::cust_bill>).
1233 foreach my $cust_bill ( qsearch('cust_bill', {
1234 'custnum' => $self->custnum,
1236 $total_bill += $cust_bill->owed;
1238 sprintf( "%.2f", $total_bill );
1241 =item total_credited
1243 Returns the total credits (see L<FS::cust_credit>) for this customer.
1247 sub total_credited {
1249 my $total_credit = 0;
1250 foreach my $cust_credit ( qsearch('cust_credit', {
1251 'custnum' => $self->custnum,
1253 $total_credit += $cust_credit->credited;
1255 sprintf( "%.2f", $total_credit );
1260 Returns the balance for this customer (total owed minus total credited).
1266 sprintf( "%.2f", $self->total_owed - $self->total_credited );
1269 =item invoicing_list [ ARRAYREF ]
1271 If an arguement is given, sets these email addresses as invoice recipients
1272 (see L<FS::cust_main_invoice>). Errors are not fatal and are not reported
1273 (except as warnings), so use check_invoicing_list first.
1275 Returns a list of email addresses (with svcnum entries expanded).
1277 Note: You can clear the invoicing list by passing an empty ARRAYREF. You can
1278 check it without disturbing anything by passing nothing.
1280 This interface may change in the future.
1284 sub invoicing_list {
1285 my( $self, $arrayref ) = @_;
1287 my @cust_main_invoice;
1288 if ( $self->custnum ) {
1289 @cust_main_invoice =
1290 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1292 @cust_main_invoice = ();
1294 foreach my $cust_main_invoice ( @cust_main_invoice ) {
1295 #warn $cust_main_invoice->destnum;
1296 unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
1297 #warn $cust_main_invoice->destnum;
1298 my $error = $cust_main_invoice->delete;
1299 warn $error if $error;
1302 if ( $self->custnum ) {
1303 @cust_main_invoice =
1304 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1306 @cust_main_invoice = ();
1308 foreach my $address ( @{$arrayref} ) {
1309 unless ( grep { $address eq $_->address } @cust_main_invoice ) {
1310 my $cust_main_invoice = new FS::cust_main_invoice ( {
1311 'custnum' => $self->custnum,
1314 my $error = $cust_main_invoice->insert;
1315 warn $error if $error;
1319 if ( $self->custnum ) {
1321 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1327 =item check_invoicing_list ARRAYREF
1329 Checks these arguements as valid input for the invoicing_list method. If there
1330 is an error, returns the error, otherwise returns false.
1334 sub check_invoicing_list {
1335 my( $self, $arrayref ) = @_;
1336 foreach my $address ( @{$arrayref} ) {
1337 my $cust_main_invoice = new FS::cust_main_invoice ( {
1338 'custnum' => $self->custnum,
1341 my $error = $self->custnum
1342 ? $cust_main_invoice->check
1343 : $cust_main_invoice->checkdest
1345 return $error if $error;
1350 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
1352 Returns an array of customers referred by this customer (referral_custnum set
1353 to this custnum). If DEPTH is given, recurses up to the given depth, returning
1354 customers referred by customers referred by this customer and so on, inclusive.
1355 The default behavior is DEPTH 1 (no recursion).
1359 sub referral_cust_main {
1361 my $depth = @_ ? shift : 1;
1362 my $exclude = @_ ? shift : {};
1365 map { $exclude->{$_->custnum}++; $_; }
1366 grep { ! $exclude->{ $_->custnum } }
1367 qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
1371 map { $_->referral_cust_main($depth-1, $exclude) }
1384 =item rebuild_fuzzyfile
1388 sub rebuild_fuzzyfiles {
1389 my @all_last = map $_->getfield('last'), qsearch('cust_main', {});
1391 grep $_, map $_->getfield('ship_last'), qsearch('cust_main',{})
1392 if defined dbdef->table('cust_main')->column('ship_last');
1401 $Id: cust_main.pm,v 1.23 2001-09-01 20:11:07 ivan Exp $
1407 The delete method should possibly take an FS::cust_main object reference
1408 instead of a scalar customer number.
1410 Bill and collect options should probably be passed as references instead of a
1413 CyberCash v2 forces us to define some variables in package main.
1415 There should probably be a configuration file with a list of allowed credit
1418 No multiple currency support (probably a larger project than just this module).
1422 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
1423 L<FS::cust_pay_batch>, L<FS::agent>, L<FS::part_referral>,
1424 L<FS::cust_main_county>, L<FS::cust_main_invoice>,
1425 L<FS::UID>, schema.html from the base documentation.