4 use vars qw( @ISA $conf $DEBUG $import );
5 use vars qw( $realtime_bop_decline_quiet ); #ugh
9 eval "use Time::Local;";
10 die "Time::Local minimum version 1.05 required with Perl versions before 5.6"
11 if $] < 5.006 && !defined($Time::Local::VERSION);
12 #eval "use Time::Local qw(timelocal timelocal_nocheck);";
13 eval "use Time::Local qw(timelocal_nocheck);";
17 use String::Approx qw(amatch);
18 use Business::CreditCard;
19 use FS::UID qw( getotaker dbh );
20 use FS::Record qw( qsearchs qsearch dbdef );
21 use FS::Misc qw( send_email );
24 use FS::cust_bill_pkg;
26 use FS::cust_pay_void;
29 use FS::part_referral;
30 use FS::cust_main_county;
32 use FS::cust_main_invoice;
33 use FS::cust_credit_bill;
34 use FS::cust_bill_pay;
35 use FS::prepay_credit;
38 use FS::part_bill_event;
39 use FS::cust_bill_event;
40 use FS::cust_tax_exempt;
42 use FS::Msgcat qw(gettext);
44 @ISA = qw( FS::Record );
46 $realtime_bop_decline_quiet = 0;
53 #ask FS::UID to run this stuff for us later
54 #$FS::UID::callback{'FS::cust_main'} = sub {
55 install_callback FS::UID sub {
57 #yes, need it for stuff below (prolly should be cached)
62 my ( $hashref, $cache ) = @_;
63 if ( exists $hashref->{'pkgnum'} ) {
64 # #@{ $self->{'_pkgnum'} } = ();
65 my $subcache = $cache->subcache( 'pkgnum', 'cust_pkg', $hashref->{custnum});
66 $self->{'_pkgnum'} = $subcache;
67 #push @{ $self->{'_pkgnum'} },
68 FS::cust_pkg->new_or_cached($hashref, $subcache) if $hashref->{pkgnum};
74 FS::cust_main - Object methods for cust_main records
80 $record = new FS::cust_main \%hash;
81 $record = new FS::cust_main { 'column' => 'value' };
83 $error = $record->insert;
85 $error = $new_record->replace($old_record);
87 $error = $record->delete;
89 $error = $record->check;
91 @cust_pkg = $record->all_pkgs;
93 @cust_pkg = $record->ncancelled_pkgs;
95 @cust_pkg = $record->suspended_pkgs;
97 $error = $record->bill;
98 $error = $record->bill %options;
99 $error = $record->bill 'time' => $time;
101 $error = $record->collect;
102 $error = $record->collect %options;
103 $error = $record->collect 'invoice_time' => $time,
104 'batch_card' => 'yes',
105 'report_badcard' => 'yes',
110 An FS::cust_main object represents a customer. FS::cust_main inherits from
111 FS::Record. The following fields are currently supported:
115 =item custnum - primary key (assigned automatically for new customers)
117 =item agentnum - agent (see L<FS::agent>)
119 =item refnum - Advertising source (see L<FS::part_referral>)
125 =item ss - social security number (optional)
127 =item company - (optional)
131 =item address2 - (optional)
135 =item county - (optional, see L<FS::cust_main_county>)
137 =item state - (see L<FS::cust_main_county>)
141 =item country - (see L<FS::cust_main_county>)
143 =item daytime - phone (optional)
145 =item night - phone (optional)
147 =item fax - phone (optional)
149 =item ship_first - name
151 =item ship_last - name
153 =item ship_company - (optional)
157 =item ship_address2 - (optional)
161 =item ship_county - (optional, see L<FS::cust_main_county>)
163 =item ship_state - (see L<FS::cust_main_county>)
167 =item ship_country - (see L<FS::cust_main_county>)
169 =item ship_daytime - phone (optional)
171 =item ship_night - phone (optional)
173 =item ship_fax - phone (optional)
175 =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>)
177 =item payinfo - card number, P.O., comp issuer (4-8 lowercase alphanumerics; think username) or prepayment identifier (see L<FS::prepay_credit>)
179 =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
181 =item paydate - expiration date, mm/yyyy, m/yyyy, mm/yy or m/yy
183 =item payname - name on card or billing name
185 =item tax - tax exempt, empty or `Y'
187 =item otaker - order taker (assigned automatically, see L<FS::UID>)
189 =item comments - comments (optional)
191 =item referral_custnum - referring customer number
201 Creates a new customer. To add the customer to the database, see L<"insert">.
203 Note that this stores the hash reference, not a distinct copy of the hash it
204 points to. You can ask the object for a copy with the I<hash> method.
208 sub table { 'cust_main'; }
210 =item insert [ CUST_PKG_HASHREF [ , INVOICING_LIST_ARYREF ] [ , OPTION => VALUE ... ] ]
212 Adds this customer to the database. If there is an error, returns the error,
213 otherwise returns false.
215 CUST_PKG_HASHREF: If you pass a Tie::RefHash data structure to the insert
216 method containing FS::cust_pkg and FS::svc_I<tablename> objects, all records
217 are inserted atomicly, or the transaction is rolled back. Passing an empty
218 hash reference is equivalent to not supplying this parameter. There should be
219 a better explanation of this, 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 to set an
234 invoicing_list destination to the newly-created svc_acct. Here's an example:
236 $cust_main->insert( {}, [ $email, 'POST' ] );
238 Currently available options are: I<depend_jobnum> and I<noexport>.
240 If I<depend_jobnum> is set, all provisioning jobs will have a dependancy
241 on the supplied jobnum (they will not run until the specific job completes).
242 This can be used to defer provisioning until some action completes (such
243 as running the customer's credit card sucessfully).
245 The I<noexport> option is deprecated. If I<noexport> is set true, no
246 provisioning jobs (exports) are scheduled. (You can schedule them later with
247 the B<reexport> method.)
253 my $cust_pkgs = @_ ? shift : {};
254 my $invoicing_list = @_ ? shift : '';
256 warn "FS::cust_main::insert called with options ".
257 join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
260 local $SIG{HUP} = 'IGNORE';
261 local $SIG{INT} = 'IGNORE';
262 local $SIG{QUIT} = 'IGNORE';
263 local $SIG{TERM} = 'IGNORE';
264 local $SIG{TSTP} = 'IGNORE';
265 local $SIG{PIPE} = 'IGNORE';
267 my $oldAutoCommit = $FS::UID::AutoCommit;
268 local $FS::UID::AutoCommit = 0;
273 if ( $self->payby eq 'PREPAY' ) {
274 $self->payby('BILL');
275 my $prepay_credit = qsearchs(
277 { 'identifier' => $self->payinfo },
281 warn "WARNING: can't find pre-found prepay_credit: ". $self->payinfo
282 unless $prepay_credit;
283 $amount = $prepay_credit->amount;
284 $seconds = $prepay_credit->seconds;
285 my $error = $prepay_credit->delete;
287 $dbh->rollback if $oldAutoCommit;
288 return "removing prepay_credit (transaction rolled back): $error";
292 my $error = $self->SUPER::insert;
294 $dbh->rollback if $oldAutoCommit;
295 #return "inserting cust_main record (transaction rolled back): $error";
300 if ( $invoicing_list ) {
301 $error = $self->check_invoicing_list( $invoicing_list );
303 $dbh->rollback if $oldAutoCommit;
304 return "checking invoicing_list (transaction rolled back): $error";
306 $self->invoicing_list( $invoicing_list );
310 $error = $self->order_pkgs($cust_pkgs, \$seconds, %options);
312 $dbh->rollback if $oldAutoCommit;
317 $dbh->rollback if $oldAutoCommit;
318 return "No svc_acct record to apply pre-paid time";
322 my $cust_credit = new FS::cust_credit {
323 'custnum' => $self->custnum,
326 $error = $cust_credit->insert;
328 $dbh->rollback if $oldAutoCommit;
329 return "inserting credit (transaction rolled back): $error";
333 $error = $self->queue_fuzzyfiles_update;
335 $dbh->rollback if $oldAutoCommit;
336 return "updating fuzzy search cache: $error";
339 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
344 =item order_pkgs HASHREF, [ SECONDSREF, [ , OPTION => VALUE ... ] ]
346 Like the insert method on an existing record, this method orders a package
347 and included services atomicaly. Pass a Tie::RefHash data structure to this
348 method containing FS::cust_pkg and FS::svc_I<tablename> objects. There should
349 be a better explanation of this, but until then, here's an example:
352 tie %hash, 'Tie::RefHash'; #this part is important
354 $cust_pkg => [ $svc_acct ],
357 $cust_main->order_pkgs( \%hash, \'0', 'noexport'=>1 );
359 Currently available options are: I<depend_jobnum> and I<noexport>.
361 If I<depend_jobnum> is set, all provisioning jobs will have a dependancy
362 on the supplied jobnum (they will not run until the specific job completes).
363 This can be used to defer provisioning until some action completes (such
364 as running the customer's credit card sucessfully).
366 The I<noexport> option is deprecated. If I<noexport> is set true, no
367 provisioning jobs (exports) are scheduled. (You can schedule them later with
368 the B<reexport> method for each cust_pkg object. Using the B<reexport> method
369 on the cust_main object is not recommended, as existing services will also be
376 my $cust_pkgs = shift;
379 my %svc_options = ();
380 $svc_options{'depend_jobnum'} = $options{'depend_jobnum'}
381 if exists $options{'depend_jobnum'};
382 warn "FS::cust_main::order_pkgs called with options ".
383 join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
386 local $SIG{HUP} = 'IGNORE';
387 local $SIG{INT} = 'IGNORE';
388 local $SIG{QUIT} = 'IGNORE';
389 local $SIG{TERM} = 'IGNORE';
390 local $SIG{TSTP} = 'IGNORE';
391 local $SIG{PIPE} = 'IGNORE';
393 my $oldAutoCommit = $FS::UID::AutoCommit;
394 local $FS::UID::AutoCommit = 0;
397 local $FS::svc_Common::noexport_hack = 1 if $options{'noexport'};
399 foreach my $cust_pkg ( keys %$cust_pkgs ) {
400 $cust_pkg->custnum( $self->custnum );
401 my $error = $cust_pkg->insert;
403 $dbh->rollback if $oldAutoCommit;
404 return "inserting cust_pkg (transaction rolled back): $error";
406 foreach my $svc_something ( @{$cust_pkgs->{$cust_pkg}} ) {
407 $svc_something->pkgnum( $cust_pkg->pkgnum );
408 if ( $seconds && $$seconds && $svc_something->isa('FS::svc_acct') ) {
409 $svc_something->seconds( $svc_something->seconds + $$seconds );
412 $error = $svc_something->insert(%svc_options);
414 $dbh->rollback if $oldAutoCommit;
415 #return "inserting svc_ (transaction rolled back): $error";
421 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
427 This method is deprecated. See the I<depend_jobnum> option to the insert and
428 order_pkgs methods for a better way to defer provisioning.
430 Re-schedules all exports by calling the B<reexport> method of all associated
431 packages (see L<FS::cust_pkg>). If there is an error, returns the error;
432 otherwise returns false.
439 carp "warning: FS::cust_main::reexport is deprectated; ".
440 "use the depend_jobnum option to insert or order_pkgs to delay export";
442 local $SIG{HUP} = 'IGNORE';
443 local $SIG{INT} = 'IGNORE';
444 local $SIG{QUIT} = 'IGNORE';
445 local $SIG{TERM} = 'IGNORE';
446 local $SIG{TSTP} = 'IGNORE';
447 local $SIG{PIPE} = 'IGNORE';
449 my $oldAutoCommit = $FS::UID::AutoCommit;
450 local $FS::UID::AutoCommit = 0;
453 foreach my $cust_pkg ( $self->ncancelled_pkgs ) {
454 my $error = $cust_pkg->reexport;
456 $dbh->rollback if $oldAutoCommit;
461 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
466 =item delete NEW_CUSTNUM
468 This deletes the customer. If there is an error, returns the error, otherwise
471 This will completely remove all traces of the customer record. This is not
472 what you want when a customer cancels service; for that, cancel all of the
473 customer's packages (see L</cancel>).
475 If the customer has any uncancelled packages, you need to pass a new (valid)
476 customer number for those packages to be transferred to. Cancelled packages
477 will be deleted. Did I mention that this is NOT what you want when a customer
478 cancels service and that you really should be looking see L<FS::cust_pkg/cancel>?
480 You can't delete a customer with invoices (see L<FS::cust_bill>),
481 or credits (see L<FS::cust_credit>), payments (see L<FS::cust_pay>) or
482 refunds (see L<FS::cust_refund>).
489 local $SIG{HUP} = 'IGNORE';
490 local $SIG{INT} = 'IGNORE';
491 local $SIG{QUIT} = 'IGNORE';
492 local $SIG{TERM} = 'IGNORE';
493 local $SIG{TSTP} = 'IGNORE';
494 local $SIG{PIPE} = 'IGNORE';
496 my $oldAutoCommit = $FS::UID::AutoCommit;
497 local $FS::UID::AutoCommit = 0;
500 if ( $self->cust_bill ) {
501 $dbh->rollback if $oldAutoCommit;
502 return "Can't delete a customer with invoices";
504 if ( $self->cust_credit ) {
505 $dbh->rollback if $oldAutoCommit;
506 return "Can't delete a customer with credits";
508 if ( $self->cust_pay ) {
509 $dbh->rollback if $oldAutoCommit;
510 return "Can't delete a customer with payments";
512 if ( $self->cust_refund ) {
513 $dbh->rollback if $oldAutoCommit;
514 return "Can't delete a customer with refunds";
517 my @cust_pkg = $self->ncancelled_pkgs;
519 my $new_custnum = shift;
520 unless ( qsearchs( 'cust_main', { 'custnum' => $new_custnum } ) ) {
521 $dbh->rollback if $oldAutoCommit;
522 return "Invalid new customer number: $new_custnum";
524 foreach my $cust_pkg ( @cust_pkg ) {
525 my %hash = $cust_pkg->hash;
526 $hash{'custnum'} = $new_custnum;
527 my $new_cust_pkg = new FS::cust_pkg ( \%hash );
528 my $error = $new_cust_pkg->replace($cust_pkg);
530 $dbh->rollback if $oldAutoCommit;
535 my @cancelled_cust_pkg = $self->all_pkgs;
536 foreach my $cust_pkg ( @cancelled_cust_pkg ) {
537 my $error = $cust_pkg->delete;
539 $dbh->rollback if $oldAutoCommit;
544 foreach my $cust_main_invoice ( #(email invoice destinations, not invoices)
545 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } )
547 my $error = $cust_main_invoice->delete;
549 $dbh->rollback if $oldAutoCommit;
554 my $error = $self->SUPER::delete;
556 $dbh->rollback if $oldAutoCommit;
560 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
565 =item replace OLD_RECORD [ INVOICING_LIST_ARYREF ]
567 Replaces the OLD_RECORD with this one in the database. If there is an error,
568 returns the error, otherwise returns false.
570 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
571 be set as the invoicing list (see L<"invoicing_list">). Errors return as
572 expected and rollback the entire transaction; it is not necessary to call
573 check_invoicing_list first. Here's an example:
575 $new_cust_main->replace( $old_cust_main, [ $email, 'POST' ] );
584 local $SIG{HUP} = 'IGNORE';
585 local $SIG{INT} = 'IGNORE';
586 local $SIG{QUIT} = 'IGNORE';
587 local $SIG{TERM} = 'IGNORE';
588 local $SIG{TSTP} = 'IGNORE';
589 local $SIG{PIPE} = 'IGNORE';
591 if ( $self->payby eq 'COMP' && $self->payby ne $old->payby
592 && $conf->config('users-allow_comp') ) {
593 return "You are not permitted to create complimentary accounts."
594 unless grep { $_ eq getotaker } $conf->config('users-allow_comp');
597 my $oldAutoCommit = $FS::UID::AutoCommit;
598 local $FS::UID::AutoCommit = 0;
601 my $error = $self->SUPER::replace($old);
604 $dbh->rollback if $oldAutoCommit;
608 if ( @param ) { # INVOICING_LIST_ARYREF
609 my $invoicing_list = shift @param;
610 $error = $self->check_invoicing_list( $invoicing_list );
612 $dbh->rollback if $oldAutoCommit;
615 $self->invoicing_list( $invoicing_list );
618 if ( $self->payby =~ /^(CARD|CHEK|LECB)$/ &&
619 grep { $self->get($_) ne $old->get($_) } qw(payinfo paydate payname) ) {
620 # card/check/lec info has changed, want to retry realtime_ invoice events
621 my $error = $self->retry_realtime;
623 $dbh->rollback if $oldAutoCommit;
628 $error = $self->queue_fuzzyfiles_update;
630 $dbh->rollback if $oldAutoCommit;
631 return "updating fuzzy search cache: $error";
634 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
639 =item queue_fuzzyfiles_update
641 Used by insert & replace to update the fuzzy search cache
645 sub queue_fuzzyfiles_update {
648 local $SIG{HUP} = 'IGNORE';
649 local $SIG{INT} = 'IGNORE';
650 local $SIG{QUIT} = 'IGNORE';
651 local $SIG{TERM} = 'IGNORE';
652 local $SIG{TSTP} = 'IGNORE';
653 local $SIG{PIPE} = 'IGNORE';
655 my $oldAutoCommit = $FS::UID::AutoCommit;
656 local $FS::UID::AutoCommit = 0;
659 my $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
660 my $error = $queue->insert($self->getfield('last'), $self->company);
662 $dbh->rollback if $oldAutoCommit;
663 return "queueing job (transaction rolled back): $error";
666 if ( defined $self->dbdef_table->column('ship_last') && $self->ship_last ) {
667 $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
668 $error = $queue->insert($self->getfield('ship_last'), $self->ship_company);
670 $dbh->rollback if $oldAutoCommit;
671 return "queueing job (transaction rolled back): $error";
675 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
682 Checks all fields to make sure this is a valid customer record. If there is
683 an error, returns the error, otherwise returns false. Called by the insert
691 #warn "BEFORE: \n". $self->_dump;
694 $self->ut_numbern('custnum')
695 || $self->ut_number('agentnum')
696 || $self->ut_number('refnum')
697 || $self->ut_name('last')
698 || $self->ut_name('first')
699 || $self->ut_textn('company')
700 || $self->ut_text('address1')
701 || $self->ut_textn('address2')
702 || $self->ut_text('city')
703 || $self->ut_textn('county')
704 || $self->ut_textn('state')
705 || $self->ut_country('country')
706 || $self->ut_anything('comments')
707 || $self->ut_numbern('referral_custnum')
709 #barf. need message catalogs. i18n. etc.
710 $error .= "Please select an advertising source."
711 if $error =~ /^Illegal or empty \(numeric\) refnum: /;
712 return $error if $error;
714 return "Unknown agent"
715 unless qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
717 return "Unknown refnum"
718 unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } );
720 return "Unknown referring custnum ". $self->referral_custnum
721 unless ! $self->referral_custnum
722 || qsearchs( 'cust_main', { 'custnum' => $self->referral_custnum } );
724 if ( $self->ss eq '' ) {
729 $ss =~ /^(\d{3})(\d{2})(\d{4})$/
730 or return "Illegal social security number: ". $self->ss;
731 $self->ss("$1-$2-$3");
735 # bad idea to disable, causes billing to fail because of no tax rates later
736 # unless ( $import ) {
737 unless ( qsearch('cust_main_county', {
738 'country' => $self->country,
741 return "Unknown state/county/country: ".
742 $self->state. "/". $self->county. "/". $self->country
743 unless qsearch('cust_main_county',{
744 'state' => $self->state,
745 'county' => $self->county,
746 'country' => $self->country,
752 $self->ut_phonen('daytime', $self->country)
753 || $self->ut_phonen('night', $self->country)
754 || $self->ut_phonen('fax', $self->country)
755 || $self->ut_zip('zip', $self->country)
757 return $error if $error;
760 last first company address1 address2 city county state zip
761 country daytime night fax
764 if ( defined $self->dbdef_table->column('ship_last') ) {
765 if ( scalar ( grep { $self->getfield($_) ne $self->getfield("ship_$_") }
767 && scalar ( grep { $self->getfield("ship_$_") ne '' } @addfields )
771 $self->ut_name('ship_last')
772 || $self->ut_name('ship_first')
773 || $self->ut_textn('ship_company')
774 || $self->ut_text('ship_address1')
775 || $self->ut_textn('ship_address2')
776 || $self->ut_text('ship_city')
777 || $self->ut_textn('ship_county')
778 || $self->ut_textn('ship_state')
779 || $self->ut_country('ship_country')
781 return $error if $error;
783 #false laziness with above
784 unless ( qsearchs('cust_main_county', {
785 'country' => $self->ship_country,
788 return "Unknown ship_state/ship_county/ship_country: ".
789 $self->ship_state. "/". $self->ship_county. "/". $self->ship_country
790 unless qsearchs('cust_main_county',{
791 'state' => $self->ship_state,
792 'county' => $self->ship_county,
793 'country' => $self->ship_country,
799 $self->ut_phonen('ship_daytime', $self->ship_country)
800 || $self->ut_phonen('ship_night', $self->ship_country)
801 || $self->ut_phonen('ship_fax', $self->ship_country)
802 || $self->ut_zip('ship_zip', $self->ship_country)
804 return $error if $error;
806 } else { # ship_ info eq billing info, so don't store dup info in database
807 $self->setfield("ship_$_", '')
808 foreach qw( last first company address1 address2 city county state zip
809 country daytime night fax );
813 $self->payby =~ /^(CARD|DCRD|CHEK|DCHK|LECB|BILL|COMP|PREPAY)$/
814 or return "Illegal payby: ". $self->payby;
817 if ( $self->payby eq 'CARD' || $self->payby eq 'DCRD' ) {
819 my $payinfo = $self->payinfo;
821 $payinfo =~ /^(\d{13,16})$/
822 or return gettext('invalid_card'); # . ": ". $self->payinfo;
824 $self->payinfo($payinfo);
826 or return gettext('invalid_card'); # . ": ". $self->payinfo;
827 return gettext('unknown_card_type')
828 if cardtype($self->payinfo) eq "Unknown";
829 if ( defined $self->dbdef_table->column('paycvv') ) {
830 if ( length($self->paycvv) ) {
831 if ( cardtype($self->payinfo) eq 'American Express card' ) {
832 $self->paycvv =~ /^(\d{4})$/
833 or return "CVV2 (CID) for American Express cards is four digits.";
836 $self->paycvv =~ /^(\d{3})$/
837 or return "CVV2 (CVC2/CID) is three digits.";
845 } elsif ( $self->payby eq 'CHEK' || $self->payby eq 'DCHK' ) {
847 my $payinfo = $self->payinfo;
848 $payinfo =~ s/[^\d\@]//g;
849 $payinfo =~ /^(\d+)\@(\d{9})$/ or return 'invalid echeck account@aba';
851 $self->payinfo($payinfo);
852 $self->paycvv('') if $self->dbdef_table->column('paycvv');
854 } elsif ( $self->payby eq 'LECB' ) {
856 my $payinfo = $self->payinfo;
858 $payinfo =~ /^1?(\d{10})$/ or return 'invalid btn billing telephone number';
860 $self->payinfo($payinfo);
861 $self->paycvv('') if $self->dbdef_table->column('paycvv');
863 } elsif ( $self->payby eq 'BILL' ) {
865 $error = $self->ut_textn('payinfo');
866 return "Illegal P.O. number: ". $self->payinfo if $error;
867 $self->paycvv('') if $self->dbdef_table->column('paycvv');
869 } elsif ( $self->payby eq 'COMP' ) {
871 if ( !$self->custnum && $conf->config('users-allow_comp') ) {
872 return "You are not permitted to create complimentary accounts."
873 unless grep { $_ eq getotaker } $conf->config('users-allow_comp');
876 $error = $self->ut_textn('payinfo');
877 return "Illegal comp account issuer: ". $self->payinfo if $error;
878 $self->paycvv('') if $self->dbdef_table->column('paycvv');
880 } elsif ( $self->payby eq 'PREPAY' ) {
882 my $payinfo = $self->payinfo;
883 $payinfo =~ s/\W//g; #anything else would just confuse things
884 $self->payinfo($payinfo);
885 $error = $self->ut_alpha('payinfo');
886 return "Illegal prepayment identifier: ". $self->payinfo if $error;
887 return "Unknown prepayment identifier"
888 unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } );
889 $self->paycvv('') if $self->dbdef_table->column('paycvv');
893 if ( $self->paydate eq '' || $self->paydate eq '-' ) {
894 return "Expriation date required"
895 unless $self->payby =~ /^(BILL|PREPAY|CHEK|LECB)$/;
899 if ( $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/ ) {
900 ( $m, $y ) = ( $1, length($2) == 4 ? $2 : "20$2" );
901 } elsif ( $self->paydate =~ /^(20)?(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) {
902 ( $m, $y ) = ( $3, "20$2" );
904 return "Illegal expiration date: ". $self->paydate;
906 $self->paydate("$y-$m-01");
907 my($nowm,$nowy)=(localtime(time))[4,5]; $nowm++; $nowy+=1900;
908 return gettext('expired_card')
909 if !$import && ( $y<$nowy || ( $y==$nowy && $1<$nowm ) );
912 if ( $self->payname eq '' && $self->payby !~ /^(CHEK|DCHK)$/ &&
913 ( ! $conf->exists('require_cardname')
914 || $self->payby !~ /^(CARD|DCRD)$/ )
916 $self->payname( $self->first. " ". $self->getfield('last') );
918 $self->payname =~ /^([\w \,\.\-\']+)$/
919 or return gettext('illegal_name'). " payname: ". $self->payname;
923 $self->tax =~ /^(Y?)$/ or return "Illegal tax: ". $self->tax;
926 $self->otaker(getotaker) unless $self->otaker;
928 #warn "AFTER: \n". $self->_dump;
935 Returns all packages (see L<FS::cust_pkg>) for this customer.
941 if ( $self->{'_pkgnum'} ) {
942 values %{ $self->{'_pkgnum'}->cache };
944 qsearch( 'cust_pkg', { 'custnum' => $self->custnum });
948 =item ncancelled_pkgs
950 Returns all non-cancelled packages (see L<FS::cust_pkg>) for this customer.
954 sub ncancelled_pkgs {
956 if ( $self->{'_pkgnum'} ) {
957 grep { ! $_->getfield('cancel') } values %{ $self->{'_pkgnum'}->cache };
959 @{ [ # force list context
960 qsearch( 'cust_pkg', {
961 'custnum' => $self->custnum,
964 qsearch( 'cust_pkg', {
965 'custnum' => $self->custnum,
974 Returns all suspended packages (see L<FS::cust_pkg>) for this customer.
980 grep { $_->susp } $self->ncancelled_pkgs;
983 =item unflagged_suspended_pkgs
985 Returns all unflagged suspended packages (see L<FS::cust_pkg>) for this
986 customer (thouse packages without the `manual_flag' set).
990 sub unflagged_suspended_pkgs {
992 return $self->suspended_pkgs
993 unless dbdef->table('cust_pkg')->column('manual_flag');
994 grep { ! $_->manual_flag } $self->suspended_pkgs;
997 =item unsuspended_pkgs
999 Returns all unsuspended (and uncancelled) packages (see L<FS::cust_pkg>) for
1004 sub unsuspended_pkgs {
1006 grep { ! $_->susp } $self->ncancelled_pkgs;
1011 Unsuspends all unflagged suspended packages (see L</unflagged_suspended_pkgs>
1012 and L<FS::cust_pkg>) for this customer. Always returns a list: an empty list
1013 on success or a list of errors.
1019 grep { $_->unsuspend } $self->suspended_pkgs;
1024 Suspends all unsuspended packages (see L<FS::cust_pkg>) for this customer.
1025 Always returns a list: an empty list on success or a list of errors.
1031 grep { $_->suspend } $self->unsuspended_pkgs;
1034 =item suspend_if_pkgpart PKGPART [ , PKGPART ... ]
1036 Suspends all unsuspended packages (see L<FS::cust_pkg>) matching the listed
1037 PKGPARTs (see L<FS::part_pkg>). Always returns a list: an empty list on
1038 success or a list of errors.
1042 sub suspend_if_pkgpart {
1045 grep { $_->suspend }
1046 grep { my $pkgpart = $_->pkgpart; grep { $pkgpart eq $_ } @pkgparts }
1047 $self->unsuspended_pkgs;
1050 =item suspend_unless_pkgpart PKGPART [ , PKGPART ... ]
1052 Suspends all unsuspended packages (see L<FS::cust_pkg>) unless they match the
1053 listed PKGPARTs (see L<FS::part_pkg>). Always returns a list: an empty list
1054 on success or a list of errors.
1058 sub suspend_unless_pkgpart {
1061 grep { $_->suspend }
1062 grep { my $pkgpart = $_->pkgpart; ! grep { $pkgpart eq $_ } @pkgparts }
1063 $self->unsuspended_pkgs;
1066 =item cancel [ OPTION => VALUE ... ]
1068 Cancels all uncancelled packages (see L<FS::cust_pkg>) for this customer.
1070 Available options are: I<quiet>
1072 I<quiet> can be set true to supress email cancellation notices.
1074 Always returns a list: an empty list on success or a list of errors.
1080 grep { $_ } map { $_->cancel(@_) } $self->ncancelled_pkgs;
1085 Returns the agent (see L<FS::agent>) for this customer.
1091 qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
1096 Generates invoices (see L<FS::cust_bill>) for this customer. Usually used in
1097 conjunction with the collect method.
1099 Options are passed as name-value pairs.
1101 Currently available options are:
1103 resetup - if set true, re-charges setup fees.
1105 time - bills the customer as if it were that time. Specified as a UNIX
1106 timestamp; see L<perlfunc/"time">). Also see L<Time::Local> and
1107 L<Date::Parse> for conversion functions. For example:
1111 $cust_main->bill( 'time' => str2time('April 20th, 2001') );
1114 If there is an error, returns the error, otherwise returns false.
1119 my( $self, %options ) = @_;
1120 return '' if $self->payby eq 'COMP';
1121 warn "bill customer ". $self->custnum if $DEBUG;
1123 my $time = $options{'time'} || time;
1128 local $SIG{HUP} = 'IGNORE';
1129 local $SIG{INT} = 'IGNORE';
1130 local $SIG{QUIT} = 'IGNORE';
1131 local $SIG{TERM} = 'IGNORE';
1132 local $SIG{TSTP} = 'IGNORE';
1133 local $SIG{PIPE} = 'IGNORE';
1135 my $oldAutoCommit = $FS::UID::AutoCommit;
1136 local $FS::UID::AutoCommit = 0;
1139 $self->select_for_update; #mutex
1141 # find the packages which are due for billing, find out how much they are
1142 # & generate invoice database.
1144 my( $total_setup, $total_recur ) = ( 0, 0 );
1145 #my( $taxable_setup, $taxable_recur ) = ( 0, 0 );
1146 my @cust_bill_pkg = ();
1148 #my $taxable_charged = 0;##
1153 foreach my $cust_pkg (
1154 qsearch('cust_pkg', { 'custnum' => $self->custnum } )
1157 #NO!! next if $cust_pkg->cancel;
1158 next if $cust_pkg->getfield('cancel');
1160 warn " bill package ". $cust_pkg->pkgnum if $DEBUG;
1162 #? to avoid use of uninitialized value errors... ?
1163 $cust_pkg->setfield('bill', '')
1164 unless defined($cust_pkg->bill);
1166 my $part_pkg = $cust_pkg->part_pkg;
1168 my %hash = $cust_pkg->hash;
1169 my $old_cust_pkg = new FS::cust_pkg \%hash;
1175 if ( !$cust_pkg->setup || $options{'resetup'} ) {
1177 warn " bill setup" if $DEBUG;
1179 $setup = eval { $cust_pkg->calc_setup( $time ) };
1181 $dbh->rollback if $oldAutoCommit;
1185 $cust_pkg->setfield('setup', $time) unless $cust_pkg->setup;
1191 if ( $part_pkg->getfield('freq') ne '0' &&
1192 ! $cust_pkg->getfield('susp') &&
1193 ( $cust_pkg->getfield('bill') || 0 ) <= $time
1196 warn " bill recur" if $DEBUG;
1198 # XXX shared with $recur_prog
1199 $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
1201 $recur = eval { $cust_pkg->calc_recur( \$sdate, \@details ) };
1203 $dbh->rollback if $oldAutoCommit;
1207 #change this bit to use Date::Manip? CAREFUL with timezones (see
1208 # mailing list archive)
1209 my ($sec,$min,$hour,$mday,$mon,$year) =
1210 (localtime($sdate) )[0,1,2,3,4,5];
1212 #pro-rating magic - if $recur_prog fiddles $sdate, want to use that
1213 # only for figuring next bill date, nothing else, so, reset $sdate again
1215 $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
1216 $cust_pkg->last_bill($sdate)
1217 if $cust_pkg->dbdef_table->column('last_bill');
1219 if ( $part_pkg->freq =~ /^\d+$/ ) {
1220 $mon += $part_pkg->freq;
1221 until ( $mon < 12 ) { $mon -= 12; $year++; }
1222 } elsif ( $part_pkg->freq =~ /^(\d+)w$/ ) {
1224 $mday += $weeks * 7;
1225 } elsif ( $part_pkg->freq =~ /^(\d+)d$/ ) {
1229 $dbh->rollback if $oldAutoCommit;
1230 return "unparsable frequency: ". $part_pkg->freq;
1232 $cust_pkg->setfield('bill',
1233 timelocal_nocheck($sec,$min,$hour,$mday,$mon,$year));
1236 warn "\$setup is undefined" unless defined($setup);
1237 warn "\$recur is undefined" unless defined($recur);
1238 warn "\$cust_pkg->bill is undefined" unless defined($cust_pkg->bill);
1240 if ( $cust_pkg->modified ) {
1242 warn " package ". $cust_pkg->pkgnum. " modified; updating\n" if $DEBUG;
1244 $error=$cust_pkg->replace($old_cust_pkg);
1245 if ( $error ) { #just in case
1246 $dbh->rollback if $oldAutoCommit;
1247 return "Error modifying pkgnum ". $cust_pkg->pkgnum. ": $error";
1250 $setup = sprintf( "%.2f", $setup );
1251 $recur = sprintf( "%.2f", $recur );
1252 if ( $setup < 0 && ! $conf->exists('allow_negative_charges') ) {
1253 $dbh->rollback if $oldAutoCommit;
1254 return "negative setup $setup for pkgnum ". $cust_pkg->pkgnum;
1256 if ( $recur < 0 && ! $conf->exists('allow_negative_charges') ) {
1257 $dbh->rollback if $oldAutoCommit;
1258 return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum;
1260 if ( $setup != 0 || $recur != 0 ) {
1261 warn " charges (setup=$setup, recur=$recur); queueing line items\n"
1263 my $cust_bill_pkg = new FS::cust_bill_pkg ({
1264 'pkgnum' => $cust_pkg->pkgnum,
1268 'edate' => $cust_pkg->bill,
1269 'details' => \@details,
1271 push @cust_bill_pkg, $cust_bill_pkg;
1272 $total_setup += $setup;
1273 $total_recur += $recur;
1275 unless ( $self->tax =~ /Y/i || $self->payby eq 'COMP' ) {
1277 my @taxes = qsearch( 'cust_main_county', {
1278 'state' => $self->state,
1279 'county' => $self->county,
1280 'country' => $self->country,
1281 'taxclass' => $part_pkg->taxclass,
1284 @taxes = qsearch( 'cust_main_county', {
1285 'state' => $self->state,
1286 'county' => $self->county,
1287 'country' => $self->country,
1292 #one more try at a whole-country tax rate
1294 @taxes = qsearch( 'cust_main_county', {
1297 'country' => $self->country,
1302 # maybe eliminate this entirely, along with all the 0% records
1304 $dbh->rollback if $oldAutoCommit;
1306 "fatal: can't find tax rate for state/county/country/taxclass ".
1307 join('/', ( map $self->$_(), qw(state county country) ),
1308 $part_pkg->taxclass ). "\n";
1311 foreach my $tax ( @taxes ) {
1313 my $taxable_charged = 0;
1314 $taxable_charged += $setup
1315 unless $part_pkg->setuptax =~ /^Y$/i
1316 || $tax->setuptax =~ /^Y$/i;
1317 $taxable_charged += $recur
1318 unless $part_pkg->recurtax =~ /^Y$/i
1319 || $tax->recurtax =~ /^Y$/i;
1320 next unless $taxable_charged;
1322 if ( $tax->exempt_amount > 0 ) {
1323 my ($mon,$year) = (localtime($sdate) )[4,5];
1325 my $freq = $part_pkg->freq || 1;
1326 if ( $freq !~ /(\d+)$/ ) {
1327 $dbh->rollback if $oldAutoCommit;
1328 return "daily/weekly package definitions not (yet?)".
1329 " compatible with monthly tax exemptions";
1331 my $taxable_per_month = sprintf("%.2f", $taxable_charged / $freq );
1332 foreach my $which_month ( 1 .. $freq ) {
1334 'custnum' => $self->custnum,
1335 'taxnum' => $tax->taxnum,
1336 'year' => 1900+$year,
1339 #until ( $mon < 12 ) { $mon -= 12; $year++; }
1340 until ( $mon < 13 ) { $mon -= 12; $year++; }
1341 my $cust_tax_exempt =
1342 qsearchs('cust_tax_exempt', \%hash)
1343 || new FS::cust_tax_exempt( { %hash, 'amount' => 0 } );
1344 my $remaining_exemption = sprintf("%.2f",
1345 $tax->exempt_amount - $cust_tax_exempt->amount );
1346 if ( $remaining_exemption > 0 ) {
1347 my $addl = $remaining_exemption > $taxable_per_month
1348 ? $taxable_per_month
1349 : $remaining_exemption;
1350 $taxable_charged -= $addl;
1351 my $new_cust_tax_exempt = new FS::cust_tax_exempt ( {
1352 $cust_tax_exempt->hash,
1354 sprintf("%.2f", $cust_tax_exempt->amount + $addl),
1356 $error = $new_cust_tax_exempt->exemptnum
1357 ? $new_cust_tax_exempt->replace($cust_tax_exempt)
1358 : $new_cust_tax_exempt->insert;
1360 $dbh->rollback if $oldAutoCommit;
1361 return "fatal: can't update cust_tax_exempt: $error";
1364 } # if $remaining_exemption > 0
1366 } #foreach $which_month
1368 } #if $tax->exempt_amount
1370 $taxable_charged = sprintf( "%.2f", $taxable_charged);
1372 #$tax += $taxable_charged * $cust_main_county->tax / 100
1373 $tax{ $tax->taxname || 'Tax' } +=
1374 $taxable_charged * $tax->tax / 100
1376 } #foreach my $tax ( @taxes )
1378 } #unless $self->tax =~ /Y/i || $self->payby eq 'COMP'
1380 } #if $setup != 0 || $recur != 0
1382 } #if $cust_pkg->modified
1384 } #foreach my $cust_pkg
1386 my $charged = sprintf( "%.2f", $total_setup + $total_recur );
1387 # my $taxable_charged = sprintf( "%.2f", $taxable_setup + $taxable_recur );
1389 unless ( @cust_bill_pkg ) { #don't create invoices with no line items
1390 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1394 # unless ( $self->tax =~ /Y/i
1395 # || $self->payby eq 'COMP'
1396 # || $taxable_charged == 0 ) {
1397 # my $cust_main_county = qsearchs('cust_main_county',{
1398 # 'state' => $self->state,
1399 # 'county' => $self->county,
1400 # 'country' => $self->country,
1401 # } ) or die "fatal: can't find tax rate for state/county/country ".
1402 # $self->state. "/". $self->county. "/". $self->country. "\n";
1403 # my $tax = sprintf( "%.2f",
1404 # $taxable_charged * ( $cust_main_county->getfield('tax') / 100 )
1407 if ( dbdef->table('cust_bill_pkg')->column('itemdesc') ) { #1.5 schema
1409 foreach my $taxname ( grep { $tax{$_} > 0 } keys %tax ) {
1410 my $tax = sprintf("%.2f", $tax{$taxname} );
1411 $charged = sprintf( "%.2f", $charged+$tax );
1413 my $cust_bill_pkg = new FS::cust_bill_pkg ({
1419 'itemdesc' => $taxname,
1421 push @cust_bill_pkg, $cust_bill_pkg;
1424 } else { #1.4 schema
1427 foreach ( values %tax ) { $tax += $_ };
1428 $tax = sprintf("%.2f", $tax);
1430 $charged = sprintf( "%.2f", $charged+$tax );
1432 my $cust_bill_pkg = new FS::cust_bill_pkg ({
1439 push @cust_bill_pkg, $cust_bill_pkg;
1444 my $cust_bill = new FS::cust_bill ( {
1445 'custnum' => $self->custnum,
1447 'charged' => $charged,
1449 $error = $cust_bill->insert;
1451 $dbh->rollback if $oldAutoCommit;
1452 return "can't create invoice for customer #". $self->custnum. ": $error";
1455 my $invnum = $cust_bill->invnum;
1457 foreach $cust_bill_pkg ( @cust_bill_pkg ) {
1459 $cust_bill_pkg->invnum($invnum);
1460 $error = $cust_bill_pkg->insert;
1462 $dbh->rollback if $oldAutoCommit;
1463 return "can't create invoice line item for customer #". $self->custnum.
1468 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1472 =item collect OPTIONS
1474 (Attempt to) collect money for this customer's outstanding invoices (see
1475 L<FS::cust_bill>). Usually used after the bill method.
1477 Depending on the value of `payby', this may print or email an invoice (I<BILL>,
1478 I<DCRD>, or I<DCHK>), charge a credit card (I<CARD>), charge via electronic
1479 check/ACH (I<CHEK>), or just add any necessary (pseudo-)payment (I<COMP>).
1481 Most actions are now triggered by invoice events; see L<FS::part_bill_event>
1482 and the invoice events web interface.
1484 If there is an error, returns the error, otherwise returns false.
1486 Options are passed as name-value pairs.
1488 Currently available options are:
1490 invoice_time - Use this time when deciding when to print invoices and
1491 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>
1492 for conversion functions.
1494 retry - Retry card/echeck/LEC transactions even when not scheduled by invoice
1497 retry_card - Deprecated alias for 'retry'
1499 batch_card - This option is deprecated. See the invoice events web interface
1500 to control whether cards are batched or run against a realtime gateway.
1502 report_badcard - This option is deprecated.
1504 force_print - This option is deprecated; see the invoice events web interface.
1506 quiet - set true to surpress email card/ACH decline notices.
1511 my( $self, %options ) = @_;
1512 my $invoice_time = $options{'invoice_time'} || time;
1515 local $SIG{HUP} = 'IGNORE';
1516 local $SIG{INT} = 'IGNORE';
1517 local $SIG{QUIT} = 'IGNORE';
1518 local $SIG{TERM} = 'IGNORE';
1519 local $SIG{TSTP} = 'IGNORE';
1520 local $SIG{PIPE} = 'IGNORE';
1522 my $oldAutoCommit = $FS::UID::AutoCommit;
1523 local $FS::UID::AutoCommit = 0;
1526 $self->select_for_update; #mutex
1528 my $balance = $self->balance;
1529 warn "collect customer ". $self->custnum. ": balance $balance" if $DEBUG;
1530 unless ( $balance > 0 ) { #redundant?????
1531 $dbh->rollback if $oldAutoCommit; #hmm
1535 if ( exists($options{'retry_card'}) ) {
1536 carp 'retry_card option passed to collect is deprecated; use retry';
1537 $options{'retry'} ||= $options{'retry_card'};
1539 if ( exists($options{'retry'}) && $options{'retry'} ) {
1540 my $error = $self->retry_realtime;
1542 $dbh->rollback if $oldAutoCommit;
1547 foreach my $cust_bill ( $self->open_cust_bill ) {
1549 # don't try to charge for the same invoice if it's already in a batch
1550 #next if qsearchs( 'cust_pay_batch', { 'invnum' => $cust_bill->invnum } );
1552 last if $self->balance <= 0;
1554 warn "invnum ". $cust_bill->invnum. " (owed ". $cust_bill->owed. ")"
1557 foreach my $part_bill_event (
1558 sort { $a->seconds <=> $b->seconds
1559 || $a->weight <=> $b->weight
1560 || $a->eventpart <=> $b->eventpart }
1561 grep { $_->seconds <= ( $invoice_time - $cust_bill->_date )
1562 && ! qsearch( 'cust_bill_event', {
1563 'invnum' => $cust_bill->invnum,
1564 'eventpart' => $_->eventpart,
1568 qsearch('part_bill_event', { 'payby' => $self->payby,
1569 'disabled' => '', } )
1572 last if $cust_bill->owed <= 0 # don't run subsequent events if owed<=0
1573 || $self->balance <= 0; # or if balance<=0
1575 warn "calling invoice event (". $part_bill_event->eventcode. ")\n"
1577 my $cust_main = $self; #for callback
1581 local $realtime_bop_decline_quiet = 1 if $options{'quiet'};
1582 $error = eval $part_bill_event->eventcode;
1586 my $statustext = '';
1590 } elsif ( $error ) {
1592 $statustext = $error;
1597 #add cust_bill_event
1598 my $cust_bill_event = new FS::cust_bill_event {
1599 'invnum' => $cust_bill->invnum,
1600 'eventpart' => $part_bill_event->eventpart,
1601 #'_date' => $invoice_time,
1603 'status' => $status,
1604 'statustext' => $statustext,
1606 $error = $cust_bill_event->insert;
1608 #$dbh->rollback if $oldAutoCommit;
1609 #return "error: $error";
1611 # gah, even with transactions.
1612 $dbh->commit if $oldAutoCommit; #well.
1613 my $e = 'WARNING: Event run but database not updated - '.
1614 'error inserting cust_bill_event, invnum #'. $cust_bill->invnum.
1615 ', eventpart '. $part_bill_event->eventpart.
1626 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1631 =item retry_realtime
1633 Schedules realtime credit card / electronic check / LEC billing events for
1634 for retry. Useful if card information has changed or manual retry is desired.
1635 The 'collect' method must be called to actually retry the transaction.
1637 Implementation details: For each of this customer's open invoices, changes
1638 the status of the first "done" (with statustext error) realtime processing
1643 sub retry_realtime {
1646 local $SIG{HUP} = 'IGNORE';
1647 local $SIG{INT} = 'IGNORE';
1648 local $SIG{QUIT} = 'IGNORE';
1649 local $SIG{TERM} = 'IGNORE';
1650 local $SIG{TSTP} = 'IGNORE';
1651 local $SIG{PIPE} = 'IGNORE';
1653 my $oldAutoCommit = $FS::UID::AutoCommit;
1654 local $FS::UID::AutoCommit = 0;
1657 foreach my $cust_bill (
1658 grep { $_->cust_bill_event }
1659 $self->open_cust_bill
1661 my @cust_bill_event =
1662 sort { $a->part_bill_event->seconds <=> $b->part_bill_event->seconds }
1664 #$_->part_bill_event->plan eq 'realtime-card'
1665 $_->part_bill_event->eventcode =~
1666 /\$cust_bill\->realtime_(card|ach|lec)/
1667 && $_->status eq 'done'
1670 $cust_bill->cust_bill_event;
1671 next unless @cust_bill_event;
1672 my $error = $cust_bill_event[0]->retry;
1674 $dbh->rollback if $oldAutoCommit;
1675 return "error scheduling invoice event for retry: $error";
1680 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1685 =item realtime_bop METHOD AMOUNT [ OPTION => VALUE ... ]
1687 Runs a realtime credit card, ACH (electronic check) or phone bill transaction
1688 via a Business::OnlinePayment realtime gateway. See
1689 L<http://420.am/business-onlinepayment> for supported gateways.
1691 Available methods are: I<CC>, I<ECHECK> and I<LEC>
1693 Available options are: I<description>, I<invnum>, I<quiet>
1695 The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
1696 I<zip>, I<payinfo> and I<paydate> are also available. Any of these options,
1697 if set, will override the value from the customer record.
1699 I<description> is a free-text field passed to the gateway. It defaults to
1700 "Internet services".
1702 If an I<invnum> is specified, this payment (if sucessful) is applied to the
1703 specified invoice. If you don't specify an I<invnum> you might want to
1704 call the B<apply_payments> method.
1706 I<quiet> can be set true to surpress email decline notices.
1708 (moved from cust_bill) (probably should get realtime_{card,ach,lec} here too)
1713 my( $self, $method, $amount, %options ) = @_;
1715 warn "$self $method $amount\n";
1716 warn " $_ => $options{$_}\n" foreach keys %options;
1719 $options{'description'} ||= 'Internet services';
1722 die "Real-time processing not enabled\n"
1723 unless $conf->exists('business-onlinepayment');
1724 eval "use Business::OnlinePayment";
1728 my $bop_config = 'business-onlinepayment';
1729 $bop_config .= '-ach'
1730 if $method eq 'ECHECK' && $conf->exists($bop_config. '-ach');
1731 my ( $processor, $login, $password, $action, @bop_options ) =
1732 $conf->config($bop_config);
1733 $action ||= 'normal authorization';
1734 pop @bop_options if scalar(@bop_options) % 2 && $bop_options[-1] =~ /^\s*$/;
1735 die "No real-time processor is enabled - ".
1736 "did you set the business-onlinepayment configuration value?\n"
1741 my $address = exists($options{'address1'})
1742 ? $options{'address1'}
1744 my $address2 = exists($options{'address2'})
1745 ? $options{'address2'}
1747 $address .= ", ". $address2 if length($address2);
1749 my $o_payname = exists($options{'payname'})
1750 ? $options{'payname'}
1752 my($payname, $payfirst, $paylast);
1753 if ( $o_payname && $method ne 'ECHECK' ) {
1754 ($payname = $o_payname) =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
1755 or return "Illegal payname $payname";
1756 ($payfirst, $paylast) = ($1, $2);
1758 $payfirst = $self->getfield('first');
1759 $paylast = $self->getfield('last');
1760 $payname = "$payfirst $paylast";
1763 my @invoicing_list = grep { $_ ne 'POST' } $self->invoicing_list;
1764 if ( $conf->exists('emailinvoiceauto')
1765 || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
1766 push @invoicing_list, $self->all_emails;
1768 my $email = $invoicing_list[0];
1770 my $payinfo = exists($options{'payinfo'})
1771 ? $options{'payinfo'}
1775 if ( $method eq 'CC' ) {
1777 $content{card_number} = $payinfo;
1778 my $paydate = exists($options{'paydate'})
1779 ? $options{'paydate'}
1781 $paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
1782 $content{expiration} = "$2/$1";
1784 if ( defined $self->dbdef_table->column('paycvv') ) {
1785 my $paycvv = exists($options{'paycvv'})
1786 ? $options{'paycvv'}
1788 $content{cvv2} = $self->paycvv
1792 $content{recurring_billing} = 'YES'
1793 if qsearch('cust_pay', { 'custnum' => $self->custnum,
1795 'payinfo' => $payinfo,
1798 } elsif ( $method eq 'ECHECK' ) {
1799 ( $content{account_number}, $content{routing_code} ) =
1800 split('@', $payinfo);
1801 $content{bank_name} = $o_payname;
1802 $content{account_type} = 'CHECKING';
1803 $content{account_name} = $payname;
1804 $content{customer_org} = $self->company ? 'B' : 'I';
1805 $content{customer_ssn} = exists($options{'ss'})
1808 } elsif ( $method eq 'LEC' ) {
1809 $content{phone} = $payinfo;
1814 my( $action1, $action2 ) = split(/\s*\,\s*/, $action );
1816 my $transaction = new Business::OnlinePayment( $processor, @bop_options );
1817 $transaction->content(
1820 'password' => $password,
1821 'action' => $action1,
1822 'description' => $options{'description'},
1823 'amount' => $amount,
1824 'invoice_number' => $options{'invnum'},
1825 'customer_id' => $self->custnum,
1826 'last_name' => $paylast,
1827 'first_name' => $payfirst,
1829 'address' => $address,
1830 'city' => ( exists($options{'city'})
1833 'state' => ( exists($options{'state'})
1836 'zip' => ( exists($options{'zip'})
1839 'country' => ( exists($options{'country'})
1840 ? $options{'country'}
1842 'referer' => 'http://cleanwhisker.420.am/',
1844 'phone' => $self->daytime || $self->night,
1847 $transaction->submit();
1849 if ( $transaction->is_success() && $action2 ) {
1850 my $auth = $transaction->authorization;
1851 my $ordernum = $transaction->can('order_number')
1852 ? $transaction->order_number
1856 new Business::OnlinePayment( $processor, @bop_options );
1863 password => $password,
1864 order_number => $ordernum,
1866 authorization => $auth,
1867 description => $options{'description'},
1870 foreach my $field (qw( authorization_source_code returned_ACI transaction_identifier validation_code
1871 transaction_sequence_num local_transaction_date
1872 local_transaction_time AVS_result_code )) {
1873 $capture{$field} = $transaction->$field() if $transaction->can($field);
1876 $capture->content( %capture );
1880 unless ( $capture->is_success ) {
1881 my $e = "Authorization sucessful but capture failed, custnum #".
1882 $self->custnum. ': '. $capture->result_code.
1883 ": ". $capture->error_message;
1890 #remove paycvv after initial transaction
1891 #false laziness w/misc/process/payment.cgi - check both to make sure working
1893 if ( defined $self->dbdef_table->column('paycvv')
1894 && length($self->paycvv)
1895 && ! grep { $_ eq cardtype($payinfo) } $conf->config('cvv-save')
1897 my $error = $self->remove_cvv;
1899 warn "error removing cvv: $error\n";
1904 if ( $transaction->is_success() ) {
1906 my %method2payby = (
1912 my $paybatch = "$processor:". $transaction->authorization;
1913 $paybatch .= ':'. $transaction->order_number
1914 if $transaction->can('order_number')
1915 && length($transaction->order_number);
1917 my $cust_pay = new FS::cust_pay ( {
1918 'custnum' => $self->custnum,
1919 'invnum' => $options{'invnum'},
1922 'payby' => $method2payby{$method},
1923 'payinfo' => $payinfo,
1924 'paybatch' => $paybatch,
1926 my $error = $cust_pay->insert;
1928 $cust_pay->invnum(''); #try again with no specific invnum
1929 my $error2 = $cust_pay->insert;
1931 # gah, even with transactions.
1932 my $e = 'WARNING: Card/ACH debited but database not updated - '.
1933 "error inserting payment ($processor): $error2".
1934 " (previously tried insert with invnum #$options{'invnum'}" .
1940 return ''; #no error
1944 my $perror = "$processor error: ". $transaction->error_message;
1946 if ( !$options{'quiet'} && !$realtime_bop_decline_quiet
1947 && $conf->exists('emaildecline')
1948 && grep { $_ ne 'POST' } $self->invoicing_list
1949 && ! grep { $transaction->error_message =~ /$_/ }
1950 $conf->config('emaildecline-exclude')
1952 my @templ = $conf->config('declinetemplate');
1953 my $template = new Text::Template (
1955 SOURCE => [ map "$_\n", @templ ],
1956 ) or return "($perror) can't create template: $Text::Template::ERROR";
1957 $template->compile()
1958 or return "($perror) can't compile template: $Text::Template::ERROR";
1960 my $templ_hash = { error => $transaction->error_message };
1962 my $error = send_email(
1963 'from' => $conf->config('invoice_from'),
1964 'to' => [ grep { $_ ne 'POST' } $self->invoicing_list ],
1965 'subject' => 'Your payment could not be processed',
1966 'body' => [ $template->fill_in(HASH => $templ_hash) ],
1969 $perror .= " (also received error sending decline notification: $error)"
1981 Removes the I<paycvv> field from the database directly.
1983 If there is an error, returns the error, otherwise returns false.
1989 my $sth = dbh->prepare("UPDATE cust_main SET paycvv = '' WHERE custnum = ?")
1990 or return dbh->errstr;
1991 $sth->execute($self->custnum)
1992 or return $sth->errstr;
1997 =item realtime_refund_bop METHOD [ OPTION => VALUE ... ]
1999 Refunds a realtime credit card, ACH (electronic check) or phone bill transaction
2000 via a Business::OnlinePayment realtime gateway. See
2001 L<http://420.am/business-onlinepayment> for supported gateways.
2003 Available methods are: I<CC>, I<ECHECK> and I<LEC>
2005 Available options are: I<amount>, I<reason>, I<paynum>
2007 Most gateways require a reference to an original payment transaction to refund,
2008 so you probably need to specify a I<paynum>.
2010 I<amount> defaults to the original amount of the payment if not specified.
2012 I<reason> specifies a reason for the refund.
2014 Implementation note: If I<amount> is unspecified or equal to the amount of the
2015 orignal payment, first an attempt is made to "void" the transaction via
2016 the gateway (to cancel a not-yet settled transaction) and then if that fails,
2017 the normal attempt is made to "refund" ("credit") the transaction via the
2018 gateway is attempted.
2020 #The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
2021 #I<zip>, I<payinfo> and I<paydate> are also available. Any of these options,
2022 #if set, will override the value from the customer record.
2024 #If an I<invnum> is specified, this payment (if sucessful) is applied to the
2025 #specified invoice. If you don't specify an I<invnum> you might want to
2026 #call the B<apply_payments> method.
2030 #some false laziness w/realtime_bop, not enough to make it worth merging
2031 #but some useful small subs should be pulled out
2032 sub realtime_refund_bop {
2033 my( $self, $method, %options ) = @_;
2035 warn "$self $method refund\n";
2036 warn " $_ => $options{$_}\n" foreach keys %options;
2040 die "Real-time processing not enabled\n"
2041 unless $conf->exists('business-onlinepayment');
2042 eval "use Business::OnlinePayment";
2046 my $bop_config = 'business-onlinepayment';
2047 $bop_config .= '-ach'
2048 if $method eq 'ECHECK' && $conf->exists($bop_config. '-ach');
2049 my ( $processor, $login, $password, $unused_action, @bop_options ) =
2050 $conf->config($bop_config);
2051 #$action ||= 'normal authorization';
2052 pop @bop_options if scalar(@bop_options) % 2 && $bop_options[-1] =~ /^\s*$/;
2053 die "No real-time processor is enabled - ".
2054 "did you set the business-onlinepayment configuration value?\n"
2058 my $amount = $options{'amount'};
2059 my( $pay_processor, $auth, $order_number ) = ( '', '', '' );
2060 if ( $options{'paynum'} ) {
2061 warn "FS::cust_main::realtime_bop: paynum: $options{paynum}\n" if $DEBUG;
2062 $cust_pay = qsearchs('cust_pay', { paynum=>$options{'paynum'} } )
2063 or return "Unknown paynum $options{'paynum'}";
2064 $amount ||= $cust_pay->paid;
2065 $cust_pay->paybatch =~ /^(\w+):(\w*)(:(\w+))?$/
2066 or return "Can't parse paybatch for paynum $options{'paynum'}: ".
2067 $cust_pay->paybatch;
2068 ( $pay_processor, $auth, $order_number ) = ( $1, $2, $4 );
2069 return "processor of payment $options{'paynum'} $pay_processor does not".
2070 " match current processor $processor"
2071 unless $pay_processor eq $processor;
2073 return "neither amount nor paynum specified" unless $amount;
2078 'password' => $password,
2079 'order_number' => $order_number,
2080 'amount' => $amount,
2081 'referer' => 'http://cleanwhisker.420.am/',
2083 $content{authorization} = $auth
2084 if length($auth); #echeck/ACH transactions have an order # but no auth
2085 #(at least with authorize.net)
2087 #first try void if applicable
2088 if ( $cust_pay && $cust_pay->paid == $amount ) { #and check dates?
2089 my $void = new Business::OnlinePayment( $processor, @bop_options );
2090 $void->content( 'action' => 'void', %content );
2092 if ( $void->is_success ) {
2093 my $error = $cust_pay->void($options{'reason'});
2095 # gah, even with transactions.
2096 my $e = 'WARNING: Card/ACH voided but database not updated - '.
2097 "error voiding payment: $error";
2106 my $address = $self->address1;
2107 $address .= ", ". $self->address2 if $self->address2;
2109 my($payname, $payfirst, $paylast);
2110 if ( $self->payname && $method ne 'ECHECK' ) {
2111 $payname = $self->payname;
2112 $payname =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
2113 or return "Illegal payname $payname";
2114 ($payfirst, $paylast) = ($1, $2);
2116 $payfirst = $self->getfield('first');
2117 $paylast = $self->getfield('last');
2118 $payname = "$payfirst $paylast";
2121 if ( $method eq 'CC' ) {
2123 $content{card_number} = $self->payinfo;
2124 $self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
2125 $content{expiration} = "$2/$1";
2127 #$content{cvv2} = $self->paycvv
2128 # if defined $self->dbdef_table->column('paycvv')
2129 # && length($self->paycvv);
2131 #$content{recurring_billing} = 'YES'
2132 # if qsearch('cust_pay', { 'custnum' => $self->custnum,
2133 # 'payby' => 'CARD',
2134 # 'payinfo' => $self->payinfo, } );
2136 } elsif ( $method eq 'ECHECK' ) {
2137 ( $content{account_number}, $content{routing_code} ) =
2138 split('@', $self->payinfo);
2139 $content{bank_name} = $self->payname;
2140 $content{account_type} = 'CHECKING';
2141 $content{account_name} = $payname;
2142 $content{customer_org} = $self->company ? 'B' : 'I';
2143 $content{customer_ssn} = $self->ss;
2144 } elsif ( $method eq 'LEC' ) {
2145 $content{phone} = $self->payinfo;
2149 my $refund = new Business::OnlinePayment( $processor, @bop_options );
2151 'action' => 'credit',
2152 'customer_id' => $self->custnum,
2153 'last_name' => $paylast,
2154 'first_name' => $payfirst,
2156 'address' => $address,
2157 'city' => $self->city,
2158 'state' => $self->state,
2159 'zip' => $self->zip,
2160 'country' => $self->country,
2165 return "$processor error: ". $refund->error_message
2166 unless $refund->is_success();
2168 my %method2payby = (
2174 my $paybatch = "$processor:". $refund->authorization;
2175 $paybatch .= ':'. $refund->order_number
2176 if $refund->can('order_number') && $refund->order_number;
2178 while ( $cust_pay && $cust_pay->unappled < $amount ) {
2179 my @cust_bill_pay = $cust_pay->cust_bill_pay;
2180 last unless @cust_bill_pay;
2181 my $cust_bill_pay = pop @cust_bill_pay;
2182 my $error = $cust_bill_pay->delete;
2186 my $cust_refund = new FS::cust_refund ( {
2187 'custnum' => $self->custnum,
2188 'paynum' => $options{'paynum'},
2189 'refund' => $amount,
2191 'payby' => $method2payby{$method},
2192 'payinfo' => $self->payinfo,
2193 'paybatch' => $paybatch,
2194 'reason' => $options{'reason'} || 'card or ACH refund',
2196 my $error = $cust_refund->insert;
2198 $cust_refund->paynum(''); #try again with no specific paynum
2199 my $error2 = $cust_refund->insert;
2201 # gah, even with transactions.
2202 my $e = 'WARNING: Card/ACH refunded but database not updated - '.
2203 "error inserting refund ($processor): $error2".
2204 " (previously tried insert with paynum #$options{'paynum'}" .
2217 Returns the total owed for this customer on all invoices
2218 (see L<FS::cust_bill/owed>).
2224 $self->total_owed_date(2145859200); #12/31/2037
2227 =item total_owed_date TIME
2229 Returns the total owed for this customer on all invoices with date earlier than
2230 TIME. TIME is specified as a UNIX timestamp; see L<perlfunc/"time">). Also
2231 see L<Time::Local> and L<Date::Parse> for conversion functions.
2235 sub total_owed_date {
2239 foreach my $cust_bill (
2240 grep { $_->_date <= $time }
2241 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
2243 $total_bill += $cust_bill->owed;
2245 sprintf( "%.2f", $total_bill );
2248 =item apply_credits OPTION => VALUE ...
2250 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
2251 to outstanding invoice balances in chronological order (or reverse
2252 chronological order if the I<order> option is set to B<newest>) and returns the
2253 value of any remaining unapplied credits available for refund (see
2254 L<FS::cust_refund>).
2262 return 0 unless $self->total_credited;
2264 my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
2265 qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
2267 my @invoices = $self->open_cust_bill;
2268 @invoices = sort { $b->_date <=> $a->_date } @invoices
2269 if defined($opt{'order'}) && $opt{'order'} eq 'newest';
2272 foreach my $cust_bill ( @invoices ) {
2275 if ( !defined($credit) || $credit->credited == 0) {
2276 $credit = pop @credits or last;
2279 if ($cust_bill->owed >= $credit->credited) {
2280 $amount=$credit->credited;
2282 $amount=$cust_bill->owed;
2285 my $cust_credit_bill = new FS::cust_credit_bill ( {
2286 'crednum' => $credit->crednum,
2287 'invnum' => $cust_bill->invnum,
2288 'amount' => $amount,
2290 my $error = $cust_credit_bill->insert;
2291 die $error if $error;
2293 redo if ($cust_bill->owed > 0);
2297 return $self->total_credited;
2300 =item apply_payments
2302 Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
2303 to outstanding invoice balances in chronological order.
2305 #and returns the value of any remaining unapplied payments.
2309 sub apply_payments {
2314 my @payments = sort { $b->_date <=> $a->_date } ( grep { $_->unapplied > 0 }
2315 qsearch('cust_pay', { 'custnum' => $self->custnum } ) );
2317 my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
2318 qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
2322 foreach my $cust_bill ( @invoices ) {
2325 if ( !defined($payment) || $payment->unapplied == 0 ) {
2326 $payment = pop @payments or last;
2329 if ( $cust_bill->owed >= $payment->unapplied ) {
2330 $amount = $payment->unapplied;
2332 $amount = $cust_bill->owed;
2335 my $cust_bill_pay = new FS::cust_bill_pay ( {
2336 'paynum' => $payment->paynum,
2337 'invnum' => $cust_bill->invnum,
2338 'amount' => $amount,
2340 my $error = $cust_bill_pay->insert;
2341 die $error if $error;
2343 redo if ( $cust_bill->owed > 0);
2347 return $self->total_unapplied_payments;
2350 =item total_credited
2352 Returns the total outstanding credit (see L<FS::cust_credit>) for this
2353 customer. See L<FS::cust_credit/credited>.
2357 sub total_credited {
2359 my $total_credit = 0;
2360 foreach my $cust_credit ( qsearch('cust_credit', {
2361 'custnum' => $self->custnum,
2363 $total_credit += $cust_credit->credited;
2365 sprintf( "%.2f", $total_credit );
2368 =item total_unapplied_payments
2370 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
2371 See L<FS::cust_pay/unapplied>.
2375 sub total_unapplied_payments {
2377 my $total_unapplied = 0;
2378 foreach my $cust_pay ( qsearch('cust_pay', {
2379 'custnum' => $self->custnum,
2381 $total_unapplied += $cust_pay->unapplied;
2383 sprintf( "%.2f", $total_unapplied );
2388 Returns the balance for this customer (total_owed minus total_credited
2389 minus total_unapplied_payments).
2396 $self->total_owed - $self->total_credited - $self->total_unapplied_payments
2400 =item balance_date TIME
2402 Returns the balance for this customer, only considering invoices with date
2403 earlier than TIME (total_owed_date minus total_credited minus
2404 total_unapplied_payments). TIME is specified as a UNIX timestamp; see
2405 L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion
2414 $self->total_owed_date($time)
2415 - $self->total_credited
2416 - $self->total_unapplied_payments
2420 =item paydate_monthyear
2422 Returns a two-element list consisting of the month and year of this customer's
2423 paydate (credit card expiration date for CARD customers)
2427 sub paydate_monthyear {
2429 if ( $self->paydate =~ /^(\d{4})-(\d{1,2})-\d{1,2}$/ ) { #Pg date format
2431 } elsif ( $self->paydate =~ /^(\d{1,2})-(\d{1,2}-)?(\d{4}$)/ ) {
2438 =item payinfo_masked
2440 Returns a "masked" payinfo field with all but the last four characters replaced
2441 by 'x'es. Useful for displaying credit cards.
2445 sub payinfo_masked {
2447 my $payinfo = $self->payinfo;
2448 'x'x(length($payinfo)-4). substr($payinfo,(length($payinfo)-4));
2451 =item invoicing_list [ ARRAYREF ]
2453 If an arguement is given, sets these email addresses as invoice recipients
2454 (see L<FS::cust_main_invoice>). Errors are not fatal and are not reported
2455 (except as warnings), so use check_invoicing_list first.
2457 Returns a list of email addresses (with svcnum entries expanded).
2459 Note: You can clear the invoicing list by passing an empty ARRAYREF. You can
2460 check it without disturbing anything by passing nothing.
2462 This interface may change in the future.
2466 sub invoicing_list {
2467 my( $self, $arrayref ) = @_;
2469 my @cust_main_invoice;
2470 if ( $self->custnum ) {
2471 @cust_main_invoice =
2472 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
2474 @cust_main_invoice = ();
2476 foreach my $cust_main_invoice ( @cust_main_invoice ) {
2477 #warn $cust_main_invoice->destnum;
2478 unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
2479 #warn $cust_main_invoice->destnum;
2480 my $error = $cust_main_invoice->delete;
2481 warn $error if $error;
2484 if ( $self->custnum ) {
2485 @cust_main_invoice =
2486 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
2488 @cust_main_invoice = ();
2490 my %seen = map { $_->address => 1 } @cust_main_invoice;
2491 foreach my $address ( @{$arrayref} ) {
2492 next if exists $seen{$address} && $seen{$address};
2493 $seen{$address} = 1;
2494 my $cust_main_invoice = new FS::cust_main_invoice ( {
2495 'custnum' => $self->custnum,
2498 my $error = $cust_main_invoice->insert;
2499 warn $error if $error;
2502 if ( $self->custnum ) {
2504 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
2510 =item check_invoicing_list ARRAYREF
2512 Checks these arguements as valid input for the invoicing_list method. If there
2513 is an error, returns the error, otherwise returns false.
2517 sub check_invoicing_list {
2518 my( $self, $arrayref ) = @_;
2519 foreach my $address ( @{$arrayref} ) {
2520 my $cust_main_invoice = new FS::cust_main_invoice ( {
2521 'custnum' => $self->custnum,
2524 my $error = $self->custnum
2525 ? $cust_main_invoice->check
2526 : $cust_main_invoice->checkdest
2528 return $error if $error;
2533 =item set_default_invoicing_list
2535 Sets the invoicing list to all accounts associated with this customer,
2536 overwriting any previous invoicing list.
2540 sub set_default_invoicing_list {
2542 $self->invoicing_list($self->all_emails);
2547 Returns the email addresses of all accounts provisioned for this customer.
2554 foreach my $cust_pkg ( $self->all_pkgs ) {
2555 my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
2557 map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
2558 grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
2560 $list{$_}=1 foreach map { $_->email } @svc_acct;
2565 =item invoicing_list_addpost
2567 Adds postal invoicing to this customer. If this customer is already configured
2568 to receive postal invoices, does nothing.
2572 sub invoicing_list_addpost {
2574 return if grep { $_ eq 'POST' } $self->invoicing_list;
2575 my @invoicing_list = $self->invoicing_list;
2576 push @invoicing_list, 'POST';
2577 $self->invoicing_list(\@invoicing_list);
2580 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
2582 Returns an array of customers referred by this customer (referral_custnum set
2583 to this custnum). If DEPTH is given, recurses up to the given depth, returning
2584 customers referred by customers referred by this customer and so on, inclusive.
2585 The default behavior is DEPTH 1 (no recursion).
2589 sub referral_cust_main {
2591 my $depth = @_ ? shift : 1;
2592 my $exclude = @_ ? shift : {};
2595 map { $exclude->{$_->custnum}++; $_; }
2596 grep { ! $exclude->{ $_->custnum } }
2597 qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
2601 map { $_->referral_cust_main($depth-1, $exclude) }
2608 =item referral_cust_main_ncancelled
2610 Same as referral_cust_main, except only returns customers with uncancelled
2615 sub referral_cust_main_ncancelled {
2617 grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
2620 =item referral_cust_pkg [ DEPTH ]
2622 Like referral_cust_main, except returns a flat list of all unsuspended (and
2623 uncancelled) packages for each customer. The number of items in this list may
2624 be useful for comission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
2628 sub referral_cust_pkg {
2630 my $depth = @_ ? shift : 1;
2632 map { $_->unsuspended_pkgs }
2633 grep { $_->unsuspended_pkgs }
2634 $self->referral_cust_main($depth);
2637 =item credit AMOUNT, REASON
2639 Applies a credit to this customer. If there is an error, returns the error,
2640 otherwise returns false.
2645 my( $self, $amount, $reason ) = @_;
2646 my $cust_credit = new FS::cust_credit {
2647 'custnum' => $self->custnum,
2648 'amount' => $amount,
2649 'reason' => $reason,
2651 $cust_credit->insert;
2654 =item charge AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
2656 Creates a one-time charge for this customer. If there is an error, returns
2657 the error, otherwise returns false.
2662 my ( $self, $amount ) = ( shift, shift );
2663 my $pkg = @_ ? shift : 'One-time charge';
2664 my $comment = @_ ? shift : '$'. sprintf("%.2f",$amount);
2665 my $taxclass = @_ ? shift : '';
2667 local $SIG{HUP} = 'IGNORE';
2668 local $SIG{INT} = 'IGNORE';
2669 local $SIG{QUIT} = 'IGNORE';
2670 local $SIG{TERM} = 'IGNORE';
2671 local $SIG{TSTP} = 'IGNORE';
2672 local $SIG{PIPE} = 'IGNORE';
2674 my $oldAutoCommit = $FS::UID::AutoCommit;
2675 local $FS::UID::AutoCommit = 0;
2678 my $part_pkg = new FS::part_pkg ( {
2680 'comment' => $comment,
2681 #'setup' => $amount,
2684 'plandata' => "setup_fee=$amount",
2687 'taxclass' => $taxclass,
2690 my $error = $part_pkg->insert;
2692 $dbh->rollback if $oldAutoCommit;
2696 my $pkgpart = $part_pkg->pkgpart;
2697 my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
2698 unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
2699 my $type_pkgs = new FS::type_pkgs \%type_pkgs;
2700 $error = $type_pkgs->insert;
2702 $dbh->rollback if $oldAutoCommit;
2707 my $cust_pkg = new FS::cust_pkg ( {
2708 'custnum' => $self->custnum,
2709 'pkgpart' => $pkgpart,
2712 $error = $cust_pkg->insert;
2714 $dbh->rollback if $oldAutoCommit;
2718 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2725 Returns all the invoices (see L<FS::cust_bill>) for this customer.
2731 sort { $a->_date <=> $b->_date }
2732 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
2735 =item open_cust_bill
2737 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
2742 sub open_cust_bill {
2744 grep { $_->owed > 0 } $self->cust_bill;
2749 Returns all the credits (see L<FS::cust_credit>) for this customer.
2755 sort { $a->_date <=> $b->_date }
2756 qsearch( 'cust_credit', { 'custnum' => $self->custnum } )
2761 Returns all the payments (see L<FS::cust_pay>) for this customer.
2767 sort { $a->_date <=> $b->_date }
2768 qsearch( 'cust_pay', { 'custnum' => $self->custnum } )
2773 Returns all voided payments (see L<FS::cust_pay_void>) for this customer.
2779 sort { $a->_date <=> $b->_date }
2780 qsearch( 'cust_pay_void', { 'custnum' => $self->custnum } )
2786 Returns all the refunds (see L<FS::cust_refund>) for this customer.
2792 sort { $a->_date <=> $b->_date }
2793 qsearch( 'cust_refund', { 'custnum' => $self->custnum } )
2796 =item select_for_update
2798 Selects this record with the SQL "FOR UPDATE" command. This can be useful as
2803 sub select_for_update {
2805 qsearch('cust_main', { 'custnum' => $self->custnum }, '*', 'FOR UPDATE' );
2810 Returns a name string for this customer, either "Company (Last, First)" or
2817 my $name = $self->get('last'). ', '. $self->first;
2818 $name = $self->company. " ($name)" if $self->company;
2824 Returns a status string for this customer, currently:
2828 =item prospect - No packages have ever been ordered
2830 =item active - One or more recurring packages is active
2832 =item suspended - All non-cancelled recurring packages are suspended
2834 =item cancelled - All recurring packages are cancelled
2842 for my $status (qw( prospect active suspended cancelled )) {
2843 my $method = $status.'_sql';
2844 my $numnum = ( my $sql = $self->$method() ) =~ s/cust_main\.custnum/?/g;
2845 my $sth = dbh->prepare("SELECT $sql") or die dbh->errstr;
2846 $sth->execute( ($self->custnum) x $numnum ) or die $sth->errstr;
2847 return $status if $sth->fetchrow_arrayref->[0];
2853 Returns a hex triplet color string for this customer's status.
2858 'prospect' => '000000',
2859 'active' => '00CC00',
2860 'suspended' => 'FF9900',
2861 'cancelled' => 'FF0000',
2865 $statuscolor{$self->status};
2870 =head1 CLASS METHODS
2876 Returns an SQL expression identifying prospective cust_main records (customers
2877 with no packages ever ordered)
2881 sub prospect_sql { "
2882 0 = ( SELECT COUNT(*) FROM cust_pkg
2883 WHERE cust_pkg.custnum = cust_main.custnum
2889 Returns an SQL expression identifying active cust_main records.
2894 0 < ( SELECT COUNT(*) FROM cust_pkg
2895 WHERE cust_pkg.custnum = cust_main.custnum
2896 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
2897 AND ( cust_pkg.susp IS NULL OR cust_pkg.susp = 0 )
2904 Returns an SQL expression identifying suspended cust_main records.
2908 sub suspended_sql { susp_sql(@_); }
2910 0 < ( SELECT COUNT(*) FROM cust_pkg
2911 WHERE cust_pkg.custnum = cust_main.custnum
2912 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
2914 AND 0 = ( SELECT COUNT(*) FROM cust_pkg
2915 WHERE cust_pkg.custnum = cust_main.custnum
2916 AND ( cust_pkg.susp IS NULL OR cust_pkg.susp = 0 )
2923 Returns an SQL expression identifying cancelled cust_main records.
2927 sub cancelled_sql { cancel_sql(@_); }
2929 0 < ( SELECT COUNT(*) FROM cust_pkg
2930 WHERE cust_pkg.custnum = cust_main.custnum
2932 AND 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 )
2938 =item fuzzy_search FUZZY_HASHREF [ HASHREF, SELECT, EXTRA_SQL, CACHE_OBJ ]
2940 Performs a fuzzy (approximate) search and returns the matching FS::cust_main
2941 records. Currently, only I<last> or I<company> may be specified (the
2942 appropriate ship_ field is also searched if applicable).
2944 Additional options are the same as FS::Record::qsearch
2949 my( $self, $fuzzy, $hash, @opt) = @_;
2954 check_and_rebuild_fuzzyfiles();
2955 foreach my $field ( keys %$fuzzy ) {
2956 my $sub = \&{"all_$field"};
2958 $match{$_}=1 foreach ( amatch($fuzzy->{$field}, ['i'], @{ &$sub() } ) );
2960 foreach ( keys %match ) {
2961 push @cust_main, qsearch('cust_main', { %$hash, $field=>$_}, @opt);
2962 push @cust_main, qsearch('cust_main', { %$hash, "ship_$field"=>$_}, @opt)
2963 if defined dbdef->table('cust_main')->column('ship_last');
2968 @cust_main = grep { !$saw{$_->custnum}++ } @cust_main;
2980 =item check_and_rebuild_fuzzyfiles
2984 sub check_and_rebuild_fuzzyfiles {
2985 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2986 -e "$dir/cust_main.last" && -e "$dir/cust_main.company"
2987 or &rebuild_fuzzyfiles;
2990 =item rebuild_fuzzyfiles
2994 sub rebuild_fuzzyfiles {
2996 use Fcntl qw(:flock);
2998 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
3002 open(LASTLOCK,">>$dir/cust_main.last")
3003 or die "can't open $dir/cust_main.last: $!";
3004 flock(LASTLOCK,LOCK_EX)
3005 or die "can't lock $dir/cust_main.last: $!";
3007 my @all_last = map $_->getfield('last'), qsearch('cust_main', {});
3009 grep $_, map $_->getfield('ship_last'), qsearch('cust_main',{})
3010 if defined dbdef->table('cust_main')->column('ship_last');
3012 open (LASTCACHE,">$dir/cust_main.last.tmp")
3013 or die "can't open $dir/cust_main.last.tmp: $!";
3014 print LASTCACHE join("\n", @all_last), "\n";
3015 close LASTCACHE or die "can't close $dir/cust_main.last.tmp: $!";
3017 rename "$dir/cust_main.last.tmp", "$dir/cust_main.last";
3022 open(COMPANYLOCK,">>$dir/cust_main.company")
3023 or die "can't open $dir/cust_main.company: $!";
3024 flock(COMPANYLOCK,LOCK_EX)
3025 or die "can't lock $dir/cust_main.company: $!";
3027 my @all_company = grep $_ ne '', map $_->company, qsearch('cust_main',{});
3029 grep $_ ne '', map $_->ship_company, qsearch('cust_main', {})
3030 if defined dbdef->table('cust_main')->column('ship_last');
3032 open (COMPANYCACHE,">$dir/cust_main.company.tmp")
3033 or die "can't open $dir/cust_main.company.tmp: $!";
3034 print COMPANYCACHE join("\n", @all_company), "\n";
3035 close COMPANYCACHE or die "can't close $dir/cust_main.company.tmp: $!";
3037 rename "$dir/cust_main.company.tmp", "$dir/cust_main.company";
3047 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
3048 open(LASTCACHE,"<$dir/cust_main.last")
3049 or die "can't open $dir/cust_main.last: $!";
3050 my @array = map { chomp; $_; } <LASTCACHE>;
3060 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
3061 open(COMPANYCACHE,"<$dir/cust_main.company")
3062 or die "can't open $dir/cust_main.last: $!";
3063 my @array = map { chomp; $_; } <COMPANYCACHE>;
3068 =item append_fuzzyfiles LASTNAME COMPANY
3072 sub append_fuzzyfiles {
3073 my( $last, $company ) = @_;
3075 &check_and_rebuild_fuzzyfiles;
3077 use Fcntl qw(:flock);
3079 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
3083 open(LAST,">>$dir/cust_main.last")
3084 or die "can't open $dir/cust_main.last: $!";
3086 or die "can't lock $dir/cust_main.last: $!";
3088 print LAST "$last\n";
3091 or die "can't unlock $dir/cust_main.last: $!";
3097 open(COMPANY,">>$dir/cust_main.company")
3098 or die "can't open $dir/cust_main.company: $!";
3099 flock(COMPANY,LOCK_EX)
3100 or die "can't lock $dir/cust_main.company: $!";
3102 print COMPANY "$company\n";
3104 flock(COMPANY,LOCK_UN)
3105 or die "can't unlock $dir/cust_main.company: $!";
3119 #warn join('-',keys %$param);
3120 my $fh = $param->{filehandle};
3121 my $agentnum = $param->{agentnum};
3122 my $refnum = $param->{refnum};
3123 my $pkgpart = $param->{pkgpart};
3124 my @fields = @{$param->{fields}};
3126 eval "use Date::Parse;";
3128 eval "use Text::CSV_XS;";
3131 my $csv = new Text::CSV_XS;
3138 local $SIG{HUP} = 'IGNORE';
3139 local $SIG{INT} = 'IGNORE';
3140 local $SIG{QUIT} = 'IGNORE';
3141 local $SIG{TERM} = 'IGNORE';
3142 local $SIG{TSTP} = 'IGNORE';
3143 local $SIG{PIPE} = 'IGNORE';
3145 my $oldAutoCommit = $FS::UID::AutoCommit;
3146 local $FS::UID::AutoCommit = 0;
3149 #while ( $columns = $csv->getline($fh) ) {
3151 while ( defined($line=<$fh>) ) {
3153 $csv->parse($line) or do {
3154 $dbh->rollback if $oldAutoCommit;
3155 return "can't parse: ". $csv->error_input();
3158 my @columns = $csv->fields();
3159 #warn join('-',@columns);
3162 agentnum => $agentnum,
3164 country => $conf->config('countrydefault') || 'US',
3165 payby => 'BILL', #default
3166 paydate => '12/2037', #default
3168 my $billtime = time;
3169 my %cust_pkg = ( pkgpart => $pkgpart );
3170 foreach my $field ( @fields ) {
3171 if ( $field =~ /^cust_pkg\.(setup|bill|susp|expire|cancel)$/ ) {
3172 #$cust_pkg{$1} = str2time( shift @$columns );
3173 if ( $1 eq 'setup' ) {
3174 $billtime = str2time(shift @columns);
3176 $cust_pkg{$1} = str2time( shift @columns );
3179 #$cust_main{$field} = shift @$columns;
3180 $cust_main{$field} = shift @columns;
3184 my $cust_pkg = new FS::cust_pkg ( \%cust_pkg ) if $pkgpart;
3185 my $cust_main = new FS::cust_main ( \%cust_main );
3187 tie my %hash, 'Tie::RefHash'; #this part is important
3188 $hash{$cust_pkg} = [] if $pkgpart;
3189 my $error = $cust_main->insert( \%hash );
3192 $dbh->rollback if $oldAutoCommit;
3193 return "can't insert customer for $line: $error";
3196 #false laziness w/bill.cgi
3197 $error = $cust_main->bill( 'time' => $billtime );
3199 $dbh->rollback if $oldAutoCommit;
3200 return "can't bill customer for $line: $error";
3203 $cust_main->apply_payments;
3204 $cust_main->apply_credits;
3206 $error = $cust_main->collect();
3208 $dbh->rollback if $oldAutoCommit;
3209 return "can't collect customer for $line: $error";
3215 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3217 return "Empty file!" unless $imported;
3229 #warn join('-',keys %$param);
3230 my $fh = $param->{filehandle};
3231 my @fields = @{$param->{fields}};
3233 eval "use Date::Parse;";
3235 eval "use Text::CSV_XS;";
3238 my $csv = new Text::CSV_XS;
3245 local $SIG{HUP} = 'IGNORE';
3246 local $SIG{INT} = 'IGNORE';
3247 local $SIG{QUIT} = 'IGNORE';
3248 local $SIG{TERM} = 'IGNORE';
3249 local $SIG{TSTP} = 'IGNORE';
3250 local $SIG{PIPE} = 'IGNORE';
3252 my $oldAutoCommit = $FS::UID::AutoCommit;
3253 local $FS::UID::AutoCommit = 0;
3256 #while ( $columns = $csv->getline($fh) ) {
3258 while ( defined($line=<$fh>) ) {
3260 $csv->parse($line) or do {
3261 $dbh->rollback if $oldAutoCommit;
3262 return "can't parse: ". $csv->error_input();
3265 my @columns = $csv->fields();
3266 #warn join('-',@columns);
3269 foreach my $field ( @fields ) {
3270 $row{$field} = shift @columns;
3273 my $cust_main = qsearchs('cust_main', { 'custnum' => $row{'custnum'} } );
3274 unless ( $cust_main ) {
3275 $dbh->rollback if $oldAutoCommit;
3276 return "unknown custnum $row{'custnum'}";
3279 if ( $row{'amount'} > 0 ) {
3280 my $error = $cust_main->charge($row{'amount'}, $row{'pkg'});
3282 $dbh->rollback if $oldAutoCommit;
3286 } elsif ( $row{'amount'} < 0 ) {
3287 my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ),
3290 $dbh->rollback if $oldAutoCommit;
3300 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3302 return "Empty file!" unless $imported;
3314 The delete method should possibly take an FS::cust_main object reference
3315 instead of a scalar customer number.
3317 Bill and collect options should probably be passed as references instead of a
3320 There should probably be a configuration file with a list of allowed credit
3323 No multiple currency support (probably a larger project than just this module).
3325 payinfo_masked false laziness with cust_pay.pm and cust_refund.pm
3329 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
3330 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
3331 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.