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
17 use Business::CreditCard;
18 use FS::UID qw( getotaker dbh );
19 use FS::Record qw( qsearchs qsearch );
22 use FS::cust_bill_pkg;
25 use FS::cust_pay_batch;
26 use FS::part_referral;
27 use FS::cust_main_county;
29 use FS::cust_main_invoice;
30 use FS::prepay_credit;
32 @ISA = qw( FS::Record );
37 #ask FS::UID to run this stuff for us later
38 $FS::UID::callback{'FS::cust_main'} = sub {
40 $lpr = $conf->config('lpr');
41 $invoice_from = $conf->config('invoice_from');
42 $smtpmachine = $conf->config('smtpmachine');
44 if ( $conf->exists('cybercash3.2') ) {
46 #qw($MCKversion %Config InitConfig CCError CCDebug CCDebug2);
47 require CCMckDirectLib3_2;
49 require CCMckErrno3_2;
50 #qw(MCKGetErrorMessage $E_NoErr);
51 import CCMckErrno3_2 qw($E_NoErr);
54 ($merchant_conf,$xaction)= $conf->config('cybercash3.2');
55 my $status = &CCMckLib3_2::InitConfig($merchant_conf);
56 if ( $status != $E_NoErr ) {
57 warn "CCMckLib3_2::InitConfig error:\n";
58 foreach my $key (keys %CCMckLib3_2::Config) {
59 warn " $key => $CCMckLib3_2::Config{$key}\n"
61 my($errmsg) = &CCMckErrno3_2::MCKGetErrorMessage($status);
62 die "CCMckLib3_2::InitConfig fatal error: $errmsg\n";
64 $processor='cybercash3.2';
65 } elsif ( $conf->exists('cybercash2') ) {
68 ( $main::paymentserverhost,
69 $main::paymentserverport,
70 $main::paymentserversecret,
72 ) = $conf->config('cybercash2');
73 $processor='cybercash2';
79 FS::cust_main - Object methods for cust_main records
85 $record = new FS::cust_main \%hash;
86 $record = new FS::cust_main { 'column' => 'value' };
88 $error = $record->insert;
90 $error = $new_record->replace($old_record);
92 $error = $record->delete;
94 $error = $record->check;
96 @cust_pkg = $record->all_pkgs;
98 @cust_pkg = $record->ncancelled_pkgs;
100 $error = $record->bill;
101 $error = $record->bill %options;
102 $error = $record->bill 'time' => $time;
104 $error = $record->collect;
105 $error = $record->collect %options;
106 $error = $record->collect 'invoice_time' => $time,
107 'batch_card' => 'yes',
108 'report_badcard' => 'yes',
113 An FS::cust_main object represents a customer. FS::cust_main inherits from
114 FS::Record. The following fields are currently supported:
118 =item custnum - primary key (assigned automatically for new customers)
120 =item agentnum - agent (see L<FS::agent>)
122 =item refnum - referral (see L<FS::part_referral>)
128 =item ss - social security number (optional)
130 =item company - (optional)
134 =item address2 - (optional)
138 =item county - (optional, see L<FS::cust_main_county>)
140 =item state - (see L<FS::cust_main_county>)
144 =item country - (see L<FS::cust_main_county>)
146 =item daytime - phone (optional)
148 =item night - phone (optional)
150 =item fax - phone (optional)
152 =item ship_first - name
154 =item ship_last - name
156 =item ship_company - (optional)
160 =item ship_address2 - (optional)
164 =item ship_county - (optional, see L<FS::cust_main_county>)
166 =item ship_state - (see L<FS::cust_main_county>)
170 =item ship_country - (see L<FS::cust_main_county>)
172 =item ship_daytime - phone (optional)
174 =item ship_night - phone (optional)
176 =item ship_fax - phone (optional)
178 =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)
180 =item payinfo - card number, P.O., comp issuer (4-8 lowercase alphanumerics; think username) or prepayment identifier (see L<FS::prepay_credit>)
182 =item paydate - expiration date, mm/yyyy, m/yyyy, mm/yy or m/yy
184 =item payname - name on card or billing name
186 =item tax - tax exempt, empty or `Y'
188 =item otaker - order taker (assigned automatically, see L<FS::UID>)
190 =item comments - comments (optional)
200 Creates a new customer. To add the customer to the database, see L<"insert">.
202 Note that this stores the hash reference, not a distinct copy of the hash it
203 points to. You can ask the object for a copy with the I<hash> method.
207 sub table { 'cust_main'; }
209 =item insert [ CUST_PKG_HASHREF [ , INVOICING_LIST_ARYREF ] ]
211 Adds this customer to the database. If there is an error, returns the error,
212 otherwise returns false.
214 CUST_PKG_HASHREF: If you pass a Tie::RefHash data structure to the insert
215 method containing FS::cust_pkg and FS::svc_I<tablename> objects, all records
216 are inserted atomicly, or the transaction is rolled back (this requries a
217 transactional database). Passing an empty hash reference is equivalent to
218 not supplying this parameter. There should be a better explanation of this,
219 but until then, here's an example:
222 tie %hash, 'Tie::RefHash'; #this part is important
224 $cust_pkg => [ $svc_acct ],
227 $cust_main->insert( \%hash );
229 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
230 be set as the invoicing list (see L<"invoicing_list">). Errors return as
231 expected and rollback the entire transaction; it is not necessary to call
232 check_invoicing_list first. The invoicing_list is set after the records in the
233 CUST_PKG_HASHREF above are inserted, so it is now possible set set an
234 invoicing_list destination to the newly-created svc_acct. Here's an example:
236 $cust_main->insert( {}, [ $email, 'POST' ] );
244 local $SIG{HUP} = 'IGNORE';
245 local $SIG{INT} = 'IGNORE';
246 local $SIG{QUIT} = 'IGNORE';
247 local $SIG{TERM} = 'IGNORE';
248 local $SIG{TSTP} = 'IGNORE';
249 local $SIG{PIPE} = 'IGNORE';
251 my $oldAutoCommit = $FS::UID::AutoCommit;
252 local $FS::UID::AutoCommit = 0;
257 if ( $self->payby eq 'PREPAY' ) {
258 $self->payby('BILL');
259 my $prepay_credit = qsearchs(
261 { 'identifier' => $self->payinfo },
265 warn "WARNING: can't find pre-found prepay_credit: ". $self->payinfo
266 unless $prepay_credit;
267 $amount = $prepay_credit->amount;
268 $seconds = $prepay_credit->seconds;
269 my $error = $prepay_credit->delete;
271 $dbh->rollback if $oldAutoCommit;
276 my $error = $self->SUPER::insert;
278 $dbh->rollback if $oldAutoCommit;
282 if ( @param ) { # CUST_PKG_HASHREF
283 my $cust_pkgs = shift @param;
284 foreach my $cust_pkg ( keys %$cust_pkgs ) {
285 $cust_pkg->custnum( $self->custnum );
286 $error = $cust_pkg->insert;
288 $dbh->rollback if $oldAutoCommit;
291 foreach my $svc_something ( @{$cust_pkgs->{$cust_pkg}} ) {
292 $svc_something->pkgnum( $cust_pkg->pkgnum );
293 if ( $seconds && $svc_something->isa('FS::svc_acct') ) {
294 $svc_something->seconds( $svc_something->seconds + $seconds );
297 $error = $svc_something->insert;
299 $dbh->rollback if $oldAutoCommit;
307 $dbh->rollback if $oldAutoCommit;
308 return "No svc_acct record to apply pre-paid time";
311 if ( @param ) { # INVOICING_LIST_ARYREF
312 my $invoicing_list = shift @param;
313 $error = $self->check_invoicing_list( $invoicing_list );
315 $dbh->rollback if $oldAutoCommit;
318 $self->invoicing_list( $invoicing_list );
322 my $cust_credit = new FS::cust_credit {
323 'custnum' => $self->custnum,
326 $error = $cust_credit->insert;
328 $dbh->rollback if $oldAutoCommit;
333 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
338 =item delete NEW_CUSTNUM
340 This deletes the customer. If there is an error, returns the error, otherwise
343 This will completely remove all traces of the customer record. This is not
344 what you want when a customer cancels service; for that, cancel all of the
345 customer's packages (see L<FS::cust_pkg/cancel>).
347 If the customer has any packages, you need to pass a new (valid) customer
348 number for those packages to be transferred to.
350 You can't delete a customer with invoices (see L<FS::cust_bill>),
351 or credits (see L<FS::cust_credit>).
358 local $SIG{HUP} = 'IGNORE';
359 local $SIG{INT} = 'IGNORE';
360 local $SIG{QUIT} = 'IGNORE';
361 local $SIG{TERM} = 'IGNORE';
362 local $SIG{TSTP} = 'IGNORE';
363 local $SIG{PIPE} = 'IGNORE';
365 my $oldAutoCommit = $FS::UID::AutoCommit;
366 local $FS::UID::AutoCommit = 0;
369 if ( qsearch( 'cust_bill', { 'custnum' => $self->custnum } ) ) {
370 $dbh->rollback if $oldAutoCommit;
371 return "Can't delete a customer with invoices";
373 if ( qsearch( 'cust_credit', { 'custnum' => $self->custnum } ) ) {
374 $dbh->rollback if $oldAutoCommit;
375 return "Can't delete a customer with credits";
378 my @cust_pkg = qsearch( 'cust_pkg', { 'custnum' => $self->custnum } );
380 my $new_custnum = shift;
381 unless ( qsearchs( 'cust_main', { 'custnum' => $new_custnum } ) ) {
382 $dbh->rollback if $oldAutoCommit;
383 return "Invalid new customer number: $new_custnum";
385 foreach my $cust_pkg ( @cust_pkg ) {
386 my %hash = $cust_pkg->hash;
387 $hash{'custnum'} = $new_custnum;
388 my $new_cust_pkg = new FS::cust_pkg ( \%hash );
389 my $error = $new_cust_pkg->replace($cust_pkg);
391 $dbh->rollback if $oldAutoCommit;
396 foreach my $cust_main_invoice (
397 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } )
399 my $error = $cust_main_invoice->delete;
401 $dbh->rollback if $oldAutoCommit;
406 my $error = $self->SUPER::delete;
408 $dbh->rollback if $oldAutoCommit;
412 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
417 =item replace OLD_RECORD [ INVOICING_LIST_ARYREF ]
419 Replaces the OLD_RECORD with this one in the database. If there is an error,
420 returns the error, otherwise returns false.
422 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
423 be set as the invoicing list (see L<"invoicing_list">). Errors return as
424 expected and rollback the entire transaction; it is not necessary to call
425 check_invoicing_list first. Here's an example:
427 $new_cust_main->replace( $old_cust_main, [ $email, 'POST' ] );
436 local $SIG{HUP} = 'IGNORE';
437 local $SIG{INT} = 'IGNORE';
438 local $SIG{QUIT} = 'IGNORE';
439 local $SIG{TERM} = 'IGNORE';
440 local $SIG{TSTP} = 'IGNORE';
441 local $SIG{PIPE} = 'IGNORE';
443 my $oldAutoCommit = $FS::UID::AutoCommit;
444 local $FS::UID::AutoCommit = 0;
447 my $error = $self->SUPER::replace($old);
450 $dbh->rollback if $oldAutoCommit;
454 if ( @param ) { # INVOICING_LIST_ARYREF
455 my $invoicing_list = shift @param;
456 $error = $self->check_invoicing_list( $invoicing_list );
458 $dbh->rollback if $oldAutoCommit;
461 $self->invoicing_list( $invoicing_list );
464 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
471 Checks all fields to make sure this is a valid customer record. If there is
472 an error, returns the error, otherwise returns false. Called by the insert
481 $self->ut_numbern('custnum')
482 || $self->ut_number('agentnum')
483 || $self->ut_number('refnum')
484 || $self->ut_name('last')
485 || $self->ut_name('first')
486 || $self->ut_textn('company')
487 || $self->ut_text('address1')
488 || $self->ut_textn('address2')
489 || $self->ut_text('city')
490 || $self->ut_textn('county')
491 || $self->ut_textn('state')
492 || $self->ut_anything('comments')
494 #barf. need message catalogs. i18n. etc.
495 $error .= "Please select a referral."
496 if $error =~ /^Illegal or empty \(numeric\) refnum: /;
497 return $error if $error;
499 return "Unknown agent"
500 unless qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
502 return "Unknown referral"
503 unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } );
505 if ( $self->ss eq '' ) {
510 $ss =~ /^(\d{3})(\d{2})(\d{4})$/
511 or return "Illegal social security number: ". $self->ss;
512 $self->ss("$1-$2-$3");
515 $self->country =~ /^(\w\w)$/ or return "Illegal country: ". $self->country;
517 unless ( qsearchs('cust_main_county', {
518 'country' => $self->country,
521 return "Unknown state/county/country: ".
522 $self->state. "/". $self->county. "/". $self->country
523 unless qsearchs('cust_main_county',{
524 'state' => $self->state,
525 'county' => $self->county,
526 'country' => $self->country,
531 $self->ut_phonen('daytime', $self->country)
532 || $self->ut_phonen('night', $self->country)
533 || $self->ut_phonen('fax', $self->country)
534 || $self->ut_zip('zip', $self->country)
536 return $error if $error;
539 last first company address1 address2 city county state zip
540 country daytime night fax
543 if ( defined $self->dbdef_table->column('ship_last') ) {
544 if ( grep { $self->getfield($_) ne $self->getfield("ship_$_") } @addfields
545 && grep $self->getfield("ship_$_"), grep $_ ne 'state', @addfields
549 $self->ut_name('ship_last')
550 || $self->ut_name('ship_first')
551 || $self->ut_textn('ship_company')
552 || $self->ut_text('ship_address1')
553 || $self->ut_textn('ship_address2')
554 || $self->ut_text('ship_city')
555 || $self->ut_textn('ship_county')
556 || $self->ut_textn('ship_state')
558 return $error if $error;
560 #false laziness with above
561 $self->ship_country =~ /^(\w\w)$/
562 or return "Illegal ship_country: ". $self->ship_country;
563 $self->ship_country($1);
564 unless ( qsearchs('cust_main_county', {
565 'country' => $self->ship_country,
568 return "Unknown ship_state/ship_county/ship_country: ".
569 $self->ship_state. "/". $self->ship_county. "/". $self->ship_country
570 unless qsearchs('cust_main_county',{
571 'state' => $self->ship_state,
572 'county' => $self->ship_county,
573 'country' => $self->ship_country,
579 $self->ut_phonen('ship_daytime', $self->ship_country)
580 || $self->ut_phonen('ship_night', $self->ship_country)
581 || $self->ut_phonen('ship_fax', $self->ship_country)
582 || $self->ut_zip('ship_zip', $self->ship_country)
584 return $error if $error;
586 } else { # ship_ info eq billing info, so don't store dup info in database
587 $self->setfield("ship_$_", '')
588 foreach qw( last first company address1 address2 city county state zip
589 country daytime night fax );
593 $self->payby =~ /^(CARD|BILL|COMP|PREPAY)$/
594 or return "Illegal payby: ". $self->payby;
597 if ( $self->payby eq 'CARD' ) {
599 my $payinfo = $self->payinfo;
601 $payinfo =~ /^(\d{13,16})$/
602 or return "Illegal credit card number: ". $self->payinfo;
604 $self->payinfo($payinfo);
606 or return "Illegal credit card number: ". $self->payinfo;
607 return "Unknown card type" if cardtype($self->payinfo) eq "Unknown";
609 } elsif ( $self->payby eq 'BILL' ) {
611 $error = $self->ut_textn('payinfo');
612 return "Illegal P.O. number: ". $self->payinfo if $error;
614 } elsif ( $self->payby eq 'COMP' ) {
616 $error = $self->ut_textn('payinfo');
617 return "Illegal comp account issuer: ". $self->payinfo if $error;
619 } elsif ( $self->payby eq 'PREPAY' ) {
621 my $payinfo = $self->payinfo;
622 $payinfo =~ s/\W//g; #anything else would just confuse things
623 $self->payinfo($payinfo);
624 $error = $self->ut_alpha('payinfo');
625 return "Illegal prepayment identifier: ". $self->payinfo if $error;
626 return "Unknown prepayment identifier"
627 unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } );
631 if ( $self->paydate eq '' || $self->paydate eq '-' ) {
632 return "Expriation date required"
633 unless $self->payby eq 'BILL' || $self->payby eq 'PREPAY';
636 $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/
637 or return "Illegal expiration date: ". $self->paydate;
638 if ( length($2) == 4 ) {
639 $self->paydate("$2-$1-01");
640 } elsif ( $2 > 97 ) { #should pry change to check for "this year"
641 $self->paydate("19$2-$1-01");
643 $self->paydate("20$2-$1-01");
647 if ( $self->payname eq '' ) {
648 $self->payname( $self->first. " ". $self->getfield('last') );
650 $self->payname =~ /^([\w \,\.\-\']+)$/
651 or return "Illegal billing name: ". $self->payname;
655 $self->tax =~ /^(Y?)$/ or return "Illegal tax: ". $self->tax;
658 $self->otaker(getotaker);
665 Returns all packages (see L<FS::cust_pkg>) for this customer.
671 qsearch( 'cust_pkg', { 'custnum' => $self->custnum });
674 =item ncancelled_pkgs
676 Returns all non-cancelled packages (see L<FS::cust_pkg>) for this customer.
680 sub ncancelled_pkgs {
682 @{ [ # force list context
683 qsearch( 'cust_pkg', {
684 'custnum' => $self->custnum,
687 qsearch( 'cust_pkg', {
688 'custnum' => $self->custnum,
696 Generates invoices (see L<FS::cust_bill>) for this customer. Usually used in
697 conjunction with the collect method.
699 The only currently available option is `time', which bills the customer as if
700 it were that time. It is specified as a UNIX timestamp; see
701 L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion
704 If there is an error, returns the error, otherwise returns false.
709 my( $self, %options ) = @_;
710 my $time = $options{'time'} || time;
715 local $SIG{HUP} = 'IGNORE';
716 local $SIG{INT} = 'IGNORE';
717 local $SIG{QUIT} = 'IGNORE';
718 local $SIG{TERM} = 'IGNORE';
719 local $SIG{TSTP} = 'IGNORE';
720 local $SIG{PIPE} = 'IGNORE';
722 my $oldAutoCommit = $FS::UID::AutoCommit;
723 local $FS::UID::AutoCommit = 0;
726 # find the packages which are due for billing, find out how much they are
727 # & generate invoice database.
729 my( $total_setup, $total_recur ) = ( 0, 0 );
732 foreach my $cust_pkg (
733 qsearch('cust_pkg',{'custnum'=> $self->getfield('custnum') } )
736 next if $cust_pkg->getfield('cancel');
738 #? to avoid use of uninitialized value errors... ?
739 $cust_pkg->setfield('bill', '')
740 unless defined($cust_pkg->bill);
742 my $part_pkg = qsearchs( 'part_pkg', { 'pkgpart' => $cust_pkg->pkgpart } );
744 #so we don't modify cust_pkg record unnecessarily
745 my $cust_pkg_mod_flag = 0;
746 my %hash = $cust_pkg->hash;
747 my $old_cust_pkg = new FS::cust_pkg \%hash;
751 unless ( $cust_pkg->setup ) {
752 my $setup_prog = $part_pkg->getfield('setup');
753 $setup_prog =~ /^(.*)$/ #presumably trusted
754 or die "Illegal setup for package ". $cust_pkg->pkgnum. ": $setup_prog";
757 #$cpt->permit(); #what is necessary?
758 $cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
759 $setup = $cpt->reval($setup_prog);
760 unless ( defined($setup) ) {
761 warn "Error reval-ing part_pkg->setup pkgpart ",
762 $part_pkg->pkgpart, ": $@";
764 $cust_pkg->setfield('setup',$time);
765 $cust_pkg_mod_flag=1;
772 if ( $part_pkg->getfield('freq') > 0 &&
773 ! $cust_pkg->getfield('susp') &&
774 ( $cust_pkg->getfield('bill') || 0 ) < $time
776 my $recur_prog = $part_pkg->getfield('recur');
777 $recur_prog =~ /^(.*)$/ #presumably trusted
778 or die "Illegal recur for package ". $cust_pkg->pkgnum. ": $recur_prog";
781 #$cpt->permit(); #what is necessary?
782 $cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
783 $recur = $cpt->reval($recur_prog);
784 unless ( defined($recur) ) {
785 warn "Error reval-ing part_pkg->recur pkgpart ",
786 $part_pkg->pkgpart, ": $@";
788 #change this bit to use Date::Manip? CAREFUL with timezones (see
789 # mailing list archive)
790 #$sdate=$cust_pkg->bill || time;
791 #$sdate=$cust_pkg->bill || $time;
792 $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
793 my ($sec,$min,$hour,$mday,$mon,$year) =
794 (localtime($sdate) )[0,1,2,3,4,5];
795 $mon += $part_pkg->getfield('freq');
796 until ( $mon < 12 ) { $mon -= 12; $year++; }
797 $cust_pkg->setfield('bill',
798 timelocal($sec,$min,$hour,$mday,$mon,$year));
799 $cust_pkg_mod_flag = 1;
803 warn "setup is undefined" unless defined($setup);
804 warn "recur is undefined" unless defined($recur);
805 warn "cust_pkg bill is undefined" unless defined($cust_pkg->bill);
807 if ( $cust_pkg_mod_flag ) {
808 $error=$cust_pkg->replace($old_cust_pkg);
809 if ( $error ) { #just in case
810 warn "Error modifying pkgnum ", $cust_pkg->pkgnum, ": $error";
812 $setup = sprintf( "%.2f", $setup );
813 $recur = sprintf( "%.2f", $recur );
814 my $cust_bill_pkg = new FS::cust_bill_pkg ({
815 'pkgnum' => $cust_pkg->pkgnum,
819 'edate' => $cust_pkg->bill,
821 push @cust_bill_pkg, $cust_bill_pkg;
822 $total_setup += $setup;
823 $total_recur += $recur;
829 my $charged = sprintf( "%.2f", $total_setup + $total_recur );
831 unless ( @cust_bill_pkg ) {
832 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
836 unless ( $self->getfield('tax') =~ /Y/i
837 || $self->getfield('payby') eq 'COMP'
839 my $cust_main_county = qsearchs('cust_main_county',{
840 'state' => $self->state,
841 'county' => $self->county,
842 'country' => $self->country,
844 my $tax = sprintf( "%.2f",
845 $charged * ( $cust_main_county->getfield('tax') / 100 )
847 $charged = sprintf( "%.2f", $charged+$tax );
849 my $cust_bill_pkg = new FS::cust_bill_pkg ({
856 push @cust_bill_pkg, $cust_bill_pkg;
859 my $cust_bill = new FS::cust_bill ( {
860 'custnum' => $self->getfield('custnum'),
862 'charged' => $charged,
864 $error = $cust_bill->insert;
866 $dbh->rollback if $oldAutoCommit;
867 return "$error for customer #". $self->custnum;
870 my $invnum = $cust_bill->invnum;
872 foreach $cust_bill_pkg ( @cust_bill_pkg ) {
873 $cust_bill_pkg->setfield( 'invnum', $invnum );
874 $error = $cust_bill_pkg->insert;
875 #shouldn't happen, but how else tohandle this?
877 $dbh->rollback if $oldAutoCommit;
878 return "$error for customer #". $self->custnum;
882 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
886 =item collect OPTIONS
888 (Attempt to) collect money for this customer's outstanding invoices (see
889 L<FS::cust_bill>). Usually used after the bill method.
891 Depending on the value of `payby', this may print an invoice (`BILL'), charge
892 a credit card (`CARD'), or just add any necessary (pseudo-)payment (`COMP').
894 If there is an error, returns the error, otherwise returns false.
896 Currently available options are:
898 invoice_time - Use this time when deciding when to print invoices and
899 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>
900 for conversion functions.
902 batch_card - Set this true to batch cards (see L<cust_pay_batch>). By
903 default, cards are processed immediately, which will generate an error if
904 CyberCash is not installed.
906 report_badcard - Set this true if you want bad card transactions to
907 return an error. By default, they don't.
912 my( $self, %options ) = @_;
913 my $invoice_time = $options{'invoice_time'} || time;
916 local $SIG{HUP} = 'IGNORE';
917 local $SIG{INT} = 'IGNORE';
918 local $SIG{QUIT} = 'IGNORE';
919 local $SIG{TERM} = 'IGNORE';
920 local $SIG{TSTP} = 'IGNORE';
921 local $SIG{PIPE} = 'IGNORE';
923 my $oldAutoCommit = $FS::UID::AutoCommit;
924 local $FS::UID::AutoCommit = 0;
927 my $total_owed = $self->balance;
928 warn "collect: total owed $total_owed " if $Debug;
929 unless ( $total_owed > 0 ) { #redundant?????
930 $dbh->rollback if $oldAutoCommit;
934 foreach my $cust_bill (
935 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
938 #this has to be before next's
939 my $amount = sprintf( "%.2f", $total_owed < $cust_bill->owed
943 $total_owed = sprintf( "%.2f", $total_owed - $amount );
945 next unless $cust_bill->owed > 0;
947 next if qsearchs( 'cust_pay_batch', { 'invnum' => $cust_bill->invnum } );
949 warn "invnum ". $cust_bill->invnum. " (owed ". $cust_bill->owed. ", amount $amount, total_owed $total_owed)" if $Debug;
951 next unless $amount > 0;
953 if ( $self->payby eq 'BILL' ) {
956 my $since = $invoice_time - ( $cust_bill->_date || 0 );
957 #warn "$invoice_time ", $cust_bill->_date, " $since";
958 if ( $since >= 0 #don't print future invoices
959 && ( $cust_bill->printed * 2592000 ) <= $since
962 #my @print_text = $cust_bill->print_text; #( date )
963 my @invoicing_list = $self->invoicing_list;
964 if ( grep { $_ ne 'POST' } @invoicing_list ) { #email invoice
965 $ENV{SMTPHOSTS} = $smtpmachine;
966 $ENV{MAILADDRESS} = $invoice_from;
967 my $header = new Mail::Header ( [
968 "From: $invoice_from",
969 "To: ". join(', ', grep { $_ ne 'POST' } @invoicing_list ),
970 "Sender: $invoice_from",
971 "Reply-To: $invoice_from",
972 "Date: ". time2str("%a, %d %b %Y %X %z", time),
975 my $message = new Mail::Internet (
977 'Body' => [ $cust_bill->print_text ], #( date)
979 $message->smtpsend or die "Can't send invoice email!"; #die? warn?
981 } elsif ( ! @invoicing_list || grep { $_ eq 'POST' } @invoicing_list ) {
982 open(LPR, "|$lpr") or die "Can't open pipe to $lpr: $!";
983 print LPR $cust_bill->print_text; #( date )
985 or die $! ? "Error closing $lpr: $!"
986 : "Exit status $? from $lpr";
989 my %hash = $cust_bill->hash;
991 my $new_cust_bill = new FS::cust_bill(\%hash);
992 my $error = $new_cust_bill->replace($cust_bill);
993 warn "Error updating $cust_bill->printed: $error" if $error;
997 } elsif ( $self->payby eq 'COMP' ) {
998 my $cust_pay = new FS::cust_pay ( {
999 'invnum' => $cust_bill->invnum,
1003 'payinfo' => $self->payinfo,
1006 my $error = $cust_pay->insert;
1008 $dbh->rollback if $oldAutoCommit;
1009 return 'Error COMPing invnum #'. $cust_bill->invnum. ": $error";
1013 } elsif ( $self->payby eq 'CARD' ) {
1015 if ( $options{'batch_card'} ne 'yes' ) {
1017 unless ( $processor ) {
1018 $dbh->rollback if $oldAutoCommit;
1019 return "Real time card processing not enabled!";
1022 if ( $processor =~ /^cybercash/ ) {
1024 #fix exp. date for cybercash
1025 #$self->paydate =~ /^(\d+)\/\d*(\d{2})$/;
1026 $self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
1029 my $paybatch = $cust_bill->invnum.
1030 '-' . time2str("%y%m%d%H%M%S", time);
1032 my $payname = $self->payname ||
1033 $self->getfield('first'). ' '. $self->getfield('last');
1035 my $address = $self->address1;
1036 $address .= ", ". $self->address2 if $self->address2;
1038 my $country = 'USA' if $self->country eq 'US';
1040 my @full_xaction = ( $xaction,
1041 'Order-ID' => $paybatch,
1042 'Amount' => "usd $amount",
1043 'Card-Number' => $self->getfield('payinfo'),
1044 'Card-Name' => $payname,
1045 'Card-Address' => $address,
1046 'Card-City' => $self->getfield('city'),
1047 'Card-State' => $self->getfield('state'),
1048 'Card-Zip' => $self->getfield('zip'),
1049 'Card-Country' => $country,
1054 if ( $processor eq 'cybercash2' ) {
1055 $^W=0; #CCLib isn't -w safe, ugh!
1056 %result = &CCLib::sendmserver(@full_xaction);
1058 } elsif ( $processor eq 'cybercash3.2' ) {
1059 %result = &CCMckDirectLib3_2::SendCC2_1Server(@full_xaction);
1061 $dbh->rollback if $oldAutoCommit;
1062 return "Unknown real-time processor $processor";
1065 #if ( $result{'MActionCode'} == 7 ) { #cybercash smps v.1.1.3
1066 #if ( $result{'action-code'} == 7 ) { #cybercash smps v.2.1
1067 if ( $result{'MStatus'} eq 'success' ) { #cybercash smps v.2 or 3
1068 my $cust_pay = new FS::cust_pay ( {
1069 'invnum' => $cust_bill->invnum,
1073 'payinfo' => $self->payinfo,
1074 'paybatch' => "$processor:$paybatch",
1076 my $error = $cust_pay->insert;
1078 # gah, even with transactions.
1079 $dbh->commit if $oldAutoCommit; #well.
1080 my $e = 'WARNING: Card debited but database not updated - '.
1081 'error applying payment, invnum #' . $cust_bill->invnum.
1082 " (CyberCash Order-ID $paybatch): $error";
1086 } elsif ( $result{'Mstatus'} ne 'failure-bad-money'
1087 || $options{'report_badcard'} ) {
1088 $dbh->commit if $oldAutoCommit;
1089 return 'Cybercash error, invnum #' .
1090 $cust_bill->invnum. ':'. $result{'MErrMsg'};
1092 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1097 $dbh->rollback if $oldAutoCommit;
1098 return "Unknown real-time processor $processor\n";
1101 } else { #batch card
1103 my $cust_pay_batch = new FS::cust_pay_batch ( {
1104 'invnum' => $cust_bill->getfield('invnum'),
1105 'custnum' => $self->getfield('custnum'),
1106 'last' => $self->getfield('last'),
1107 'first' => $self->getfield('first'),
1108 'address1' => $self->getfield('address1'),
1109 'address2' => $self->getfield('address2'),
1110 'city' => $self->getfield('city'),
1111 'state' => $self->getfield('state'),
1112 'zip' => $self->getfield('zip'),
1113 'country' => $self->getfield('country'),
1115 'cardnum' => $self->getfield('payinfo'),
1116 'exp' => $self->getfield('paydate'),
1117 'payname' => $self->getfield('payname'),
1118 'amount' => $amount,
1120 my $error = $cust_pay_batch->insert;
1122 $dbh->rollback if $oldAutoCommit;
1123 return "Error adding to cust_pay_batch: $error";
1129 $dbh->rollback if $oldAutoCommit;
1130 return "Unknown payment type ". $self->payby;
1134 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1141 Returns the total owed for this customer on all invoices
1142 (see L<FS::cust_bill>).
1149 foreach my $cust_bill ( qsearch('cust_bill', {
1150 'custnum' => $self->custnum,
1152 $total_bill += $cust_bill->owed;
1154 sprintf( "%.2f", $total_bill );
1157 =item total_credited
1159 Returns the total credits (see L<FS::cust_credit>) for this customer.
1163 sub total_credited {
1165 my $total_credit = 0;
1166 foreach my $cust_credit ( qsearch('cust_credit', {
1167 'custnum' => $self->custnum,
1169 $total_credit += $cust_credit->credited;
1171 sprintf( "%.2f", $total_credit );
1176 Returns the balance for this customer (total owed minus total credited).
1182 sprintf( "%.2f", $self->total_owed - $self->total_credited );
1185 =item invoicing_list [ ARRAYREF ]
1187 If an arguement is given, sets these email addresses as invoice recipients
1188 (see L<FS::cust_main_invoice>). Errors are not fatal and are not reported
1189 (except as warnings), so use check_invoicing_list first.
1191 Returns a list of email addresses (with svcnum entries expanded).
1193 Note: You can clear the invoicing list by passing an empty ARRAYREF. You can
1194 check it without disturbing anything by passing nothing.
1196 This interface may change in the future.
1200 sub invoicing_list {
1201 my( $self, $arrayref ) = @_;
1203 my @cust_main_invoice;
1204 if ( $self->custnum ) {
1205 @cust_main_invoice =
1206 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1208 @cust_main_invoice = ();
1210 foreach my $cust_main_invoice ( @cust_main_invoice ) {
1211 #warn $cust_main_invoice->destnum;
1212 unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
1213 #warn $cust_main_invoice->destnum;
1214 my $error = $cust_main_invoice->delete;
1215 warn $error if $error;
1218 if ( $self->custnum ) {
1219 @cust_main_invoice =
1220 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1222 @cust_main_invoice = ();
1224 foreach my $address ( @{$arrayref} ) {
1225 unless ( grep { $address eq $_->address } @cust_main_invoice ) {
1226 my $cust_main_invoice = new FS::cust_main_invoice ( {
1227 'custnum' => $self->custnum,
1230 my $error = $cust_main_invoice->insert;
1231 warn $error if $error;
1235 if ( $self->custnum ) {
1237 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1243 =item check_invoicing_list ARRAYREF
1245 Checks these arguements as valid input for the invoicing_list method. If there
1246 is an error, returns the error, otherwise returns false.
1250 sub check_invoicing_list {
1251 my( $self, $arrayref ) = @_;
1252 foreach my $address ( @{$arrayref} ) {
1253 my $cust_main_invoice = new FS::cust_main_invoice ( {
1254 'custnum' => $self->custnum,
1257 my $error = $self->custnum
1258 ? $cust_main_invoice->check
1259 : $cust_main_invoice->checkdest
1261 return $error if $error;
1270 $Id: cust_main.pm,v 1.17 2001-08-12 00:07:00 ivan Exp $
1276 The delete method should possibly take an FS::cust_main object reference
1277 instead of a scalar customer number.
1279 Bill and collect options should probably be passed as references instead of a
1282 CyberCash v2 forces us to define some variables in package main.
1284 There should probably be a configuration file with a list of allowed credit
1287 CyberCash is the only processor.
1289 No multiple currency support (probably a larger project than just this module).
1293 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
1294 L<FS::cust_pay_batch>, L<FS::agent>, L<FS::part_referral>,
1295 L<FS::cust_main_county>, L<FS::cust_main_invoice>,
1296 L<FS::UID>, schema.html from the base documentation.