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;
960 next if qsearchs( 'cust_pay_batch', { 'invnum' => $cust_bill->invnum } );
962 warn "invnum ". $cust_bill->invnum. " (owed ". $cust_bill->owed. ", amount $amount, total_owed $total_owed)" if $Debug;
964 next unless $amount > 0;
966 if ( $self->payby eq 'BILL' ) {
969 my $since = $invoice_time - ( $cust_bill->_date || 0 );
970 #warn "$invoice_time ", $cust_bill->_date, " $since";
971 if ( $since >= 0 #don't print future invoices
972 && ( $cust_bill->printed * 2592000 ) <= $since
975 #my @print_text = $cust_bill->print_text; #( date )
976 my @invoicing_list = $self->invoicing_list;
977 if ( grep { $_ ne 'POST' } @invoicing_list ) { #email invoice
978 $ENV{SMTPHOSTS} = $smtpmachine;
979 $ENV{MAILADDRESS} = $invoice_from;
980 my $header = new Mail::Header ( [
981 "From: $invoice_from",
982 "To: ". join(', ', grep { $_ ne 'POST' } @invoicing_list ),
983 "Sender: $invoice_from",
984 "Reply-To: $invoice_from",
985 "Date: ". time2str("%a, %d %b %Y %X %z", time),
988 my $message = new Mail::Internet (
990 'Body' => [ $cust_bill->print_text ], #( date)
992 $message->smtpsend or die "Can't send invoice email!"; #die? warn?
994 } elsif ( ! @invoicing_list || grep { $_ eq 'POST' } @invoicing_list ) {
995 open(LPR, "|$lpr") or die "Can't open pipe to $lpr: $!";
996 print LPR $cust_bill->print_text; #( date )
998 or die $! ? "Error closing $lpr: $!"
999 : "Exit status $? from $lpr";
1002 my %hash = $cust_bill->hash;
1004 my $new_cust_bill = new FS::cust_bill(\%hash);
1005 my $error = $new_cust_bill->replace($cust_bill);
1006 warn "Error updating $cust_bill->printed: $error" if $error;
1010 } elsif ( $self->payby eq 'COMP' ) {
1011 my $cust_pay = new FS::cust_pay ( {
1012 'invnum' => $cust_bill->invnum,
1016 'payinfo' => $self->payinfo,
1019 my $error = $cust_pay->insert;
1021 $dbh->rollback if $oldAutoCommit;
1022 return 'Error COMPing invnum #'. $cust_bill->invnum. ": $error";
1026 } elsif ( $self->payby eq 'CARD' ) {
1028 if ( $options{'batch_card'} ne 'yes' ) {
1030 unless ( $processor ) {
1031 $dbh->rollback if $oldAutoCommit;
1032 return "Real time card processing not enabled!";
1035 my $address = $self->address1;
1036 $address .= ", ". $self->address2 if $self->address2;
1039 #$self->paydate =~ /^(\d+)\/\d*(\d{2})$/;
1040 $self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
1043 if ( $processor =~ /^cybercash/ ) {
1045 #fix exp. date for cybercash
1046 #$self->paydate =~ /^(\d+)\/\d*(\d{2})$/;
1047 $self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
1050 my $paybatch = $cust_bill->invnum.
1051 '-' . time2str("%y%m%d%H%M%S", time);
1053 my $payname = $self->payname ||
1054 $self->getfield('first'). ' '. $self->getfield('last');
1057 my $country = $self->country eq 'US' ? 'USA' : $self->country;
1059 my @full_xaction = ( $xaction,
1060 'Order-ID' => $paybatch,
1061 'Amount' => "usd $amount",
1062 'Card-Number' => $self->getfield('payinfo'),
1063 'Card-Name' => $payname,
1064 'Card-Address' => $address,
1065 'Card-City' => $self->getfield('city'),
1066 'Card-State' => $self->getfield('state'),
1067 'Card-Zip' => $self->getfield('zip'),
1068 'Card-Country' => $country,
1073 if ( $processor eq 'cybercash2' ) {
1074 $^W=0; #CCLib isn't -w safe, ugh!
1075 %result = &CCLib::sendmserver(@full_xaction);
1077 } elsif ( $processor eq 'cybercash3.2' ) {
1078 %result = &CCMckDirectLib3_2::SendCC2_1Server(@full_xaction);
1080 $dbh->rollback if $oldAutoCommit;
1081 return "Unknown real-time processor $processor";
1084 #if ( $result{'MActionCode'} == 7 ) { #cybercash smps v.1.1.3
1085 #if ( $result{'action-code'} == 7 ) { #cybercash smps v.2.1
1086 if ( $result{'MStatus'} eq 'success' ) { #cybercash smps v.2 or 3
1087 my $cust_pay = new FS::cust_pay ( {
1088 'invnum' => $cust_bill->invnum,
1092 'payinfo' => $self->payinfo,
1093 'paybatch' => "$processor:$paybatch",
1095 my $error = $cust_pay->insert;
1097 # gah, even with transactions.
1098 $dbh->commit if $oldAutoCommit; #well.
1099 my $e = 'WARNING: Card debited but database not updated - '.
1100 'error applying payment, invnum #' . $cust_bill->invnum.
1101 " (CyberCash Order-ID $paybatch): $error";
1105 } elsif ( $result{'Mstatus'} ne 'failure-bad-money'
1106 || $options{'report_badcard'} ) {
1107 $dbh->commit if $oldAutoCommit;
1108 return 'Cybercash error, invnum #' .
1109 $cust_bill->invnum. ':'. $result{'MErrMsg'};
1111 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1115 } elsif ( $processor =~ /^Business::OnlinePayment::(.*)$/ ) {
1117 my($payname, $payfirst, $paylast);
1118 if ( $self->payname ) {
1119 $payname = $self->payname;
1120 $payname =~ /^\s*([\w \,\.\-\']*\w)?\s+([\w\,\.\-\']+)$/
1122 $dbh->rollback if $oldAutoCommit;
1123 return "Illegal payname $payname";
1125 ($payfirst, $paylast) = ($1, $2);
1127 $payfirst = $self->getfield('first');
1128 $paylast = $self->getfield('first');
1129 $payname = "$payfirst $paylast";
1132 my $transaction = new Business::OnlinePayment( $1, @bop_options );
1133 $transaction->content(
1135 'login' => $bop_login,
1136 'password' => $bop_password,
1137 'action' => $bop_action,
1138 'amount' => $amount,
1139 'invoice_number' => $cust_bill->invnum,
1140 'customer_id' => $self->custnum,
1141 'last_name' => $paylast,
1142 'first_name' => $payfirst,
1144 'address' => $address,
1145 'city' => $self->city,
1146 'state' => $self->state,
1147 'zip' => $self->zip,
1148 'country' => $self->country,
1149 'card_number' => $self->payinfo,
1150 'expiration' => $exp,
1152 $transaction->submit();
1154 if ( $transaction->is_success()) {
1155 my $cust_pay = new FS::cust_pay ( {
1156 'invnum' => $cust_bill->invnum,
1160 'payinfo' => $self->payinfo,
1161 'paybatch' => "$processor:". $transaction->authorization,
1163 my $error = $cust_pay->insert;
1165 # gah, even with transactions.
1166 $dbh->commit if $oldAutoCommit; #well.
1167 my $e = 'WARNING: Card debited but database not updated - '.
1168 'error applying payment, invnum #' . $cust_bill->invnum.
1169 " ($processor): $error";
1173 } elsif ( $options{'report_badcard'} ) {
1174 $dbh->commit if $oldAutoCommit;
1175 return "$processor error, invnum #". $cust_bill->invnum. ': '.
1176 $transaction->result_code. ": ". $transaction->error_message;
1178 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1183 $dbh->rollback if $oldAutoCommit;
1184 return "Unknown real-time processor $processor\n";
1187 } else { #batch card
1189 my $cust_pay_batch = new FS::cust_pay_batch ( {
1190 'invnum' => $cust_bill->getfield('invnum'),
1191 'custnum' => $self->getfield('custnum'),
1192 'last' => $self->getfield('last'),
1193 'first' => $self->getfield('first'),
1194 'address1' => $self->getfield('address1'),
1195 'address2' => $self->getfield('address2'),
1196 'city' => $self->getfield('city'),
1197 'state' => $self->getfield('state'),
1198 'zip' => $self->getfield('zip'),
1199 'country' => $self->getfield('country'),
1201 'cardnum' => $self->getfield('payinfo'),
1202 'exp' => $self->getfield('paydate'),
1203 'payname' => $self->getfield('payname'),
1204 'amount' => $amount,
1206 my $error = $cust_pay_batch->insert;
1208 $dbh->rollback if $oldAutoCommit;
1209 return "Error adding to cust_pay_batch: $error";
1215 $dbh->rollback if $oldAutoCommit;
1216 return "Unknown payment type ". $self->payby;
1220 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1227 Returns the total owed for this customer on all invoices
1228 (see L<FS::cust_bill>).
1235 foreach my $cust_bill ( qsearch('cust_bill', {
1236 'custnum' => $self->custnum,
1238 $total_bill += $cust_bill->owed;
1240 sprintf( "%.2f", $total_bill );
1245 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
1246 of any remaining unapplied credits available for refund (see L<FS::cust_refund>).
1253 return 0 unless $self->total_credited;
1255 my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
1256 qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
1258 my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
1259 qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
1263 foreach my $cust_bill ( @invoices ) {
1266 if (!(defined $credit) || $credit->credited == 0) {
1267 $credit = pop @credits;
1268 last unless defined $credit;
1271 if ($cust_bill->owed >= $credit->credited) {
1272 $amount=$credit->credited;
1274 $amount=$cust_bill->owed;
1277 my $cust_credit_bill = new FS::cust_credit_bill ( {
1278 'crednum' => $credit->crednum,
1279 'invnum' => $cust_bill->invnum,
1280 'amount' => $amount,
1283 my $error = $cust_credit_bill->insert;
1284 die $error if $error;
1286 redo if ($cust_bill->owed > 0);
1290 return $self->total_credited;
1294 =item total_credited
1296 Returns the total credits (see L<FS::cust_credit>) for this customer.
1300 sub total_credited {
1302 my $total_credit = 0;
1303 foreach my $cust_credit ( qsearch('cust_credit', {
1304 'custnum' => $self->custnum,
1306 $total_credit += $cust_credit->credited;
1308 sprintf( "%.2f", $total_credit );
1313 Returns the balance for this customer (total owed minus total credited).
1319 sprintf( "%.2f", $self->total_owed - $self->total_credited );
1322 =item invoicing_list [ ARRAYREF ]
1324 If an arguement is given, sets these email addresses as invoice recipients
1325 (see L<FS::cust_main_invoice>). Errors are not fatal and are not reported
1326 (except as warnings), so use check_invoicing_list first.
1328 Returns a list of email addresses (with svcnum entries expanded).
1330 Note: You can clear the invoicing list by passing an empty ARRAYREF. You can
1331 check it without disturbing anything by passing nothing.
1333 This interface may change in the future.
1337 sub invoicing_list {
1338 my( $self, $arrayref ) = @_;
1340 my @cust_main_invoice;
1341 if ( $self->custnum ) {
1342 @cust_main_invoice =
1343 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1345 @cust_main_invoice = ();
1347 foreach my $cust_main_invoice ( @cust_main_invoice ) {
1348 #warn $cust_main_invoice->destnum;
1349 unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
1350 #warn $cust_main_invoice->destnum;
1351 my $error = $cust_main_invoice->delete;
1352 warn $error if $error;
1355 if ( $self->custnum ) {
1356 @cust_main_invoice =
1357 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1359 @cust_main_invoice = ();
1361 foreach my $address ( @{$arrayref} ) {
1362 unless ( grep { $address eq $_->address } @cust_main_invoice ) {
1363 my $cust_main_invoice = new FS::cust_main_invoice ( {
1364 'custnum' => $self->custnum,
1367 my $error = $cust_main_invoice->insert;
1368 warn $error if $error;
1372 if ( $self->custnum ) {
1374 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1380 =item check_invoicing_list ARRAYREF
1382 Checks these arguements as valid input for the invoicing_list method. If there
1383 is an error, returns the error, otherwise returns false.
1387 sub check_invoicing_list {
1388 my( $self, $arrayref ) = @_;
1389 foreach my $address ( @{$arrayref} ) {
1390 my $cust_main_invoice = new FS::cust_main_invoice ( {
1391 'custnum' => $self->custnum,
1394 my $error = $self->custnum
1395 ? $cust_main_invoice->check
1396 : $cust_main_invoice->checkdest
1398 return $error if $error;
1403 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
1405 Returns an array of customers referred by this customer (referral_custnum set
1406 to this custnum). If DEPTH is given, recurses up to the given depth, returning
1407 customers referred by customers referred by this customer and so on, inclusive.
1408 The default behavior is DEPTH 1 (no recursion).
1412 sub referral_cust_main {
1414 my $depth = @_ ? shift : 1;
1415 my $exclude = @_ ? shift : {};
1418 map { $exclude->{$_->custnum}++; $_; }
1419 grep { ! $exclude->{ $_->custnum } }
1420 qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
1424 map { $_->referral_cust_main($depth-1, $exclude) }
1437 =item rebuild_fuzzyfile
1441 sub rebuild_fuzzyfiles {
1442 my @all_last = map $_->getfield('last'), qsearch('cust_main', {});
1444 grep $_, map $_->getfield('ship_last'), qsearch('cust_main',{})
1445 if defined dbdef->table('cust_main')->column('ship_last');
1454 $Id: cust_main.pm,v 1.26 2001-09-02 01:27:11 ivan Exp $
1460 The delete method should possibly take an FS::cust_main object reference
1461 instead of a scalar customer number.
1463 Bill and collect options should probably be passed as references instead of a
1466 CyberCash v2 forces us to define some variables in package main.
1468 There should probably be a configuration file with a list of allowed credit
1471 No multiple currency support (probably a larger project than just this module).
1475 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
1476 L<FS::cust_pay_batch>, L<FS::agent>, L<FS::part_referral>,
1477 L<FS::cust_main_county>, L<FS::cust_main_invoice>,
1478 L<FS::UID>, schema.html from the base documentation.