1 #this is so kludgy i'd be embarassed if it wasn't cybercash's fault
3 use vars qw($paymentserversecret $paymentserverport $paymentserverhost);
8 use vars qw( @ISA $conf $lpr $processor $xaction $E_NoErr $invoice_from
9 $smtpmachine $Debug $bop_processor $bop_login $bop_password
10 $bop_action @bop_options);
18 use Business::CreditCard;
19 use FS::UID qw( getotaker dbh );
20 use FS::Record qw( qsearchs qsearch dbdef );
23 use FS::cust_bill_pkg;
26 use FS::cust_pay_batch;
27 use FS::part_referral;
28 use FS::cust_main_county;
30 use FS::cust_main_invoice;
31 use FS::prepay_credit;
33 @ISA = qw( FS::Record );
38 #ask FS::UID to run this stuff for us later
39 $FS::UID::callback{'FS::cust_main'} = sub {
41 $lpr = $conf->config('lpr');
42 $invoice_from = $conf->config('invoice_from');
43 $smtpmachine = $conf->config('smtpmachine');
45 if ( $conf->exists('cybercash3.2') ) {
47 #qw($MCKversion %Config InitConfig CCError CCDebug CCDebug2);
48 require CCMckDirectLib3_2;
50 require CCMckErrno3_2;
51 #qw(MCKGetErrorMessage $E_NoErr);
52 import CCMckErrno3_2 qw($E_NoErr);
55 ($merchant_conf,$xaction)= $conf->config('cybercash3.2');
56 my $status = &CCMckLib3_2::InitConfig($merchant_conf);
57 if ( $status != $E_NoErr ) {
58 warn "CCMckLib3_2::InitConfig error:\n";
59 foreach my $key (keys %CCMckLib3_2::Config) {
60 warn " $key => $CCMckLib3_2::Config{$key}\n"
62 my($errmsg) = &CCMckErrno3_2::MCKGetErrorMessage($status);
63 die "CCMckLib3_2::InitConfig fatal error: $errmsg\n";
65 $processor='cybercash3.2';
66 } elsif ( $conf->exists('cybercash2') ) {
69 ( $main::paymentserverhost,
70 $main::paymentserverport,
71 $main::paymentserversecret,
73 ) = $conf->config('cybercash2');
74 $processor='cybercash2';
75 } elsif ( $conf->exists('business-onlinepayment') ) {
81 ) = $conf->config('business-onlinepayment');
82 $bop_action ||= 'normal authorization';
83 eval "use Business::OnlinePayment";
84 $processor="Business::OnlinePayment::$bop_processor";
90 FS::cust_main - Object methods for cust_main records
96 $record = new FS::cust_main \%hash;
97 $record = new FS::cust_main { 'column' => 'value' };
99 $error = $record->insert;
101 $error = $new_record->replace($old_record);
103 $error = $record->delete;
105 $error = $record->check;
107 @cust_pkg = $record->all_pkgs;
109 @cust_pkg = $record->ncancelled_pkgs;
111 $error = $record->bill;
112 $error = $record->bill %options;
113 $error = $record->bill 'time' => $time;
115 $error = $record->collect;
116 $error = $record->collect %options;
117 $error = $record->collect 'invoice_time' => $time,
118 'batch_card' => 'yes',
119 'report_badcard' => 'yes',
124 An FS::cust_main object represents a customer. FS::cust_main inherits from
125 FS::Record. The following fields are currently supported:
129 =item custnum - primary key (assigned automatically for new customers)
131 =item agentnum - agent (see L<FS::agent>)
133 =item refnum - referral (see L<FS::part_referral>)
139 =item ss - social security number (optional)
141 =item company - (optional)
145 =item address2 - (optional)
149 =item county - (optional, see L<FS::cust_main_county>)
151 =item state - (see L<FS::cust_main_county>)
155 =item country - (see L<FS::cust_main_county>)
157 =item daytime - phone (optional)
159 =item night - phone (optional)
161 =item fax - phone (optional)
163 =item ship_first - name
165 =item ship_last - name
167 =item ship_company - (optional)
171 =item ship_address2 - (optional)
175 =item ship_county - (optional, see L<FS::cust_main_county>)
177 =item ship_state - (see L<FS::cust_main_county>)
181 =item ship_country - (see L<FS::cust_main_county>)
183 =item ship_daytime - phone (optional)
185 =item ship_night - phone (optional)
187 =item ship_fax - phone (optional)
189 =item payby - `CARD' (credit cards), `BILL' (billing), `COMP' (free), or `PREPAY' (special billing type: applies a credit - see L<FS::prepay_credit> and sets billing type to BILL)
191 =item payinfo - card number, P.O., comp issuer (4-8 lowercase alphanumerics; think username) or prepayment identifier (see L<FS::prepay_credit>)
193 =item paydate - expiration date, mm/yyyy, m/yyyy, mm/yy or m/yy
195 =item payname - name on card or billing name
197 =item tax - tax exempt, empty or `Y'
199 =item otaker - order taker (assigned automatically, see L<FS::UID>)
201 =item comments - comments (optional)
211 Creates a new customer. To add the customer to the database, see L<"insert">.
213 Note that this stores the hash reference, not a distinct copy of the hash it
214 points to. You can ask the object for a copy with the I<hash> method.
218 sub table { 'cust_main'; }
220 =item insert [ CUST_PKG_HASHREF [ , INVOICING_LIST_ARYREF ] ]
222 Adds this customer to the database. If there is an error, returns the error,
223 otherwise returns false.
225 CUST_PKG_HASHREF: If you pass a Tie::RefHash data structure to the insert
226 method containing FS::cust_pkg and FS::svc_I<tablename> objects, all records
227 are inserted atomicly, or the transaction is rolled back (this requries a
228 transactional database). Passing an empty hash reference is equivalent to
229 not supplying this parameter. There should be a better explanation of this,
230 but until then, here's an example:
233 tie %hash, 'Tie::RefHash'; #this part is important
235 $cust_pkg => [ $svc_acct ],
238 $cust_main->insert( \%hash );
240 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
241 be set as the invoicing list (see L<"invoicing_list">). Errors return as
242 expected and rollback the entire transaction; it is not necessary to call
243 check_invoicing_list first. The invoicing_list is set after the records in the
244 CUST_PKG_HASHREF above are inserted, so it is now possible set set an
245 invoicing_list destination to the newly-created svc_acct. Here's an example:
247 $cust_main->insert( {}, [ $email, 'POST' ] );
255 local $SIG{HUP} = 'IGNORE';
256 local $SIG{INT} = 'IGNORE';
257 local $SIG{QUIT} = 'IGNORE';
258 local $SIG{TERM} = 'IGNORE';
259 local $SIG{TSTP} = 'IGNORE';
260 local $SIG{PIPE} = 'IGNORE';
262 my $oldAutoCommit = $FS::UID::AutoCommit;
263 local $FS::UID::AutoCommit = 0;
268 if ( $self->payby eq 'PREPAY' ) {
269 $self->payby('BILL');
270 my $prepay_credit = qsearchs(
272 { 'identifier' => $self->payinfo },
276 warn "WARNING: can't find pre-found prepay_credit: ". $self->payinfo
277 unless $prepay_credit;
278 $amount = $prepay_credit->amount;
279 $seconds = $prepay_credit->seconds;
280 my $error = $prepay_credit->delete;
282 $dbh->rollback if $oldAutoCommit;
283 return "removing prepay_credit (transaction rolled back): $error";
287 my $error = $self->SUPER::insert;
289 $dbh->rollback if $oldAutoCommit;
290 return "inserting cust_main record (transaction rolled back): $error";
293 if ( @param ) { # CUST_PKG_HASHREF
294 my $cust_pkgs = shift @param;
295 foreach my $cust_pkg ( keys %$cust_pkgs ) {
296 $cust_pkg->custnum( $self->custnum );
297 $error = $cust_pkg->insert;
299 $dbh->rollback if $oldAutoCommit;
300 return "inserting cust_pkg (transaction rolled back): $error";
302 foreach my $svc_something ( @{$cust_pkgs->{$cust_pkg}} ) {
303 $svc_something->pkgnum( $cust_pkg->pkgnum );
304 if ( $seconds && $svc_something->isa('FS::svc_acct') ) {
305 $svc_something->seconds( $svc_something->seconds + $seconds );
308 $error = $svc_something->insert;
310 $dbh->rollback if $oldAutoCommit;
311 return "inserting svc_ (transaction rolled back): $error";
318 $dbh->rollback if $oldAutoCommit;
319 return "No svc_acct record to apply pre-paid time";
322 if ( @param ) { # INVOICING_LIST_ARYREF
323 my $invoicing_list = shift @param;
324 $error = $self->check_invoicing_list( $invoicing_list );
326 $dbh->rollback if $oldAutoCommit;
327 return "checking invoicing_list (transaction rolled back): $error";
329 $self->invoicing_list( $invoicing_list );
333 my $cust_credit = new FS::cust_credit {
334 'custnum' => $self->custnum,
337 $error = $cust_credit->insert;
339 $dbh->rollback if $oldAutoCommit;
340 return "inserting credit (transaction rolled back): $error";
344 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
349 =item delete NEW_CUSTNUM
351 This deletes the customer. If there is an error, returns the error, otherwise
354 This will completely remove all traces of the customer record. This is not
355 what you want when a customer cancels service; for that, cancel all of the
356 customer's packages (see L<FS::cust_pkg/cancel>).
358 If the customer has any packages, you need to pass a new (valid) customer
359 number for those packages to be transferred to.
361 You can't delete a customer with invoices (see L<FS::cust_bill>),
362 or credits (see L<FS::cust_credit>).
369 local $SIG{HUP} = 'IGNORE';
370 local $SIG{INT} = 'IGNORE';
371 local $SIG{QUIT} = 'IGNORE';
372 local $SIG{TERM} = 'IGNORE';
373 local $SIG{TSTP} = 'IGNORE';
374 local $SIG{PIPE} = 'IGNORE';
376 my $oldAutoCommit = $FS::UID::AutoCommit;
377 local $FS::UID::AutoCommit = 0;
380 if ( qsearch( 'cust_bill', { 'custnum' => $self->custnum } ) ) {
381 $dbh->rollback if $oldAutoCommit;
382 return "Can't delete a customer with invoices";
384 if ( qsearch( 'cust_credit', { 'custnum' => $self->custnum } ) ) {
385 $dbh->rollback if $oldAutoCommit;
386 return "Can't delete a customer with credits";
389 my @cust_pkg = qsearch( 'cust_pkg', { 'custnum' => $self->custnum } );
391 my $new_custnum = shift;
392 unless ( qsearchs( 'cust_main', { 'custnum' => $new_custnum } ) ) {
393 $dbh->rollback if $oldAutoCommit;
394 return "Invalid new customer number: $new_custnum";
396 foreach my $cust_pkg ( @cust_pkg ) {
397 my %hash = $cust_pkg->hash;
398 $hash{'custnum'} = $new_custnum;
399 my $new_cust_pkg = new FS::cust_pkg ( \%hash );
400 my $error = $new_cust_pkg->replace($cust_pkg);
402 $dbh->rollback if $oldAutoCommit;
407 foreach my $cust_main_invoice (
408 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } )
410 my $error = $cust_main_invoice->delete;
412 $dbh->rollback if $oldAutoCommit;
417 my $error = $self->SUPER::delete;
419 $dbh->rollback if $oldAutoCommit;
423 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
428 =item replace OLD_RECORD [ INVOICING_LIST_ARYREF ]
430 Replaces the OLD_RECORD with this one in the database. If there is an error,
431 returns the error, otherwise returns false.
433 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
434 be set as the invoicing list (see L<"invoicing_list">). Errors return as
435 expected and rollback the entire transaction; it is not necessary to call
436 check_invoicing_list first. Here's an example:
438 $new_cust_main->replace( $old_cust_main, [ $email, 'POST' ] );
447 local $SIG{HUP} = 'IGNORE';
448 local $SIG{INT} = 'IGNORE';
449 local $SIG{QUIT} = 'IGNORE';
450 local $SIG{TERM} = 'IGNORE';
451 local $SIG{TSTP} = 'IGNORE';
452 local $SIG{PIPE} = 'IGNORE';
454 my $oldAutoCommit = $FS::UID::AutoCommit;
455 local $FS::UID::AutoCommit = 0;
458 my $error = $self->SUPER::replace($old);
461 $dbh->rollback if $oldAutoCommit;
465 if ( @param ) { # INVOICING_LIST_ARYREF
466 my $invoicing_list = shift @param;
467 $error = $self->check_invoicing_list( $invoicing_list );
469 $dbh->rollback if $oldAutoCommit;
472 $self->invoicing_list( $invoicing_list );
475 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
482 Checks all fields to make sure this is a valid customer record. If there is
483 an error, returns the error, otherwise returns false. Called by the insert
492 $self->ut_numbern('custnum')
493 || $self->ut_number('agentnum')
494 || $self->ut_number('refnum')
495 || $self->ut_name('last')
496 || $self->ut_name('first')
497 || $self->ut_textn('company')
498 || $self->ut_text('address1')
499 || $self->ut_textn('address2')
500 || $self->ut_text('city')
501 || $self->ut_textn('county')
502 || $self->ut_textn('state')
503 || $self->ut_country('country')
504 || $self->ut_anything('comments')
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");
649 $self->paydate("20$2-$1-01");
653 if ( $self->payname eq '' ) {
654 $self->payname( $self->first. " ". $self->getfield('last') );
656 $self->payname =~ /^([\w \,\.\-\']+)$/
657 or return "Illegal billing name: ". $self->payname;
661 $self->tax =~ /^(Y?)$/ or return "Illegal tax: ". $self->tax;
664 $self->otaker(getotaker);
671 Returns all packages (see L<FS::cust_pkg>) for this customer.
677 qsearch( 'cust_pkg', { 'custnum' => $self->custnum });
680 =item ncancelled_pkgs
682 Returns all non-cancelled packages (see L<FS::cust_pkg>) for this customer.
686 sub ncancelled_pkgs {
688 @{ [ # force list context
689 qsearch( 'cust_pkg', {
690 'custnum' => $self->custnum,
693 qsearch( 'cust_pkg', {
694 'custnum' => $self->custnum,
702 Generates invoices (see L<FS::cust_bill>) for this customer. Usually used in
703 conjunction with the collect method.
705 The only currently available option is `time', which bills the customer as if
706 it were that time. It is specified as a UNIX timestamp; see
707 L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion
710 If there is an error, returns the error, otherwise returns false.
715 my( $self, %options ) = @_;
716 my $time = $options{'time'} || time;
721 local $SIG{HUP} = 'IGNORE';
722 local $SIG{INT} = 'IGNORE';
723 local $SIG{QUIT} = 'IGNORE';
724 local $SIG{TERM} = 'IGNORE';
725 local $SIG{TSTP} = 'IGNORE';
726 local $SIG{PIPE} = 'IGNORE';
728 my $oldAutoCommit = $FS::UID::AutoCommit;
729 local $FS::UID::AutoCommit = 0;
732 # find the packages which are due for billing, find out how much they are
733 # & generate invoice database.
735 my( $total_setup, $total_recur ) = ( 0, 0 );
738 foreach my $cust_pkg (
739 qsearch('cust_pkg',{'custnum'=> $self->getfield('custnum') } )
742 next if $cust_pkg->getfield('cancel');
744 #? to avoid use of uninitialized value errors... ?
745 $cust_pkg->setfield('bill', '')
746 unless defined($cust_pkg->bill);
748 my $part_pkg = qsearchs( 'part_pkg', { 'pkgpart' => $cust_pkg->pkgpart } );
750 #so we don't modify cust_pkg record unnecessarily
751 my $cust_pkg_mod_flag = 0;
752 my %hash = $cust_pkg->hash;
753 my $old_cust_pkg = new FS::cust_pkg \%hash;
757 unless ( $cust_pkg->setup ) {
758 my $setup_prog = $part_pkg->getfield('setup');
759 $setup_prog =~ /^(.*)$/ #presumably trusted
760 or die "Illegal setup for package ". $cust_pkg->pkgnum. ": $setup_prog";
763 #$cpt->permit(); #what is necessary?
764 $cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
765 $setup = $cpt->reval($setup_prog);
766 unless ( defined($setup) ) {
767 warn "Error reval-ing part_pkg->setup pkgpart ",
768 $part_pkg->pkgpart, ": $@";
770 $cust_pkg->setfield('setup',$time);
771 $cust_pkg_mod_flag=1;
778 if ( $part_pkg->getfield('freq') > 0 &&
779 ! $cust_pkg->getfield('susp') &&
780 ( $cust_pkg->getfield('bill') || 0 ) < $time
782 my $recur_prog = $part_pkg->getfield('recur');
783 $recur_prog =~ /^(.*)$/ #presumably trusted
784 or die "Illegal recur for package ". $cust_pkg->pkgnum. ": $recur_prog";
787 #$cpt->permit(); #what is necessary?
788 $cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
789 $recur = $cpt->reval($recur_prog);
790 unless ( defined($recur) ) {
791 warn "Error reval-ing part_pkg->recur pkgpart ",
792 $part_pkg->pkgpart, ": $@";
794 #change this bit to use Date::Manip? CAREFUL with timezones (see
795 # mailing list archive)
796 #$sdate=$cust_pkg->bill || time;
797 #$sdate=$cust_pkg->bill || $time;
798 $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
799 my ($sec,$min,$hour,$mday,$mon,$year) =
800 (localtime($sdate) )[0,1,2,3,4,5];
801 $mon += $part_pkg->getfield('freq');
802 until ( $mon < 12 ) { $mon -= 12; $year++; }
803 $cust_pkg->setfield('bill',
804 timelocal($sec,$min,$hour,$mday,$mon,$year));
805 $cust_pkg_mod_flag = 1;
809 warn "setup is undefined" unless defined($setup);
810 warn "recur is undefined" unless defined($recur);
811 warn "cust_pkg bill is undefined" unless defined($cust_pkg->bill);
813 if ( $cust_pkg_mod_flag ) {
814 $error=$cust_pkg->replace($old_cust_pkg);
815 if ( $error ) { #just in case
816 warn "Error modifying pkgnum ", $cust_pkg->pkgnum, ": $error";
818 $setup = sprintf( "%.2f", $setup );
819 $recur = sprintf( "%.2f", $recur );
820 my $cust_bill_pkg = new FS::cust_bill_pkg ({
821 'pkgnum' => $cust_pkg->pkgnum,
825 'edate' => $cust_pkg->bill,
827 push @cust_bill_pkg, $cust_bill_pkg;
828 $total_setup += $setup;
829 $total_recur += $recur;
835 my $charged = sprintf( "%.2f", $total_setup + $total_recur );
837 unless ( @cust_bill_pkg ) {
838 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
842 unless ( $self->getfield('tax') =~ /Y/i
843 || $self->getfield('payby') eq 'COMP'
845 my $cust_main_county = qsearchs('cust_main_county',{
846 'state' => $self->state,
847 'county' => $self->county,
848 'country' => $self->country,
850 my $tax = sprintf( "%.2f",
851 $charged * ( $cust_main_county->getfield('tax') / 100 )
853 $charged = sprintf( "%.2f", $charged+$tax );
855 my $cust_bill_pkg = new FS::cust_bill_pkg ({
862 push @cust_bill_pkg, $cust_bill_pkg;
865 my $cust_bill = new FS::cust_bill ( {
866 'custnum' => $self->getfield('custnum'),
868 'charged' => $charged,
870 $error = $cust_bill->insert;
872 $dbh->rollback if $oldAutoCommit;
873 return "$error for customer #". $self->custnum;
876 my $invnum = $cust_bill->invnum;
878 foreach $cust_bill_pkg ( @cust_bill_pkg ) {
879 $cust_bill_pkg->setfield( 'invnum', $invnum );
880 $error = $cust_bill_pkg->insert;
881 #shouldn't happen, but how else tohandle this?
883 $dbh->rollback if $oldAutoCommit;
884 return "$error for customer #". $self->custnum;
888 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
892 =item collect OPTIONS
894 (Attempt to) collect money for this customer's outstanding invoices (see
895 L<FS::cust_bill>). Usually used after the bill method.
897 Depending on the value of `payby', this may print an invoice (`BILL'), charge
898 a credit card (`CARD'), or just add any necessary (pseudo-)payment (`COMP').
900 If there is an error, returns the error, otherwise returns false.
902 Currently available options are:
904 invoice_time - Use this time when deciding when to print invoices and
905 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>
906 for conversion functions.
908 batch_card - Set this true to batch cards (see L<cust_pay_batch>). By
909 default, cards are processed immediately, which will generate an error if
910 CyberCash is not installed.
912 report_badcard - Set this true if you want bad card transactions to
913 return an error. By default, they don't.
918 my( $self, %options ) = @_;
919 my $invoice_time = $options{'invoice_time'} || time;
922 local $SIG{HUP} = 'IGNORE';
923 local $SIG{INT} = 'IGNORE';
924 local $SIG{QUIT} = 'IGNORE';
925 local $SIG{TERM} = 'IGNORE';
926 local $SIG{TSTP} = 'IGNORE';
927 local $SIG{PIPE} = 'IGNORE';
929 my $oldAutoCommit = $FS::UID::AutoCommit;
930 local $FS::UID::AutoCommit = 0;
933 my $total_owed = $self->balance;
934 warn "collect: total owed $total_owed " if $Debug;
935 unless ( $total_owed > 0 ) { #redundant?????
936 $dbh->rollback if $oldAutoCommit;
940 foreach my $cust_bill (
941 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
944 #this has to be before next's
945 my $amount = sprintf( "%.2f", $total_owed < $cust_bill->owed
949 $total_owed = sprintf( "%.2f", $total_owed - $amount );
951 next unless $cust_bill->owed > 0;
953 next if qsearchs( 'cust_pay_batch', { 'invnum' => $cust_bill->invnum } );
955 warn "invnum ". $cust_bill->invnum. " (owed ". $cust_bill->owed. ", amount $amount, total_owed $total_owed)" if $Debug;
957 next unless $amount > 0;
959 if ( $self->payby eq 'BILL' ) {
962 my $since = $invoice_time - ( $cust_bill->_date || 0 );
963 #warn "$invoice_time ", $cust_bill->_date, " $since";
964 if ( $since >= 0 #don't print future invoices
965 && ( $cust_bill->printed * 2592000 ) <= $since
968 #my @print_text = $cust_bill->print_text; #( date )
969 my @invoicing_list = $self->invoicing_list;
970 if ( grep { $_ ne 'POST' } @invoicing_list ) { #email invoice
971 $ENV{SMTPHOSTS} = $smtpmachine;
972 $ENV{MAILADDRESS} = $invoice_from;
973 my $header = new Mail::Header ( [
974 "From: $invoice_from",
975 "To: ". join(', ', grep { $_ ne 'POST' } @invoicing_list ),
976 "Sender: $invoice_from",
977 "Reply-To: $invoice_from",
978 "Date: ". time2str("%a, %d %b %Y %X %z", time),
981 my $message = new Mail::Internet (
983 'Body' => [ $cust_bill->print_text ], #( date)
985 $message->smtpsend or die "Can't send invoice email!"; #die? warn?
987 } elsif ( ! @invoicing_list || grep { $_ eq 'POST' } @invoicing_list ) {
988 open(LPR, "|$lpr") or die "Can't open pipe to $lpr: $!";
989 print LPR $cust_bill->print_text; #( date )
991 or die $! ? "Error closing $lpr: $!"
992 : "Exit status $? from $lpr";
995 my %hash = $cust_bill->hash;
997 my $new_cust_bill = new FS::cust_bill(\%hash);
998 my $error = $new_cust_bill->replace($cust_bill);
999 warn "Error updating $cust_bill->printed: $error" if $error;
1003 } elsif ( $self->payby eq 'COMP' ) {
1004 my $cust_pay = new FS::cust_pay ( {
1005 'invnum' => $cust_bill->invnum,
1009 'payinfo' => $self->payinfo,
1012 my $error = $cust_pay->insert;
1014 $dbh->rollback if $oldAutoCommit;
1015 return 'Error COMPing invnum #'. $cust_bill->invnum. ": $error";
1019 } elsif ( $self->payby eq 'CARD' ) {
1021 if ( $options{'batch_card'} ne 'yes' ) {
1023 unless ( $processor ) {
1024 $dbh->rollback if $oldAutoCommit;
1025 return "Real time card processing not enabled!";
1028 my $address = $self->address1;
1029 $address .= ", ". $self->address2 if $self->address2;
1032 #$self->paydate =~ /^(\d+)\/\d*(\d{2})$/;
1033 $self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
1036 if ( $processor =~ /^cybercash/ ) {
1038 #fix exp. date for cybercash
1039 #$self->paydate =~ /^(\d+)\/\d*(\d{2})$/;
1040 $self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
1043 my $paybatch = $cust_bill->invnum.
1044 '-' . time2str("%y%m%d%H%M%S", time);
1046 my $payname = $self->payname ||
1047 $self->getfield('first'). ' '. $self->getfield('last');
1050 my $country = $self->country eq 'US' ? 'USA' : $self->country;
1052 my @full_xaction = ( $xaction,
1053 'Order-ID' => $paybatch,
1054 'Amount' => "usd $amount",
1055 'Card-Number' => $self->getfield('payinfo'),
1056 'Card-Name' => $payname,
1057 'Card-Address' => $address,
1058 'Card-City' => $self->getfield('city'),
1059 'Card-State' => $self->getfield('state'),
1060 'Card-Zip' => $self->getfield('zip'),
1061 'Card-Country' => $country,
1066 if ( $processor eq 'cybercash2' ) {
1067 $^W=0; #CCLib isn't -w safe, ugh!
1068 %result = &CCLib::sendmserver(@full_xaction);
1070 } elsif ( $processor eq 'cybercash3.2' ) {
1071 %result = &CCMckDirectLib3_2::SendCC2_1Server(@full_xaction);
1073 $dbh->rollback if $oldAutoCommit;
1074 return "Unknown real-time processor $processor";
1077 #if ( $result{'MActionCode'} == 7 ) { #cybercash smps v.1.1.3
1078 #if ( $result{'action-code'} == 7 ) { #cybercash smps v.2.1
1079 if ( $result{'MStatus'} eq 'success' ) { #cybercash smps v.2 or 3
1080 my $cust_pay = new FS::cust_pay ( {
1081 'invnum' => $cust_bill->invnum,
1085 'payinfo' => $self->payinfo,
1086 'paybatch' => "$processor:$paybatch",
1088 my $error = $cust_pay->insert;
1090 # gah, even with transactions.
1091 $dbh->commit if $oldAutoCommit; #well.
1092 my $e = 'WARNING: Card debited but database not updated - '.
1093 'error applying payment, invnum #' . $cust_bill->invnum.
1094 " (CyberCash Order-ID $paybatch): $error";
1098 } elsif ( $result{'Mstatus'} ne 'failure-bad-money'
1099 || $options{'report_badcard'} ) {
1100 $dbh->commit if $oldAutoCommit;
1101 return 'Cybercash error, invnum #' .
1102 $cust_bill->invnum. ':'. $result{'MErrMsg'};
1104 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1108 } elsif ( $processor =~ /^Business::OnlinePayment::(.*)$/ ) {
1110 my($payname, $payfirst, $paylast);
1111 if ( $self->payname ) {
1112 $payname = $self->payname;
1113 $payname =~ /^\s*([\w \,\.\-\']*\w)?\s+([\w\,\.\-\']+)$/
1115 $dbh->rollback if $oldAutoCommit;
1116 return "Illegal payname $payname";
1118 ($payfirst, $paylast) = ($1, $2);
1120 $payfirst = $self->getfield('first');
1121 $paylast = $self->getfield('first');
1122 $payname = "$payfirst $paylast";
1125 my $transaction = new Business::OnlinePayment( $1, @bop_options );
1126 $transaction->content(
1128 'login' => $bop_login,
1129 'password' => $bop_password,
1130 'action' => $bop_action,
1131 'amount' => $amount,
1132 'invoice_number' => $cust_bill->invnum,
1133 'customer_id' => $self->custnum,
1134 'last_name' => $paylast,
1135 'first_name' => $payfirst,
1137 'address' => $address,
1138 'city' => $self->city,
1139 'state' => $self->state,
1140 'zip' => $self->zip,
1141 'country' => $self->country,
1142 'card_number' => $self->payinfo,
1143 'expiration' => $exp,
1145 $transaction->submit();
1147 if ( $transaction->is_success()) {
1148 my $cust_pay = new FS::cust_pay ( {
1149 'invnum' => $cust_bill->invnum,
1153 'payinfo' => $self->payinfo,
1154 'paybatch' => "$processor:". $transaction->authorization,
1156 my $error = $cust_pay->insert;
1158 # gah, even with transactions.
1159 $dbh->commit if $oldAutoCommit; #well.
1160 my $e = 'WARNING: Card debited but database not updated - '.
1161 'error applying payment, invnum #' . $cust_bill->invnum.
1162 " ($processor): $error";
1166 } elsif ( $options{'report_badcard'} ) {
1167 $dbh->commit if $oldAutoCommit;
1168 return "$processor error, invnum #". $cust_bill->invnum. ': '.
1169 $transaction->result_code. ": ". $transaction->error_message;
1171 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1176 $dbh->rollback if $oldAutoCommit;
1177 return "Unknown real-time processor $processor\n";
1180 } else { #batch card
1182 my $cust_pay_batch = new FS::cust_pay_batch ( {
1183 'invnum' => $cust_bill->getfield('invnum'),
1184 'custnum' => $self->getfield('custnum'),
1185 'last' => $self->getfield('last'),
1186 'first' => $self->getfield('first'),
1187 'address1' => $self->getfield('address1'),
1188 'address2' => $self->getfield('address2'),
1189 'city' => $self->getfield('city'),
1190 'state' => $self->getfield('state'),
1191 'zip' => $self->getfield('zip'),
1192 'country' => $self->getfield('country'),
1194 'cardnum' => $self->getfield('payinfo'),
1195 'exp' => $self->getfield('paydate'),
1196 'payname' => $self->getfield('payname'),
1197 'amount' => $amount,
1199 my $error = $cust_pay_batch->insert;
1201 $dbh->rollback if $oldAutoCommit;
1202 return "Error adding to cust_pay_batch: $error";
1208 $dbh->rollback if $oldAutoCommit;
1209 return "Unknown payment type ". $self->payby;
1213 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1220 Returns the total owed for this customer on all invoices
1221 (see L<FS::cust_bill>).
1228 foreach my $cust_bill ( qsearch('cust_bill', {
1229 'custnum' => $self->custnum,
1231 $total_bill += $cust_bill->owed;
1233 sprintf( "%.2f", $total_bill );
1236 =item total_credited
1238 Returns the total credits (see L<FS::cust_credit>) for this customer.
1242 sub total_credited {
1244 my $total_credit = 0;
1245 foreach my $cust_credit ( qsearch('cust_credit', {
1246 'custnum' => $self->custnum,
1248 $total_credit += $cust_credit->credited;
1250 sprintf( "%.2f", $total_credit );
1255 Returns the balance for this customer (total owed minus total credited).
1261 sprintf( "%.2f", $self->total_owed - $self->total_credited );
1264 =item invoicing_list [ ARRAYREF ]
1266 If an arguement is given, sets these email addresses as invoice recipients
1267 (see L<FS::cust_main_invoice>). Errors are not fatal and are not reported
1268 (except as warnings), so use check_invoicing_list first.
1270 Returns a list of email addresses (with svcnum entries expanded).
1272 Note: You can clear the invoicing list by passing an empty ARRAYREF. You can
1273 check it without disturbing anything by passing nothing.
1275 This interface may change in the future.
1279 sub invoicing_list {
1280 my( $self, $arrayref ) = @_;
1282 my @cust_main_invoice;
1283 if ( $self->custnum ) {
1284 @cust_main_invoice =
1285 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1287 @cust_main_invoice = ();
1289 foreach my $cust_main_invoice ( @cust_main_invoice ) {
1290 #warn $cust_main_invoice->destnum;
1291 unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
1292 #warn $cust_main_invoice->destnum;
1293 my $error = $cust_main_invoice->delete;
1294 warn $error if $error;
1297 if ( $self->custnum ) {
1298 @cust_main_invoice =
1299 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1301 @cust_main_invoice = ();
1303 foreach my $address ( @{$arrayref} ) {
1304 unless ( grep { $address eq $_->address } @cust_main_invoice ) {
1305 my $cust_main_invoice = new FS::cust_main_invoice ( {
1306 'custnum' => $self->custnum,
1309 my $error = $cust_main_invoice->insert;
1310 warn $error if $error;
1314 if ( $self->custnum ) {
1316 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1322 =item check_invoicing_list ARRAYREF
1324 Checks these arguements as valid input for the invoicing_list method. If there
1325 is an error, returns the error, otherwise returns false.
1329 sub check_invoicing_list {
1330 my( $self, $arrayref ) = @_;
1331 foreach my $address ( @{$arrayref} ) {
1332 my $cust_main_invoice = new FS::cust_main_invoice ( {
1333 'custnum' => $self->custnum,
1336 my $error = $self->custnum
1337 ? $cust_main_invoice->check
1338 : $cust_main_invoice->checkdest
1340 return $error if $error;
1351 =item rebuild_fuzzyfile
1355 sub rebuild_fuzzyfiles {
1356 my @all_last = map $_->getfield('last'), qsearch('cust_main', {});
1358 grep $_, map $_->getfield('ship_last'), qsearch('cust_main',{})
1359 if defined dbdef->table('cust_main')->column('ship_last');
1368 $Id: cust_main.pm,v 1.21 2001-08-26 05:06:19 ivan Exp $
1374 The delete method should possibly take an FS::cust_main object reference
1375 instead of a scalar customer number.
1377 Bill and collect options should probably be passed as references instead of a
1380 CyberCash v2 forces us to define some variables in package main.
1382 There should probably be a configuration file with a list of allowed credit
1385 CyberCash is the only processor.
1387 No multiple currency support (probably a larger project than just this module).
1391 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
1392 L<FS::cust_pay_batch>, L<FS::agent>, L<FS::part_referral>,
1393 L<FS::cust_main_county>, L<FS::cust_main_invoice>,
1394 L<FS::UID>, schema.html from the base documentation.