4 use vars qw( @ISA @EXPORT_OK $conf $DEBUG $import );
5 use vars qw( $realtime_bop_decline_quiet ); #ugh
10 eval "use Time::Local;";
11 die "Time::Local minimum version 1.05 required with Perl versions before 5.6"
12 if $] < 5.006 && !defined($Time::Local::VERSION);
13 #eval "use Time::Local qw(timelocal timelocal_nocheck);";
14 eval "use Time::Local qw(timelocal_nocheck);";
18 use String::Approx qw(amatch);
19 use Business::CreditCard;
20 use FS::UID qw( getotaker dbh );
21 use FS::Record qw( qsearchs qsearch dbdef );
22 use FS::Misc qw( send_email );
25 use FS::cust_bill_pkg;
27 use FS::cust_pay_void;
30 use FS::part_referral;
31 use FS::cust_main_county;
33 use FS::cust_main_invoice;
34 use FS::cust_credit_bill;
35 use FS::cust_bill_pay;
36 use FS::prepay_credit;
39 use FS::part_bill_event;
40 use FS::cust_bill_event;
41 use FS::cust_tax_exempt;
43 use FS::Msgcat qw(gettext);
45 @ISA = qw( FS::Record );
47 @EXPORT_OK = qw( smart_search );
49 $realtime_bop_decline_quiet = 0;
56 #ask FS::UID to run this stuff for us later
57 #$FS::UID::callback{'FS::cust_main'} = sub {
58 install_callback FS::UID sub {
60 #yes, need it for stuff below (prolly should be cached)
65 my ( $hashref, $cache ) = @_;
66 if ( exists $hashref->{'pkgnum'} ) {
67 # #@{ $self->{'_pkgnum'} } = ();
68 my $subcache = $cache->subcache( 'pkgnum', 'cust_pkg', $hashref->{custnum});
69 $self->{'_pkgnum'} = $subcache;
70 #push @{ $self->{'_pkgnum'} },
71 FS::cust_pkg->new_or_cached($hashref, $subcache) if $hashref->{pkgnum};
77 FS::cust_main - Object methods for cust_main records
83 $record = new FS::cust_main \%hash;
84 $record = new FS::cust_main { 'column' => 'value' };
86 $error = $record->insert;
88 $error = $new_record->replace($old_record);
90 $error = $record->delete;
92 $error = $record->check;
94 @cust_pkg = $record->all_pkgs;
96 @cust_pkg = $record->ncancelled_pkgs;
98 @cust_pkg = $record->suspended_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 - Advertising source (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 - I<CARD> (credit card - automatic), I<DCRD> (credit card - on-demand), I<CHEK> (electronic check - automatic), I<DCHK> (electronic check - on-demand), I<LECB> (Phone bill billing), I<BILL> (billing), I<COMP> (free), or I<PREPAY> (special billing type: applies a credit - see L<FS::prepay_credit> and sets billing type to I<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 paycvv - Card Verification Value, "CVV2" (also known as CVC2 or CID), the 3 or 4 digit number on the back (or front, for American Express) of the credit card
184 =item paydate - expiration date, mm/yyyy, m/yyyy, mm/yy or m/yy
186 =item payname - name on card or billing name
188 =item tax - tax exempt, empty or `Y'
190 =item otaker - order taker (assigned automatically, see L<FS::UID>)
192 =item comments - comments (optional)
194 =item referral_custnum - referring customer number
204 Creates a new customer. To add the customer to the database, see L<"insert">.
206 Note that this stores the hash reference, not a distinct copy of the hash it
207 points to. You can ask the object for a copy with the I<hash> method.
211 sub table { 'cust_main'; }
213 =item insert [ CUST_PKG_HASHREF [ , INVOICING_LIST_ARYREF ] [ , OPTION => VALUE ... ] ]
215 Adds this customer to the database. If there is an error, returns the error,
216 otherwise returns false.
218 CUST_PKG_HASHREF: If you pass a Tie::RefHash data structure to the insert
219 method containing FS::cust_pkg and FS::svc_I<tablename> objects, all records
220 are inserted atomicly, or the transaction is rolled back. Passing an empty
221 hash reference is equivalent to not supplying this parameter. There should be
222 a better explanation of this, but until then, here's an example:
225 tie %hash, 'Tie::RefHash'; #this part is important
227 $cust_pkg => [ $svc_acct ],
230 $cust_main->insert( \%hash );
232 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
233 be set as the invoicing list (see L<"invoicing_list">). Errors return as
234 expected and rollback the entire transaction; it is not necessary to call
235 check_invoicing_list first. The invoicing_list is set after the records in the
236 CUST_PKG_HASHREF above are inserted, so it is now possible to set an
237 invoicing_list destination to the newly-created svc_acct. Here's an example:
239 $cust_main->insert( {}, [ $email, 'POST' ] );
241 Currently available options are: I<depend_jobnum> and I<noexport>.
243 If I<depend_jobnum> is set, all provisioning jobs will have a dependancy
244 on the supplied jobnum (they will not run until the specific job completes).
245 This can be used to defer provisioning until some action completes (such
246 as running the customer's credit card sucessfully).
248 The I<noexport> option is deprecated. If I<noexport> is set true, no
249 provisioning jobs (exports) are scheduled. (You can schedule them later with
250 the B<reexport> method.)
256 my $cust_pkgs = @_ ? shift : {};
257 my $invoicing_list = @_ ? shift : '';
259 warn "FS::cust_main::insert called with options ".
260 join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
263 local $SIG{HUP} = 'IGNORE';
264 local $SIG{INT} = 'IGNORE';
265 local $SIG{QUIT} = 'IGNORE';
266 local $SIG{TERM} = 'IGNORE';
267 local $SIG{TSTP} = 'IGNORE';
268 local $SIG{PIPE} = 'IGNORE';
270 my $oldAutoCommit = $FS::UID::AutoCommit;
271 local $FS::UID::AutoCommit = 0;
276 if ( $self->payby eq 'PREPAY' ) {
277 $self->payby('BILL');
278 my $prepay_credit = qsearchs(
280 { 'identifier' => $self->payinfo },
284 warn "WARNING: can't find pre-found prepay_credit: ". $self->payinfo
285 unless $prepay_credit;
286 $amount = $prepay_credit->amount;
287 $seconds = $prepay_credit->seconds;
288 my $error = $prepay_credit->delete;
290 $dbh->rollback if $oldAutoCommit;
291 return "removing prepay_credit (transaction rolled back): $error";
295 my $error = $self->SUPER::insert;
297 $dbh->rollback if $oldAutoCommit;
298 #return "inserting cust_main record (transaction rolled back): $error";
303 if ( $invoicing_list ) {
304 $error = $self->check_invoicing_list( $invoicing_list );
306 $dbh->rollback if $oldAutoCommit;
307 return "checking invoicing_list (transaction rolled back): $error";
309 $self->invoicing_list( $invoicing_list );
313 $error = $self->order_pkgs($cust_pkgs, \$seconds, %options);
315 $dbh->rollback if $oldAutoCommit;
320 $dbh->rollback if $oldAutoCommit;
321 return "No svc_acct record to apply pre-paid time";
325 my $cust_credit = new FS::cust_credit {
326 'custnum' => $self->custnum,
329 $error = $cust_credit->insert;
331 $dbh->rollback if $oldAutoCommit;
332 return "inserting credit (transaction rolled back): $error";
336 $error = $self->queue_fuzzyfiles_update;
338 $dbh->rollback if $oldAutoCommit;
339 return "updating fuzzy search cache: $error";
342 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
347 =item order_pkgs HASHREF, [ SECONDSREF, [ , OPTION => VALUE ... ] ]
349 Like the insert method on an existing record, this method orders a package
350 and included services atomicaly. Pass a Tie::RefHash data structure to this
351 method containing FS::cust_pkg and FS::svc_I<tablename> objects. There should
352 be a better explanation of this, but until then, here's an example:
355 tie %hash, 'Tie::RefHash'; #this part is important
357 $cust_pkg => [ $svc_acct ],
360 $cust_main->order_pkgs( \%hash, \'0', 'noexport'=>1 );
362 Currently available options are: I<depend_jobnum> and I<noexport>.
364 If I<depend_jobnum> is set, all provisioning jobs will have a dependancy
365 on the supplied jobnum (they will not run until the specific job completes).
366 This can be used to defer provisioning until some action completes (such
367 as running the customer's credit card sucessfully).
369 The I<noexport> option is deprecated. If I<noexport> is set true, no
370 provisioning jobs (exports) are scheduled. (You can schedule them later with
371 the B<reexport> method for each cust_pkg object. Using the B<reexport> method
372 on the cust_main object is not recommended, as existing services will also be
379 my $cust_pkgs = shift;
382 my %svc_options = ();
383 $svc_options{'depend_jobnum'} = $options{'depend_jobnum'}
384 if exists $options{'depend_jobnum'};
385 warn "FS::cust_main::order_pkgs called with options ".
386 join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
389 local $SIG{HUP} = 'IGNORE';
390 local $SIG{INT} = 'IGNORE';
391 local $SIG{QUIT} = 'IGNORE';
392 local $SIG{TERM} = 'IGNORE';
393 local $SIG{TSTP} = 'IGNORE';
394 local $SIG{PIPE} = 'IGNORE';
396 my $oldAutoCommit = $FS::UID::AutoCommit;
397 local $FS::UID::AutoCommit = 0;
400 local $FS::svc_Common::noexport_hack = 1 if $options{'noexport'};
402 foreach my $cust_pkg ( keys %$cust_pkgs ) {
403 $cust_pkg->custnum( $self->custnum );
404 my $error = $cust_pkg->insert;
406 $dbh->rollback if $oldAutoCommit;
407 return "inserting cust_pkg (transaction rolled back): $error";
409 foreach my $svc_something ( @{$cust_pkgs->{$cust_pkg}} ) {
410 $svc_something->pkgnum( $cust_pkg->pkgnum );
411 if ( $seconds && $$seconds && $svc_something->isa('FS::svc_acct') ) {
412 $svc_something->seconds( $svc_something->seconds + $$seconds );
415 $error = $svc_something->insert(%svc_options);
417 $dbh->rollback if $oldAutoCommit;
418 #return "inserting svc_ (transaction rolled back): $error";
424 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
430 This method is deprecated. See the I<depend_jobnum> option to the insert and
431 order_pkgs methods for a better way to defer provisioning.
433 Re-schedules all exports by calling the B<reexport> method of all associated
434 packages (see L<FS::cust_pkg>). If there is an error, returns the error;
435 otherwise returns false.
442 carp "warning: FS::cust_main::reexport is deprectated; ".
443 "use the depend_jobnum option to insert or order_pkgs to delay export";
445 local $SIG{HUP} = 'IGNORE';
446 local $SIG{INT} = 'IGNORE';
447 local $SIG{QUIT} = 'IGNORE';
448 local $SIG{TERM} = 'IGNORE';
449 local $SIG{TSTP} = 'IGNORE';
450 local $SIG{PIPE} = 'IGNORE';
452 my $oldAutoCommit = $FS::UID::AutoCommit;
453 local $FS::UID::AutoCommit = 0;
456 foreach my $cust_pkg ( $self->ncancelled_pkgs ) {
457 my $error = $cust_pkg->reexport;
459 $dbh->rollback if $oldAutoCommit;
464 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
469 =item delete NEW_CUSTNUM
471 This deletes the customer. If there is an error, returns the error, otherwise
474 This will completely remove all traces of the customer record. This is not
475 what you want when a customer cancels service; for that, cancel all of the
476 customer's packages (see L</cancel>).
478 If the customer has any uncancelled packages, you need to pass a new (valid)
479 customer number for those packages to be transferred to. Cancelled packages
480 will be deleted. Did I mention that this is NOT what you want when a customer
481 cancels service and that you really should be looking see L<FS::cust_pkg/cancel>?
483 You can't delete a customer with invoices (see L<FS::cust_bill>),
484 or credits (see L<FS::cust_credit>), payments (see L<FS::cust_pay>) or
485 refunds (see L<FS::cust_refund>).
492 local $SIG{HUP} = 'IGNORE';
493 local $SIG{INT} = 'IGNORE';
494 local $SIG{QUIT} = 'IGNORE';
495 local $SIG{TERM} = 'IGNORE';
496 local $SIG{TSTP} = 'IGNORE';
497 local $SIG{PIPE} = 'IGNORE';
499 my $oldAutoCommit = $FS::UID::AutoCommit;
500 local $FS::UID::AutoCommit = 0;
503 if ( $self->cust_bill ) {
504 $dbh->rollback if $oldAutoCommit;
505 return "Can't delete a customer with invoices";
507 if ( $self->cust_credit ) {
508 $dbh->rollback if $oldAutoCommit;
509 return "Can't delete a customer with credits";
511 if ( $self->cust_pay ) {
512 $dbh->rollback if $oldAutoCommit;
513 return "Can't delete a customer with payments";
515 if ( $self->cust_refund ) {
516 $dbh->rollback if $oldAutoCommit;
517 return "Can't delete a customer with refunds";
520 my @cust_pkg = $self->ncancelled_pkgs;
522 my $new_custnum = shift;
523 unless ( qsearchs( 'cust_main', { 'custnum' => $new_custnum } ) ) {
524 $dbh->rollback if $oldAutoCommit;
525 return "Invalid new customer number: $new_custnum";
527 foreach my $cust_pkg ( @cust_pkg ) {
528 my %hash = $cust_pkg->hash;
529 $hash{'custnum'} = $new_custnum;
530 my $new_cust_pkg = new FS::cust_pkg ( \%hash );
531 my $error = $new_cust_pkg->replace($cust_pkg);
533 $dbh->rollback if $oldAutoCommit;
538 my @cancelled_cust_pkg = $self->all_pkgs;
539 foreach my $cust_pkg ( @cancelled_cust_pkg ) {
540 my $error = $cust_pkg->delete;
542 $dbh->rollback if $oldAutoCommit;
547 foreach my $cust_main_invoice ( #(email invoice destinations, not invoices)
548 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } )
550 my $error = $cust_main_invoice->delete;
552 $dbh->rollback if $oldAutoCommit;
557 my $error = $self->SUPER::delete;
559 $dbh->rollback if $oldAutoCommit;
563 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
568 =item replace OLD_RECORD [ INVOICING_LIST_ARYREF ]
570 Replaces the OLD_RECORD with this one in the database. If there is an error,
571 returns the error, otherwise returns false.
573 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
574 be set as the invoicing list (see L<"invoicing_list">). Errors return as
575 expected and rollback the entire transaction; it is not necessary to call
576 check_invoicing_list first. Here's an example:
578 $new_cust_main->replace( $old_cust_main, [ $email, 'POST' ] );
587 local $SIG{HUP} = 'IGNORE';
588 local $SIG{INT} = 'IGNORE';
589 local $SIG{QUIT} = 'IGNORE';
590 local $SIG{TERM} = 'IGNORE';
591 local $SIG{TSTP} = 'IGNORE';
592 local $SIG{PIPE} = 'IGNORE';
594 if ( $self->payby eq 'COMP' && $self->payby ne $old->payby
595 && $conf->config('users-allow_comp') ) {
596 return "You are not permitted to create complimentary accounts."
597 unless grep { $_ eq getotaker } $conf->config('users-allow_comp');
600 my $oldAutoCommit = $FS::UID::AutoCommit;
601 local $FS::UID::AutoCommit = 0;
604 my $error = $self->SUPER::replace($old);
607 $dbh->rollback if $oldAutoCommit;
611 if ( @param ) { # INVOICING_LIST_ARYREF
612 my $invoicing_list = shift @param;
613 $error = $self->check_invoicing_list( $invoicing_list );
615 $dbh->rollback if $oldAutoCommit;
618 $self->invoicing_list( $invoicing_list );
621 if ( $self->payby =~ /^(CARD|CHEK|LECB)$/ &&
622 grep { $self->get($_) ne $old->get($_) } qw(payinfo paydate payname) ) {
623 # card/check/lec info has changed, want to retry realtime_ invoice events
624 my $error = $self->retry_realtime;
626 $dbh->rollback if $oldAutoCommit;
631 $error = $self->queue_fuzzyfiles_update;
633 $dbh->rollback if $oldAutoCommit;
634 return "updating fuzzy search cache: $error";
637 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
642 =item queue_fuzzyfiles_update
644 Used by insert & replace to update the fuzzy search cache
648 sub queue_fuzzyfiles_update {
651 local $SIG{HUP} = 'IGNORE';
652 local $SIG{INT} = 'IGNORE';
653 local $SIG{QUIT} = 'IGNORE';
654 local $SIG{TERM} = 'IGNORE';
655 local $SIG{TSTP} = 'IGNORE';
656 local $SIG{PIPE} = 'IGNORE';
658 my $oldAutoCommit = $FS::UID::AutoCommit;
659 local $FS::UID::AutoCommit = 0;
662 my $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
663 my $error = $queue->insert($self->getfield('last'), $self->company);
665 $dbh->rollback if $oldAutoCommit;
666 return "queueing job (transaction rolled back): $error";
669 if ( defined $self->dbdef_table->column('ship_last') && $self->ship_last ) {
670 $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
671 $error = $queue->insert($self->getfield('ship_last'), $self->ship_company);
673 $dbh->rollback if $oldAutoCommit;
674 return "queueing job (transaction rolled back): $error";
678 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
685 Checks all fields to make sure this is a valid customer record. If there is
686 an error, returns the error, otherwise returns false. Called by the insert
694 #warn "BEFORE: \n". $self->_dump;
697 $self->ut_numbern('custnum')
698 || $self->ut_number('agentnum')
699 || $self->ut_number('refnum')
700 || $self->ut_name('last')
701 || $self->ut_name('first')
702 || $self->ut_textn('company')
703 || $self->ut_text('address1')
704 || $self->ut_textn('address2')
705 || $self->ut_text('city')
706 || $self->ut_textn('county')
707 || $self->ut_textn('state')
708 || $self->ut_country('country')
709 || $self->ut_anything('comments')
710 || $self->ut_numbern('referral_custnum')
712 #barf. need message catalogs. i18n. etc.
713 $error .= "Please select an advertising source."
714 if $error =~ /^Illegal or empty \(numeric\) refnum: /;
715 return $error if $error;
717 return "Unknown agent"
718 unless qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
720 return "Unknown refnum"
721 unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } );
723 return "Unknown referring custnum ". $self->referral_custnum
724 unless ! $self->referral_custnum
725 || qsearchs( 'cust_main', { 'custnum' => $self->referral_custnum } );
727 if ( $self->ss eq '' ) {
732 $ss =~ /^(\d{3})(\d{2})(\d{4})$/
733 or return "Illegal social security number: ". $self->ss;
734 $self->ss("$1-$2-$3");
738 # bad idea to disable, causes billing to fail because of no tax rates later
739 # unless ( $import ) {
740 unless ( qsearch('cust_main_county', {
741 'country' => $self->country,
744 return "Unknown state/county/country: ".
745 $self->state. "/". $self->county. "/". $self->country
746 unless qsearch('cust_main_county',{
747 'state' => $self->state,
748 'county' => $self->county,
749 'country' => $self->country,
755 $self->ut_phonen('daytime', $self->country)
756 || $self->ut_phonen('night', $self->country)
757 || $self->ut_phonen('fax', $self->country)
758 || $self->ut_zip('zip', $self->country)
760 return $error if $error;
763 last first company address1 address2 city county state zip
764 country daytime night fax
767 if ( defined $self->dbdef_table->column('ship_last') ) {
768 if ( scalar ( grep { $self->getfield($_) ne $self->getfield("ship_$_") }
770 && scalar ( grep { $self->getfield("ship_$_") ne '' } @addfields )
774 $self->ut_name('ship_last')
775 || $self->ut_name('ship_first')
776 || $self->ut_textn('ship_company')
777 || $self->ut_text('ship_address1')
778 || $self->ut_textn('ship_address2')
779 || $self->ut_text('ship_city')
780 || $self->ut_textn('ship_county')
781 || $self->ut_textn('ship_state')
782 || $self->ut_country('ship_country')
784 return $error if $error;
786 #false laziness with above
787 unless ( qsearchs('cust_main_county', {
788 'country' => $self->ship_country,
791 return "Unknown ship_state/ship_county/ship_country: ".
792 $self->ship_state. "/". $self->ship_county. "/". $self->ship_country
793 unless qsearchs('cust_main_county',{
794 'state' => $self->ship_state,
795 'county' => $self->ship_county,
796 'country' => $self->ship_country,
802 $self->ut_phonen('ship_daytime', $self->ship_country)
803 || $self->ut_phonen('ship_night', $self->ship_country)
804 || $self->ut_phonen('ship_fax', $self->ship_country)
805 || $self->ut_zip('ship_zip', $self->ship_country)
807 return $error if $error;
809 } else { # ship_ info eq billing info, so don't store dup info in database
810 $self->setfield("ship_$_", '')
811 foreach qw( last first company address1 address2 city county state zip
812 country daytime night fax );
816 $self->payby =~ /^(CARD|DCRD|CHEK|DCHK|LECB|BILL|COMP|PREPAY)$/
817 or return "Illegal payby: ". $self->payby;
820 if ( $self->payby eq 'CARD' || $self->payby eq 'DCRD' ) {
822 my $payinfo = $self->payinfo;
824 $payinfo =~ /^(\d{13,16})$/
825 or return gettext('invalid_card'); # . ": ". $self->payinfo;
827 $self->payinfo($payinfo);
829 or return gettext('invalid_card'); # . ": ". $self->payinfo;
830 return gettext('unknown_card_type')
831 if cardtype($self->payinfo) eq "Unknown";
832 if ( defined $self->dbdef_table->column('paycvv') ) {
833 if ( length($self->paycvv) ) {
834 if ( cardtype($self->payinfo) eq 'American Express card' ) {
835 $self->paycvv =~ /^(\d{4})$/
836 or return "CVV2 (CID) for American Express cards is four digits.";
839 $self->paycvv =~ /^(\d{3})$/
840 or return "CVV2 (CVC2/CID) is three digits.";
848 } elsif ( $self->payby eq 'CHEK' || $self->payby eq 'DCHK' ) {
850 my $payinfo = $self->payinfo;
851 $payinfo =~ s/[^\d\@]//g;
852 $payinfo =~ /^(\d+)\@(\d{9})$/ or return 'invalid echeck account@aba';
854 $self->payinfo($payinfo);
855 $self->paycvv('') if $self->dbdef_table->column('paycvv');
857 } elsif ( $self->payby eq 'LECB' ) {
859 my $payinfo = $self->payinfo;
861 $payinfo =~ /^1?(\d{10})$/ or return 'invalid btn billing telephone number';
863 $self->payinfo($payinfo);
864 $self->paycvv('') if $self->dbdef_table->column('paycvv');
866 } elsif ( $self->payby eq 'BILL' ) {
868 $error = $self->ut_textn('payinfo');
869 return "Illegal P.O. number: ". $self->payinfo if $error;
870 $self->paycvv('') if $self->dbdef_table->column('paycvv');
872 } elsif ( $self->payby eq 'COMP' ) {
874 if ( !$self->custnum && $conf->config('users-allow_comp') ) {
875 return "You are not permitted to create complimentary accounts."
876 unless grep { $_ eq getotaker } $conf->config('users-allow_comp');
879 $error = $self->ut_textn('payinfo');
880 return "Illegal comp account issuer: ". $self->payinfo if $error;
881 $self->paycvv('') if $self->dbdef_table->column('paycvv');
883 } elsif ( $self->payby eq 'PREPAY' ) {
885 my $payinfo = $self->payinfo;
886 $payinfo =~ s/\W//g; #anything else would just confuse things
887 $self->payinfo($payinfo);
888 $error = $self->ut_alpha('payinfo');
889 return "Illegal prepayment identifier: ". $self->payinfo if $error;
890 return "Unknown prepayment identifier"
891 unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } );
892 $self->paycvv('') if $self->dbdef_table->column('paycvv');
896 if ( $self->paydate eq '' || $self->paydate eq '-' ) {
897 return "Expriation date required"
898 unless $self->payby =~ /^(BILL|PREPAY|CHEK|LECB)$/;
902 if ( $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/ ) {
903 ( $m, $y ) = ( $1, length($2) == 4 ? $2 : "20$2" );
904 } elsif ( $self->paydate =~ /^(20)?(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) {
905 ( $m, $y ) = ( $3, "20$2" );
907 return "Illegal expiration date: ". $self->paydate;
909 $self->paydate("$y-$m-01");
910 my($nowm,$nowy)=(localtime(time))[4,5]; $nowm++; $nowy+=1900;
911 return gettext('expired_card')
912 if !$import && ( $y<$nowy || ( $y==$nowy && $1<$nowm ) );
915 if ( $self->payname eq '' && $self->payby !~ /^(CHEK|DCHK)$/ &&
916 ( ! $conf->exists('require_cardname')
917 || $self->payby !~ /^(CARD|DCRD)$/ )
919 $self->payname( $self->first. " ". $self->getfield('last') );
921 $self->payname =~ /^([\w \,\.\-\']+)$/
922 or return gettext('illegal_name'). " payname: ". $self->payname;
926 $self->tax =~ /^(Y?)$/ or return "Illegal tax: ". $self->tax;
929 $self->otaker(getotaker) unless $self->otaker;
931 #warn "AFTER: \n". $self->_dump;
938 Returns all packages (see L<FS::cust_pkg>) for this customer.
944 if ( $self->{'_pkgnum'} ) {
945 values %{ $self->{'_pkgnum'}->cache };
947 qsearch( 'cust_pkg', { 'custnum' => $self->custnum });
951 =item ncancelled_pkgs
953 Returns all non-cancelled packages (see L<FS::cust_pkg>) for this customer.
957 sub ncancelled_pkgs {
959 if ( $self->{'_pkgnum'} ) {
960 grep { ! $_->getfield('cancel') } values %{ $self->{'_pkgnum'}->cache };
962 @{ [ # force list context
963 qsearch( 'cust_pkg', {
964 'custnum' => $self->custnum,
967 qsearch( 'cust_pkg', {
968 'custnum' => $self->custnum,
977 Returns all suspended packages (see L<FS::cust_pkg>) for this customer.
983 grep { $_->susp } $self->ncancelled_pkgs;
986 =item unflagged_suspended_pkgs
988 Returns all unflagged suspended packages (see L<FS::cust_pkg>) for this
989 customer (thouse packages without the `manual_flag' set).
993 sub unflagged_suspended_pkgs {
995 return $self->suspended_pkgs
996 unless dbdef->table('cust_pkg')->column('manual_flag');
997 grep { ! $_->manual_flag } $self->suspended_pkgs;
1000 =item unsuspended_pkgs
1002 Returns all unsuspended (and uncancelled) packages (see L<FS::cust_pkg>) for
1007 sub unsuspended_pkgs {
1009 grep { ! $_->susp } $self->ncancelled_pkgs;
1012 =item num_cancelled_pkgs
1014 Returns the number of cancelled packages (see L<FS::cust_pkg>) for this
1019 sub num_cancelled_pkgs {
1021 $self->num_pkgs("cancel IS NOT NULL AND cust_pkg.cancel != 0");
1025 my( $self, $sql ) = @_;
1026 my $sth = dbh->prepare(
1027 "SELECT COUNT(*) FROM cust_pkg WHERE custnum = ? AND $sql"
1028 ) or die dbh->errstr;
1029 $sth->execute($self->custnum) or die $sth->errstr;
1030 $sth->fetchrow_arrayref->[0];
1035 Unsuspends all unflagged suspended packages (see L</unflagged_suspended_pkgs>
1036 and L<FS::cust_pkg>) for this customer. Always returns a list: an empty list
1037 on success or a list of errors.
1043 grep { $_->unsuspend } $self->suspended_pkgs;
1048 Suspends all unsuspended packages (see L<FS::cust_pkg>) for this customer.
1049 Always returns a list: an empty list on success or a list of errors.
1055 grep { $_->suspend } $self->unsuspended_pkgs;
1058 =item suspend_if_pkgpart PKGPART [ , PKGPART ... ]
1060 Suspends all unsuspended packages (see L<FS::cust_pkg>) matching the listed
1061 PKGPARTs (see L<FS::part_pkg>). Always returns a list: an empty list on
1062 success or a list of errors.
1066 sub suspend_if_pkgpart {
1069 grep { $_->suspend }
1070 grep { my $pkgpart = $_->pkgpart; grep { $pkgpart eq $_ } @pkgparts }
1071 $self->unsuspended_pkgs;
1074 =item suspend_unless_pkgpart PKGPART [ , PKGPART ... ]
1076 Suspends all unsuspended packages (see L<FS::cust_pkg>) unless they match the
1077 listed PKGPARTs (see L<FS::part_pkg>). Always returns a list: an empty list
1078 on success or a list of errors.
1082 sub suspend_unless_pkgpart {
1085 grep { $_->suspend }
1086 grep { my $pkgpart = $_->pkgpart; ! grep { $pkgpart eq $_ } @pkgparts }
1087 $self->unsuspended_pkgs;
1090 =item cancel [ OPTION => VALUE ... ]
1092 Cancels all uncancelled packages (see L<FS::cust_pkg>) for this customer.
1094 Available options are: I<quiet>
1096 I<quiet> can be set true to supress email cancellation notices.
1098 Always returns a list: an empty list on success or a list of errors.
1104 grep { $_ } map { $_->cancel(@_) } $self->ncancelled_pkgs;
1109 Returns the agent (see L<FS::agent>) for this customer.
1115 qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
1120 Generates invoices (see L<FS::cust_bill>) for this customer. Usually used in
1121 conjunction with the collect method.
1123 Options are passed as name-value pairs.
1125 Currently available options are:
1127 resetup - if set true, re-charges setup fees.
1129 time - bills the customer as if it were that time. Specified as a UNIX
1130 timestamp; see L<perlfunc/"time">). Also see L<Time::Local> and
1131 L<Date::Parse> for conversion functions. For example:
1135 $cust_main->bill( 'time' => str2time('April 20th, 2001') );
1138 If there is an error, returns the error, otherwise returns false.
1143 my( $self, %options ) = @_;
1144 return '' if $self->payby eq 'COMP';
1145 warn "bill customer ". $self->custnum if $DEBUG;
1147 my $time = $options{'time'} || time;
1152 local $SIG{HUP} = 'IGNORE';
1153 local $SIG{INT} = 'IGNORE';
1154 local $SIG{QUIT} = 'IGNORE';
1155 local $SIG{TERM} = 'IGNORE';
1156 local $SIG{TSTP} = 'IGNORE';
1157 local $SIG{PIPE} = 'IGNORE';
1159 my $oldAutoCommit = $FS::UID::AutoCommit;
1160 local $FS::UID::AutoCommit = 0;
1163 $self->select_for_update; #mutex
1165 # find the packages which are due for billing, find out how much they are
1166 # & generate invoice database.
1168 my( $total_setup, $total_recur ) = ( 0, 0 );
1169 #my( $taxable_setup, $taxable_recur ) = ( 0, 0 );
1170 my @cust_bill_pkg = ();
1172 #my $taxable_charged = 0;##
1177 foreach my $cust_pkg (
1178 qsearch('cust_pkg', { 'custnum' => $self->custnum } )
1181 #NO!! next if $cust_pkg->cancel;
1182 next if $cust_pkg->getfield('cancel');
1184 warn " bill package ". $cust_pkg->pkgnum if $DEBUG;
1186 #? to avoid use of uninitialized value errors... ?
1187 $cust_pkg->setfield('bill', '')
1188 unless defined($cust_pkg->bill);
1190 my $part_pkg = $cust_pkg->part_pkg;
1192 my %hash = $cust_pkg->hash;
1193 my $old_cust_pkg = new FS::cust_pkg \%hash;
1199 if ( !$cust_pkg->setup || $options{'resetup'} ) {
1201 warn " bill setup" if $DEBUG;
1203 $setup = eval { $cust_pkg->calc_setup( $time ) };
1205 $dbh->rollback if $oldAutoCommit;
1209 $cust_pkg->setfield('setup', $time) unless $cust_pkg->setup;
1215 if ( $part_pkg->getfield('freq') ne '0' &&
1216 ! $cust_pkg->getfield('susp') &&
1217 ( $cust_pkg->getfield('bill') || 0 ) <= $time
1220 warn " bill recur" if $DEBUG;
1222 # XXX shared with $recur_prog
1223 $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
1225 $recur = eval { $cust_pkg->calc_recur( \$sdate, \@details ) };
1227 $dbh->rollback if $oldAutoCommit;
1231 #change this bit to use Date::Manip? CAREFUL with timezones (see
1232 # mailing list archive)
1233 my ($sec,$min,$hour,$mday,$mon,$year) =
1234 (localtime($sdate) )[0,1,2,3,4,5];
1236 #pro-rating magic - if $recur_prog fiddles $sdate, want to use that
1237 # only for figuring next bill date, nothing else, so, reset $sdate again
1239 $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
1240 $cust_pkg->last_bill($sdate)
1241 if $cust_pkg->dbdef_table->column('last_bill');
1243 if ( $part_pkg->freq =~ /^\d+$/ ) {
1244 $mon += $part_pkg->freq;
1245 until ( $mon < 12 ) { $mon -= 12; $year++; }
1246 } elsif ( $part_pkg->freq =~ /^(\d+)w$/ ) {
1248 $mday += $weeks * 7;
1249 } elsif ( $part_pkg->freq =~ /^(\d+)d$/ ) {
1253 $dbh->rollback if $oldAutoCommit;
1254 return "unparsable frequency: ". $part_pkg->freq;
1256 $cust_pkg->setfield('bill',
1257 timelocal_nocheck($sec,$min,$hour,$mday,$mon,$year));
1260 warn "\$setup is undefined" unless defined($setup);
1261 warn "\$recur is undefined" unless defined($recur);
1262 warn "\$cust_pkg->bill is undefined" unless defined($cust_pkg->bill);
1264 if ( $cust_pkg->modified ) {
1266 warn " package ". $cust_pkg->pkgnum. " modified; updating\n" if $DEBUG;
1268 $error=$cust_pkg->replace($old_cust_pkg);
1269 if ( $error ) { #just in case
1270 $dbh->rollback if $oldAutoCommit;
1271 return "Error modifying pkgnum ". $cust_pkg->pkgnum. ": $error";
1274 $setup = sprintf( "%.2f", $setup );
1275 $recur = sprintf( "%.2f", $recur );
1276 if ( $setup < 0 && ! $conf->exists('allow_negative_charges') ) {
1277 $dbh->rollback if $oldAutoCommit;
1278 return "negative setup $setup for pkgnum ". $cust_pkg->pkgnum;
1280 if ( $recur < 0 && ! $conf->exists('allow_negative_charges') ) {
1281 $dbh->rollback if $oldAutoCommit;
1282 return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum;
1284 if ( $setup != 0 || $recur != 0 ) {
1285 warn " charges (setup=$setup, recur=$recur); queueing line items\n"
1287 my $cust_bill_pkg = new FS::cust_bill_pkg ({
1288 'pkgnum' => $cust_pkg->pkgnum,
1292 'edate' => $cust_pkg->bill,
1293 'details' => \@details,
1295 push @cust_bill_pkg, $cust_bill_pkg;
1296 $total_setup += $setup;
1297 $total_recur += $recur;
1299 unless ( $self->tax =~ /Y/i || $self->payby eq 'COMP' ) {
1301 my @taxes = qsearch( 'cust_main_county', {
1302 'state' => $self->state,
1303 'county' => $self->county,
1304 'country' => $self->country,
1305 'taxclass' => $part_pkg->taxclass,
1308 @taxes = qsearch( 'cust_main_county', {
1309 'state' => $self->state,
1310 'county' => $self->county,
1311 'country' => $self->country,
1316 #one more try at a whole-country tax rate
1318 @taxes = qsearch( 'cust_main_county', {
1321 'country' => $self->country,
1326 # maybe eliminate this entirely, along with all the 0% records
1328 $dbh->rollback if $oldAutoCommit;
1330 "fatal: can't find tax rate for state/county/country/taxclass ".
1331 join('/', ( map $self->$_(), qw(state county country) ),
1332 $part_pkg->taxclass ). "\n";
1335 foreach my $tax ( @taxes ) {
1337 my $taxable_charged = 0;
1338 $taxable_charged += $setup
1339 unless $part_pkg->setuptax =~ /^Y$/i
1340 || $tax->setuptax =~ /^Y$/i;
1341 $taxable_charged += $recur
1342 unless $part_pkg->recurtax =~ /^Y$/i
1343 || $tax->recurtax =~ /^Y$/i;
1344 next unless $taxable_charged;
1346 if ( $tax->exempt_amount && $tax->exempt_amount > 0 ) {
1347 my ($mon,$year) = (localtime($sdate) )[4,5];
1349 my $freq = $part_pkg->freq || 1;
1350 if ( $freq !~ /(\d+)$/ ) {
1351 $dbh->rollback if $oldAutoCommit;
1352 return "daily/weekly package definitions not (yet?)".
1353 " compatible with monthly tax exemptions";
1355 my $taxable_per_month = sprintf("%.2f", $taxable_charged / $freq );
1356 foreach my $which_month ( 1 .. $freq ) {
1358 'custnum' => $self->custnum,
1359 'taxnum' => $tax->taxnum,
1360 'year' => 1900+$year,
1363 #until ( $mon < 12 ) { $mon -= 12; $year++; }
1364 until ( $mon < 13 ) { $mon -= 12; $year++; }
1365 my $cust_tax_exempt =
1366 qsearchs('cust_tax_exempt', \%hash)
1367 || new FS::cust_tax_exempt( { %hash, 'amount' => 0 } );
1368 my $remaining_exemption = sprintf("%.2f",
1369 $tax->exempt_amount - $cust_tax_exempt->amount );
1370 if ( $remaining_exemption > 0 ) {
1371 my $addl = $remaining_exemption > $taxable_per_month
1372 ? $taxable_per_month
1373 : $remaining_exemption;
1374 $taxable_charged -= $addl;
1375 my $new_cust_tax_exempt = new FS::cust_tax_exempt ( {
1376 $cust_tax_exempt->hash,
1378 sprintf("%.2f", $cust_tax_exempt->amount + $addl),
1380 $error = $new_cust_tax_exempt->exemptnum
1381 ? $new_cust_tax_exempt->replace($cust_tax_exempt)
1382 : $new_cust_tax_exempt->insert;
1384 $dbh->rollback if $oldAutoCommit;
1385 return "fatal: can't update cust_tax_exempt: $error";
1388 } # if $remaining_exemption > 0
1390 } #foreach $which_month
1392 } #if $tax->exempt_amount
1394 $taxable_charged = sprintf( "%.2f", $taxable_charged);
1396 #$tax += $taxable_charged * $cust_main_county->tax / 100
1397 $tax{ $tax->taxname || 'Tax' } +=
1398 $taxable_charged * $tax->tax / 100
1400 } #foreach my $tax ( @taxes )
1402 } #unless $self->tax =~ /Y/i || $self->payby eq 'COMP'
1404 } #if $setup != 0 || $recur != 0
1406 } #if $cust_pkg->modified
1408 } #foreach my $cust_pkg
1410 my $charged = sprintf( "%.2f", $total_setup + $total_recur );
1411 # my $taxable_charged = sprintf( "%.2f", $taxable_setup + $taxable_recur );
1413 unless ( @cust_bill_pkg ) { #don't create invoices with no line items
1414 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1418 # unless ( $self->tax =~ /Y/i
1419 # || $self->payby eq 'COMP'
1420 # || $taxable_charged == 0 ) {
1421 # my $cust_main_county = qsearchs('cust_main_county',{
1422 # 'state' => $self->state,
1423 # 'county' => $self->county,
1424 # 'country' => $self->country,
1425 # } ) or die "fatal: can't find tax rate for state/county/country ".
1426 # $self->state. "/". $self->county. "/". $self->country. "\n";
1427 # my $tax = sprintf( "%.2f",
1428 # $taxable_charged * ( $cust_main_county->getfield('tax') / 100 )
1431 if ( dbdef->table('cust_bill_pkg')->column('itemdesc') ) { #1.5 schema
1433 foreach my $taxname ( grep { $tax{$_} > 0 } keys %tax ) {
1434 my $tax = sprintf("%.2f", $tax{$taxname} );
1435 $charged = sprintf( "%.2f", $charged+$tax );
1437 my $cust_bill_pkg = new FS::cust_bill_pkg ({
1443 'itemdesc' => $taxname,
1445 push @cust_bill_pkg, $cust_bill_pkg;
1448 } else { #1.4 schema
1451 foreach ( values %tax ) { $tax += $_ };
1452 $tax = sprintf("%.2f", $tax);
1454 $charged = sprintf( "%.2f", $charged+$tax );
1456 my $cust_bill_pkg = new FS::cust_bill_pkg ({
1463 push @cust_bill_pkg, $cust_bill_pkg;
1468 my $cust_bill = new FS::cust_bill ( {
1469 'custnum' => $self->custnum,
1471 'charged' => $charged,
1473 $error = $cust_bill->insert;
1475 $dbh->rollback if $oldAutoCommit;
1476 return "can't create invoice for customer #". $self->custnum. ": $error";
1479 my $invnum = $cust_bill->invnum;
1481 foreach $cust_bill_pkg ( @cust_bill_pkg ) {
1483 $cust_bill_pkg->invnum($invnum);
1484 $error = $cust_bill_pkg->insert;
1486 $dbh->rollback if $oldAutoCommit;
1487 return "can't create invoice line item for customer #". $self->custnum.
1492 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1496 =item collect OPTIONS
1498 (Attempt to) collect money for this customer's outstanding invoices (see
1499 L<FS::cust_bill>). Usually used after the bill method.
1501 Depending on the value of `payby', this may print or email an invoice (I<BILL>,
1502 I<DCRD>, or I<DCHK>), charge a credit card (I<CARD>), charge via electronic
1503 check/ACH (I<CHEK>), or just add any necessary (pseudo-)payment (I<COMP>).
1505 Most actions are now triggered by invoice events; see L<FS::part_bill_event>
1506 and the invoice events web interface.
1508 If there is an error, returns the error, otherwise returns false.
1510 Options are passed as name-value pairs.
1512 Currently available options are:
1514 invoice_time - Use this time when deciding when to print invoices and
1515 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>
1516 for conversion functions.
1518 retry - Retry card/echeck/LEC transactions even when not scheduled by invoice
1521 retry_card - Deprecated alias for 'retry'
1523 batch_card - This option is deprecated. See the invoice events web interface
1524 to control whether cards are batched or run against a realtime gateway.
1526 report_badcard - This option is deprecated.
1528 force_print - This option is deprecated; see the invoice events web interface.
1530 quiet - set true to surpress email card/ACH decline notices.
1535 my( $self, %options ) = @_;
1536 my $invoice_time = $options{'invoice_time'} || time;
1539 local $SIG{HUP} = 'IGNORE';
1540 local $SIG{INT} = 'IGNORE';
1541 local $SIG{QUIT} = 'IGNORE';
1542 local $SIG{TERM} = 'IGNORE';
1543 local $SIG{TSTP} = 'IGNORE';
1544 local $SIG{PIPE} = 'IGNORE';
1546 my $oldAutoCommit = $FS::UID::AutoCommit;
1547 local $FS::UID::AutoCommit = 0;
1550 $self->select_for_update; #mutex
1552 my $balance = $self->balance;
1553 warn "collect customer ". $self->custnum. ": balance $balance" if $DEBUG;
1554 unless ( $balance > 0 ) { #redundant?????
1555 $dbh->rollback if $oldAutoCommit; #hmm
1559 if ( exists($options{'retry_card'}) ) {
1560 carp 'retry_card option passed to collect is deprecated; use retry';
1561 $options{'retry'} ||= $options{'retry_card'};
1563 if ( exists($options{'retry'}) && $options{'retry'} ) {
1564 my $error = $self->retry_realtime;
1566 $dbh->rollback if $oldAutoCommit;
1571 foreach my $cust_bill ( $self->open_cust_bill ) {
1573 # don't try to charge for the same invoice if it's already in a batch
1574 #next if qsearchs( 'cust_pay_batch', { 'invnum' => $cust_bill->invnum } );
1576 last if $self->balance <= 0;
1578 warn "invnum ". $cust_bill->invnum. " (owed ". $cust_bill->owed. ")"
1581 foreach my $part_bill_event (
1582 sort { $a->seconds <=> $b->seconds
1583 || $a->weight <=> $b->weight
1584 || $a->eventpart <=> $b->eventpart }
1585 grep { $_->seconds <= ( $invoice_time - $cust_bill->_date )
1586 && ! qsearch( 'cust_bill_event', {
1587 'invnum' => $cust_bill->invnum,
1588 'eventpart' => $_->eventpart,
1592 qsearch('part_bill_event', { 'payby' => $self->payby,
1593 'disabled' => '', } )
1596 last if $cust_bill->owed <= 0 # don't run subsequent events if owed<=0
1597 || $self->balance <= 0; # or if balance<=0
1599 warn "calling invoice event (". $part_bill_event->eventcode. ")\n"
1601 my $cust_main = $self; #for callback
1605 local $realtime_bop_decline_quiet = 1 if $options{'quiet'};
1606 local $SIG{__DIE__}; # don't want Mason __DIE__ handler active
1607 $error = eval $part_bill_event->eventcode;
1611 my $statustext = '';
1615 } elsif ( $error ) {
1617 $statustext = $error;
1622 #add cust_bill_event
1623 my $cust_bill_event = new FS::cust_bill_event {
1624 'invnum' => $cust_bill->invnum,
1625 'eventpart' => $part_bill_event->eventpart,
1626 #'_date' => $invoice_time,
1628 'status' => $status,
1629 'statustext' => $statustext,
1631 $error = $cust_bill_event->insert;
1633 #$dbh->rollback if $oldAutoCommit;
1634 #return "error: $error";
1636 # gah, even with transactions.
1637 $dbh->commit if $oldAutoCommit; #well.
1638 my $e = 'WARNING: Event run but database not updated - '.
1639 'error inserting cust_bill_event, invnum #'. $cust_bill->invnum.
1640 ', eventpart '. $part_bill_event->eventpart.
1651 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1656 =item retry_realtime
1658 Schedules realtime credit card / electronic check / LEC billing events for
1659 for retry. Useful if card information has changed or manual retry is desired.
1660 The 'collect' method must be called to actually retry the transaction.
1662 Implementation details: For each of this customer's open invoices, changes
1663 the status of the first "done" (with statustext error) realtime processing
1668 sub retry_realtime {
1671 local $SIG{HUP} = 'IGNORE';
1672 local $SIG{INT} = 'IGNORE';
1673 local $SIG{QUIT} = 'IGNORE';
1674 local $SIG{TERM} = 'IGNORE';
1675 local $SIG{TSTP} = 'IGNORE';
1676 local $SIG{PIPE} = 'IGNORE';
1678 my $oldAutoCommit = $FS::UID::AutoCommit;
1679 local $FS::UID::AutoCommit = 0;
1682 foreach my $cust_bill (
1683 grep { $_->cust_bill_event }
1684 $self->open_cust_bill
1686 my @cust_bill_event =
1687 sort { $a->part_bill_event->seconds <=> $b->part_bill_event->seconds }
1689 #$_->part_bill_event->plan eq 'realtime-card'
1690 $_->part_bill_event->eventcode =~
1691 /\$cust_bill\->realtime_(card|ach|lec)/
1692 && $_->status eq 'done'
1695 $cust_bill->cust_bill_event;
1696 next unless @cust_bill_event;
1697 my $error = $cust_bill_event[0]->retry;
1699 $dbh->rollback if $oldAutoCommit;
1700 return "error scheduling invoice event for retry: $error";
1705 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1710 =item realtime_bop METHOD AMOUNT [ OPTION => VALUE ... ]
1712 Runs a realtime credit card, ACH (electronic check) or phone bill transaction
1713 via a Business::OnlinePayment realtime gateway. See
1714 L<http://420.am/business-onlinepayment> for supported gateways.
1716 Available methods are: I<CC>, I<ECHECK> and I<LEC>
1718 Available options are: I<description>, I<invnum>, I<quiet>
1720 The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
1721 I<zip>, I<payinfo> and I<paydate> are also available. Any of these options,
1722 if set, will override the value from the customer record.
1724 I<description> is a free-text field passed to the gateway. It defaults to
1725 "Internet services".
1727 If an I<invnum> is specified, this payment (if sucessful) is applied to the
1728 specified invoice. If you don't specify an I<invnum> you might want to
1729 call the B<apply_payments> method.
1731 I<quiet> can be set true to surpress email decline notices.
1733 (moved from cust_bill) (probably should get realtime_{card,ach,lec} here too)
1738 my( $self, $method, $amount, %options ) = @_;
1740 warn "$self $method $amount\n";
1741 warn " $_ => $options{$_}\n" foreach keys %options;
1744 $options{'description'} ||= 'Internet services';
1747 die "Real-time processing not enabled\n"
1748 unless $conf->exists('business-onlinepayment');
1749 eval "use Business::OnlinePayment";
1753 my $bop_config = 'business-onlinepayment';
1754 $bop_config .= '-ach'
1755 if $method eq 'ECHECK' && $conf->exists($bop_config. '-ach');
1756 my ( $processor, $login, $password, $action, @bop_options ) =
1757 $conf->config($bop_config);
1758 $action ||= 'normal authorization';
1759 pop @bop_options if scalar(@bop_options) % 2 && $bop_options[-1] =~ /^\s*$/;
1760 die "No real-time processor is enabled - ".
1761 "did you set the business-onlinepayment configuration value?\n"
1766 my $address = exists($options{'address1'})
1767 ? $options{'address1'}
1769 my $address2 = exists($options{'address2'})
1770 ? $options{'address2'}
1772 $address .= ", ". $address2 if length($address2);
1774 my $o_payname = exists($options{'payname'})
1775 ? $options{'payname'}
1777 my($payname, $payfirst, $paylast);
1778 if ( $o_payname && $method ne 'ECHECK' ) {
1779 ($payname = $o_payname) =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
1780 or return "Illegal payname $payname";
1781 ($payfirst, $paylast) = ($1, $2);
1783 $payfirst = $self->getfield('first');
1784 $paylast = $self->getfield('last');
1785 $payname = "$payfirst $paylast";
1788 my @invoicing_list = grep { $_ ne 'POST' } $self->invoicing_list;
1789 if ( $conf->exists('emailinvoiceauto')
1790 || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
1791 push @invoicing_list, $self->all_emails;
1793 my $email = $invoicing_list[0];
1795 my $payinfo = exists($options{'payinfo'})
1796 ? $options{'payinfo'}
1800 if ( $method eq 'CC' ) {
1802 $content{card_number} = $payinfo;
1803 my $paydate = exists($options{'paydate'})
1804 ? $options{'paydate'}
1806 $paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
1807 $content{expiration} = "$2/$1";
1809 if ( defined $self->dbdef_table->column('paycvv') ) {
1810 my $paycvv = exists($options{'paycvv'})
1811 ? $options{'paycvv'}
1813 $content{cvv2} = $self->paycvv
1817 $content{recurring_billing} = 'YES'
1818 if qsearch('cust_pay', { 'custnum' => $self->custnum,
1820 'payinfo' => $payinfo,
1823 } elsif ( $method eq 'ECHECK' ) {
1824 ( $content{account_number}, $content{routing_code} ) =
1825 split('@', $payinfo);
1826 $content{bank_name} = $o_payname;
1827 $content{account_type} = 'CHECKING';
1828 $content{account_name} = $payname;
1829 $content{customer_org} = $self->company ? 'B' : 'I';
1830 $content{customer_ssn} = exists($options{'ss'})
1833 } elsif ( $method eq 'LEC' ) {
1834 $content{phone} = $payinfo;
1839 my( $action1, $action2 ) = split(/\s*\,\s*/, $action );
1841 my $transaction = new Business::OnlinePayment( $processor, @bop_options );
1842 $transaction->content(
1845 'password' => $password,
1846 'action' => $action1,
1847 'description' => $options{'description'},
1848 'amount' => $amount,
1849 'invoice_number' => $options{'invnum'},
1850 'customer_id' => $self->custnum,
1851 'last_name' => $paylast,
1852 'first_name' => $payfirst,
1854 'address' => $address,
1855 'city' => ( exists($options{'city'})
1858 'state' => ( exists($options{'state'})
1861 'zip' => ( exists($options{'zip'})
1864 'country' => ( exists($options{'country'})
1865 ? $options{'country'}
1867 'referer' => 'http://cleanwhisker.420.am/',
1869 'phone' => $self->daytime || $self->night,
1872 $transaction->submit();
1874 if ( $transaction->is_success() && $action2 ) {
1875 my $auth = $transaction->authorization;
1876 my $ordernum = $transaction->can('order_number')
1877 ? $transaction->order_number
1881 new Business::OnlinePayment( $processor, @bop_options );
1888 password => $password,
1889 order_number => $ordernum,
1891 authorization => $auth,
1892 description => $options{'description'},
1895 foreach my $field (qw( authorization_source_code returned_ACI transaction_identifier validation_code
1896 transaction_sequence_num local_transaction_date
1897 local_transaction_time AVS_result_code )) {
1898 $capture{$field} = $transaction->$field() if $transaction->can($field);
1901 $capture->content( %capture );
1905 unless ( $capture->is_success ) {
1906 my $e = "Authorization sucessful but capture failed, custnum #".
1907 $self->custnum. ': '. $capture->result_code.
1908 ": ". $capture->error_message;
1915 #remove paycvv after initial transaction
1916 #false laziness w/misc/process/payment.cgi - check both to make sure working
1918 if ( defined $self->dbdef_table->column('paycvv')
1919 && length($self->paycvv)
1920 && ! grep { $_ eq cardtype($payinfo) } $conf->config('cvv-save')
1922 my $error = $self->remove_cvv;
1924 warn "error removing cvv: $error\n";
1929 if ( $transaction->is_success() ) {
1931 my %method2payby = (
1937 my $paybatch = "$processor:". $transaction->authorization;
1938 $paybatch .= ':'. $transaction->order_number
1939 if $transaction->can('order_number')
1940 && length($transaction->order_number);
1942 my $cust_pay = new FS::cust_pay ( {
1943 'custnum' => $self->custnum,
1944 'invnum' => $options{'invnum'},
1947 'payby' => $method2payby{$method},
1948 'payinfo' => $payinfo,
1949 'paybatch' => $paybatch,
1951 my $error = $cust_pay->insert;
1953 $cust_pay->invnum(''); #try again with no specific invnum
1954 my $error2 = $cust_pay->insert;
1956 # gah, even with transactions.
1957 my $e = 'WARNING: Card/ACH debited but database not updated - '.
1958 "error inserting payment ($processor): $error2".
1959 " (previously tried insert with invnum #$options{'invnum'}" .
1965 return ''; #no error
1969 my $perror = "$processor error: ". $transaction->error_message;
1971 if ( !$options{'quiet'} && !$realtime_bop_decline_quiet
1972 && $conf->exists('emaildecline')
1973 && grep { $_ ne 'POST' } $self->invoicing_list
1974 && ! grep { $transaction->error_message =~ /$_/ }
1975 $conf->config('emaildecline-exclude')
1977 my @templ = $conf->config('declinetemplate');
1978 my $template = new Text::Template (
1980 SOURCE => [ map "$_\n", @templ ],
1981 ) or return "($perror) can't create template: $Text::Template::ERROR";
1982 $template->compile()
1983 or return "($perror) can't compile template: $Text::Template::ERROR";
1985 my $templ_hash = { error => $transaction->error_message };
1987 my $error = send_email(
1988 'from' => $conf->config('invoice_from'),
1989 'to' => [ grep { $_ ne 'POST' } $self->invoicing_list ],
1990 'subject' => 'Your payment could not be processed',
1991 'body' => [ $template->fill_in(HASH => $templ_hash) ],
1994 $perror .= " (also received error sending decline notification: $error)"
2006 Removes the I<paycvv> field from the database directly.
2008 If there is an error, returns the error, otherwise returns false.
2014 my $sth = dbh->prepare("UPDATE cust_main SET paycvv = '' WHERE custnum = ?")
2015 or return dbh->errstr;
2016 $sth->execute($self->custnum)
2017 or return $sth->errstr;
2022 =item realtime_refund_bop METHOD [ OPTION => VALUE ... ]
2024 Refunds a realtime credit card, ACH (electronic check) or phone bill transaction
2025 via a Business::OnlinePayment realtime gateway. See
2026 L<http://420.am/business-onlinepayment> for supported gateways.
2028 Available methods are: I<CC>, I<ECHECK> and I<LEC>
2030 Available options are: I<amount>, I<reason>, I<paynum>
2032 Most gateways require a reference to an original payment transaction to refund,
2033 so you probably need to specify a I<paynum>.
2035 I<amount> defaults to the original amount of the payment if not specified.
2037 I<reason> specifies a reason for the refund.
2039 Implementation note: If I<amount> is unspecified or equal to the amount of the
2040 orignal payment, first an attempt is made to "void" the transaction via
2041 the gateway (to cancel a not-yet settled transaction) and then if that fails,
2042 the normal attempt is made to "refund" ("credit") the transaction via the
2043 gateway is attempted.
2045 #The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
2046 #I<zip>, I<payinfo> and I<paydate> are also available. Any of these options,
2047 #if set, will override the value from the customer record.
2049 #If an I<invnum> is specified, this payment (if sucessful) is applied to the
2050 #specified invoice. If you don't specify an I<invnum> you might want to
2051 #call the B<apply_payments> method.
2055 #some false laziness w/realtime_bop, not enough to make it worth merging
2056 #but some useful small subs should be pulled out
2057 sub realtime_refund_bop {
2058 my( $self, $method, %options ) = @_;
2060 warn "$self $method refund\n";
2061 warn " $_ => $options{$_}\n" foreach keys %options;
2065 die "Real-time processing not enabled\n"
2066 unless $conf->exists('business-onlinepayment');
2067 eval "use Business::OnlinePayment";
2071 my $bop_config = 'business-onlinepayment';
2072 $bop_config .= '-ach'
2073 if $method eq 'ECHECK' && $conf->exists($bop_config. '-ach');
2074 my ( $processor, $login, $password, $unused_action, @bop_options ) =
2075 $conf->config($bop_config);
2076 #$action ||= 'normal authorization';
2077 pop @bop_options if scalar(@bop_options) % 2 && $bop_options[-1] =~ /^\s*$/;
2078 die "No real-time processor is enabled - ".
2079 "did you set the business-onlinepayment configuration value?\n"
2083 my $amount = $options{'amount'};
2084 my( $pay_processor, $auth, $order_number ) = ( '', '', '' );
2085 if ( $options{'paynum'} ) {
2086 warn "FS::cust_main::realtime_bop: paynum: $options{paynum}\n" if $DEBUG;
2087 $cust_pay = qsearchs('cust_pay', { paynum=>$options{'paynum'} } )
2088 or return "Unknown paynum $options{'paynum'}";
2089 $amount ||= $cust_pay->paid;
2090 $cust_pay->paybatch =~ /^(\w+):(\w*)(:(\w+))?$/
2091 or return "Can't parse paybatch for paynum $options{'paynum'}: ".
2092 $cust_pay->paybatch;
2093 ( $pay_processor, $auth, $order_number ) = ( $1, $2, $4 );
2094 return "processor of payment $options{'paynum'} $pay_processor does not".
2095 " match current processor $processor"
2096 unless $pay_processor eq $processor;
2098 return "neither amount nor paynum specified" unless $amount;
2103 'password' => $password,
2104 'order_number' => $order_number,
2105 'amount' => $amount,
2106 'referer' => 'http://cleanwhisker.420.am/',
2108 $content{authorization} = $auth
2109 if length($auth); #echeck/ACH transactions have an order # but no auth
2110 #(at least with authorize.net)
2112 #first try void if applicable
2113 if ( $cust_pay && $cust_pay->paid == $amount ) { #and check dates?
2114 my $void = new Business::OnlinePayment( $processor, @bop_options );
2115 $void->content( 'action' => 'void', %content );
2117 if ( $void->is_success ) {
2118 my $error = $cust_pay->void($options{'reason'});
2120 # gah, even with transactions.
2121 my $e = 'WARNING: Card/ACH voided but database not updated - '.
2122 "error voiding payment: $error";
2131 my $address = $self->address1;
2132 $address .= ", ". $self->address2 if $self->address2;
2134 my($payname, $payfirst, $paylast);
2135 if ( $self->payname && $method ne 'ECHECK' ) {
2136 $payname = $self->payname;
2137 $payname =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
2138 or return "Illegal payname $payname";
2139 ($payfirst, $paylast) = ($1, $2);
2141 $payfirst = $self->getfield('first');
2142 $paylast = $self->getfield('last');
2143 $payname = "$payfirst $paylast";
2146 if ( $method eq 'CC' ) {
2148 $content{card_number} = $self->payinfo;
2149 $self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
2150 $content{expiration} = "$2/$1";
2152 #$content{cvv2} = $self->paycvv
2153 # if defined $self->dbdef_table->column('paycvv')
2154 # && length($self->paycvv);
2156 #$content{recurring_billing} = 'YES'
2157 # if qsearch('cust_pay', { 'custnum' => $self->custnum,
2158 # 'payby' => 'CARD',
2159 # 'payinfo' => $self->payinfo, } );
2161 } elsif ( $method eq 'ECHECK' ) {
2162 ( $content{account_number}, $content{routing_code} ) =
2163 split('@', $self->payinfo);
2164 $content{bank_name} = $self->payname;
2165 $content{account_type} = 'CHECKING';
2166 $content{account_name} = $payname;
2167 $content{customer_org} = $self->company ? 'B' : 'I';
2168 $content{customer_ssn} = $self->ss;
2169 } elsif ( $method eq 'LEC' ) {
2170 $content{phone} = $self->payinfo;
2174 my $refund = new Business::OnlinePayment( $processor, @bop_options );
2176 'action' => 'credit',
2177 'customer_id' => $self->custnum,
2178 'last_name' => $paylast,
2179 'first_name' => $payfirst,
2181 'address' => $address,
2182 'city' => $self->city,
2183 'state' => $self->state,
2184 'zip' => $self->zip,
2185 'country' => $self->country,
2190 return "$processor error: ". $refund->error_message
2191 unless $refund->is_success();
2193 my %method2payby = (
2199 my $paybatch = "$processor:". $refund->authorization;
2200 $paybatch .= ':'. $refund->order_number
2201 if $refund->can('order_number') && $refund->order_number;
2203 while ( $cust_pay && $cust_pay->unappled < $amount ) {
2204 my @cust_bill_pay = $cust_pay->cust_bill_pay;
2205 last unless @cust_bill_pay;
2206 my $cust_bill_pay = pop @cust_bill_pay;
2207 my $error = $cust_bill_pay->delete;
2211 my $cust_refund = new FS::cust_refund ( {
2212 'custnum' => $self->custnum,
2213 'paynum' => $options{'paynum'},
2214 'refund' => $amount,
2216 'payby' => $method2payby{$method},
2217 'payinfo' => $self->payinfo,
2218 'paybatch' => $paybatch,
2219 'reason' => $options{'reason'} || 'card or ACH refund',
2221 my $error = $cust_refund->insert;
2223 $cust_refund->paynum(''); #try again with no specific paynum
2224 my $error2 = $cust_refund->insert;
2226 # gah, even with transactions.
2227 my $e = 'WARNING: Card/ACH refunded but database not updated - '.
2228 "error inserting refund ($processor): $error2".
2229 " (previously tried insert with paynum #$options{'paynum'}" .
2242 Returns the total owed for this customer on all invoices
2243 (see L<FS::cust_bill/owed>).
2249 $self->total_owed_date(2145859200); #12/31/2037
2252 =item total_owed_date TIME
2254 Returns the total owed for this customer on all invoices with date earlier than
2255 TIME. TIME is specified as a UNIX timestamp; see L<perlfunc/"time">). Also
2256 see L<Time::Local> and L<Date::Parse> for conversion functions.
2260 sub total_owed_date {
2264 foreach my $cust_bill (
2265 grep { $_->_date <= $time }
2266 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
2268 $total_bill += $cust_bill->owed;
2270 sprintf( "%.2f", $total_bill );
2273 =item apply_credits OPTION => VALUE ...
2275 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
2276 to outstanding invoice balances in chronological order (or reverse
2277 chronological order if the I<order> option is set to B<newest>) and returns the
2278 value of any remaining unapplied credits available for refund (see
2279 L<FS::cust_refund>).
2287 return 0 unless $self->total_credited;
2289 my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
2290 qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
2292 my @invoices = $self->open_cust_bill;
2293 @invoices = sort { $b->_date <=> $a->_date } @invoices
2294 if defined($opt{'order'}) && $opt{'order'} eq 'newest';
2297 foreach my $cust_bill ( @invoices ) {
2300 if ( !defined($credit) || $credit->credited == 0) {
2301 $credit = pop @credits or last;
2304 if ($cust_bill->owed >= $credit->credited) {
2305 $amount=$credit->credited;
2307 $amount=$cust_bill->owed;
2310 my $cust_credit_bill = new FS::cust_credit_bill ( {
2311 'crednum' => $credit->crednum,
2312 'invnum' => $cust_bill->invnum,
2313 'amount' => $amount,
2315 my $error = $cust_credit_bill->insert;
2316 die $error if $error;
2318 redo if ($cust_bill->owed > 0);
2322 return $self->total_credited;
2325 =item apply_payments
2327 Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
2328 to outstanding invoice balances in chronological order.
2330 #and returns the value of any remaining unapplied payments.
2334 sub apply_payments {
2339 my @payments = sort { $b->_date <=> $a->_date } ( grep { $_->unapplied > 0 }
2340 qsearch('cust_pay', { 'custnum' => $self->custnum } ) );
2342 my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
2343 qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
2347 foreach my $cust_bill ( @invoices ) {
2350 if ( !defined($payment) || $payment->unapplied == 0 ) {
2351 $payment = pop @payments or last;
2354 if ( $cust_bill->owed >= $payment->unapplied ) {
2355 $amount = $payment->unapplied;
2357 $amount = $cust_bill->owed;
2360 my $cust_bill_pay = new FS::cust_bill_pay ( {
2361 'paynum' => $payment->paynum,
2362 'invnum' => $cust_bill->invnum,
2363 'amount' => $amount,
2365 my $error = $cust_bill_pay->insert;
2366 die $error if $error;
2368 redo if ( $cust_bill->owed > 0);
2372 return $self->total_unapplied_payments;
2375 =item total_credited
2377 Returns the total outstanding credit (see L<FS::cust_credit>) for this
2378 customer. See L<FS::cust_credit/credited>.
2382 sub total_credited {
2384 my $total_credit = 0;
2385 foreach my $cust_credit ( qsearch('cust_credit', {
2386 'custnum' => $self->custnum,
2388 $total_credit += $cust_credit->credited;
2390 sprintf( "%.2f", $total_credit );
2393 =item total_unapplied_payments
2395 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
2396 See L<FS::cust_pay/unapplied>.
2400 sub total_unapplied_payments {
2402 my $total_unapplied = 0;
2403 foreach my $cust_pay ( qsearch('cust_pay', {
2404 'custnum' => $self->custnum,
2406 $total_unapplied += $cust_pay->unapplied;
2408 sprintf( "%.2f", $total_unapplied );
2413 Returns the balance for this customer (total_owed minus total_credited
2414 minus total_unapplied_payments).
2421 $self->total_owed - $self->total_credited - $self->total_unapplied_payments
2425 =item balance_date TIME
2427 Returns the balance for this customer, only considering invoices with date
2428 earlier than TIME (total_owed_date minus total_credited minus
2429 total_unapplied_payments). TIME is specified as a UNIX timestamp; see
2430 L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion
2439 $self->total_owed_date($time)
2440 - $self->total_credited
2441 - $self->total_unapplied_payments
2445 =item paydate_monthyear
2447 Returns a two-element list consisting of the month and year of this customer's
2448 paydate (credit card expiration date for CARD customers)
2452 sub paydate_monthyear {
2454 if ( $self->paydate =~ /^(\d{4})-(\d{1,2})-\d{1,2}$/ ) { #Pg date format
2456 } elsif ( $self->paydate =~ /^(\d{1,2})-(\d{1,2}-)?(\d{4}$)/ ) {
2463 =item payinfo_masked
2465 Returns a "masked" payinfo field with all but the last four characters replaced
2466 by 'x'es. Useful for displaying credit cards.
2470 sub payinfo_masked {
2472 my $payinfo = $self->payinfo;
2473 'x'x(length($payinfo)-4). substr($payinfo,(length($payinfo)-4));
2476 =item invoicing_list [ ARRAYREF ]
2478 If an arguement is given, sets these email addresses as invoice recipients
2479 (see L<FS::cust_main_invoice>). Errors are not fatal and are not reported
2480 (except as warnings), so use check_invoicing_list first.
2482 Returns a list of email addresses (with svcnum entries expanded).
2484 Note: You can clear the invoicing list by passing an empty ARRAYREF. You can
2485 check it without disturbing anything by passing nothing.
2487 This interface may change in the future.
2491 sub invoicing_list {
2492 my( $self, $arrayref ) = @_;
2494 my @cust_main_invoice;
2495 if ( $self->custnum ) {
2496 @cust_main_invoice =
2497 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
2499 @cust_main_invoice = ();
2501 foreach my $cust_main_invoice ( @cust_main_invoice ) {
2502 #warn $cust_main_invoice->destnum;
2503 unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
2504 #warn $cust_main_invoice->destnum;
2505 my $error = $cust_main_invoice->delete;
2506 warn $error if $error;
2509 if ( $self->custnum ) {
2510 @cust_main_invoice =
2511 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
2513 @cust_main_invoice = ();
2515 my %seen = map { $_->address => 1 } @cust_main_invoice;
2516 foreach my $address ( @{$arrayref} ) {
2517 next if exists $seen{$address} && $seen{$address};
2518 $seen{$address} = 1;
2519 my $cust_main_invoice = new FS::cust_main_invoice ( {
2520 'custnum' => $self->custnum,
2523 my $error = $cust_main_invoice->insert;
2524 warn $error if $error;
2527 if ( $self->custnum ) {
2529 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
2535 =item check_invoicing_list ARRAYREF
2537 Checks these arguements as valid input for the invoicing_list method. If there
2538 is an error, returns the error, otherwise returns false.
2542 sub check_invoicing_list {
2543 my( $self, $arrayref ) = @_;
2544 foreach my $address ( @{$arrayref} ) {
2545 my $cust_main_invoice = new FS::cust_main_invoice ( {
2546 'custnum' => $self->custnum,
2549 my $error = $self->custnum
2550 ? $cust_main_invoice->check
2551 : $cust_main_invoice->checkdest
2553 return $error if $error;
2558 =item set_default_invoicing_list
2560 Sets the invoicing list to all accounts associated with this customer,
2561 overwriting any previous invoicing list.
2565 sub set_default_invoicing_list {
2567 $self->invoicing_list($self->all_emails);
2572 Returns the email addresses of all accounts provisioned for this customer.
2579 foreach my $cust_pkg ( $self->all_pkgs ) {
2580 my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
2582 map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
2583 grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
2585 $list{$_}=1 foreach map { $_->email } @svc_acct;
2590 =item invoicing_list_addpost
2592 Adds postal invoicing to this customer. If this customer is already configured
2593 to receive postal invoices, does nothing.
2597 sub invoicing_list_addpost {
2599 return if grep { $_ eq 'POST' } $self->invoicing_list;
2600 my @invoicing_list = $self->invoicing_list;
2601 push @invoicing_list, 'POST';
2602 $self->invoicing_list(\@invoicing_list);
2605 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
2607 Returns an array of customers referred by this customer (referral_custnum set
2608 to this custnum). If DEPTH is given, recurses up to the given depth, returning
2609 customers referred by customers referred by this customer and so on, inclusive.
2610 The default behavior is DEPTH 1 (no recursion).
2614 sub referral_cust_main {
2616 my $depth = @_ ? shift : 1;
2617 my $exclude = @_ ? shift : {};
2620 map { $exclude->{$_->custnum}++; $_; }
2621 grep { ! $exclude->{ $_->custnum } }
2622 qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
2626 map { $_->referral_cust_main($depth-1, $exclude) }
2633 =item referral_cust_main_ncancelled
2635 Same as referral_cust_main, except only returns customers with uncancelled
2640 sub referral_cust_main_ncancelled {
2642 grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
2645 =item referral_cust_pkg [ DEPTH ]
2647 Like referral_cust_main, except returns a flat list of all unsuspended (and
2648 uncancelled) packages for each customer. The number of items in this list may
2649 be useful for comission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
2653 sub referral_cust_pkg {
2655 my $depth = @_ ? shift : 1;
2657 map { $_->unsuspended_pkgs }
2658 grep { $_->unsuspended_pkgs }
2659 $self->referral_cust_main($depth);
2662 =item referring_cust_main
2664 Returns the single cust_main record for the customer who referred this customer
2665 (referral_custnum), or false.
2669 sub referring_cust_main {
2671 return '' unless $self->referral_custnum;
2672 qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
2675 =item credit AMOUNT, REASON
2677 Applies a credit to this customer. If there is an error, returns the error,
2678 otherwise returns false.
2683 my( $self, $amount, $reason ) = @_;
2684 my $cust_credit = new FS::cust_credit {
2685 'custnum' => $self->custnum,
2686 'amount' => $amount,
2687 'reason' => $reason,
2689 $cust_credit->insert;
2692 =item charge AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
2694 Creates a one-time charge for this customer. If there is an error, returns
2695 the error, otherwise returns false.
2700 my ( $self, $amount ) = ( shift, shift );
2701 my $pkg = @_ ? shift : 'One-time charge';
2702 my $comment = @_ ? shift : '$'. sprintf("%.2f",$amount);
2703 my $taxclass = @_ ? shift : '';
2705 local $SIG{HUP} = 'IGNORE';
2706 local $SIG{INT} = 'IGNORE';
2707 local $SIG{QUIT} = 'IGNORE';
2708 local $SIG{TERM} = 'IGNORE';
2709 local $SIG{TSTP} = 'IGNORE';
2710 local $SIG{PIPE} = 'IGNORE';
2712 my $oldAutoCommit = $FS::UID::AutoCommit;
2713 local $FS::UID::AutoCommit = 0;
2716 my $part_pkg = new FS::part_pkg ( {
2718 'comment' => $comment,
2719 #'setup' => $amount,
2722 'plandata' => "setup_fee=$amount",
2725 'taxclass' => $taxclass,
2728 my $error = $part_pkg->insert;
2730 $dbh->rollback if $oldAutoCommit;
2734 my $pkgpart = $part_pkg->pkgpart;
2735 my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
2736 unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
2737 my $type_pkgs = new FS::type_pkgs \%type_pkgs;
2738 $error = $type_pkgs->insert;
2740 $dbh->rollback if $oldAutoCommit;
2745 my $cust_pkg = new FS::cust_pkg ( {
2746 'custnum' => $self->custnum,
2747 'pkgpart' => $pkgpart,
2750 $error = $cust_pkg->insert;
2752 $dbh->rollback if $oldAutoCommit;
2756 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2763 Returns all the invoices (see L<FS::cust_bill>) for this customer.
2769 sort { $a->_date <=> $b->_date }
2770 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
2773 =item open_cust_bill
2775 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
2780 sub open_cust_bill {
2782 grep { $_->owed > 0 } $self->cust_bill;
2787 Returns all the credits (see L<FS::cust_credit>) for this customer.
2793 sort { $a->_date <=> $b->_date }
2794 qsearch( 'cust_credit', { 'custnum' => $self->custnum } )
2799 Returns all the payments (see L<FS::cust_pay>) for this customer.
2805 sort { $a->_date <=> $b->_date }
2806 qsearch( 'cust_pay', { 'custnum' => $self->custnum } )
2811 Returns all voided payments (see L<FS::cust_pay_void>) for this customer.
2817 sort { $a->_date <=> $b->_date }
2818 qsearch( 'cust_pay_void', { 'custnum' => $self->custnum } )
2824 Returns all the refunds (see L<FS::cust_refund>) for this customer.
2830 sort { $a->_date <=> $b->_date }
2831 qsearch( 'cust_refund', { 'custnum' => $self->custnum } )
2834 =item select_for_update
2836 Selects this record with the SQL "FOR UPDATE" command. This can be useful as
2841 sub select_for_update {
2843 qsearch('cust_main', { 'custnum' => $self->custnum }, '*', 'FOR UPDATE' );
2848 Returns a name string for this customer, either "Company (Last, First)" or
2855 my $name = $self->get('last'). ', '. $self->first;
2856 $name = $self->company. " ($name)" if $self->company;
2862 Returns a status string for this customer, currently:
2866 =item prospect - No packages have ever been ordered
2868 =item active - One or more recurring packages is active
2870 =item suspended - All non-cancelled recurring packages are suspended
2872 =item cancelled - All recurring packages are cancelled
2880 for my $status (qw( prospect active suspended cancelled )) {
2881 my $method = $status.'_sql';
2882 my $numnum = ( my $sql = $self->$method() ) =~ s/cust_main\.custnum/?/g;
2883 my $sth = dbh->prepare("SELECT $sql") or die dbh->errstr;
2884 $sth->execute( ($self->custnum) x $numnum ) or die $sth->errstr;
2885 return $status if $sth->fetchrow_arrayref->[0];
2891 Returns a hex triplet color string for this customer's status.
2896 'prospect' => '000000',
2897 'active' => '00CC00',
2898 'suspended' => 'FF9900',
2899 'cancelled' => 'FF0000',
2903 $statuscolor{$self->status};
2908 =head1 CLASS METHODS
2914 Returns an SQL expression identifying prospective cust_main records (customers
2915 with no packages ever ordered)
2919 sub prospect_sql { "
2920 0 = ( SELECT COUNT(*) FROM cust_pkg
2921 WHERE cust_pkg.custnum = cust_main.custnum
2927 Returns an SQL expression identifying active cust_main records.
2932 0 < ( SELECT COUNT(*) FROM cust_pkg
2933 WHERE cust_pkg.custnum = cust_main.custnum
2934 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
2935 AND ( cust_pkg.susp IS NULL OR cust_pkg.susp = 0 )
2942 Returns an SQL expression identifying suspended cust_main records.
2946 sub suspended_sql { susp_sql(@_); }
2948 0 < ( SELECT COUNT(*) FROM cust_pkg
2949 WHERE cust_pkg.custnum = cust_main.custnum
2950 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
2952 AND 0 = ( SELECT COUNT(*) FROM cust_pkg
2953 WHERE cust_pkg.custnum = cust_main.custnum
2954 AND ( cust_pkg.susp IS NULL OR cust_pkg.susp = 0 )
2955 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
2962 Returns an SQL expression identifying cancelled cust_main records.
2966 sub cancelled_sql { cancel_sql(@_); }
2968 0 < ( SELECT COUNT(*) FROM cust_pkg
2969 WHERE cust_pkg.custnum = cust_main.custnum
2971 AND 0 = ( SELECT COUNT(*) FROM cust_pkg
2972 WHERE cust_pkg.custnum = cust_main.custnum
2973 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
2977 =item fuzzy_search FUZZY_HASHREF [ HASHREF, SELECT, EXTRA_SQL, CACHE_OBJ ]
2979 Performs a fuzzy (approximate) search and returns the matching FS::cust_main
2980 records. Currently, only I<last> or I<company> may be specified (the
2981 appropriate ship_ field is also searched if applicable).
2983 Additional options are the same as FS::Record::qsearch
2988 my( $self, $fuzzy, $hash, @opt) = @_;
2993 check_and_rebuild_fuzzyfiles();
2994 foreach my $field ( keys %$fuzzy ) {
2995 my $sub = \&{"all_$field"};
2997 $match{$_}=1 foreach ( amatch($fuzzy->{$field}, ['i'], @{ &$sub() } ) );
2999 foreach ( keys %match ) {
3000 push @cust_main, qsearch('cust_main', { %$hash, $field=>$_}, @opt);
3001 push @cust_main, qsearch('cust_main', { %$hash, "ship_$field"=>$_}, @opt)
3002 if defined dbdef->table('cust_main')->column('ship_last');
3007 @cust_main = grep { !$saw{$_->custnum}++ } @cust_main;
3019 =item smart_search OPTION => VALUE ...
3021 Accepts the following options: I<search>, the string to search for. The string
3022 will be searched for as a customer number, last name or company name, first
3023 searching for an exact match then fuzzy and substring matches.
3025 Any additional options treated as an additional qualifier on the search
3028 Returns a (possibly empty) array of FS::cust_main objects.
3034 my $search = delete $options{'search'};
3037 if ( $search =~ /^\s*(\d+)\s*$/ ) { # customer # search
3039 push @cust_main, qsearch('cust_main', { 'custnum' => $1, %options } );
3041 } elsif ( $search =~ /^\s*(\S.*\S)\s*$/ ) { #value search
3044 my $q_value = dbh->quote($value);
3047 my $sql = scalar(keys %options) ? ' AND ' : ' WHERE ';
3048 $sql .= " ( LOWER(last) = $q_value OR LOWER(company) = $q_value";
3049 $sql .= " OR LOWER(ship_last) = $q_value OR LOWER(ship_company) = $q_value"
3050 if defined dbdef->table('cust_main')->column('ship_last');
3053 push @cust_main, qsearch( 'cust_main', \%options, '', $sql );
3055 unless ( @cust_main ) { #no exact match, trying substring/fuzzy
3057 #still some false laziness w/ search/cust_main.cgi
3060 push @cust_main, qsearch( 'cust_main',
3061 { 'last' => { 'op' => 'ILIKE',
3062 'value' => "%$q_value%" },
3066 push @cust_main, qsearch( 'cust_main',
3067 { 'ship_last' => { 'op' => 'ILIKE',
3068 'value' => "%$q_value%" },
3073 if defined dbdef->table('cust_main')->column('ship_last');
3075 push @cust_main, qsearch( 'cust_main',
3076 { 'company' => { 'op' => 'ILIKE',
3077 'value' => "%$q_value%" },
3081 push @cust_main, qsearch( 'cust_main',
3082 { 'ship_company' => { 'op' => 'ILIKE',
3083 'value' => "%$q_value%" },
3087 if defined dbdef->table('cust_main')->column('ship_last');
3090 push @cust_main, FS::cust_main->fuzzy_search(
3091 { 'last' => $value },
3094 push @cust_main, FS::cust_main->fuzzy_search(
3095 { 'company' => $value },
3107 =item check_and_rebuild_fuzzyfiles
3111 sub check_and_rebuild_fuzzyfiles {
3112 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
3113 -e "$dir/cust_main.last" && -e "$dir/cust_main.company"
3114 or &rebuild_fuzzyfiles;
3117 =item rebuild_fuzzyfiles
3121 sub rebuild_fuzzyfiles {
3123 use Fcntl qw(:flock);
3125 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
3129 open(LASTLOCK,">>$dir/cust_main.last")
3130 or die "can't open $dir/cust_main.last: $!";
3131 flock(LASTLOCK,LOCK_EX)
3132 or die "can't lock $dir/cust_main.last: $!";
3134 my @all_last = map $_->getfield('last'), qsearch('cust_main', {});
3136 grep $_, map $_->getfield('ship_last'), qsearch('cust_main',{})
3137 if defined dbdef->table('cust_main')->column('ship_last');
3139 open (LASTCACHE,">$dir/cust_main.last.tmp")
3140 or die "can't open $dir/cust_main.last.tmp: $!";
3141 print LASTCACHE join("\n", @all_last), "\n";
3142 close LASTCACHE or die "can't close $dir/cust_main.last.tmp: $!";
3144 rename "$dir/cust_main.last.tmp", "$dir/cust_main.last";
3149 open(COMPANYLOCK,">>$dir/cust_main.company")
3150 or die "can't open $dir/cust_main.company: $!";
3151 flock(COMPANYLOCK,LOCK_EX)
3152 or die "can't lock $dir/cust_main.company: $!";
3154 my @all_company = grep $_ ne '', map $_->company, qsearch('cust_main',{});
3156 grep $_ ne '', map $_->ship_company, qsearch('cust_main', {})
3157 if defined dbdef->table('cust_main')->column('ship_last');
3159 open (COMPANYCACHE,">$dir/cust_main.company.tmp")
3160 or die "can't open $dir/cust_main.company.tmp: $!";
3161 print COMPANYCACHE join("\n", @all_company), "\n";
3162 close COMPANYCACHE or die "can't close $dir/cust_main.company.tmp: $!";
3164 rename "$dir/cust_main.company.tmp", "$dir/cust_main.company";
3174 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
3175 open(LASTCACHE,"<$dir/cust_main.last")
3176 or die "can't open $dir/cust_main.last: $!";
3177 my @array = map { chomp; $_; } <LASTCACHE>;
3187 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
3188 open(COMPANYCACHE,"<$dir/cust_main.company")
3189 or die "can't open $dir/cust_main.last: $!";
3190 my @array = map { chomp; $_; } <COMPANYCACHE>;
3195 =item append_fuzzyfiles LASTNAME COMPANY
3199 sub append_fuzzyfiles {
3200 my( $last, $company ) = @_;
3202 &check_and_rebuild_fuzzyfiles;
3204 use Fcntl qw(:flock);
3206 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
3210 open(LAST,">>$dir/cust_main.last")
3211 or die "can't open $dir/cust_main.last: $!";
3213 or die "can't lock $dir/cust_main.last: $!";
3215 print LAST "$last\n";
3218 or die "can't unlock $dir/cust_main.last: $!";
3224 open(COMPANY,">>$dir/cust_main.company")
3225 or die "can't open $dir/cust_main.company: $!";
3226 flock(COMPANY,LOCK_EX)
3227 or die "can't lock $dir/cust_main.company: $!";
3229 print COMPANY "$company\n";
3231 flock(COMPANY,LOCK_UN)
3232 or die "can't unlock $dir/cust_main.company: $!";
3246 #warn join('-',keys %$param);
3247 my $fh = $param->{filehandle};
3248 my $agentnum = $param->{agentnum};
3249 my $refnum = $param->{refnum};
3250 my $pkgpart = $param->{pkgpart};
3251 my @fields = @{$param->{fields}};
3253 eval "use Date::Parse;";
3255 eval "use Text::CSV_XS;";
3258 my $csv = new Text::CSV_XS;
3265 local $SIG{HUP} = 'IGNORE';
3266 local $SIG{INT} = 'IGNORE';
3267 local $SIG{QUIT} = 'IGNORE';
3268 local $SIG{TERM} = 'IGNORE';
3269 local $SIG{TSTP} = 'IGNORE';
3270 local $SIG{PIPE} = 'IGNORE';
3272 my $oldAutoCommit = $FS::UID::AutoCommit;
3273 local $FS::UID::AutoCommit = 0;
3276 #while ( $columns = $csv->getline($fh) ) {
3278 while ( defined($line=<$fh>) ) {
3280 $csv->parse($line) or do {
3281 $dbh->rollback if $oldAutoCommit;
3282 return "can't parse: ". $csv->error_input();
3285 my @columns = $csv->fields();
3286 #warn join('-',@columns);
3289 agentnum => $agentnum,
3291 country => $conf->config('countrydefault') || 'US',
3292 payby => 'BILL', #default
3293 paydate => '12/2037', #default
3295 my $billtime = time;
3296 my %cust_pkg = ( pkgpart => $pkgpart );
3297 foreach my $field ( @fields ) {
3298 if ( $field =~ /^cust_pkg\.(setup|bill|susp|expire|cancel)$/ ) {
3299 #$cust_pkg{$1} = str2time( shift @$columns );
3300 if ( $1 eq 'setup' ) {
3301 $billtime = str2time(shift @columns);
3303 $cust_pkg{$1} = str2time( shift @columns );
3306 #$cust_main{$field} = shift @$columns;
3307 $cust_main{$field} = shift @columns;
3311 my $cust_pkg = new FS::cust_pkg ( \%cust_pkg ) if $pkgpart;
3312 my $cust_main = new FS::cust_main ( \%cust_main );
3314 tie my %hash, 'Tie::RefHash'; #this part is important
3315 $hash{$cust_pkg} = [] if $pkgpart;
3316 my $error = $cust_main->insert( \%hash );
3319 $dbh->rollback if $oldAutoCommit;
3320 return "can't insert customer for $line: $error";
3323 #false laziness w/bill.cgi
3324 $error = $cust_main->bill( 'time' => $billtime );
3326 $dbh->rollback if $oldAutoCommit;
3327 return "can't bill customer for $line: $error";
3330 $cust_main->apply_payments;
3331 $cust_main->apply_credits;
3333 $error = $cust_main->collect();
3335 $dbh->rollback if $oldAutoCommit;
3336 return "can't collect customer for $line: $error";
3342 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3344 return "Empty file!" unless $imported;
3356 #warn join('-',keys %$param);
3357 my $fh = $param->{filehandle};
3358 my @fields = @{$param->{fields}};
3360 eval "use Date::Parse;";
3362 eval "use Text::CSV_XS;";
3365 my $csv = new Text::CSV_XS;
3372 local $SIG{HUP} = 'IGNORE';
3373 local $SIG{INT} = 'IGNORE';
3374 local $SIG{QUIT} = 'IGNORE';
3375 local $SIG{TERM} = 'IGNORE';
3376 local $SIG{TSTP} = 'IGNORE';
3377 local $SIG{PIPE} = 'IGNORE';
3379 my $oldAutoCommit = $FS::UID::AutoCommit;
3380 local $FS::UID::AutoCommit = 0;
3383 #while ( $columns = $csv->getline($fh) ) {
3385 while ( defined($line=<$fh>) ) {
3387 $csv->parse($line) or do {
3388 $dbh->rollback if $oldAutoCommit;
3389 return "can't parse: ". $csv->error_input();
3392 my @columns = $csv->fields();
3393 #warn join('-',@columns);
3396 foreach my $field ( @fields ) {
3397 $row{$field} = shift @columns;
3400 my $cust_main = qsearchs('cust_main', { 'custnum' => $row{'custnum'} } );
3401 unless ( $cust_main ) {
3402 $dbh->rollback if $oldAutoCommit;
3403 return "unknown custnum $row{'custnum'}";
3406 if ( $row{'amount'} > 0 ) {
3407 my $error = $cust_main->charge($row{'amount'}, $row{'pkg'});
3409 $dbh->rollback if $oldAutoCommit;
3413 } elsif ( $row{'amount'} < 0 ) {
3414 my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ),
3417 $dbh->rollback if $oldAutoCommit;
3427 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3429 return "Empty file!" unless $imported;
3441 The delete method should possibly take an FS::cust_main object reference
3442 instead of a scalar customer number.
3444 Bill and collect options should probably be passed as references instead of a
3447 There should probably be a configuration file with a list of allowed credit
3450 No multiple currency support (probably a larger project than just this module).
3452 payinfo_masked false laziness with cust_pay.pm and cust_refund.pm
3456 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
3457 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
3458 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.