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 );
23 use FS::cust_bill_pkg;
26 use FS::cust_pay_batch;
27 use FS::part_referral;
28 use FS::cust_main_county;
30 use FS::cust_main_invoice;
31 use FS::prepay_credit;
33 @ISA = qw( FS::Record );
38 #ask FS::UID to run this stuff for us later
39 $FS::UID::callback{'FS::cust_main'} = sub {
41 $lpr = $conf->config('lpr');
42 $invoice_from = $conf->config('invoice_from');
43 $smtpmachine = $conf->config('smtpmachine');
45 if ( $conf->exists('cybercash3.2') ) {
47 #qw($MCKversion %Config InitConfig CCError CCDebug CCDebug2);
48 require CCMckDirectLib3_2;
50 require CCMckErrno3_2;
51 #qw(MCKGetErrorMessage $E_NoErr);
52 import CCMckErrno3_2 qw($E_NoErr);
55 ($merchant_conf,$xaction)= $conf->config('cybercash3.2');
56 my $status = &CCMckLib3_2::InitConfig($merchant_conf);
57 if ( $status != $E_NoErr ) {
58 warn "CCMckLib3_2::InitConfig error:\n";
59 foreach my $key (keys %CCMckLib3_2::Config) {
60 warn " $key => $CCMckLib3_2::Config{$key}\n"
62 my($errmsg) = &CCMckErrno3_2::MCKGetErrorMessage($status);
63 die "CCMckLib3_2::InitConfig fatal error: $errmsg\n";
65 $processor='cybercash3.2';
66 } elsif ( $conf->exists('cybercash2') ) {
69 ( $main::paymentserverhost,
70 $main::paymentserverport,
71 $main::paymentserversecret,
73 ) = $conf->config('cybercash2');
74 $processor='cybercash2';
75 } elsif ( $conf->exists('business-onlinepayment') ) {
81 ) = $conf->config('business-onlinepayment');
82 $bop_action ||= 'normal authorization';
83 eval "use Business::OnlinePayment";
84 $processor="Business::OnlinePayment::$bop_processor";
90 FS::cust_main - Object methods for cust_main records
96 $record = new FS::cust_main \%hash;
97 $record = new FS::cust_main { 'column' => 'value' };
99 $error = $record->insert;
101 $error = $new_record->replace($old_record);
103 $error = $record->delete;
105 $error = $record->check;
107 @cust_pkg = $record->all_pkgs;
109 @cust_pkg = $record->ncancelled_pkgs;
111 $error = $record->bill;
112 $error = $record->bill %options;
113 $error = $record->bill 'time' => $time;
115 $error = $record->collect;
116 $error = $record->collect %options;
117 $error = $record->collect 'invoice_time' => $time,
118 'batch_card' => 'yes',
119 'report_badcard' => 'yes',
124 An FS::cust_main object represents a customer. FS::cust_main inherits from
125 FS::Record. The following fields are currently supported:
129 =item custnum - primary key (assigned automatically for new customers)
131 =item agentnum - agent (see L<FS::agent>)
133 =item refnum - referral (see L<FS::part_referral>)
139 =item ss - social security number (optional)
141 =item company - (optional)
145 =item address2 - (optional)
149 =item county - (optional, see L<FS::cust_main_county>)
151 =item state - (see L<FS::cust_main_county>)
155 =item country - (see L<FS::cust_main_county>)
157 =item daytime - phone (optional)
159 =item night - phone (optional)
161 =item fax - phone (optional)
163 =item ship_first - name
165 =item ship_last - name
167 =item ship_company - (optional)
171 =item ship_address2 - (optional)
175 =item ship_county - (optional, see L<FS::cust_main_county>)
177 =item ship_state - (see L<FS::cust_main_county>)
181 =item ship_country - (see L<FS::cust_main_county>)
183 =item ship_daytime - phone (optional)
185 =item ship_night - phone (optional)
187 =item ship_fax - phone (optional)
189 =item payby - `CARD' (credit cards), `BILL' (billing), `COMP' (free), or `PREPAY' (special billing type: applies a credit - see L<FS::prepay_credit> and sets billing type to BILL)
191 =item payinfo - card number, P.O., comp issuer (4-8 lowercase alphanumerics; think username) or prepayment identifier (see L<FS::prepay_credit>)
193 =item paydate - expiration date, mm/yyyy, m/yyyy, mm/yy or m/yy
195 =item payname - name on card or billing name
197 =item tax - tax exempt, empty or `Y'
199 =item otaker - order taker (assigned automatically, see L<FS::UID>)
201 =item comments - comments (optional)
211 Creates a new customer. To add the customer to the database, see L<"insert">.
213 Note that this stores the hash reference, not a distinct copy of the hash it
214 points to. You can ask the object for a copy with the I<hash> method.
218 sub table { 'cust_main'; }
220 =item insert [ CUST_PKG_HASHREF [ , INVOICING_LIST_ARYREF ] ]
222 Adds this customer to the database. If there is an error, returns the error,
223 otherwise returns false.
225 CUST_PKG_HASHREF: If you pass a Tie::RefHash data structure to the insert
226 method containing FS::cust_pkg and FS::svc_I<tablename> objects, all records
227 are inserted atomicly, or the transaction is rolled back (this requries a
228 transactional database). Passing an empty hash reference is equivalent to
229 not supplying this parameter. There should be a better explanation of this,
230 but until then, here's an example:
233 tie %hash, 'Tie::RefHash'; #this part is important
235 $cust_pkg => [ $svc_acct ],
238 $cust_main->insert( \%hash );
240 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
241 be set as the invoicing list (see L<"invoicing_list">). Errors return as
242 expected and rollback the entire transaction; it is not necessary to call
243 check_invoicing_list first. The invoicing_list is set after the records in the
244 CUST_PKG_HASHREF above are inserted, so it is now possible set set an
245 invoicing_list destination to the newly-created svc_acct. Here's an example:
247 $cust_main->insert( {}, [ $email, 'POST' ] );
255 local $SIG{HUP} = 'IGNORE';
256 local $SIG{INT} = 'IGNORE';
257 local $SIG{QUIT} = 'IGNORE';
258 local $SIG{TERM} = 'IGNORE';
259 local $SIG{TSTP} = 'IGNORE';
260 local $SIG{PIPE} = 'IGNORE';
262 my $oldAutoCommit = $FS::UID::AutoCommit;
263 local $FS::UID::AutoCommit = 0;
268 if ( $self->payby eq 'PREPAY' ) {
269 $self->payby('BILL');
270 my $prepay_credit = qsearchs(
272 { 'identifier' => $self->payinfo },
276 warn "WARNING: can't find pre-found prepay_credit: ". $self->payinfo
277 unless $prepay_credit;
278 $amount = $prepay_credit->amount;
279 $seconds = $prepay_credit->seconds;
280 my $error = $prepay_credit->delete;
282 $dbh->rollback if $oldAutoCommit;
287 my $error = $self->SUPER::insert;
289 $dbh->rollback if $oldAutoCommit;
293 if ( @param ) { # CUST_PKG_HASHREF
294 my $cust_pkgs = shift @param;
295 foreach my $cust_pkg ( keys %$cust_pkgs ) {
296 $cust_pkg->custnum( $self->custnum );
297 $error = $cust_pkg->insert;
299 $dbh->rollback if $oldAutoCommit;
302 foreach my $svc_something ( @{$cust_pkgs->{$cust_pkg}} ) {
303 $svc_something->pkgnum( $cust_pkg->pkgnum );
304 if ( $seconds && $svc_something->isa('FS::svc_acct') ) {
305 $svc_something->seconds( $svc_something->seconds + $seconds );
308 $error = $svc_something->insert;
310 $dbh->rollback if $oldAutoCommit;
318 $dbh->rollback if $oldAutoCommit;
319 return "No svc_acct record to apply pre-paid time";
322 if ( @param ) { # INVOICING_LIST_ARYREF
323 my $invoicing_list = shift @param;
324 $error = $self->check_invoicing_list( $invoicing_list );
326 $dbh->rollback if $oldAutoCommit;
329 $self->invoicing_list( $invoicing_list );
333 my $cust_credit = new FS::cust_credit {
334 'custnum' => $self->custnum,
337 $error = $cust_credit->insert;
339 $dbh->rollback if $oldAutoCommit;
344 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
349 =item delete NEW_CUSTNUM
351 This deletes the customer. If there is an error, returns the error, otherwise
354 This will completely remove all traces of the customer record. This is not
355 what you want when a customer cancels service; for that, cancel all of the
356 customer's packages (see L<FS::cust_pkg/cancel>).
358 If the customer has any packages, you need to pass a new (valid) customer
359 number for those packages to be transferred to.
361 You can't delete a customer with invoices (see L<FS::cust_bill>),
362 or credits (see L<FS::cust_credit>).
369 local $SIG{HUP} = 'IGNORE';
370 local $SIG{INT} = 'IGNORE';
371 local $SIG{QUIT} = 'IGNORE';
372 local $SIG{TERM} = 'IGNORE';
373 local $SIG{TSTP} = 'IGNORE';
374 local $SIG{PIPE} = 'IGNORE';
376 my $oldAutoCommit = $FS::UID::AutoCommit;
377 local $FS::UID::AutoCommit = 0;
380 if ( qsearch( 'cust_bill', { 'custnum' => $self->custnum } ) ) {
381 $dbh->rollback if $oldAutoCommit;
382 return "Can't delete a customer with invoices";
384 if ( qsearch( 'cust_credit', { 'custnum' => $self->custnum } ) ) {
385 $dbh->rollback if $oldAutoCommit;
386 return "Can't delete a customer with credits";
389 my @cust_pkg = qsearch( 'cust_pkg', { 'custnum' => $self->custnum } );
391 my $new_custnum = shift;
392 unless ( qsearchs( 'cust_main', { 'custnum' => $new_custnum } ) ) {
393 $dbh->rollback if $oldAutoCommit;
394 return "Invalid new customer number: $new_custnum";
396 foreach my $cust_pkg ( @cust_pkg ) {
397 my %hash = $cust_pkg->hash;
398 $hash{'custnum'} = $new_custnum;
399 my $new_cust_pkg = new FS::cust_pkg ( \%hash );
400 my $error = $new_cust_pkg->replace($cust_pkg);
402 $dbh->rollback if $oldAutoCommit;
407 foreach my $cust_main_invoice (
408 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } )
410 my $error = $cust_main_invoice->delete;
412 $dbh->rollback if $oldAutoCommit;
417 my $error = $self->SUPER::delete;
419 $dbh->rollback if $oldAutoCommit;
423 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
428 =item replace OLD_RECORD [ INVOICING_LIST_ARYREF ]
430 Replaces the OLD_RECORD with this one in the database. If there is an error,
431 returns the error, otherwise returns false.
433 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
434 be set as the invoicing list (see L<"invoicing_list">). Errors return as
435 expected and rollback the entire transaction; it is not necessary to call
436 check_invoicing_list first. Here's an example:
438 $new_cust_main->replace( $old_cust_main, [ $email, 'POST' ] );
447 local $SIG{HUP} = 'IGNORE';
448 local $SIG{INT} = 'IGNORE';
449 local $SIG{QUIT} = 'IGNORE';
450 local $SIG{TERM} = 'IGNORE';
451 local $SIG{TSTP} = 'IGNORE';
452 local $SIG{PIPE} = 'IGNORE';
454 my $oldAutoCommit = $FS::UID::AutoCommit;
455 local $FS::UID::AutoCommit = 0;
458 my $error = $self->SUPER::replace($old);
461 $dbh->rollback if $oldAutoCommit;
465 if ( @param ) { # INVOICING_LIST_ARYREF
466 my $invoicing_list = shift @param;
467 $error = $self->check_invoicing_list( $invoicing_list );
469 $dbh->rollback if $oldAutoCommit;
472 $self->invoicing_list( $invoicing_list );
475 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
482 Checks all fields to make sure this is a valid customer record. If there is
483 an error, returns the error, otherwise returns false. Called by the insert
492 $self->ut_numbern('custnum')
493 || $self->ut_number('agentnum')
494 || $self->ut_number('refnum')
495 || $self->ut_name('last')
496 || $self->ut_name('first')
497 || $self->ut_textn('company')
498 || $self->ut_text('address1')
499 || $self->ut_textn('address2')
500 || $self->ut_text('city')
501 || $self->ut_textn('county')
502 || $self->ut_textn('state')
503 || $self->ut_country('country')
504 || $self->ut_anything('comments')
506 #barf. need message catalogs. i18n. etc.
507 $error .= "Please select a referral."
508 if $error =~ /^Illegal or empty \(numeric\) refnum: /;
509 return $error if $error;
511 return "Unknown agent"
512 unless qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
514 return "Unknown referral"
515 unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } );
517 if ( $self->ss eq '' ) {
522 $ss =~ /^(\d{3})(\d{2})(\d{4})$/
523 or return "Illegal social security number: ". $self->ss;
524 $self->ss("$1-$2-$3");
527 unless ( qsearchs('cust_main_county', {
528 'country' => $self->country,
531 return "Unknown state/county/country: ".
532 $self->state. "/". $self->county. "/". $self->country
533 unless qsearchs('cust_main_county',{
534 'state' => $self->state,
535 'county' => $self->county,
536 'country' => $self->country,
541 $self->ut_phonen('daytime', $self->country)
542 || $self->ut_phonen('night', $self->country)
543 || $self->ut_phonen('fax', $self->country)
544 || $self->ut_zip('zip', $self->country)
546 return $error if $error;
549 last first company address1 address2 city county state zip
550 country daytime night fax
553 if ( defined $self->dbdef_table->column('ship_last') ) {
554 if ( grep { $self->getfield($_) ne $self->getfield("ship_$_") } @addfields
555 && grep $self->getfield("ship_$_"), grep $_ ne 'state', @addfields
559 $self->ut_name('ship_last')
560 || $self->ut_name('ship_first')
561 || $self->ut_textn('ship_company')
562 || $self->ut_text('ship_address1')
563 || $self->ut_textn('ship_address2')
564 || $self->ut_text('ship_city')
565 || $self->ut_textn('ship_county')
566 || $self->ut_textn('ship_state')
567 || $self->ut_country('ship_country')
569 return $error if $error;
571 #false laziness with above
572 unless ( qsearchs('cust_main_county', {
573 'country' => $self->ship_country,
576 return "Unknown ship_state/ship_county/ship_country: ".
577 $self->ship_state. "/". $self->ship_county. "/". $self->ship_country
578 unless qsearchs('cust_main_county',{
579 'state' => $self->ship_state,
580 'county' => $self->ship_county,
581 'country' => $self->ship_country,
587 $self->ut_phonen('ship_daytime', $self->ship_country)
588 || $self->ut_phonen('ship_night', $self->ship_country)
589 || $self->ut_phonen('ship_fax', $self->ship_country)
590 || $self->ut_zip('ship_zip', $self->ship_country)
592 return $error if $error;
594 } else { # ship_ info eq billing info, so don't store dup info in database
595 $self->setfield("ship_$_", '')
596 foreach qw( last first company address1 address2 city county state zip
597 country daytime night fax );
601 $self->payby =~ /^(CARD|BILL|COMP|PREPAY)$/
602 or return "Illegal payby: ". $self->payby;
605 if ( $self->payby eq 'CARD' ) {
607 my $payinfo = $self->payinfo;
609 $payinfo =~ /^(\d{13,16})$/
610 or return "Illegal credit card number: ". $self->payinfo;
612 $self->payinfo($payinfo);
614 or return "Illegal credit card number: ". $self->payinfo;
615 return "Unknown card type" if cardtype($self->payinfo) eq "Unknown";
617 } elsif ( $self->payby eq 'BILL' ) {
619 $error = $self->ut_textn('payinfo');
620 return "Illegal P.O. number: ". $self->payinfo if $error;
622 } elsif ( $self->payby eq 'COMP' ) {
624 $error = $self->ut_textn('payinfo');
625 return "Illegal comp account issuer: ". $self->payinfo if $error;
627 } elsif ( $self->payby eq 'PREPAY' ) {
629 my $payinfo = $self->payinfo;
630 $payinfo =~ s/\W//g; #anything else would just confuse things
631 $self->payinfo($payinfo);
632 $error = $self->ut_alpha('payinfo');
633 return "Illegal prepayment identifier: ". $self->payinfo if $error;
634 return "Unknown prepayment identifier"
635 unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } );
639 if ( $self->paydate eq '' || $self->paydate eq '-' ) {
640 return "Expriation date required"
641 unless $self->payby eq 'BILL' || $self->payby eq 'PREPAY';
644 $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/
645 or return "Illegal expiration date: ". $self->paydate;
646 if ( length($2) == 4 ) {
647 $self->paydate("$2-$1-01");
648 } elsif ( $2 > 97 ) { #should pry change to check for "this year"
649 $self->paydate("19$2-$1-01");
651 $self->paydate("20$2-$1-01");
655 if ( $self->payname eq '' ) {
656 $self->payname( $self->first. " ". $self->getfield('last') );
658 $self->payname =~ /^([\w \,\.\-\']+)$/
659 or return "Illegal billing name: ". $self->payname;
663 $self->tax =~ /^(Y?)$/ or return "Illegal tax: ". $self->tax;
666 $self->otaker(getotaker);
673 Returns all packages (see L<FS::cust_pkg>) for this customer.
679 qsearch( 'cust_pkg', { 'custnum' => $self->custnum });
682 =item ncancelled_pkgs
684 Returns all non-cancelled packages (see L<FS::cust_pkg>) for this customer.
688 sub ncancelled_pkgs {
690 @{ [ # force list context
691 qsearch( 'cust_pkg', {
692 'custnum' => $self->custnum,
695 qsearch( 'cust_pkg', {
696 'custnum' => $self->custnum,
704 Generates invoices (see L<FS::cust_bill>) for this customer. Usually used in
705 conjunction with the collect method.
707 The only currently available option is `time', which bills the customer as if
708 it were that time. It is specified as a UNIX timestamp; see
709 L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion
712 If there is an error, returns the error, otherwise returns false.
717 my( $self, %options ) = @_;
718 my $time = $options{'time'} || time;
723 local $SIG{HUP} = 'IGNORE';
724 local $SIG{INT} = 'IGNORE';
725 local $SIG{QUIT} = 'IGNORE';
726 local $SIG{TERM} = 'IGNORE';
727 local $SIG{TSTP} = 'IGNORE';
728 local $SIG{PIPE} = 'IGNORE';
730 my $oldAutoCommit = $FS::UID::AutoCommit;
731 local $FS::UID::AutoCommit = 0;
734 # find the packages which are due for billing, find out how much they are
735 # & generate invoice database.
737 my( $total_setup, $total_recur ) = ( 0, 0 );
740 foreach my $cust_pkg (
741 qsearch('cust_pkg',{'custnum'=> $self->getfield('custnum') } )
744 next if $cust_pkg->getfield('cancel');
746 #? to avoid use of uninitialized value errors... ?
747 $cust_pkg->setfield('bill', '')
748 unless defined($cust_pkg->bill);
750 my $part_pkg = qsearchs( 'part_pkg', { 'pkgpart' => $cust_pkg->pkgpart } );
752 #so we don't modify cust_pkg record unnecessarily
753 my $cust_pkg_mod_flag = 0;
754 my %hash = $cust_pkg->hash;
755 my $old_cust_pkg = new FS::cust_pkg \%hash;
759 unless ( $cust_pkg->setup ) {
760 my $setup_prog = $part_pkg->getfield('setup');
761 $setup_prog =~ /^(.*)$/ #presumably trusted
762 or die "Illegal setup for package ". $cust_pkg->pkgnum. ": $setup_prog";
765 #$cpt->permit(); #what is necessary?
766 $cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
767 $setup = $cpt->reval($setup_prog);
768 unless ( defined($setup) ) {
769 warn "Error reval-ing part_pkg->setup pkgpart ",
770 $part_pkg->pkgpart, ": $@";
772 $cust_pkg->setfield('setup',$time);
773 $cust_pkg_mod_flag=1;
780 if ( $part_pkg->getfield('freq') > 0 &&
781 ! $cust_pkg->getfield('susp') &&
782 ( $cust_pkg->getfield('bill') || 0 ) < $time
784 my $recur_prog = $part_pkg->getfield('recur');
785 $recur_prog =~ /^(.*)$/ #presumably trusted
786 or die "Illegal recur for package ". $cust_pkg->pkgnum. ": $recur_prog";
789 #$cpt->permit(); #what is necessary?
790 $cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
791 $recur = $cpt->reval($recur_prog);
792 unless ( defined($recur) ) {
793 warn "Error reval-ing part_pkg->recur pkgpart ",
794 $part_pkg->pkgpart, ": $@";
796 #change this bit to use Date::Manip? CAREFUL with timezones (see
797 # mailing list archive)
798 #$sdate=$cust_pkg->bill || time;
799 #$sdate=$cust_pkg->bill || $time;
800 $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
801 my ($sec,$min,$hour,$mday,$mon,$year) =
802 (localtime($sdate) )[0,1,2,3,4,5];
803 $mon += $part_pkg->getfield('freq');
804 until ( $mon < 12 ) { $mon -= 12; $year++; }
805 $cust_pkg->setfield('bill',
806 timelocal($sec,$min,$hour,$mday,$mon,$year));
807 $cust_pkg_mod_flag = 1;
811 warn "setup is undefined" unless defined($setup);
812 warn "recur is undefined" unless defined($recur);
813 warn "cust_pkg bill is undefined" unless defined($cust_pkg->bill);
815 if ( $cust_pkg_mod_flag ) {
816 $error=$cust_pkg->replace($old_cust_pkg);
817 if ( $error ) { #just in case
818 warn "Error modifying pkgnum ", $cust_pkg->pkgnum, ": $error";
820 $setup = sprintf( "%.2f", $setup );
821 $recur = sprintf( "%.2f", $recur );
822 my $cust_bill_pkg = new FS::cust_bill_pkg ({
823 'pkgnum' => $cust_pkg->pkgnum,
827 'edate' => $cust_pkg->bill,
829 push @cust_bill_pkg, $cust_bill_pkg;
830 $total_setup += $setup;
831 $total_recur += $recur;
837 my $charged = sprintf( "%.2f", $total_setup + $total_recur );
839 unless ( @cust_bill_pkg ) {
840 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
844 unless ( $self->getfield('tax') =~ /Y/i
845 || $self->getfield('payby') eq 'COMP'
847 my $cust_main_county = qsearchs('cust_main_county',{
848 'state' => $self->state,
849 'county' => $self->county,
850 'country' => $self->country,
852 my $tax = sprintf( "%.2f",
853 $charged * ( $cust_main_county->getfield('tax') / 100 )
855 $charged = sprintf( "%.2f", $charged+$tax );
857 my $cust_bill_pkg = new FS::cust_bill_pkg ({
864 push @cust_bill_pkg, $cust_bill_pkg;
867 my $cust_bill = new FS::cust_bill ( {
868 'custnum' => $self->getfield('custnum'),
870 'charged' => $charged,
872 $error = $cust_bill->insert;
874 $dbh->rollback if $oldAutoCommit;
875 return "$error for customer #". $self->custnum;
878 my $invnum = $cust_bill->invnum;
880 foreach $cust_bill_pkg ( @cust_bill_pkg ) {
881 $cust_bill_pkg->setfield( 'invnum', $invnum );
882 $error = $cust_bill_pkg->insert;
883 #shouldn't happen, but how else tohandle this?
885 $dbh->rollback if $oldAutoCommit;
886 return "$error for customer #". $self->custnum;
890 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
894 =item collect OPTIONS
896 (Attempt to) collect money for this customer's outstanding invoices (see
897 L<FS::cust_bill>). Usually used after the bill method.
899 Depending on the value of `payby', this may print an invoice (`BILL'), charge
900 a credit card (`CARD'), or just add any necessary (pseudo-)payment (`COMP').
902 If there is an error, returns the error, otherwise returns false.
904 Currently available options are:
906 invoice_time - Use this time when deciding when to print invoices and
907 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>
908 for conversion functions.
910 batch_card - Set this true to batch cards (see L<cust_pay_batch>). By
911 default, cards are processed immediately, which will generate an error if
912 CyberCash is not installed.
914 report_badcard - Set this true if you want bad card transactions to
915 return an error. By default, they don't.
920 my( $self, %options ) = @_;
921 my $invoice_time = $options{'invoice_time'} || time;
924 local $SIG{HUP} = 'IGNORE';
925 local $SIG{INT} = 'IGNORE';
926 local $SIG{QUIT} = 'IGNORE';
927 local $SIG{TERM} = 'IGNORE';
928 local $SIG{TSTP} = 'IGNORE';
929 local $SIG{PIPE} = 'IGNORE';
931 my $oldAutoCommit = $FS::UID::AutoCommit;
932 local $FS::UID::AutoCommit = 0;
935 my $total_owed = $self->balance;
936 warn "collect: total owed $total_owed " if $Debug;
937 unless ( $total_owed > 0 ) { #redundant?????
938 $dbh->rollback if $oldAutoCommit;
942 foreach my $cust_bill (
943 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
946 #this has to be before next's
947 my $amount = sprintf( "%.2f", $total_owed < $cust_bill->owed
951 $total_owed = sprintf( "%.2f", $total_owed - $amount );
953 next unless $cust_bill->owed > 0;
955 next if qsearchs( 'cust_pay_batch', { 'invnum' => $cust_bill->invnum } );
957 warn "invnum ". $cust_bill->invnum. " (owed ". $cust_bill->owed. ", amount $amount, total_owed $total_owed)" if $Debug;
959 next unless $amount > 0;
961 if ( $self->payby eq 'BILL' ) {
964 my $since = $invoice_time - ( $cust_bill->_date || 0 );
965 #warn "$invoice_time ", $cust_bill->_date, " $since";
966 if ( $since >= 0 #don't print future invoices
967 && ( $cust_bill->printed * 2592000 ) <= $since
970 #my @print_text = $cust_bill->print_text; #( date )
971 my @invoicing_list = $self->invoicing_list;
972 if ( grep { $_ ne 'POST' } @invoicing_list ) { #email invoice
973 $ENV{SMTPHOSTS} = $smtpmachine;
974 $ENV{MAILADDRESS} = $invoice_from;
975 my $header = new Mail::Header ( [
976 "From: $invoice_from",
977 "To: ". join(', ', grep { $_ ne 'POST' } @invoicing_list ),
978 "Sender: $invoice_from",
979 "Reply-To: $invoice_from",
980 "Date: ". time2str("%a, %d %b %Y %X %z", time),
983 my $message = new Mail::Internet (
985 'Body' => [ $cust_bill->print_text ], #( date)
987 $message->smtpsend or die "Can't send invoice email!"; #die? warn?
989 } elsif ( ! @invoicing_list || grep { $_ eq 'POST' } @invoicing_list ) {
990 open(LPR, "|$lpr") or die "Can't open pipe to $lpr: $!";
991 print LPR $cust_bill->print_text; #( date )
993 or die $! ? "Error closing $lpr: $!"
994 : "Exit status $? from $lpr";
997 my %hash = $cust_bill->hash;
999 my $new_cust_bill = new FS::cust_bill(\%hash);
1000 my $error = $new_cust_bill->replace($cust_bill);
1001 warn "Error updating $cust_bill->printed: $error" if $error;
1005 } elsif ( $self->payby eq 'COMP' ) {
1006 my $cust_pay = new FS::cust_pay ( {
1007 'invnum' => $cust_bill->invnum,
1011 'payinfo' => $self->payinfo,
1014 my $error = $cust_pay->insert;
1016 $dbh->rollback if $oldAutoCommit;
1017 return 'Error COMPing invnum #'. $cust_bill->invnum. ": $error";
1021 } elsif ( $self->payby eq 'CARD' ) {
1023 if ( $options{'batch_card'} ne 'yes' ) {
1025 unless ( $processor ) {
1026 $dbh->rollback if $oldAutoCommit;
1027 return "Real time card processing not enabled!";
1030 my $address = $self->address1;
1031 $address .= ", ". $self->address2 if $self->address2;
1034 #$self->paydate =~ /^(\d+)\/\d*(\d{2})$/;
1035 $self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
1038 if ( $processor =~ /^cybercash/ ) {
1040 #fix exp. date for cybercash
1041 #$self->paydate =~ /^(\d+)\/\d*(\d{2})$/;
1042 $self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
1045 my $paybatch = $cust_bill->invnum.
1046 '-' . time2str("%y%m%d%H%M%S", time);
1048 my $payname = $self->payname ||
1049 $self->getfield('first'). ' '. $self->getfield('last');
1052 my $country = $self->country eq 'US' ? 'USA' : $self->country;
1054 my @full_xaction = ( $xaction,
1055 'Order-ID' => $paybatch,
1056 'Amount' => "usd $amount",
1057 'Card-Number' => $self->getfield('payinfo'),
1058 'Card-Name' => $payname,
1059 'Card-Address' => $address,
1060 'Card-City' => $self->getfield('city'),
1061 'Card-State' => $self->getfield('state'),
1062 'Card-Zip' => $self->getfield('zip'),
1063 'Card-Country' => $country,
1068 if ( $processor eq 'cybercash2' ) {
1069 $^W=0; #CCLib isn't -w safe, ugh!
1070 %result = &CCLib::sendmserver(@full_xaction);
1072 } elsif ( $processor eq 'cybercash3.2' ) {
1073 %result = &CCMckDirectLib3_2::SendCC2_1Server(@full_xaction);
1075 $dbh->rollback if $oldAutoCommit;
1076 return "Unknown real-time processor $processor";
1079 #if ( $result{'MActionCode'} == 7 ) { #cybercash smps v.1.1.3
1080 #if ( $result{'action-code'} == 7 ) { #cybercash smps v.2.1
1081 if ( $result{'MStatus'} eq 'success' ) { #cybercash smps v.2 or 3
1082 my $cust_pay = new FS::cust_pay ( {
1083 'invnum' => $cust_bill->invnum,
1087 'payinfo' => $self->payinfo,
1088 'paybatch' => "$processor:$paybatch",
1090 my $error = $cust_pay->insert;
1092 # gah, even with transactions.
1093 $dbh->commit if $oldAutoCommit; #well.
1094 my $e = 'WARNING: Card debited but database not updated - '.
1095 'error applying payment, invnum #' . $cust_bill->invnum.
1096 " (CyberCash Order-ID $paybatch): $error";
1100 } elsif ( $result{'Mstatus'} ne 'failure-bad-money'
1101 || $options{'report_badcard'} ) {
1102 $dbh->commit if $oldAutoCommit;
1103 return 'Cybercash error, invnum #' .
1104 $cust_bill->invnum. ':'. $result{'MErrMsg'};
1106 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1110 } elsif ( $processor =~ /^Business::OnlinePayment::(.*)$/ ) {
1112 my($payname, $payfirst, $paylast);
1113 if ( $self->payname ) {
1114 $payname = $self->payname;
1115 $payname =~ /^\s*([\w \,\.\-\']*\w)?\s+([\w\,\.\-\']+)$/
1117 $dbh->rollback if $oldAutoCommit;
1118 return "Illegal payname $payname";
1120 ($payfirst, $paylast) = ($1, $2);
1122 $payfirst = $self->getfield('first');
1123 $paylast = $self->getfield('first');
1124 $payname = "$payfirst $paylast";
1127 my $transaction = new Business::OnlinePayment( $1, @bop_options );
1128 $transaction->content(
1130 'login' => $bop_login,
1131 'password' => $bop_password,
1132 'action' => $bop_action,
1133 'amount' => $amount,
1134 'invoice_number' => $cust_bill->invnum,
1135 'customer_id' => $self->custnum,
1136 'last_name' => $paylast,
1137 'first_name' => $payfirst,
1139 'address' => $address,
1140 'city' => $self->city,
1141 'state' => $self->state,
1142 'zip' => $self->zip,
1143 'country' => $self->country,
1144 'card_number' => $self->payinfo,
1145 'expiration' => $exp,
1147 $transaction->submit();
1149 if ( $transaction->is_success()) {
1150 my $cust_pay = new FS::cust_pay ( {
1151 'invnum' => $cust_bill->invnum,
1155 'payinfo' => $self->payinfo,
1156 'paybatch' => "$processor:". $transaction->authorization,
1158 my $error = $cust_pay->insert;
1160 # gah, even with transactions.
1161 $dbh->commit if $oldAutoCommit; #well.
1162 my $e = 'WARNING: Card debited but database not updated - '.
1163 'error applying payment, invnum #' . $cust_bill->invnum.
1164 " ($processor): $error";
1168 } elsif ( $options{'report_badcard'} ) {
1169 $dbh->commit if $oldAutoCommit;
1170 return "$processor error, invnum #". $cust_bill->invnum. ': '.
1171 $transaction->result_code. ": ". $transaction->error_message;
1173 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1178 $dbh->rollback if $oldAutoCommit;
1179 return "Unknown real-time processor $processor\n";
1182 } else { #batch card
1184 my $cust_pay_batch = new FS::cust_pay_batch ( {
1185 'invnum' => $cust_bill->getfield('invnum'),
1186 'custnum' => $self->getfield('custnum'),
1187 'last' => $self->getfield('last'),
1188 'first' => $self->getfield('first'),
1189 'address1' => $self->getfield('address1'),
1190 'address2' => $self->getfield('address2'),
1191 'city' => $self->getfield('city'),
1192 'state' => $self->getfield('state'),
1193 'zip' => $self->getfield('zip'),
1194 'country' => $self->getfield('country'),
1196 'cardnum' => $self->getfield('payinfo'),
1197 'exp' => $self->getfield('paydate'),
1198 'payname' => $self->getfield('payname'),
1199 'amount' => $amount,
1201 my $error = $cust_pay_batch->insert;
1203 $dbh->rollback if $oldAutoCommit;
1204 return "Error adding to cust_pay_batch: $error";
1210 $dbh->rollback if $oldAutoCommit;
1211 return "Unknown payment type ". $self->payby;
1215 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1222 Returns the total owed for this customer on all invoices
1223 (see L<FS::cust_bill>).
1230 foreach my $cust_bill ( qsearch('cust_bill', {
1231 'custnum' => $self->custnum,
1233 $total_bill += $cust_bill->owed;
1235 sprintf( "%.2f", $total_bill );
1238 =item total_credited
1240 Returns the total credits (see L<FS::cust_credit>) for this customer.
1244 sub total_credited {
1246 my $total_credit = 0;
1247 foreach my $cust_credit ( qsearch('cust_credit', {
1248 'custnum' => $self->custnum,
1250 $total_credit += $cust_credit->credited;
1252 sprintf( "%.2f", $total_credit );
1257 Returns the balance for this customer (total owed minus total credited).
1263 sprintf( "%.2f", $self->total_owed - $self->total_credited );
1266 =item invoicing_list [ ARRAYREF ]
1268 If an arguement is given, sets these email addresses as invoice recipients
1269 (see L<FS::cust_main_invoice>). Errors are not fatal and are not reported
1270 (except as warnings), so use check_invoicing_list first.
1272 Returns a list of email addresses (with svcnum entries expanded).
1274 Note: You can clear the invoicing list by passing an empty ARRAYREF. You can
1275 check it without disturbing anything by passing nothing.
1277 This interface may change in the future.
1281 sub invoicing_list {
1282 my( $self, $arrayref ) = @_;
1284 my @cust_main_invoice;
1285 if ( $self->custnum ) {
1286 @cust_main_invoice =
1287 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1289 @cust_main_invoice = ();
1291 foreach my $cust_main_invoice ( @cust_main_invoice ) {
1292 #warn $cust_main_invoice->destnum;
1293 unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
1294 #warn $cust_main_invoice->destnum;
1295 my $error = $cust_main_invoice->delete;
1296 warn $error if $error;
1299 if ( $self->custnum ) {
1300 @cust_main_invoice =
1301 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1303 @cust_main_invoice = ();
1305 foreach my $address ( @{$arrayref} ) {
1306 unless ( grep { $address eq $_->address } @cust_main_invoice ) {
1307 my $cust_main_invoice = new FS::cust_main_invoice ( {
1308 'custnum' => $self->custnum,
1311 my $error = $cust_main_invoice->insert;
1312 warn $error if $error;
1316 if ( $self->custnum ) {
1318 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1324 =item check_invoicing_list ARRAYREF
1326 Checks these arguements as valid input for the invoicing_list method. If there
1327 is an error, returns the error, otherwise returns false.
1331 sub check_invoicing_list {
1332 my( $self, $arrayref ) = @_;
1333 foreach my $address ( @{$arrayref} ) {
1334 my $cust_main_invoice = new FS::cust_main_invoice ( {
1335 'custnum' => $self->custnum,
1338 my $error = $self->custnum
1339 ? $cust_main_invoice->check
1340 : $cust_main_invoice->checkdest
1342 return $error if $error;
1351 $Id: cust_main.pm,v 1.19 2001-08-19 00:48:49 ivan Exp $
1357 The delete method should possibly take an FS::cust_main object reference
1358 instead of a scalar customer number.
1360 Bill and collect options should probably be passed as references instead of a
1363 CyberCash v2 forces us to define some variables in package main.
1365 There should probably be a configuration file with a list of allowed credit
1368 CyberCash is the only processor.
1370 No multiple currency support (probably a larger project than just this module).
1374 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
1375 L<FS::cust_pay_batch>, L<FS::agent>, L<FS::part_referral>,
1376 L<FS::cust_main_county>, L<FS::cust_main_invoice>,
1377 L<FS::UID>, schema.html from the base documentation.