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 Options are passed as name-value pairs.
714 The only currently available option is `time', which bills the customer as if
715 it were that time. It is specified as a UNIX timestamp; see
716 L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion
717 functions. For example:
721 $cust_main->bill( 'time' => str2time('April 20th, 2001') );
723 If there is an error, returns the error, otherwise returns false.
728 my( $self, %options ) = @_;
729 my $time = $options{'time'} || time;
734 local $SIG{HUP} = 'IGNORE';
735 local $SIG{INT} = 'IGNORE';
736 local $SIG{QUIT} = 'IGNORE';
737 local $SIG{TERM} = 'IGNORE';
738 local $SIG{TSTP} = 'IGNORE';
739 local $SIG{PIPE} = 'IGNORE';
741 my $oldAutoCommit = $FS::UID::AutoCommit;
742 local $FS::UID::AutoCommit = 0;
745 # find the packages which are due for billing, find out how much they are
746 # & generate invoice database.
748 my( $total_setup, $total_recur ) = ( 0, 0 );
749 my @cust_bill_pkg = ();
751 foreach my $cust_pkg (
752 qsearch('cust_pkg',{'custnum'=> $self->getfield('custnum') } )
755 next if $cust_pkg->getfield('cancel');
757 #? to avoid use of uninitialized value errors... ?
758 $cust_pkg->setfield('bill', '')
759 unless defined($cust_pkg->bill);
761 my $part_pkg = qsearchs( 'part_pkg', { 'pkgpart' => $cust_pkg->pkgpart } );
763 #so we don't modify cust_pkg record unnecessarily
764 my $cust_pkg_mod_flag = 0;
765 my %hash = $cust_pkg->hash;
766 my $old_cust_pkg = new FS::cust_pkg \%hash;
770 unless ( $cust_pkg->setup ) {
771 my $setup_prog = $part_pkg->getfield('setup');
772 $setup_prog =~ /^(.*)$/ or do {
773 $dbh->rollback if $oldAutoCommit;
774 return "Illegal setup for pkgpart ". $part_pkg->pkgpart.
780 #$cpt->permit(); #what is necessary?
781 $cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
782 $setup = $cpt->reval($setup_prog);
783 unless ( defined($setup) ) {
784 $dbh->rollback if $oldAutoCommit;
785 return "Error reval-ing part_pkg->setup pkgpart ". $part_pkg->pkgpart.
788 $cust_pkg->setfield('setup',$time);
789 $cust_pkg_mod_flag=1;
795 if ( $part_pkg->getfield('freq') > 0 &&
796 ! $cust_pkg->getfield('susp') &&
797 ( $cust_pkg->getfield('bill') || 0 ) < $time
799 my $recur_prog = $part_pkg->getfield('recur');
800 $recur_prog =~ /^(.*)$/ or do {
801 $dbh->rollback if $oldAutoCommit;
802 return "Illegal recur for pkgpart ". $part_pkg->pkgpart.
808 #$cpt->permit(); #what is necessary?
809 $cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
810 $recur = $cpt->reval($recur_prog);
811 unless ( defined($recur) ) {
812 $dbh->rollback if $oldAutoCommit;
813 return "Error reval-ing part_pkg->recur pkgpart ".
814 $part_pkg->pkgpart. ": $@";
816 #change this bit to use Date::Manip? CAREFUL with timezones (see
817 # mailing list archive)
818 #$sdate=$cust_pkg->bill || time;
819 #$sdate=$cust_pkg->bill || $time;
820 $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
821 my ($sec,$min,$hour,$mday,$mon,$year) =
822 (localtime($sdate) )[0,1,2,3,4,5];
823 $mon += $part_pkg->getfield('freq');
824 until ( $mon < 12 ) { $mon -= 12; $year++; }
825 $cust_pkg->setfield('bill',
826 timelocal($sec,$min,$hour,$mday,$mon,$year));
827 $cust_pkg_mod_flag = 1;
830 warn "\$setup is undefined" unless defined($setup);
831 warn "\$recur is undefined" unless defined($recur);
832 warn "\$cust_pkg->bill is undefined" unless defined($cust_pkg->bill);
834 if ( $cust_pkg_mod_flag ) {
835 $error=$cust_pkg->replace($old_cust_pkg);
836 if ( $error ) { #just in case
837 $dbh->rollback if $oldAutoCommit;
838 return "Error modifying pkgnum ". $cust_pkg->pkgnum. ": $error";
840 $setup = sprintf( "%.2f", $setup );
841 $recur = sprintf( "%.2f", $recur );
843 $dbh->rollback if $oldAutoCommit;
844 return "negative setup $setup for pkgnum ". $cust_pkg->pkgnum;
847 $dbh->rollback if $oldAutoCommit;
848 return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum;
850 if ( $setup > 0 || $recur > 0 ) {
851 my $cust_bill_pkg = new FS::cust_bill_pkg ({
852 'pkgnum' => $cust_pkg->pkgnum,
856 'edate' => $cust_pkg->bill,
858 push @cust_bill_pkg, $cust_bill_pkg;
859 $total_setup += $setup;
860 $total_recur += $recur;
866 my $charged = sprintf( "%.2f", $total_setup + $total_recur );
868 unless ( @cust_bill_pkg ) {
869 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
873 unless ( $self->tax =~ /Y/i || $self->payby eq 'COMP' ) {
874 my $cust_main_county = qsearchs('cust_main_county',{
875 'state' => $self->state,
876 'county' => $self->county,
877 'country' => $self->country,
879 my $tax = sprintf( "%.2f",
880 $charged * ( $cust_main_county->getfield('tax') / 100 )
882 $charged = sprintf( "%.2f", $charged+$tax );
884 my $cust_bill_pkg = new FS::cust_bill_pkg ({
891 push @cust_bill_pkg, $cust_bill_pkg;
894 my $cust_bill = new FS::cust_bill ( {
895 'custnum' => $self->custnum,
897 'charged' => $charged,
899 $error = $cust_bill->insert;
901 $dbh->rollback if $oldAutoCommit;
902 return "can't create invoice for customer #". $self->custnum. ": $error";
905 my $invnum = $cust_bill->invnum;
907 foreach $cust_bill_pkg ( @cust_bill_pkg ) {
908 warn $cust_bill_pkg->invnum($invnum);
909 $error = $cust_bill_pkg->insert;
911 $dbh->rollback if $oldAutoCommit;
912 return "can't create invoice line item for customer #". $self->custnum.
917 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
921 =item collect OPTIONS
923 (Attempt to) collect money for this customer's outstanding invoices (see
924 L<FS::cust_bill>). Usually used after the bill method.
926 Depending on the value of `payby', this may print an invoice (`BILL'), charge
927 a credit card (`CARD'), or just add any necessary (pseudo-)payment (`COMP').
929 If there is an error, returns the error, otherwise returns false.
931 Options are passed as name-value pairs.
933 Currently available options are:
935 invoice_time - Use this time when deciding when to print invoices and
936 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>
937 for conversion functions.
939 batch_card - Set this true to batch cards (see L<cust_pay_batch>). By
940 default, cards are processed immediately, which will generate an error if
941 CyberCash is not installed.
943 report_badcard - Set this true if you want bad card transactions to
944 return an error. By default, they don't.
949 my( $self, %options ) = @_;
950 my $invoice_time = $options{'invoice_time'} || time;
953 local $SIG{HUP} = 'IGNORE';
954 local $SIG{INT} = 'IGNORE';
955 local $SIG{QUIT} = 'IGNORE';
956 local $SIG{TERM} = 'IGNORE';
957 local $SIG{TSTP} = 'IGNORE';
958 local $SIG{PIPE} = 'IGNORE';
960 my $oldAutoCommit = $FS::UID::AutoCommit;
961 local $FS::UID::AutoCommit = 0;
964 my $balance = $self->balance;
965 warn "collect: balance $balance" if $Debug;
966 unless ( $balance > 0 ) { #redundant?????
967 $dbh->rollback if $oldAutoCommit; #hmm
971 foreach my $cust_bill (
972 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
975 #this has to be before next's
976 my $amount = sprintf( "%.2f", $balance < $cust_bill->owed
980 $balance = sprintf( "%.2f", $balance - $amount );
982 next unless $cust_bill->owed > 0;
984 # don't try to charge for the same invoice if it's already in a batch
985 next if qsearchs( 'cust_pay_batch', { 'invnum' => $cust_bill->invnum } );
987 warn "invnum ". $cust_bill->invnum. " (owed ". $cust_bill->owed. ", amount $amount, balance $balance)" if $Debug;
989 next unless $amount > 0;
991 if ( $self->payby eq 'BILL' ) {
994 my $since = $invoice_time - ( $cust_bill->_date || 0 );
995 #warn "$invoice_time ", $cust_bill->_date, " $since";
996 if ( $since >= 0 #don't print future invoices
997 && ( $cust_bill->printed * 2592000 ) <= $since
1000 #my @print_text = $cust_bill->print_text; #( date )
1001 my @invoicing_list = $self->invoicing_list;
1002 if ( grep { $_ ne 'POST' } @invoicing_list ) { #email invoice
1003 $ENV{SMTPHOSTS} = $smtpmachine;
1004 $ENV{MAILADDRESS} = $invoice_from;
1005 my $header = new Mail::Header ( [
1006 "From: $invoice_from",
1007 "To: ". join(', ', grep { $_ ne 'POST' } @invoicing_list ),
1008 "Sender: $invoice_from",
1009 "Reply-To: $invoice_from",
1010 "Date: ". time2str("%a, %d %b %Y %X %z", time),
1013 my $message = new Mail::Internet (
1014 'Header' => $header,
1015 'Body' => [ $cust_bill->print_text ], #( date)
1017 $message->smtpsend or die "Can't send invoice email!"; #die? warn?
1019 } elsif ( ! @invoicing_list || grep { $_ eq 'POST' } @invoicing_list ) {
1020 open(LPR, "|$lpr") or die "Can't open pipe to $lpr: $!";
1021 print LPR $cust_bill->print_text; #( date )
1023 or die $! ? "Error closing $lpr: $!"
1024 : "Exit status $? from $lpr";
1027 my %hash = $cust_bill->hash;
1029 my $new_cust_bill = new FS::cust_bill(\%hash);
1030 my $error = $new_cust_bill->replace($cust_bill);
1031 warn "Error updating $cust_bill->printed: $error" if $error;
1035 } elsif ( $self->payby eq 'COMP' ) {
1036 my $cust_pay = new FS::cust_pay ( {
1037 'invnum' => $cust_bill->invnum,
1041 'payinfo' => $self->payinfo,
1044 my $error = $cust_pay->insert;
1046 $dbh->rollback if $oldAutoCommit;
1047 return 'Error COMPing invnum #'. $cust_bill->invnum. ": $error";
1051 } elsif ( $self->payby eq 'CARD' ) {
1053 if ( $options{'batch_card'} ne 'yes' ) {
1055 unless ( $processor ) {
1056 $dbh->rollback if $oldAutoCommit;
1057 return "Real time card processing not enabled!";
1060 my $address = $self->address1;
1061 $address .= ", ". $self->address2 if $self->address2;
1064 #$self->paydate =~ /^(\d+)\/\d*(\d{2})$/;
1065 $self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
1068 if ( $processor =~ /^cybercash/ ) {
1070 #fix exp. date for cybercash
1071 #$self->paydate =~ /^(\d+)\/\d*(\d{2})$/;
1072 $self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
1075 my $paybatch = $cust_bill->invnum.
1076 '-' . time2str("%y%m%d%H%M%S", time);
1078 my $payname = $self->payname ||
1079 $self->getfield('first'). ' '. $self->getfield('last');
1082 my $country = $self->country eq 'US' ? 'USA' : $self->country;
1084 my @full_xaction = ( $xaction,
1085 'Order-ID' => $paybatch,
1086 'Amount' => "usd $amount",
1087 'Card-Number' => $self->getfield('payinfo'),
1088 'Card-Name' => $payname,
1089 'Card-Address' => $address,
1090 'Card-City' => $self->getfield('city'),
1091 'Card-State' => $self->getfield('state'),
1092 'Card-Zip' => $self->getfield('zip'),
1093 'Card-Country' => $country,
1098 if ( $processor eq 'cybercash2' ) {
1099 $^W=0; #CCLib isn't -w safe, ugh!
1100 %result = &CCLib::sendmserver(@full_xaction);
1102 } elsif ( $processor eq 'cybercash3.2' ) {
1103 %result = &CCMckDirectLib3_2::SendCC2_1Server(@full_xaction);
1105 $dbh->rollback if $oldAutoCommit;
1106 return "Unknown real-time processor $processor";
1109 #if ( $result{'MActionCode'} == 7 ) { #cybercash smps v.1.1.3
1110 #if ( $result{'action-code'} == 7 ) { #cybercash smps v.2.1
1111 if ( $result{'MStatus'} eq 'success' ) { #cybercash smps v.2 or 3
1112 my $cust_pay = new FS::cust_pay ( {
1113 'invnum' => $cust_bill->invnum,
1117 'payinfo' => $self->payinfo,
1118 'paybatch' => "$processor:$paybatch",
1120 my $error = $cust_pay->insert;
1122 # gah, even with transactions.
1123 $dbh->commit if $oldAutoCommit; #well.
1124 my $e = 'WARNING: Card debited but database not updated - '.
1125 'error applying payment, invnum #' . $cust_bill->invnum.
1126 " (CyberCash Order-ID $paybatch): $error";
1130 } elsif ( $result{'Mstatus'} ne 'failure-bad-money'
1131 || $options{'report_badcard'} ) {
1132 $dbh->commit if $oldAutoCommit;
1133 return 'Cybercash error, invnum #' .
1134 $cust_bill->invnum. ':'. $result{'MErrMsg'};
1136 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1140 } elsif ( $processor =~ /^Business::OnlinePayment::(.*)$/ ) {
1142 my $bop_processor = $1;
1144 my($payname, $payfirst, $paylast);
1145 if ( $self->payname ) {
1146 $payname = $self->payname;
1147 $payname =~ /^\s*([\w \,\.\-\']*\w)?\s+([\w\,\.\-\']+)$/
1149 $dbh->rollback if $oldAutoCommit;
1150 return "Illegal payname $payname";
1152 ($payfirst, $paylast) = ($1, $2);
1154 $payfirst = $self->getfield('first');
1155 $paylast = $self->getfield('first');
1156 $payname = "$payfirst $paylast";
1160 new Business::OnlinePayment( $bop_processor, @bop_options );
1161 $transaction->content(
1163 'login' => $bop_login,
1164 'password' => $bop_password,
1165 'action' => $bop_action,
1166 'amount' => $amount,
1167 'invoice_number' => $cust_bill->invnum,
1168 'customer_id' => $self->custnum,
1169 'last_name' => $paylast,
1170 'first_name' => $payfirst,
1172 'address' => $address,
1173 'city' => $self->city,
1174 'state' => $self->state,
1175 'zip' => $self->zip,
1176 'country' => $self->country,
1177 'card_number' => $self->payinfo,
1178 'expiration' => $exp,
1180 $transaction->submit();
1182 if ( $transaction->is_success()) {
1183 my $cust_pay = new FS::cust_pay ( {
1184 'invnum' => $cust_bill->invnum,
1188 'payinfo' => $self->payinfo,
1189 'paybatch' => "$processor:". $transaction->authorization,
1191 my $error = $cust_pay->insert;
1193 # gah, even with transactions.
1194 $dbh->commit if $oldAutoCommit; #well.
1195 my $e = 'WARNING: Card debited but database not updated - '.
1196 'error applying payment, invnum #' . $cust_bill->invnum.
1197 " ($processor): $error";
1201 } elsif ( $options{'report_badcard'} ) {
1202 $dbh->commit if $oldAutoCommit;
1203 return "$processor error, invnum #". $cust_bill->invnum. ': '.
1204 $transaction->result_code. ": ". $transaction->error_message;
1206 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1211 $dbh->rollback if $oldAutoCommit;
1212 return "Unknown real-time processor $processor\n";
1215 } else { #batch card
1217 my $cust_pay_batch = new FS::cust_pay_batch ( {
1218 'invnum' => $cust_bill->getfield('invnum'),
1219 'custnum' => $self->getfield('custnum'),
1220 'last' => $self->getfield('last'),
1221 'first' => $self->getfield('first'),
1222 'address1' => $self->getfield('address1'),
1223 'address2' => $self->getfield('address2'),
1224 'city' => $self->getfield('city'),
1225 'state' => $self->getfield('state'),
1226 'zip' => $self->getfield('zip'),
1227 'country' => $self->getfield('country'),
1229 'cardnum' => $self->getfield('payinfo'),
1230 'exp' => $self->getfield('paydate'),
1231 'payname' => $self->getfield('payname'),
1232 'amount' => $amount,
1234 my $error = $cust_pay_batch->insert;
1236 $dbh->rollback if $oldAutoCommit;
1237 return "Error adding to cust_pay_batch: $error";
1243 $dbh->rollback if $oldAutoCommit;
1244 return "Unknown payment type ". $self->payby;
1248 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1255 Returns the total owed for this customer on all invoices
1256 (see L<FS::cust_bill/owed>).
1263 foreach my $cust_bill ( qsearch('cust_bill', {
1264 'custnum' => $self->custnum,
1266 $total_bill += $cust_bill->owed;
1268 sprintf( "%.2f", $total_bill );
1273 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
1274 to outstanding invoice balances in chronological order and returns the value
1275 of any remaining unapplied credits available for refund
1276 (see L<FS::cust_refund>).
1283 return 0 unless $self->total_credited;
1285 my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
1286 qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
1288 my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
1289 qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
1293 foreach my $cust_bill ( @invoices ) {
1296 if ( !defined($credit) || $credit->credited == 0) {
1297 $credit = pop @credits or last;
1300 if ($cust_bill->owed >= $credit->credited) {
1301 $amount=$credit->credited;
1303 $amount=$cust_bill->owed;
1306 my $cust_credit_bill = new FS::cust_credit_bill ( {
1307 'crednum' => $credit->crednum,
1308 'invnum' => $cust_bill->invnum,
1309 'amount' => $amount,
1311 my $error = $cust_credit_bill->insert;
1312 die $error if $error;
1314 redo if ($cust_bill->owed > 0);
1318 return $self->total_credited;
1321 =item apply_payments
1323 Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
1324 to outstanding invoice balances in chronological order.
1326 #and returns the value of any remaining unapplied payments.
1330 sub apply_payments {
1335 my @payments = sort { $b->_date <=> $a->_date } ( grep { $_->unapplied > 0 }
1336 qsearch('cust_pay', { 'custnum' => $self->custnum } ) );
1338 my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
1339 qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
1343 foreach my $cust_bill ( @invoices ) {
1346 if ( !defined($payment) || $payment->unapplied == 0 ) {
1347 $payment = pop @payments or last;
1350 if ( $cust_bill->owed >= $payment->unapplied ) {
1351 $amount = $payment->unapplied;
1353 $amount = $cust_bill->owed;
1356 my $cust_bill_pay = new FS::cust_bill_pay ( {
1357 'paynum' => $payment->paynum,
1358 'invnum' => $cust_bill->invnum,
1359 'amount' => $amount,
1361 my $error = $cust_bill_pay->insert;
1362 die $error if $error;
1364 redo if ( $cust_bill->owed > 0);
1371 =item total_credited
1373 Returns the total outstanding credit (see L<FS::cust_credit>) for this
1374 customer. See L<FS::cust_credit/credited>.
1378 sub total_credited {
1380 my $total_credit = 0;
1381 foreach my $cust_credit ( qsearch('cust_credit', {
1382 'custnum' => $self->custnum,
1384 $total_credit += $cust_credit->credited;
1386 sprintf( "%.2f", $total_credit );
1389 =item total_unapplied_payments
1391 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
1392 See L<FS::cust_pay/unapplied>.
1396 sub total_unapplied_payments {
1398 my $total_unapplied = 0;
1399 foreach my $cust_pay ( qsearch('cust_pay', {
1400 'custnum' => $self->custnum,
1402 $total_unapplied += $cust_pay->unapplied;
1404 sprintf( "%.2f", $total_unapplied );
1409 Returns the balance for this customer (total_owed minus total_credited
1410 minus total_unapplied_payments).
1417 $self->total_owed - $self->total_credited - $self->total_unapplied_payments
1421 =item invoicing_list [ ARRAYREF ]
1423 If an arguement is given, sets these email addresses as invoice recipients
1424 (see L<FS::cust_main_invoice>). Errors are not fatal and are not reported
1425 (except as warnings), so use check_invoicing_list first.
1427 Returns a list of email addresses (with svcnum entries expanded).
1429 Note: You can clear the invoicing list by passing an empty ARRAYREF. You can
1430 check it without disturbing anything by passing nothing.
1432 This interface may change in the future.
1436 sub invoicing_list {
1437 my( $self, $arrayref ) = @_;
1439 my @cust_main_invoice;
1440 if ( $self->custnum ) {
1441 @cust_main_invoice =
1442 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1444 @cust_main_invoice = ();
1446 foreach my $cust_main_invoice ( @cust_main_invoice ) {
1447 #warn $cust_main_invoice->destnum;
1448 unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
1449 #warn $cust_main_invoice->destnum;
1450 my $error = $cust_main_invoice->delete;
1451 warn $error if $error;
1454 if ( $self->custnum ) {
1455 @cust_main_invoice =
1456 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1458 @cust_main_invoice = ();
1460 foreach my $address ( @{$arrayref} ) {
1461 unless ( grep { $address eq $_->address } @cust_main_invoice ) {
1462 my $cust_main_invoice = new FS::cust_main_invoice ( {
1463 'custnum' => $self->custnum,
1466 my $error = $cust_main_invoice->insert;
1467 warn $error if $error;
1471 if ( $self->custnum ) {
1473 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1479 =item check_invoicing_list ARRAYREF
1481 Checks these arguements as valid input for the invoicing_list method. If there
1482 is an error, returns the error, otherwise returns false.
1486 sub check_invoicing_list {
1487 my( $self, $arrayref ) = @_;
1488 foreach my $address ( @{$arrayref} ) {
1489 my $cust_main_invoice = new FS::cust_main_invoice ( {
1490 'custnum' => $self->custnum,
1493 my $error = $self->custnum
1494 ? $cust_main_invoice->check
1495 : $cust_main_invoice->checkdest
1497 return $error if $error;
1502 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
1504 Returns an array of customers referred by this customer (referral_custnum set
1505 to this custnum). If DEPTH is given, recurses up to the given depth, returning
1506 customers referred by customers referred by this customer and so on, inclusive.
1507 The default behavior is DEPTH 1 (no recursion).
1511 sub referral_cust_main {
1513 my $depth = @_ ? shift : 1;
1514 my $exclude = @_ ? shift : {};
1517 map { $exclude->{$_->custnum}++; $_; }
1518 grep { ! $exclude->{ $_->custnum } }
1519 qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
1523 map { $_->referral_cust_main($depth-1, $exclude) }
1536 =item rebuild_fuzzyfile
1540 sub rebuild_fuzzyfiles {
1541 my @all_last = map $_->getfield('last'), qsearch('cust_main', {});
1543 grep $_, map $_->getfield('ship_last'), qsearch('cust_main',{})
1544 if defined dbdef->table('cust_main')->column('ship_last');
1553 $Id: cust_main.pm,v 1.29 2001-09-03 22:07:38 ivan Exp $
1559 The delete method should possibly take an FS::cust_main object reference
1560 instead of a scalar customer number.
1562 Bill and collect options should probably be passed as references instead of a
1565 CyberCash v2 forces us to define some variables in package main.
1567 There should probably be a configuration file with a list of allowed credit
1570 No multiple currency support (probably a larger project than just this module).
1574 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
1575 L<FS::cust_pay_batch>, L<FS::agent>, L<FS::part_referral>,
1576 L<FS::cust_main_county>, L<FS::cust_main_invoice>,
1577 L<FS::UID>, schema.html from the base documentation.