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::cust_bill_pay;
33 use FS::prepay_credit;
35 @ISA = qw( FS::Record );
40 #ask FS::UID to run this stuff for us later
41 $FS::UID::callback{'FS::cust_main'} = sub {
43 $lpr = $conf->config('lpr');
44 $invoice_from = $conf->config('invoice_from');
45 $smtpmachine = $conf->config('smtpmachine');
47 if ( $conf->exists('cybercash3.2') ) {
49 #qw($MCKversion %Config InitConfig CCError CCDebug CCDebug2);
50 require CCMckDirectLib3_2;
52 require CCMckErrno3_2;
53 #qw(MCKGetErrorMessage $E_NoErr);
54 import CCMckErrno3_2 qw($E_NoErr);
57 ($merchant_conf,$xaction)= $conf->config('cybercash3.2');
58 my $status = &CCMckLib3_2::InitConfig($merchant_conf);
59 if ( $status != $E_NoErr ) {
60 warn "CCMckLib3_2::InitConfig error:\n";
61 foreach my $key (keys %CCMckLib3_2::Config) {
62 warn " $key => $CCMckLib3_2::Config{$key}\n"
64 my($errmsg) = &CCMckErrno3_2::MCKGetErrorMessage($status);
65 die "CCMckLib3_2::InitConfig fatal error: $errmsg\n";
67 $processor='cybercash3.2';
68 } elsif ( $conf->exists('cybercash2') ) {
71 ( $main::paymentserverhost,
72 $main::paymentserverport,
73 $main::paymentserversecret,
75 ) = $conf->config('cybercash2');
76 $processor='cybercash2';
77 } elsif ( $conf->exists('business-onlinepayment') ) {
83 ) = $conf->config('business-onlinepayment');
84 $bop_action ||= 'normal authorization';
85 eval "use Business::OnlinePayment";
86 $processor="Business::OnlinePayment::$bop_processor";
92 FS::cust_main - Object methods for cust_main records
98 $record = new FS::cust_main \%hash;
99 $record = new FS::cust_main { 'column' => 'value' };
101 $error = $record->insert;
103 $error = $new_record->replace($old_record);
105 $error = $record->delete;
107 $error = $record->check;
109 @cust_pkg = $record->all_pkgs;
111 @cust_pkg = $record->ncancelled_pkgs;
113 $error = $record->bill;
114 $error = $record->bill %options;
115 $error = $record->bill 'time' => $time;
117 $error = $record->collect;
118 $error = $record->collect %options;
119 $error = $record->collect 'invoice_time' => $time,
120 'batch_card' => 'yes',
121 'report_badcard' => 'yes',
126 An FS::cust_main object represents a customer. FS::cust_main inherits from
127 FS::Record. The following fields are currently supported:
131 =item custnum - primary key (assigned automatically for new customers)
133 =item agentnum - agent (see L<FS::agent>)
135 =item refnum - referral (see L<FS::part_referral>)
141 =item ss - social security number (optional)
143 =item company - (optional)
147 =item address2 - (optional)
151 =item county - (optional, see L<FS::cust_main_county>)
153 =item state - (see L<FS::cust_main_county>)
157 =item country - (see L<FS::cust_main_county>)
159 =item daytime - phone (optional)
161 =item night - phone (optional)
163 =item fax - phone (optional)
165 =item ship_first - name
167 =item ship_last - name
169 =item ship_company - (optional)
173 =item ship_address2 - (optional)
177 =item ship_county - (optional, see L<FS::cust_main_county>)
179 =item ship_state - (see L<FS::cust_main_county>)
183 =item ship_country - (see L<FS::cust_main_county>)
185 =item ship_daytime - phone (optional)
187 =item ship_night - phone (optional)
189 =item ship_fax - phone (optional)
191 =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)
193 =item payinfo - card number, P.O., comp issuer (4-8 lowercase alphanumerics; think username) or prepayment identifier (see L<FS::prepay_credit>)
195 =item paydate - expiration date, mm/yyyy, m/yyyy, mm/yy or m/yy
197 =item payname - name on card or billing name
199 =item tax - tax exempt, empty or `Y'
201 =item otaker - order taker (assigned automatically, see L<FS::UID>)
203 =item comments - comments (optional)
213 Creates a new customer. To add the customer to the database, see L<"insert">.
215 Note that this stores the hash reference, not a distinct copy of the hash it
216 points to. You can ask the object for a copy with the I<hash> method.
220 sub table { 'cust_main'; }
222 =item insert [ CUST_PKG_HASHREF [ , INVOICING_LIST_ARYREF ] ]
224 Adds this customer to the database. If there is an error, returns the error,
225 otherwise returns false.
227 CUST_PKG_HASHREF: If you pass a Tie::RefHash data structure to the insert
228 method containing FS::cust_pkg and FS::svc_I<tablename> objects, all records
229 are inserted atomicly, or the transaction is rolled back (this requries a
230 transactional database). Passing an empty hash reference is equivalent to
231 not supplying this parameter. There should be a better explanation of this,
232 but until then, here's an example:
235 tie %hash, 'Tie::RefHash'; #this part is important
237 $cust_pkg => [ $svc_acct ],
240 $cust_main->insert( \%hash );
242 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
243 be set as the invoicing list (see L<"invoicing_list">). Errors return as
244 expected and rollback the entire transaction; it is not necessary to call
245 check_invoicing_list first. The invoicing_list is set after the records in the
246 CUST_PKG_HASHREF above are inserted, so it is now possible set set an
247 invoicing_list destination to the newly-created svc_acct. Here's an example:
249 $cust_main->insert( {}, [ $email, 'POST' ] );
257 local $SIG{HUP} = 'IGNORE';
258 local $SIG{INT} = 'IGNORE';
259 local $SIG{QUIT} = 'IGNORE';
260 local $SIG{TERM} = 'IGNORE';
261 local $SIG{TSTP} = 'IGNORE';
262 local $SIG{PIPE} = 'IGNORE';
264 my $oldAutoCommit = $FS::UID::AutoCommit;
265 local $FS::UID::AutoCommit = 0;
270 if ( $self->payby eq 'PREPAY' ) {
271 $self->payby('BILL');
272 my $prepay_credit = qsearchs(
274 { 'identifier' => $self->payinfo },
278 warn "WARNING: can't find pre-found prepay_credit: ". $self->payinfo
279 unless $prepay_credit;
280 $amount = $prepay_credit->amount;
281 $seconds = $prepay_credit->seconds;
282 my $error = $prepay_credit->delete;
284 $dbh->rollback if $oldAutoCommit;
285 return "removing prepay_credit (transaction rolled back): $error";
289 my $error = $self->SUPER::insert;
291 $dbh->rollback if $oldAutoCommit;
292 return "inserting cust_main record (transaction rolled back): $error";
295 if ( @param ) { # CUST_PKG_HASHREF
296 my $cust_pkgs = shift @param;
297 foreach my $cust_pkg ( keys %$cust_pkgs ) {
298 $cust_pkg->custnum( $self->custnum );
299 $error = $cust_pkg->insert;
301 $dbh->rollback if $oldAutoCommit;
302 return "inserting cust_pkg (transaction rolled back): $error";
304 foreach my $svc_something ( @{$cust_pkgs->{$cust_pkg}} ) {
305 $svc_something->pkgnum( $cust_pkg->pkgnum );
306 if ( $seconds && $svc_something->isa('FS::svc_acct') ) {
307 $svc_something->seconds( $svc_something->seconds + $seconds );
310 $error = $svc_something->insert;
312 $dbh->rollback if $oldAutoCommit;
313 return "inserting svc_ (transaction rolled back): $error";
320 $dbh->rollback if $oldAutoCommit;
321 return "No svc_acct record to apply pre-paid time";
324 if ( @param ) { # INVOICING_LIST_ARYREF
325 my $invoicing_list = shift @param;
326 $error = $self->check_invoicing_list( $invoicing_list );
328 $dbh->rollback if $oldAutoCommit;
329 return "checking invoicing_list (transaction rolled back): $error";
331 $self->invoicing_list( $invoicing_list );
335 my $cust_credit = new FS::cust_credit {
336 'custnum' => $self->custnum,
339 $error = $cust_credit->insert;
341 $dbh->rollback if $oldAutoCommit;
342 return "inserting credit (transaction rolled back): $error";
346 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
351 =item delete NEW_CUSTNUM
353 This deletes the customer. If there is an error, returns the error, otherwise
356 This will completely remove all traces of the customer record. This is not
357 what you want when a customer cancels service; for that, cancel all of the
358 customer's packages (see L<FS::cust_pkg/cancel>).
360 If the customer has any packages, you need to pass a new (valid) customer
361 number for those packages to be transferred to.
363 You can't delete a customer with invoices (see L<FS::cust_bill>),
364 or credits (see L<FS::cust_credit>).
371 local $SIG{HUP} = 'IGNORE';
372 local $SIG{INT} = 'IGNORE';
373 local $SIG{QUIT} = 'IGNORE';
374 local $SIG{TERM} = 'IGNORE';
375 local $SIG{TSTP} = 'IGNORE';
376 local $SIG{PIPE} = 'IGNORE';
378 my $oldAutoCommit = $FS::UID::AutoCommit;
379 local $FS::UID::AutoCommit = 0;
382 if ( qsearch( 'cust_bill', { 'custnum' => $self->custnum } ) ) {
383 $dbh->rollback if $oldAutoCommit;
384 return "Can't delete a customer with invoices";
386 if ( qsearch( 'cust_credit', { 'custnum' => $self->custnum } ) ) {
387 $dbh->rollback if $oldAutoCommit;
388 return "Can't delete a customer with credits";
391 my @cust_pkg = qsearch( 'cust_pkg', { 'custnum' => $self->custnum } );
393 my $new_custnum = shift;
394 unless ( qsearchs( 'cust_main', { 'custnum' => $new_custnum } ) ) {
395 $dbh->rollback if $oldAutoCommit;
396 return "Invalid new customer number: $new_custnum";
398 foreach my $cust_pkg ( @cust_pkg ) {
399 my %hash = $cust_pkg->hash;
400 $hash{'custnum'} = $new_custnum;
401 my $new_cust_pkg = new FS::cust_pkg ( \%hash );
402 my $error = $new_cust_pkg->replace($cust_pkg);
404 $dbh->rollback if $oldAutoCommit;
409 foreach my $cust_main_invoice (
410 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } )
412 my $error = $cust_main_invoice->delete;
414 $dbh->rollback if $oldAutoCommit;
419 my $error = $self->SUPER::delete;
421 $dbh->rollback if $oldAutoCommit;
425 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
430 =item replace OLD_RECORD [ INVOICING_LIST_ARYREF ]
432 Replaces the OLD_RECORD with this one in the database. If there is an error,
433 returns the error, otherwise returns false.
435 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
436 be set as the invoicing list (see L<"invoicing_list">). Errors return as
437 expected and rollback the entire transaction; it is not necessary to call
438 check_invoicing_list first. Here's an example:
440 $new_cust_main->replace( $old_cust_main, [ $email, 'POST' ] );
449 local $SIG{HUP} = 'IGNORE';
450 local $SIG{INT} = 'IGNORE';
451 local $SIG{QUIT} = 'IGNORE';
452 local $SIG{TERM} = 'IGNORE';
453 local $SIG{TSTP} = 'IGNORE';
454 local $SIG{PIPE} = 'IGNORE';
456 my $oldAutoCommit = $FS::UID::AutoCommit;
457 local $FS::UID::AutoCommit = 0;
460 my $error = $self->SUPER::replace($old);
463 $dbh->rollback if $oldAutoCommit;
467 if ( @param ) { # INVOICING_LIST_ARYREF
468 my $invoicing_list = shift @param;
469 $error = $self->check_invoicing_list( $invoicing_list );
471 $dbh->rollback if $oldAutoCommit;
474 $self->invoicing_list( $invoicing_list );
477 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
484 Checks all fields to make sure this is a valid customer record. If there is
485 an error, returns the error, otherwise returns false. Called by the insert
494 $self->ut_numbern('custnum')
495 || $self->ut_number('agentnum')
496 || $self->ut_number('refnum')
497 || $self->ut_name('last')
498 || $self->ut_name('first')
499 || $self->ut_textn('company')
500 || $self->ut_text('address1')
501 || $self->ut_textn('address2')
502 || $self->ut_text('city')
503 || $self->ut_textn('county')
504 || $self->ut_textn('state')
505 || $self->ut_country('country')
506 || $self->ut_anything('comments')
507 || $self->ut_numbern('referral_custnum')
509 #barf. need message catalogs. i18n. etc.
510 $error .= "Please select a referral."
511 if $error =~ /^Illegal or empty \(numeric\) refnum: /;
512 return $error if $error;
514 return "Unknown agent"
515 unless qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
517 return "Unknown referral"
518 unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } );
520 return "Unknown referring custnum ". $self->referral_custnum
521 unless ! $self->referral_custnum
522 || qsearchs( 'cust_main', { 'custnum' => $self->referral_custnum } );
524 if ( $self->ss eq '' ) {
529 $ss =~ /^(\d{3})(\d{2})(\d{4})$/
530 or return "Illegal social security number: ". $self->ss;
531 $self->ss("$1-$2-$3");
534 unless ( qsearchs('cust_main_county', {
535 'country' => $self->country,
538 return "Unknown state/county/country: ".
539 $self->state. "/". $self->county. "/". $self->country
540 unless qsearchs('cust_main_county',{
541 'state' => $self->state,
542 'county' => $self->county,
543 'country' => $self->country,
548 $self->ut_phonen('daytime', $self->country)
549 || $self->ut_phonen('night', $self->country)
550 || $self->ut_phonen('fax', $self->country)
551 || $self->ut_zip('zip', $self->country)
553 return $error if $error;
556 last first company address1 address2 city county state zip
557 country daytime night fax
560 if ( defined $self->dbdef_table->column('ship_last') ) {
561 if ( grep { $self->getfield($_) ne $self->getfield("ship_$_") } @addfields
562 && grep $self->getfield("ship_$_"), grep $_ ne 'state', @addfields
566 $self->ut_name('ship_last')
567 || $self->ut_name('ship_first')
568 || $self->ut_textn('ship_company')
569 || $self->ut_text('ship_address1')
570 || $self->ut_textn('ship_address2')
571 || $self->ut_text('ship_city')
572 || $self->ut_textn('ship_county')
573 || $self->ut_textn('ship_state')
574 || $self->ut_country('ship_country')
576 return $error if $error;
578 #false laziness with above
579 unless ( qsearchs('cust_main_county', {
580 'country' => $self->ship_country,
583 return "Unknown ship_state/ship_county/ship_country: ".
584 $self->ship_state. "/". $self->ship_county. "/". $self->ship_country
585 unless qsearchs('cust_main_county',{
586 'state' => $self->ship_state,
587 'county' => $self->ship_county,
588 'country' => $self->ship_country,
594 $self->ut_phonen('ship_daytime', $self->ship_country)
595 || $self->ut_phonen('ship_night', $self->ship_country)
596 || $self->ut_phonen('ship_fax', $self->ship_country)
597 || $self->ut_zip('ship_zip', $self->ship_country)
599 return $error if $error;
601 } else { # ship_ info eq billing info, so don't store dup info in database
602 $self->setfield("ship_$_", '')
603 foreach qw( last first company address1 address2 city county state zip
604 country daytime night fax );
608 $self->payby =~ /^(CARD|BILL|COMP|PREPAY)$/
609 or return "Illegal payby: ". $self->payby;
612 if ( $self->payby eq 'CARD' ) {
614 my $payinfo = $self->payinfo;
616 $payinfo =~ /^(\d{13,16})$/
617 or return "Illegal credit card number: ". $self->payinfo;
619 $self->payinfo($payinfo);
621 or return "Illegal credit card number: ". $self->payinfo;
622 return "Unknown card type" if cardtype($self->payinfo) eq "Unknown";
624 } elsif ( $self->payby eq 'BILL' ) {
626 $error = $self->ut_textn('payinfo');
627 return "Illegal P.O. number: ". $self->payinfo if $error;
629 } elsif ( $self->payby eq 'COMP' ) {
631 $error = $self->ut_textn('payinfo');
632 return "Illegal comp account issuer: ". $self->payinfo if $error;
634 } elsif ( $self->payby eq 'PREPAY' ) {
636 my $payinfo = $self->payinfo;
637 $payinfo =~ s/\W//g; #anything else would just confuse things
638 $self->payinfo($payinfo);
639 $error = $self->ut_alpha('payinfo');
640 return "Illegal prepayment identifier: ". $self->payinfo if $error;
641 return "Unknown prepayment identifier"
642 unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } );
646 if ( $self->paydate eq '' || $self->paydate eq '-' ) {
647 return "Expriation date required"
648 unless $self->payby eq 'BILL' || $self->payby eq 'PREPAY';
651 $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/
652 or return "Illegal expiration date: ". $self->paydate;
653 if ( length($2) == 4 ) {
654 $self->paydate("$2-$1-01");
656 $self->paydate("20$2-$1-01");
660 if ( $self->payname eq '' ) {
661 $self->payname( $self->first. " ". $self->getfield('last') );
663 $self->payname =~ /^([\w \,\.\-\']+)$/
664 or return "Illegal billing name: ". $self->payname;
668 $self->tax =~ /^(Y?)$/ or return "Illegal tax: ". $self->tax;
671 $self->otaker(getotaker);
678 Returns all packages (see L<FS::cust_pkg>) for this customer.
684 qsearch( 'cust_pkg', { 'custnum' => $self->custnum });
687 =item ncancelled_pkgs
689 Returns all non-cancelled packages (see L<FS::cust_pkg>) for this customer.
693 sub ncancelled_pkgs {
695 @{ [ # force list context
696 qsearch( 'cust_pkg', {
697 'custnum' => $self->custnum,
700 qsearch( 'cust_pkg', {
701 'custnum' => $self->custnum,
709 Generates invoices (see L<FS::cust_bill>) for this customer. Usually used in
710 conjunction with the collect method.
712 The only currently available option is `time', which bills the customer as if
713 it were that time. It is specified as a UNIX timestamp; see
714 L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion
717 If there is an error, returns the error, otherwise returns false.
722 my( $self, %options ) = @_;
723 my $time = $options{'time'} || time;
728 local $SIG{HUP} = 'IGNORE';
729 local $SIG{INT} = 'IGNORE';
730 local $SIG{QUIT} = 'IGNORE';
731 local $SIG{TERM} = 'IGNORE';
732 local $SIG{TSTP} = 'IGNORE';
733 local $SIG{PIPE} = 'IGNORE';
735 my $oldAutoCommit = $FS::UID::AutoCommit;
736 local $FS::UID::AutoCommit = 0;
739 # find the packages which are due for billing, find out how much they are
740 # & generate invoice database.
742 my( $total_setup, $total_recur ) = ( 0, 0 );
745 foreach my $cust_pkg (
746 qsearch('cust_pkg',{'custnum'=> $self->getfield('custnum') } )
749 next if $cust_pkg->getfield('cancel');
751 #? to avoid use of uninitialized value errors... ?
752 $cust_pkg->setfield('bill', '')
753 unless defined($cust_pkg->bill);
755 my $part_pkg = qsearchs( 'part_pkg', { 'pkgpart' => $cust_pkg->pkgpart } );
757 #so we don't modify cust_pkg record unnecessarily
758 my $cust_pkg_mod_flag = 0;
759 my %hash = $cust_pkg->hash;
760 my $old_cust_pkg = new FS::cust_pkg \%hash;
764 unless ( $cust_pkg->setup ) {
765 my $setup_prog = $part_pkg->getfield('setup');
766 $setup_prog =~ /^(.*)$/ #presumably trusted
767 or die "Illegal setup for package ". $cust_pkg->pkgnum. ": $setup_prog";
770 #$cpt->permit(); #what is necessary?
771 $cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
772 $setup = $cpt->reval($setup_prog);
773 unless ( defined($setup) ) {
774 warn "Error reval-ing part_pkg->setup pkgpart ",
775 $part_pkg->pkgpart, ": $@";
777 $cust_pkg->setfield('setup',$time);
778 $cust_pkg_mod_flag=1;
785 if ( $part_pkg->getfield('freq') > 0 &&
786 ! $cust_pkg->getfield('susp') &&
787 ( $cust_pkg->getfield('bill') || 0 ) < $time
789 my $recur_prog = $part_pkg->getfield('recur');
790 $recur_prog =~ /^(.*)$/ #presumably trusted
791 or die "Illegal recur for package ". $cust_pkg->pkgnum. ": $recur_prog";
794 #$cpt->permit(); #what is necessary?
795 $cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
796 $recur = $cpt->reval($recur_prog);
797 unless ( defined($recur) ) {
798 warn "Error reval-ing part_pkg->recur pkgpart ",
799 $part_pkg->pkgpart, ": $@";
801 #change this bit to use Date::Manip? CAREFUL with timezones (see
802 # mailing list archive)
803 #$sdate=$cust_pkg->bill || time;
804 #$sdate=$cust_pkg->bill || $time;
805 $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
806 my ($sec,$min,$hour,$mday,$mon,$year) =
807 (localtime($sdate) )[0,1,2,3,4,5];
808 $mon += $part_pkg->getfield('freq');
809 until ( $mon < 12 ) { $mon -= 12; $year++; }
810 $cust_pkg->setfield('bill',
811 timelocal($sec,$min,$hour,$mday,$mon,$year));
812 $cust_pkg_mod_flag = 1;
816 warn "setup is undefined" unless defined($setup);
817 warn "recur is undefined" unless defined($recur);
818 warn "cust_pkg bill is undefined" unless defined($cust_pkg->bill);
820 if ( $cust_pkg_mod_flag ) {
821 $error=$cust_pkg->replace($old_cust_pkg);
822 if ( $error ) { #just in case
823 warn "Error modifying pkgnum ", $cust_pkg->pkgnum, ": $error";
825 $setup = sprintf( "%.2f", $setup );
826 $recur = sprintf( "%.2f", $recur );
827 my $cust_bill_pkg = new FS::cust_bill_pkg ({
828 'pkgnum' => $cust_pkg->pkgnum,
832 'edate' => $cust_pkg->bill,
834 push @cust_bill_pkg, $cust_bill_pkg;
835 $total_setup += $setup;
836 $total_recur += $recur;
842 my $charged = sprintf( "%.2f", $total_setup + $total_recur );
844 unless ( @cust_bill_pkg ) {
845 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
849 unless ( $self->getfield('tax') =~ /Y/i
850 || $self->getfield('payby') eq 'COMP'
852 my $cust_main_county = qsearchs('cust_main_county',{
853 'state' => $self->state,
854 'county' => $self->county,
855 'country' => $self->country,
857 my $tax = sprintf( "%.2f",
858 $charged * ( $cust_main_county->getfield('tax') / 100 )
860 $charged = sprintf( "%.2f", $charged+$tax );
862 my $cust_bill_pkg = new FS::cust_bill_pkg ({
869 push @cust_bill_pkg, $cust_bill_pkg;
872 my $cust_bill = new FS::cust_bill ( {
873 'custnum' => $self->getfield('custnum'),
875 'charged' => $charged,
877 $error = $cust_bill->insert;
879 $dbh->rollback if $oldAutoCommit;
880 return "$error for customer #". $self->custnum;
883 my $invnum = $cust_bill->invnum;
885 foreach $cust_bill_pkg ( @cust_bill_pkg ) {
886 $cust_bill_pkg->setfield( 'invnum', $invnum );
887 $error = $cust_bill_pkg->insert;
888 #shouldn't happen, but how else tohandle this?
890 $dbh->rollback if $oldAutoCommit;
891 return "$error for customer #". $self->custnum;
895 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
899 =item collect OPTIONS
901 (Attempt to) collect money for this customer's outstanding invoices (see
902 L<FS::cust_bill>). Usually used after the bill method.
904 Depending on the value of `payby', this may print an invoice (`BILL'), charge
905 a credit card (`CARD'), or just add any necessary (pseudo-)payment (`COMP').
907 If there is an error, returns the error, otherwise returns false.
909 Currently available options are:
911 invoice_time - Use this time when deciding when to print invoices and
912 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>
913 for conversion functions.
915 batch_card - Set this true to batch cards (see L<cust_pay_batch>). By
916 default, cards are processed immediately, which will generate an error if
917 CyberCash is not installed.
919 report_badcard - Set this true if you want bad card transactions to
920 return an error. By default, they don't.
925 my( $self, %options ) = @_;
926 my $invoice_time = $options{'invoice_time'} || time;
929 local $SIG{HUP} = 'IGNORE';
930 local $SIG{INT} = 'IGNORE';
931 local $SIG{QUIT} = 'IGNORE';
932 local $SIG{TERM} = 'IGNORE';
933 local $SIG{TSTP} = 'IGNORE';
934 local $SIG{PIPE} = 'IGNORE';
936 my $oldAutoCommit = $FS::UID::AutoCommit;
937 local $FS::UID::AutoCommit = 0;
940 my $total_owed = $self->balance;
941 warn "collect: total owed $total_owed " if $Debug;
942 unless ( $total_owed > 0 ) { #redundant?????
943 $dbh->rollback if $oldAutoCommit;
947 foreach my $cust_bill (
948 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
951 #this has to be before next's
952 my $amount = sprintf( "%.2f", $total_owed < $cust_bill->owed
956 $total_owed = sprintf( "%.2f", $total_owed - $amount );
958 next unless $cust_bill->owed > 0;
961 next if qsearchs( 'cust_pay_batch', { 'invnum' => $cust_bill->invnum } );
963 warn "invnum ". $cust_bill->invnum. " (owed ". $cust_bill->owed. ", amount $amount, total_owed $total_owed)" if $Debug;
965 next unless $amount > 0;
967 if ( $self->payby eq 'BILL' ) {
970 my $since = $invoice_time - ( $cust_bill->_date || 0 );
971 #warn "$invoice_time ", $cust_bill->_date, " $since";
972 if ( $since >= 0 #don't print future invoices
973 && ( $cust_bill->printed * 2592000 ) <= $since
976 #my @print_text = $cust_bill->print_text; #( date )
977 my @invoicing_list = $self->invoicing_list;
978 if ( grep { $_ ne 'POST' } @invoicing_list ) { #email invoice
979 $ENV{SMTPHOSTS} = $smtpmachine;
980 $ENV{MAILADDRESS} = $invoice_from;
981 my $header = new Mail::Header ( [
982 "From: $invoice_from",
983 "To: ". join(', ', grep { $_ ne 'POST' } @invoicing_list ),
984 "Sender: $invoice_from",
985 "Reply-To: $invoice_from",
986 "Date: ". time2str("%a, %d %b %Y %X %z", time),
989 my $message = new Mail::Internet (
991 'Body' => [ $cust_bill->print_text ], #( date)
993 $message->smtpsend or die "Can't send invoice email!"; #die? warn?
995 } elsif ( ! @invoicing_list || grep { $_ eq 'POST' } @invoicing_list ) {
996 open(LPR, "|$lpr") or die "Can't open pipe to $lpr: $!";
997 print LPR $cust_bill->print_text; #( date )
999 or die $! ? "Error closing $lpr: $!"
1000 : "Exit status $? from $lpr";
1003 my %hash = $cust_bill->hash;
1005 my $new_cust_bill = new FS::cust_bill(\%hash);
1006 my $error = $new_cust_bill->replace($cust_bill);
1007 warn "Error updating $cust_bill->printed: $error" if $error;
1011 } elsif ( $self->payby eq 'COMP' ) {
1012 my $cust_pay = new FS::cust_pay ( {
1013 'invnum' => $cust_bill->invnum,
1017 'payinfo' => $self->payinfo,
1020 my $error = $cust_pay->insert;
1022 $dbh->rollback if $oldAutoCommit;
1023 return 'Error COMPing invnum #'. $cust_bill->invnum. ": $error";
1027 } elsif ( $self->payby eq 'CARD' ) {
1029 if ( $options{'batch_card'} ne 'yes' ) {
1031 unless ( $processor ) {
1032 $dbh->rollback if $oldAutoCommit;
1033 return "Real time card processing not enabled!";
1036 my $address = $self->address1;
1037 $address .= ", ". $self->address2 if $self->address2;
1040 #$self->paydate =~ /^(\d+)\/\d*(\d{2})$/;
1041 $self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
1044 if ( $processor =~ /^cybercash/ ) {
1046 #fix exp. date for cybercash
1047 #$self->paydate =~ /^(\d+)\/\d*(\d{2})$/;
1048 $self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
1051 my $paybatch = $cust_bill->invnum.
1052 '-' . time2str("%y%m%d%H%M%S", time);
1054 my $payname = $self->payname ||
1055 $self->getfield('first'). ' '. $self->getfield('last');
1058 my $country = $self->country eq 'US' ? 'USA' : $self->country;
1060 my @full_xaction = ( $xaction,
1061 'Order-ID' => $paybatch,
1062 'Amount' => "usd $amount",
1063 'Card-Number' => $self->getfield('payinfo'),
1064 'Card-Name' => $payname,
1065 'Card-Address' => $address,
1066 'Card-City' => $self->getfield('city'),
1067 'Card-State' => $self->getfield('state'),
1068 'Card-Zip' => $self->getfield('zip'),
1069 'Card-Country' => $country,
1074 if ( $processor eq 'cybercash2' ) {
1075 $^W=0; #CCLib isn't -w safe, ugh!
1076 %result = &CCLib::sendmserver(@full_xaction);
1078 } elsif ( $processor eq 'cybercash3.2' ) {
1079 %result = &CCMckDirectLib3_2::SendCC2_1Server(@full_xaction);
1081 $dbh->rollback if $oldAutoCommit;
1082 return "Unknown real-time processor $processor";
1085 #if ( $result{'MActionCode'} == 7 ) { #cybercash smps v.1.1.3
1086 #if ( $result{'action-code'} == 7 ) { #cybercash smps v.2.1
1087 if ( $result{'MStatus'} eq 'success' ) { #cybercash smps v.2 or 3
1088 my $cust_pay = new FS::cust_pay ( {
1089 'invnum' => $cust_bill->invnum,
1093 'payinfo' => $self->payinfo,
1094 'paybatch' => "$processor:$paybatch",
1096 my $error = $cust_pay->insert;
1098 # gah, even with transactions.
1099 $dbh->commit if $oldAutoCommit; #well.
1100 my $e = 'WARNING: Card debited but database not updated - '.
1101 'error applying payment, invnum #' . $cust_bill->invnum.
1102 " (CyberCash Order-ID $paybatch): $error";
1106 } elsif ( $result{'Mstatus'} ne 'failure-bad-money'
1107 || $options{'report_badcard'} ) {
1108 $dbh->commit if $oldAutoCommit;
1109 return 'Cybercash error, invnum #' .
1110 $cust_bill->invnum. ':'. $result{'MErrMsg'};
1112 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1116 } elsif ( $processor =~ /^Business::OnlinePayment::(.*)$/ ) {
1118 my($payname, $payfirst, $paylast);
1119 if ( $self->payname ) {
1120 $payname = $self->payname;
1121 $payname =~ /^\s*([\w \,\.\-\']*\w)?\s+([\w\,\.\-\']+)$/
1123 $dbh->rollback if $oldAutoCommit;
1124 return "Illegal payname $payname";
1126 ($payfirst, $paylast) = ($1, $2);
1128 $payfirst = $self->getfield('first');
1129 $paylast = $self->getfield('first');
1130 $payname = "$payfirst $paylast";
1133 my $transaction = new Business::OnlinePayment( $1, @bop_options );
1134 $transaction->content(
1136 'login' => $bop_login,
1137 'password' => $bop_password,
1138 'action' => $bop_action,
1139 'amount' => $amount,
1140 'invoice_number' => $cust_bill->invnum,
1141 'customer_id' => $self->custnum,
1142 'last_name' => $paylast,
1143 'first_name' => $payfirst,
1145 'address' => $address,
1146 'city' => $self->city,
1147 'state' => $self->state,
1148 'zip' => $self->zip,
1149 'country' => $self->country,
1150 'card_number' => $self->payinfo,
1151 'expiration' => $exp,
1153 $transaction->submit();
1155 if ( $transaction->is_success()) {
1156 my $cust_pay = new FS::cust_pay ( {
1157 'invnum' => $cust_bill->invnum,
1161 'payinfo' => $self->payinfo,
1162 'paybatch' => "$processor:". $transaction->authorization,
1164 my $error = $cust_pay->insert;
1166 # gah, even with transactions.
1167 $dbh->commit if $oldAutoCommit; #well.
1168 my $e = 'WARNING: Card debited but database not updated - '.
1169 'error applying payment, invnum #' . $cust_bill->invnum.
1170 " ($processor): $error";
1174 } elsif ( $options{'report_badcard'} ) {
1175 $dbh->commit if $oldAutoCommit;
1176 return "$processor error, invnum #". $cust_bill->invnum. ': '.
1177 $transaction->result_code. ": ". $transaction->error_message;
1179 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1184 $dbh->rollback if $oldAutoCommit;
1185 return "Unknown real-time processor $processor\n";
1188 } else { #batch card
1190 my $cust_pay_batch = new FS::cust_pay_batch ( {
1191 'invnum' => $cust_bill->getfield('invnum'),
1192 'custnum' => $self->getfield('custnum'),
1193 'last' => $self->getfield('last'),
1194 'first' => $self->getfield('first'),
1195 'address1' => $self->getfield('address1'),
1196 'address2' => $self->getfield('address2'),
1197 'city' => $self->getfield('city'),
1198 'state' => $self->getfield('state'),
1199 'zip' => $self->getfield('zip'),
1200 'country' => $self->getfield('country'),
1202 'cardnum' => $self->getfield('payinfo'),
1203 'exp' => $self->getfield('paydate'),
1204 'payname' => $self->getfield('payname'),
1205 'amount' => $amount,
1207 my $error = $cust_pay_batch->insert;
1209 $dbh->rollback if $oldAutoCommit;
1210 return "Error adding to cust_pay_batch: $error";
1216 $dbh->rollback if $oldAutoCommit;
1217 return "Unknown payment type ". $self->payby;
1221 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1228 Returns the total owed for this customer on all invoices
1229 (see L<FS::cust_bill>).
1236 foreach my $cust_bill ( qsearch('cust_bill', {
1237 'custnum' => $self->custnum,
1239 $total_bill += $cust_bill->owed;
1241 sprintf( "%.2f", $total_bill );
1246 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
1247 to outstanding invoice balances in chronological order and returns the value
1248 of any remaining unapplied credits available for refund
1249 (see L<FS::cust_refund>).
1256 return 0 unless $self->total_credited;
1258 my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
1259 qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
1261 my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
1262 qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
1266 foreach my $cust_bill ( @invoices ) {
1269 if ( !defined($credit) || $credit->credited == 0) {
1270 $credit = pop @credits or last;
1273 if ($cust_bill->owed >= $credit->credited) {
1274 $amount=$credit->credited;
1276 $amount=$cust_bill->owed;
1279 my $cust_credit_bill = new FS::cust_credit_bill ( {
1280 'crednum' => $credit->crednum,
1281 'invnum' => $cust_bill->invnum,
1282 'amount' => $amount,
1284 my $error = $cust_credit_bill->insert;
1285 die $error if $error;
1287 redo if ($cust_bill->owed > 0);
1291 return $self->total_credited;
1294 =item apply_payments
1296 Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
1297 to outstanding invoice balances in chronological order.
1299 #and returns the value of any remaining unapplied payments.
1303 sub apply_payments {
1308 my @payments = sort { $b->_date <=> $a->_date } ( grep { $_->unapplied > 0 }
1309 qsearch('cust_pay', { 'custnum' => $self->custnum } ) );
1311 my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
1312 qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
1316 foreach my $cust_bill ( @invoices ) {
1319 if ( !defined($payment) || $payment->unapplied == 0 ) {
1320 $payment = pop @payments or last;
1323 if ( $cust_bill->owed >= $payment->unapplied ) {
1324 $amount = $payment->unapplied;
1326 $amount = $payment->owed;
1329 my $cust_bill_pay = new FS::cust_bill_pay ( {
1330 'paynum' => $payment->paynum,
1331 'invnum' => $cust_bill->invnum,
1332 'amount' => $amount,
1334 my $error = $cust_bill_pay->insert;
1335 die $error if $error;
1337 redo if ( $cust_bill->owed > 0);
1344 =item total_credited
1346 Returns the total credits (see L<FS::cust_credit>) for this customer.
1350 sub total_credited {
1352 my $total_credit = 0;
1353 foreach my $cust_credit ( qsearch('cust_credit', {
1354 'custnum' => $self->custnum,
1356 $total_credit += $cust_credit->credited;
1358 sprintf( "%.2f", $total_credit );
1363 Returns the balance for this customer (total owed minus total credited).
1369 sprintf( "%.2f", $self->total_owed - $self->total_credited );
1372 =item invoicing_list [ ARRAYREF ]
1374 If an arguement is given, sets these email addresses as invoice recipients
1375 (see L<FS::cust_main_invoice>). Errors are not fatal and are not reported
1376 (except as warnings), so use check_invoicing_list first.
1378 Returns a list of email addresses (with svcnum entries expanded).
1380 Note: You can clear the invoicing list by passing an empty ARRAYREF. You can
1381 check it without disturbing anything by passing nothing.
1383 This interface may change in the future.
1387 sub invoicing_list {
1388 my( $self, $arrayref ) = @_;
1390 my @cust_main_invoice;
1391 if ( $self->custnum ) {
1392 @cust_main_invoice =
1393 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1395 @cust_main_invoice = ();
1397 foreach my $cust_main_invoice ( @cust_main_invoice ) {
1398 #warn $cust_main_invoice->destnum;
1399 unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
1400 #warn $cust_main_invoice->destnum;
1401 my $error = $cust_main_invoice->delete;
1402 warn $error if $error;
1405 if ( $self->custnum ) {
1406 @cust_main_invoice =
1407 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1409 @cust_main_invoice = ();
1411 foreach my $address ( @{$arrayref} ) {
1412 unless ( grep { $address eq $_->address } @cust_main_invoice ) {
1413 my $cust_main_invoice = new FS::cust_main_invoice ( {
1414 'custnum' => $self->custnum,
1417 my $error = $cust_main_invoice->insert;
1418 warn $error if $error;
1422 if ( $self->custnum ) {
1424 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1430 =item check_invoicing_list ARRAYREF
1432 Checks these arguements as valid input for the invoicing_list method. If there
1433 is an error, returns the error, otherwise returns false.
1437 sub check_invoicing_list {
1438 my( $self, $arrayref ) = @_;
1439 foreach my $address ( @{$arrayref} ) {
1440 my $cust_main_invoice = new FS::cust_main_invoice ( {
1441 'custnum' => $self->custnum,
1444 my $error = $self->custnum
1445 ? $cust_main_invoice->check
1446 : $cust_main_invoice->checkdest
1448 return $error if $error;
1453 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
1455 Returns an array of customers referred by this customer (referral_custnum set
1456 to this custnum). If DEPTH is given, recurses up to the given depth, returning
1457 customers referred by customers referred by this customer and so on, inclusive.
1458 The default behavior is DEPTH 1 (no recursion).
1462 sub referral_cust_main {
1464 my $depth = @_ ? shift : 1;
1465 my $exclude = @_ ? shift : {};
1468 map { $exclude->{$_->custnum}++; $_; }
1469 grep { ! $exclude->{ $_->custnum } }
1470 qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
1474 map { $_->referral_cust_main($depth-1, $exclude) }
1487 =item rebuild_fuzzyfile
1491 sub rebuild_fuzzyfiles {
1492 my @all_last = map $_->getfield('last'), qsearch('cust_main', {});
1494 grep $_, map $_->getfield('ship_last'), qsearch('cust_main',{})
1495 if defined dbdef->table('cust_main')->column('ship_last');
1504 $Id: cust_main.pm,v 1.28 2001-09-02 04:25:55 ivan Exp $
1510 The delete method should possibly take an FS::cust_main object reference
1511 instead of a scalar customer number.
1513 Bill and collect options should probably be passed as references instead of a
1516 CyberCash v2 forces us to define some variables in package main.
1518 There should probably be a configuration file with a list of allowed credit
1521 No multiple currency support (probably a larger project than just this module).
1525 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
1526 L<FS::cust_pay_batch>, L<FS::agent>, L<FS::part_referral>,
1527 L<FS::cust_main_county>, L<FS::cust_main_invoice>,
1528 L<FS::UID>, schema.html from the base documentation.