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);";
16 use Business::CreditCard;
17 use FS::UID qw( getotaker dbh );
18 use FS::Record qw( qsearchs qsearch dbdef );
19 use FS::Misc qw( send_email );
22 use FS::cust_bill_pkg;
26 use FS::part_referral;
27 use FS::cust_main_county;
29 use FS::cust_main_invoice;
30 use FS::cust_credit_bill;
31 use FS::cust_bill_pay;
32 use FS::prepay_credit;
35 use FS::part_bill_event;
36 use FS::cust_bill_event;
37 use FS::cust_tax_exempt;
39 use FS::Msgcat qw(gettext);
41 @ISA = qw( FS::Record );
43 $realtime_bop_decline_quiet = 0;
50 #ask FS::UID to run this stuff for us later
51 #$FS::UID::callback{'FS::cust_main'} = sub {
52 install_callback FS::UID sub {
54 #yes, need it for stuff below (prolly should be cached)
59 my ( $hashref, $cache ) = @_;
60 if ( exists $hashref->{'pkgnum'} ) {
61 # #@{ $self->{'_pkgnum'} } = ();
62 my $subcache = $cache->subcache( 'pkgnum', 'cust_pkg', $hashref->{custnum});
63 $self->{'_pkgnum'} = $subcache;
64 #push @{ $self->{'_pkgnum'} },
65 FS::cust_pkg->new_or_cached($hashref, $subcache) if $hashref->{pkgnum};
71 FS::cust_main - Object methods for cust_main records
77 $record = new FS::cust_main \%hash;
78 $record = new FS::cust_main { 'column' => 'value' };
80 $error = $record->insert;
82 $error = $new_record->replace($old_record);
84 $error = $record->delete;
86 $error = $record->check;
88 @cust_pkg = $record->all_pkgs;
90 @cust_pkg = $record->ncancelled_pkgs;
92 @cust_pkg = $record->suspended_pkgs;
94 $error = $record->bill;
95 $error = $record->bill %options;
96 $error = $record->bill 'time' => $time;
98 $error = $record->collect;
99 $error = $record->collect %options;
100 $error = $record->collect 'invoice_time' => $time,
101 'batch_card' => 'yes',
102 'report_badcard' => 'yes',
107 An FS::cust_main object represents a customer. FS::cust_main inherits from
108 FS::Record. The following fields are currently supported:
112 =item custnum - primary key (assigned automatically for new customers)
114 =item agentnum - agent (see L<FS::agent>)
116 =item refnum - Advertising source (see L<FS::part_referral>)
122 =item ss - social security number (optional)
124 =item company - (optional)
128 =item address2 - (optional)
132 =item county - (optional, see L<FS::cust_main_county>)
134 =item state - (see L<FS::cust_main_county>)
138 =item country - (see L<FS::cust_main_county>)
140 =item daytime - phone (optional)
142 =item night - phone (optional)
144 =item fax - phone (optional)
146 =item ship_first - name
148 =item ship_last - name
150 =item ship_company - (optional)
154 =item ship_address2 - (optional)
158 =item ship_county - (optional, see L<FS::cust_main_county>)
160 =item ship_state - (see L<FS::cust_main_county>)
164 =item ship_country - (see L<FS::cust_main_county>)
166 =item ship_daytime - phone (optional)
168 =item ship_night - phone (optional)
170 =item ship_fax - phone (optional)
172 =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>)
174 =item payinfo - card number, P.O., comp issuer (4-8 lowercase alphanumerics; think username) or prepayment identifier (see L<FS::prepay_credit>)
176 =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
178 =item paydate - expiration date, mm/yyyy, m/yyyy, mm/yy or m/yy
180 =item payname - name on card or billing name
182 =item tax - tax exempt, empty or `Y'
184 =item otaker - order taker (assigned automatically, see L<FS::UID>)
186 =item comments - comments (optional)
188 =item referral_custnum - referring customer number
198 Creates a new customer. To add the customer to the database, see L<"insert">.
200 Note that this stores the hash reference, not a distinct copy of the hash it
201 points to. You can ask the object for a copy with the I<hash> method.
205 sub table { 'cust_main'; }
207 =item insert [ CUST_PKG_HASHREF [ , INVOICING_LIST_ARYREF ] [ , OPTION => VALUE ... ] ]
209 Adds this customer to the database. If there is an error, returns the error,
210 otherwise returns false.
212 CUST_PKG_HASHREF: If you pass a Tie::RefHash data structure to the insert
213 method containing FS::cust_pkg and FS::svc_I<tablename> objects, all records
214 are inserted atomicly, or the transaction is rolled back. Passing an empty
215 hash reference is equivalent to not supplying this parameter. There should be
216 a better explanation of this, but until then, here's an example:
219 tie %hash, 'Tie::RefHash'; #this part is important
221 $cust_pkg => [ $svc_acct ],
224 $cust_main->insert( \%hash );
226 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
227 be set as the invoicing list (see L<"invoicing_list">). Errors return as
228 expected and rollback the entire transaction; it is not necessary to call
229 check_invoicing_list first. The invoicing_list is set after the records in the
230 CUST_PKG_HASHREF above are inserted, so it is now possible to set an
231 invoicing_list destination to the newly-created svc_acct. Here's an example:
233 $cust_main->insert( {}, [ $email, 'POST' ] );
235 Currently available options are: I<depend_jobnum> and I<noexport>.
237 If I<depend_jobnum> is set, all provisioning jobs will have a dependancy
238 on the supplied jobnum (they will not run until the specific job completes).
239 This can be used to defer provisioning until some action completes (such
240 as running the customer's credit card sucessfully).
242 The I<noexport> option is deprecated. If I<noexport> is set true, no
243 provisioning jobs (exports) are scheduled. (You can schedule them later with
244 the B<reexport> method.)
250 my $cust_pkgs = @_ ? shift : {};
251 my $invoicing_list = @_ ? shift : '';
253 warn "FS::cust_main::insert called with options ".
254 join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
257 local $SIG{HUP} = 'IGNORE';
258 local $SIG{INT} = 'IGNORE';
259 local $SIG{QUIT} = 'IGNORE';
260 local $SIG{TERM} = 'IGNORE';
261 local $SIG{TSTP} = 'IGNORE';
262 local $SIG{PIPE} = 'IGNORE';
264 my $oldAutoCommit = $FS::UID::AutoCommit;
265 local $FS::UID::AutoCommit = 0;
270 if ( $self->payby eq 'PREPAY' ) {
271 $self->payby('BILL');
272 my $prepay_credit = qsearchs(
274 { 'identifier' => $self->payinfo },
278 warn "WARNING: can't find pre-found prepay_credit: ". $self->payinfo
279 unless $prepay_credit;
280 $amount = $prepay_credit->amount;
281 $seconds = $prepay_credit->seconds;
282 my $error = $prepay_credit->delete;
284 $dbh->rollback if $oldAutoCommit;
285 return "removing prepay_credit (transaction rolled back): $error";
289 my $error = $self->SUPER::insert;
291 $dbh->rollback if $oldAutoCommit;
292 #return "inserting cust_main record (transaction rolled back): $error";
297 if ( $invoicing_list ) {
298 $error = $self->check_invoicing_list( $invoicing_list );
300 $dbh->rollback if $oldAutoCommit;
301 return "checking invoicing_list (transaction rolled back): $error";
303 $self->invoicing_list( $invoicing_list );
307 $error = $self->order_pkgs($cust_pkgs, \$seconds, %options);
309 $dbh->rollback if $oldAutoCommit;
314 $dbh->rollback if $oldAutoCommit;
315 return "No svc_acct record to apply pre-paid time";
319 my $cust_credit = new FS::cust_credit {
320 'custnum' => $self->custnum,
323 $error = $cust_credit->insert;
325 $dbh->rollback if $oldAutoCommit;
326 return "inserting credit (transaction rolled back): $error";
330 $error = $self->queue_fuzzyfiles_update;
332 $dbh->rollback if $oldAutoCommit;
333 return "updating fuzzy search cache: $error";
336 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
341 =item order_pkgs HASHREF, [ SECONDSREF, [ , OPTION => VALUE ... ] ]
343 Like the insert method on an existing record, this method orders a package
344 and included services atomicaly. Pass a Tie::RefHash data structure to this
345 method containing FS::cust_pkg and FS::svc_I<tablename> objects. There should
346 be a better explanation of this, but until then, here's an example:
349 tie %hash, 'Tie::RefHash'; #this part is important
351 $cust_pkg => [ $svc_acct ],
354 $cust_main->order_pkgs( \%hash, \'0', 'noexport'=>1 );
356 Currently available options are: I<depend_jobnum> and I<noexport>.
358 If I<depend_jobnum> is set, all provisioning jobs will have a dependancy
359 on the supplied jobnum (they will not run until the specific job completes).
360 This can be used to defer provisioning until some action completes (such
361 as running the customer's credit card sucessfully).
363 The I<noexport> option is deprecated. If I<noexport> is set true, no
364 provisioning jobs (exports) are scheduled. (You can schedule them later with
365 the B<reexport> method for each cust_pkg object. Using the B<reexport> method
366 on the cust_main object is not recommended, as existing services will also be
373 my $cust_pkgs = shift;
376 my %svc_options = ();
377 $svc_options{'depend_jobnum'} = $options{'depend_jobnum'}
378 if exists $options{'depend_jobnum'};
379 warn "FS::cust_main::order_pkgs called with options ".
380 join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
383 local $SIG{HUP} = 'IGNORE';
384 local $SIG{INT} = 'IGNORE';
385 local $SIG{QUIT} = 'IGNORE';
386 local $SIG{TERM} = 'IGNORE';
387 local $SIG{TSTP} = 'IGNORE';
388 local $SIG{PIPE} = 'IGNORE';
390 my $oldAutoCommit = $FS::UID::AutoCommit;
391 local $FS::UID::AutoCommit = 0;
394 local $FS::svc_Common::noexport_hack = 1 if $options{'noexport'};
396 foreach my $cust_pkg ( keys %$cust_pkgs ) {
397 $cust_pkg->custnum( $self->custnum );
398 my $error = $cust_pkg->insert;
400 $dbh->rollback if $oldAutoCommit;
401 return "inserting cust_pkg (transaction rolled back): $error";
403 foreach my $svc_something ( @{$cust_pkgs->{$cust_pkg}} ) {
404 $svc_something->pkgnum( $cust_pkg->pkgnum );
405 if ( $seconds && $$seconds && $svc_something->isa('FS::svc_acct') ) {
406 $svc_something->seconds( $svc_something->seconds + $$seconds );
409 $error = $svc_something->insert(%svc_options);
411 $dbh->rollback if $oldAutoCommit;
412 #return "inserting svc_ (transaction rolled back): $error";
418 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
424 This method is deprecated. See the I<depend_jobnum> option to the insert and
425 order_pkgs methods for a better way to defer provisioning.
427 Re-schedules all exports by calling the B<reexport> method of all associated
428 packages (see L<FS::cust_pkg>). If there is an error, returns the error;
429 otherwise returns false.
436 carp "warning: FS::cust_main::reexport is deprectated; ".
437 "use the depend_jobnum option to insert or order_pkgs to delay export";
439 local $SIG{HUP} = 'IGNORE';
440 local $SIG{INT} = 'IGNORE';
441 local $SIG{QUIT} = 'IGNORE';
442 local $SIG{TERM} = 'IGNORE';
443 local $SIG{TSTP} = 'IGNORE';
444 local $SIG{PIPE} = 'IGNORE';
446 my $oldAutoCommit = $FS::UID::AutoCommit;
447 local $FS::UID::AutoCommit = 0;
450 foreach my $cust_pkg ( $self->ncancelled_pkgs ) {
451 my $error = $cust_pkg->reexport;
453 $dbh->rollback if $oldAutoCommit;
458 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
463 =item delete NEW_CUSTNUM
465 This deletes the customer. If there is an error, returns the error, otherwise
468 This will completely remove all traces of the customer record. This is not
469 what you want when a customer cancels service; for that, cancel all of the
470 customer's packages (see L</cancel>).
472 If the customer has any uncancelled packages, you need to pass a new (valid)
473 customer number for those packages to be transferred to. Cancelled packages
474 will be deleted. Did I mention that this is NOT what you want when a customer
475 cancels service and that you really should be looking see L<FS::cust_pkg/cancel>?
477 You can't delete a customer with invoices (see L<FS::cust_bill>),
478 or credits (see L<FS::cust_credit>), payments (see L<FS::cust_pay>) or
479 refunds (see L<FS::cust_refund>).
486 local $SIG{HUP} = 'IGNORE';
487 local $SIG{INT} = 'IGNORE';
488 local $SIG{QUIT} = 'IGNORE';
489 local $SIG{TERM} = 'IGNORE';
490 local $SIG{TSTP} = 'IGNORE';
491 local $SIG{PIPE} = 'IGNORE';
493 my $oldAutoCommit = $FS::UID::AutoCommit;
494 local $FS::UID::AutoCommit = 0;
497 if ( $self->cust_bill ) {
498 $dbh->rollback if $oldAutoCommit;
499 return "Can't delete a customer with invoices";
501 if ( $self->cust_credit ) {
502 $dbh->rollback if $oldAutoCommit;
503 return "Can't delete a customer with credits";
505 if ( $self->cust_pay ) {
506 $dbh->rollback if $oldAutoCommit;
507 return "Can't delete a customer with payments";
509 if ( $self->cust_refund ) {
510 $dbh->rollback if $oldAutoCommit;
511 return "Can't delete a customer with refunds";
514 my @cust_pkg = $self->ncancelled_pkgs;
516 my $new_custnum = shift;
517 unless ( qsearchs( 'cust_main', { 'custnum' => $new_custnum } ) ) {
518 $dbh->rollback if $oldAutoCommit;
519 return "Invalid new customer number: $new_custnum";
521 foreach my $cust_pkg ( @cust_pkg ) {
522 my %hash = $cust_pkg->hash;
523 $hash{'custnum'} = $new_custnum;
524 my $new_cust_pkg = new FS::cust_pkg ( \%hash );
525 my $error = $new_cust_pkg->replace($cust_pkg);
527 $dbh->rollback if $oldAutoCommit;
532 my @cancelled_cust_pkg = $self->all_pkgs;
533 foreach my $cust_pkg ( @cancelled_cust_pkg ) {
534 my $error = $cust_pkg->delete;
536 $dbh->rollback if $oldAutoCommit;
541 foreach my $cust_main_invoice ( #(email invoice destinations, not invoices)
542 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } )
544 my $error = $cust_main_invoice->delete;
546 $dbh->rollback if $oldAutoCommit;
551 my $error = $self->SUPER::delete;
553 $dbh->rollback if $oldAutoCommit;
557 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
562 =item replace OLD_RECORD [ INVOICING_LIST_ARYREF ]
564 Replaces the OLD_RECORD with this one in the database. If there is an error,
565 returns the error, otherwise returns false.
567 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
568 be set as the invoicing list (see L<"invoicing_list">). Errors return as
569 expected and rollback the entire transaction; it is not necessary to call
570 check_invoicing_list first. Here's an example:
572 $new_cust_main->replace( $old_cust_main, [ $email, 'POST' ] );
581 local $SIG{HUP} = 'IGNORE';
582 local $SIG{INT} = 'IGNORE';
583 local $SIG{QUIT} = 'IGNORE';
584 local $SIG{TERM} = 'IGNORE';
585 local $SIG{TSTP} = 'IGNORE';
586 local $SIG{PIPE} = 'IGNORE';
588 if ( $self->payby eq 'COMP' && $self->payby ne $old->payby
589 && $conf->config('users-allow_comp') ) {
590 return "You are not permitted to create complimentary accounts."
591 unless grep { $_ eq getotaker } $conf->config('users-allow_comp');
594 my $oldAutoCommit = $FS::UID::AutoCommit;
595 local $FS::UID::AutoCommit = 0;
598 my $error = $self->SUPER::replace($old);
601 $dbh->rollback if $oldAutoCommit;
605 if ( @param ) { # INVOICING_LIST_ARYREF
606 my $invoicing_list = shift @param;
607 $error = $self->check_invoicing_list( $invoicing_list );
609 $dbh->rollback if $oldAutoCommit;
612 $self->invoicing_list( $invoicing_list );
615 if ( $self->payby =~ /^(CARD|CHEK|LECB)$/ &&
616 grep { $self->get($_) ne $old->get($_) } qw(payinfo paydate payname) ) {
617 # card/check/lec info has changed, want to retry realtime_ invoice events
618 my $error = $self->retry_realtime;
620 $dbh->rollback if $oldAutoCommit;
625 $error = $self->queue_fuzzyfiles_update;
627 $dbh->rollback if $oldAutoCommit;
628 return "updating fuzzy search cache: $error";
631 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
636 =item queue_fuzzyfiles_update
638 Used by insert & replace to update the fuzzy search cache
642 sub queue_fuzzyfiles_update {
645 local $SIG{HUP} = 'IGNORE';
646 local $SIG{INT} = 'IGNORE';
647 local $SIG{QUIT} = 'IGNORE';
648 local $SIG{TERM} = 'IGNORE';
649 local $SIG{TSTP} = 'IGNORE';
650 local $SIG{PIPE} = 'IGNORE';
652 my $oldAutoCommit = $FS::UID::AutoCommit;
653 local $FS::UID::AutoCommit = 0;
656 my $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
657 my $error = $queue->insert($self->getfield('last'), $self->company);
659 $dbh->rollback if $oldAutoCommit;
660 return "queueing job (transaction rolled back): $error";
663 if ( defined $self->dbdef_table->column('ship_last') && $self->ship_last ) {
664 $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
665 $error = $queue->insert($self->getfield('ship_last'), $self->ship_company);
667 $dbh->rollback if $oldAutoCommit;
668 return "queueing job (transaction rolled back): $error";
672 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
679 Checks all fields to make sure this is a valid customer record. If there is
680 an error, returns the error, otherwise returns false. Called by the insert
688 #warn "BEFORE: \n". $self->_dump;
691 $self->ut_numbern('custnum')
692 || $self->ut_number('agentnum')
693 || $self->ut_number('refnum')
694 || $self->ut_name('last')
695 || $self->ut_name('first')
696 || $self->ut_textn('company')
697 || $self->ut_text('address1')
698 || $self->ut_textn('address2')
699 || $self->ut_text('city')
700 || $self->ut_textn('county')
701 || $self->ut_textn('state')
702 || $self->ut_country('country')
703 || $self->ut_anything('comments')
704 || $self->ut_numbern('referral_custnum')
706 #barf. need message catalogs. i18n. etc.
707 $error .= "Please select an advertising source."
708 if $error =~ /^Illegal or empty \(numeric\) refnum: /;
709 return $error if $error;
711 return "Unknown agent"
712 unless qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
714 return "Unknown refnum"
715 unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } );
717 return "Unknown referring custnum ". $self->referral_custnum
718 unless ! $self->referral_custnum
719 || qsearchs( 'cust_main', { 'custnum' => $self->referral_custnum } );
721 if ( $self->ss eq '' ) {
726 $ss =~ /^(\d{3})(\d{2})(\d{4})$/
727 or return "Illegal social security number: ". $self->ss;
728 $self->ss("$1-$2-$3");
732 # bad idea to disable, causes billing to fail because of no tax rates later
733 # unless ( $import ) {
734 unless ( qsearch('cust_main_county', {
735 'country' => $self->country,
738 return "Unknown state/county/country: ".
739 $self->state. "/". $self->county. "/". $self->country
740 unless qsearch('cust_main_county',{
741 'state' => $self->state,
742 'county' => $self->county,
743 'country' => $self->country,
749 $self->ut_phonen('daytime', $self->country)
750 || $self->ut_phonen('night', $self->country)
751 || $self->ut_phonen('fax', $self->country)
752 || $self->ut_zip('zip', $self->country)
754 return $error if $error;
757 last first company address1 address2 city county state zip
758 country daytime night fax
761 if ( defined $self->dbdef_table->column('ship_last') ) {
762 if ( scalar ( grep { $self->getfield($_) ne $self->getfield("ship_$_") }
764 && scalar ( grep { $self->getfield("ship_$_") ne '' } @addfields )
768 $self->ut_name('ship_last')
769 || $self->ut_name('ship_first')
770 || $self->ut_textn('ship_company')
771 || $self->ut_text('ship_address1')
772 || $self->ut_textn('ship_address2')
773 || $self->ut_text('ship_city')
774 || $self->ut_textn('ship_county')
775 || $self->ut_textn('ship_state')
776 || $self->ut_country('ship_country')
778 return $error if $error;
780 #false laziness with above
781 unless ( qsearchs('cust_main_county', {
782 'country' => $self->ship_country,
785 return "Unknown ship_state/ship_county/ship_country: ".
786 $self->ship_state. "/". $self->ship_county. "/". $self->ship_country
787 unless qsearchs('cust_main_county',{
788 'state' => $self->ship_state,
789 'county' => $self->ship_county,
790 'country' => $self->ship_country,
796 $self->ut_phonen('ship_daytime', $self->ship_country)
797 || $self->ut_phonen('ship_night', $self->ship_country)
798 || $self->ut_phonen('ship_fax', $self->ship_country)
799 || $self->ut_zip('ship_zip', $self->ship_country)
801 return $error if $error;
803 } else { # ship_ info eq billing info, so don't store dup info in database
804 $self->setfield("ship_$_", '')
805 foreach qw( last first company address1 address2 city county state zip
806 country daytime night fax );
810 $self->payby =~ /^(CARD|DCRD|CHEK|DCHK|LECB|BILL|COMP|PREPAY)$/
811 or return "Illegal payby: ". $self->payby;
814 if ( $self->payby eq 'CARD' || $self->payby eq 'DCRD' ) {
816 my $payinfo = $self->payinfo;
818 $payinfo =~ /^(\d{13,16})$/
819 or return gettext('invalid_card'); # . ": ". $self->payinfo;
821 $self->payinfo($payinfo);
823 or return gettext('invalid_card'); # . ": ". $self->payinfo;
824 return gettext('unknown_card_type')
825 if cardtype($self->payinfo) eq "Unknown";
826 if ( defined $self->dbdef_table->column('paycvv') ) {
827 if ( length($self->paycvv) ) {
828 if ( cardtype($self->payinfo) eq 'American Express card' ) {
829 $self->paycvv =~ /^(\d{4})$/
830 or return "CVV2 (CID) for American Express cards is four digits.";
833 $self->paycvv =~ /^(\d{3})$/
834 or return "CVV2 (CVC2/CID) is three digits.";
842 } elsif ( $self->payby eq 'CHEK' || $self->payby eq 'DCHK' ) {
844 my $payinfo = $self->payinfo;
845 $payinfo =~ s/[^\d\@]//g;
846 $payinfo =~ /^(\d+)\@(\d{9})$/ or return 'invalid echeck account@aba';
848 $self->payinfo($payinfo);
849 $self->paycvv('') if $self->dbdef_table->column('paycvv');
851 } elsif ( $self->payby eq 'LECB' ) {
853 my $payinfo = $self->payinfo;
855 $payinfo =~ /^1?(\d{10})$/ or return 'invalid btn billing telephone number';
857 $self->payinfo($payinfo);
858 $self->paycvv('') if $self->dbdef_table->column('paycvv');
860 } elsif ( $self->payby eq 'BILL' ) {
862 $error = $self->ut_textn('payinfo');
863 return "Illegal P.O. number: ". $self->payinfo if $error;
864 $self->paycvv('') if $self->dbdef_table->column('paycvv');
866 } elsif ( $self->payby eq 'COMP' ) {
868 if ( !$self->custnum && $conf->config('users-allow_comp') ) {
869 return "You are not permitted to create complimentary accounts."
870 unless grep { $_ eq getotaker } $conf->config('users-allow_comp');
873 $error = $self->ut_textn('payinfo');
874 return "Illegal comp account issuer: ". $self->payinfo if $error;
875 $self->paycvv('') if $self->dbdef_table->column('paycvv');
877 } elsif ( $self->payby eq 'PREPAY' ) {
879 my $payinfo = $self->payinfo;
880 $payinfo =~ s/\W//g; #anything else would just confuse things
881 $self->payinfo($payinfo);
882 $error = $self->ut_alpha('payinfo');
883 return "Illegal prepayment identifier: ". $self->payinfo if $error;
884 return "Unknown prepayment identifier"
885 unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } );
886 $self->paycvv('') if $self->dbdef_table->column('paycvv');
890 if ( $self->paydate eq '' || $self->paydate eq '-' ) {
891 return "Expriation date required"
892 unless $self->payby =~ /^(BILL|PREPAY|CHEK|LECB)$/;
896 if ( $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/ ) {
897 ( $m, $y ) = ( $1, length($2) == 4 ? $2 : "20$2" );
898 } elsif ( $self->paydate =~ /^(20)?(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) {
899 ( $m, $y ) = ( $3, "20$2" );
901 return "Illegal expiration date: ". $self->paydate;
903 $self->paydate("$y-$m-01");
904 my($nowm,$nowy)=(localtime(time))[4,5]; $nowm++; $nowy+=1900;
905 return gettext('expired_card')
906 if !$import && ( $y<$nowy || ( $y==$nowy && $1<$nowm ) );
909 if ( $self->payname eq '' && $self->payby !~ /^(CHEK|DCHK)$/ &&
910 ( ! $conf->exists('require_cardname')
911 || $self->payby !~ /^(CARD|DCRD)$/ )
913 $self->payname( $self->first. " ". $self->getfield('last') );
915 $self->payname =~ /^([\w \,\.\-\']+)$/
916 or return gettext('illegal_name'). " payname: ". $self->payname;
920 $self->tax =~ /^(Y?)$/ or return "Illegal tax: ". $self->tax;
923 $self->otaker(getotaker) unless $self->otaker;
925 #warn "AFTER: \n". $self->_dump;
932 Returns all packages (see L<FS::cust_pkg>) for this customer.
938 if ( $self->{'_pkgnum'} ) {
939 values %{ $self->{'_pkgnum'}->cache };
941 qsearch( 'cust_pkg', { 'custnum' => $self->custnum });
945 =item ncancelled_pkgs
947 Returns all non-cancelled packages (see L<FS::cust_pkg>) for this customer.
951 sub ncancelled_pkgs {
953 if ( $self->{'_pkgnum'} ) {
954 grep { ! $_->getfield('cancel') } values %{ $self->{'_pkgnum'}->cache };
956 @{ [ # force list context
957 qsearch( 'cust_pkg', {
958 'custnum' => $self->custnum,
961 qsearch( 'cust_pkg', {
962 'custnum' => $self->custnum,
971 Returns all suspended packages (see L<FS::cust_pkg>) for this customer.
977 grep { $_->susp } $self->ncancelled_pkgs;
980 =item unflagged_suspended_pkgs
982 Returns all unflagged suspended packages (see L<FS::cust_pkg>) for this
983 customer (thouse packages without the `manual_flag' set).
987 sub unflagged_suspended_pkgs {
989 return $self->suspended_pkgs
990 unless dbdef->table('cust_pkg')->column('manual_flag');
991 grep { ! $_->manual_flag } $self->suspended_pkgs;
994 =item unsuspended_pkgs
996 Returns all unsuspended (and uncancelled) packages (see L<FS::cust_pkg>) for
1001 sub unsuspended_pkgs {
1003 grep { ! $_->susp } $self->ncancelled_pkgs;
1008 Unsuspends all unflagged suspended packages (see L</unflagged_suspended_pkgs>
1009 and L<FS::cust_pkg>) for this customer. Always returns a list: an empty list
1010 on success or a list of errors.
1016 grep { $_->unsuspend } $self->suspended_pkgs;
1021 Suspends all unsuspended packages (see L<FS::cust_pkg>) for this customer.
1022 Always returns a list: an empty list on success or a list of errors.
1028 grep { $_->suspend } $self->unsuspended_pkgs;
1031 =item suspend_if_pkgpart PKGPART [ , PKGPART ... ]
1033 Suspends all unsuspended packages (see L<FS::cust_pkg>) matching the listed
1034 PKGPARTs (see L<FS::part_pkg>). Always returns a list: an empty list on
1035 success or a list of errors.
1039 sub suspend_if_pkgpart {
1042 grep { $_->suspend }
1043 grep { my $pkgpart = $_->pkgpart; grep { $pkgpart eq $_ } @pkgparts }
1044 $self->unsuspended_pkgs;
1047 =item suspend_unless_pkgpart PKGPART [ , PKGPART ... ]
1049 Suspends all unsuspended packages (see L<FS::cust_pkg>) unless they match the
1050 listed PKGPARTs (see L<FS::part_pkg>). Always returns a list: an empty list
1051 on success or a list of errors.
1055 sub suspend_unless_pkgpart {
1058 grep { $_->suspend }
1059 grep { my $pkgpart = $_->pkgpart; ! grep { $pkgpart eq $_ } @pkgparts }
1060 $self->unsuspended_pkgs;
1063 =item cancel [ OPTION => VALUE ... ]
1065 Cancels all uncancelled packages (see L<FS::cust_pkg>) for this customer.
1067 Available options are: I<quiet>
1069 I<quiet> can be set true to supress email cancellation notices.
1071 Always returns a list: an empty list on success or a list of errors.
1077 grep { $_ } map { $_->cancel(@_) } $self->ncancelled_pkgs;
1082 Returns the agent (see L<FS::agent>) for this customer.
1088 qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
1093 Generates invoices (see L<FS::cust_bill>) for this customer. Usually used in
1094 conjunction with the collect method.
1096 Options are passed as name-value pairs.
1098 Currently available options are:
1100 resetup - if set true, re-charges setup fees.
1102 time - bills the customer as if it were that time. Specified as a UNIX
1103 timestamp; see L<perlfunc/"time">). Also see L<Time::Local> and
1104 L<Date::Parse> for conversion functions. For example:
1108 $cust_main->bill( 'time' => str2time('April 20th, 2001') );
1111 If there is an error, returns the error, otherwise returns false.
1116 my( $self, %options ) = @_;
1117 my $time = $options{'time'} || time;
1122 local $SIG{HUP} = 'IGNORE';
1123 local $SIG{INT} = 'IGNORE';
1124 local $SIG{QUIT} = 'IGNORE';
1125 local $SIG{TERM} = 'IGNORE';
1126 local $SIG{TSTP} = 'IGNORE';
1127 local $SIG{PIPE} = 'IGNORE';
1129 my $oldAutoCommit = $FS::UID::AutoCommit;
1130 local $FS::UID::AutoCommit = 0;
1133 $self->select_for_update; #mutex
1135 # find the packages which are due for billing, find out how much they are
1136 # & generate invoice database.
1138 my( $total_setup, $total_recur ) = ( 0, 0 );
1139 #my( $taxable_setup, $taxable_recur ) = ( 0, 0 );
1140 my @cust_bill_pkg = ();
1142 #my $taxable_charged = 0;##
1147 foreach my $cust_pkg (
1148 qsearch('cust_pkg', { 'custnum' => $self->custnum } )
1151 #NO!! next if $cust_pkg->cancel;
1152 next if $cust_pkg->getfield('cancel');
1154 #? to avoid use of uninitialized value errors... ?
1155 $cust_pkg->setfield('bill', '')
1156 unless defined($cust_pkg->bill);
1158 my $part_pkg = $cust_pkg->part_pkg;
1160 #so we don't modify cust_pkg record unnecessarily
1161 my $cust_pkg_mod_flag = 0;
1162 my %hash = $cust_pkg->hash;
1163 my $old_cust_pkg = new FS::cust_pkg \%hash;
1169 if ( !$cust_pkg->setup || $options{'resetup'} ) {
1170 my $setup_prog = $part_pkg->getfield('setup');
1171 $setup_prog =~ /^(.*)$/ or do {
1172 $dbh->rollback if $oldAutoCommit;
1173 return "Illegal setup for pkgpart ". $part_pkg->pkgpart.
1177 $setup_prog = '0' if $setup_prog =~ /^\s*$/;
1179 #my $cpt = new Safe;
1180 ##$cpt->permit(); #what is necessary?
1181 #$cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
1182 #$setup = $cpt->reval($setup_prog);
1183 $setup = eval $setup_prog;
1184 unless ( defined($setup) ) {
1185 $dbh->rollback if $oldAutoCommit;
1186 return "Error eval-ing part_pkg->setup pkgpart ". $part_pkg->pkgpart.
1187 "(expression $setup_prog): $@";
1189 $cust_pkg->setfield('setup', $time) unless $cust_pkg->setup;
1190 $cust_pkg_mod_flag=1;
1196 if ( $part_pkg->getfield('freq') ne '0' &&
1197 ! $cust_pkg->getfield('susp') &&
1198 ( $cust_pkg->getfield('bill') || 0 ) <= $time
1200 my $recur_prog = $part_pkg->getfield('recur');
1201 $recur_prog =~ /^(.*)$/ or do {
1202 $dbh->rollback if $oldAutoCommit;
1203 return "Illegal recur for pkgpart ". $part_pkg->pkgpart.
1207 $recur_prog = '0' if $recur_prog =~ /^\s*$/;
1209 # shared with $recur_prog
1210 $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
1212 #my $cpt = new Safe;
1213 ##$cpt->permit(); #what is necessary?
1214 #$cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
1215 #$recur = $cpt->reval($recur_prog);
1216 $recur = eval $recur_prog;
1217 unless ( defined($recur) ) {
1218 $dbh->rollback if $oldAutoCommit;
1219 return "Error eval-ing part_pkg->recur pkgpart ". $part_pkg->pkgpart.
1220 "(expression $recur_prog): $@";
1222 #change this bit to use Date::Manip? CAREFUL with timezones (see
1223 # mailing list archive)
1224 my ($sec,$min,$hour,$mday,$mon,$year) =
1225 (localtime($sdate) )[0,1,2,3,4,5];
1227 #pro-rating magic - if $recur_prog fiddles $sdate, want to use that
1228 # only for figuring next bill date, nothing else, so, reset $sdate again
1230 $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
1231 $cust_pkg->last_bill($sdate)
1232 if $cust_pkg->dbdef_table->column('last_bill');
1234 if ( $part_pkg->freq =~ /^\d+$/ ) {
1235 $mon += $part_pkg->freq;
1236 until ( $mon < 12 ) { $mon -= 12; $year++; }
1237 } elsif ( $part_pkg->freq =~ /^(\d+)w$/ ) {
1239 $mday += $weeks * 7;
1240 } elsif ( $part_pkg->freq =~ /^(\d+)d$/ ) {
1244 $dbh->rollback if $oldAutoCommit;
1245 return "unparsable frequency: ". $part_pkg->freq;
1247 $cust_pkg->setfield('bill',
1248 timelocal_nocheck($sec,$min,$hour,$mday,$mon,$year));
1249 $cust_pkg_mod_flag = 1;
1252 warn "\$setup is undefined" unless defined($setup);
1253 warn "\$recur is undefined" unless defined($recur);
1254 warn "\$cust_pkg->bill is undefined" unless defined($cust_pkg->bill);
1256 if ( $cust_pkg_mod_flag ) {
1257 $error=$cust_pkg->replace($old_cust_pkg);
1258 if ( $error ) { #just in case
1259 $dbh->rollback if $oldAutoCommit;
1260 return "Error modifying pkgnum ". $cust_pkg->pkgnum. ": $error";
1262 $setup = sprintf( "%.2f", $setup );
1263 $recur = sprintf( "%.2f", $recur );
1264 if ( $setup < 0 && ! $conf->exists('allow_negative_charges') ) {
1265 $dbh->rollback if $oldAutoCommit;
1266 return "negative setup $setup for pkgnum ". $cust_pkg->pkgnum;
1268 if ( $recur < 0 && ! $conf->exists('allow_negative_charges') ) {
1269 $dbh->rollback if $oldAutoCommit;
1270 return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum;
1272 if ( $setup != 0 || $recur != 0 ) {
1273 my $cust_bill_pkg = new FS::cust_bill_pkg ({
1274 'pkgnum' => $cust_pkg->pkgnum,
1278 'edate' => $cust_pkg->bill,
1279 'details' => \@details,
1281 push @cust_bill_pkg, $cust_bill_pkg;
1282 $total_setup += $setup;
1283 $total_recur += $recur;
1285 unless ( $self->tax =~ /Y/i || $self->payby eq 'COMP' ) {
1287 my @taxes = qsearch( 'cust_main_county', {
1288 'state' => $self->state,
1289 'county' => $self->county,
1290 'country' => $self->country,
1291 'taxclass' => $part_pkg->taxclass,
1294 @taxes = qsearch( 'cust_main_county', {
1295 'state' => $self->state,
1296 'county' => $self->county,
1297 'country' => $self->country,
1302 #one more try at a whole-country tax rate
1304 @taxes = qsearch( 'cust_main_county', {
1307 'country' => $self->country,
1312 # maybe eliminate this entirely, along with all the 0% records
1314 $dbh->rollback if $oldAutoCommit;
1316 "fatal: can't find tax rate for state/county/country/taxclass ".
1317 join('/', ( map $self->$_(), qw(state county country) ),
1318 $part_pkg->taxclass ). "\n";
1321 foreach my $tax ( @taxes ) {
1323 my $taxable_charged = 0;
1324 $taxable_charged += $setup
1325 unless $part_pkg->setuptax =~ /^Y$/i
1326 || $tax->setuptax =~ /^Y$/i;
1327 $taxable_charged += $recur
1328 unless $part_pkg->recurtax =~ /^Y$/i
1329 || $tax->recurtax =~ /^Y$/i;
1330 next unless $taxable_charged;
1332 if ( $tax->exempt_amount > 0 ) {
1333 my ($mon,$year) = (localtime($sdate) )[4,5];
1335 my $freq = $part_pkg->freq || 1;
1336 if ( $freq !~ /(\d+)$/ ) {
1337 $dbh->rollback if $oldAutoCommit;
1338 return "daily/weekly package definitions not (yet?)".
1339 " compatible with monthly tax exemptions";
1341 my $taxable_per_month = sprintf("%.2f", $taxable_charged / $freq );
1342 foreach my $which_month ( 1 .. $freq ) {
1344 'custnum' => $self->custnum,
1345 'taxnum' => $tax->taxnum,
1346 'year' => 1900+$year,
1349 #until ( $mon < 12 ) { $mon -= 12; $year++; }
1350 until ( $mon < 13 ) { $mon -= 12; $year++; }
1351 my $cust_tax_exempt =
1352 qsearchs('cust_tax_exempt', \%hash)
1353 || new FS::cust_tax_exempt( { %hash, 'amount' => 0 } );
1354 my $remaining_exemption = sprintf("%.2f",
1355 $tax->exempt_amount - $cust_tax_exempt->amount );
1356 if ( $remaining_exemption > 0 ) {
1357 my $addl = $remaining_exemption > $taxable_per_month
1358 ? $taxable_per_month
1359 : $remaining_exemption;
1360 $taxable_charged -= $addl;
1361 my $new_cust_tax_exempt = new FS::cust_tax_exempt ( {
1362 $cust_tax_exempt->hash,
1364 sprintf("%.2f", $cust_tax_exempt->amount + $addl),
1366 $error = $new_cust_tax_exempt->exemptnum
1367 ? $new_cust_tax_exempt->replace($cust_tax_exempt)
1368 : $new_cust_tax_exempt->insert;
1370 $dbh->rollback if $oldAutoCommit;
1371 return "fatal: can't update cust_tax_exempt: $error";
1374 } # if $remaining_exemption > 0
1376 } #foreach $which_month
1378 } #if $tax->exempt_amount
1380 $taxable_charged = sprintf( "%.2f", $taxable_charged);
1382 #$tax += $taxable_charged * $cust_main_county->tax / 100
1383 $tax{ $tax->taxname || 'Tax' } +=
1384 $taxable_charged * $tax->tax / 100
1386 } #foreach my $tax ( @taxes )
1388 } #unless $self->tax =~ /Y/i || $self->payby eq 'COMP'
1390 } #if $setup != 0 || $recur != 0
1392 } #if $cust_pkg_mod_flag
1394 } #foreach my $cust_pkg
1396 my $charged = sprintf( "%.2f", $total_setup + $total_recur );
1397 # my $taxable_charged = sprintf( "%.2f", $taxable_setup + $taxable_recur );
1399 unless ( @cust_bill_pkg ) { #don't create invoices with no line items
1400 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1404 # unless ( $self->tax =~ /Y/i
1405 # || $self->payby eq 'COMP'
1406 # || $taxable_charged == 0 ) {
1407 # my $cust_main_county = qsearchs('cust_main_county',{
1408 # 'state' => $self->state,
1409 # 'county' => $self->county,
1410 # 'country' => $self->country,
1411 # } ) or die "fatal: can't find tax rate for state/county/country ".
1412 # $self->state. "/". $self->county. "/". $self->country. "\n";
1413 # my $tax = sprintf( "%.2f",
1414 # $taxable_charged * ( $cust_main_county->getfield('tax') / 100 )
1417 if ( dbdef->table('cust_bill_pkg')->column('itemdesc') ) { #1.5 schema
1419 foreach my $taxname ( grep { $tax{$_} > 0 } keys %tax ) {
1420 my $tax = sprintf("%.2f", $tax{$taxname} );
1421 $charged = sprintf( "%.2f", $charged+$tax );
1423 my $cust_bill_pkg = new FS::cust_bill_pkg ({
1429 'itemdesc' => $taxname,
1431 push @cust_bill_pkg, $cust_bill_pkg;
1434 } else { #1.4 schema
1437 foreach ( values %tax ) { $tax += $_ };
1438 $tax = sprintf("%.2f", $tax);
1440 $charged = sprintf( "%.2f", $charged+$tax );
1442 my $cust_bill_pkg = new FS::cust_bill_pkg ({
1449 push @cust_bill_pkg, $cust_bill_pkg;
1454 my $cust_bill = new FS::cust_bill ( {
1455 'custnum' => $self->custnum,
1457 'charged' => $charged,
1459 $error = $cust_bill->insert;
1461 $dbh->rollback if $oldAutoCommit;
1462 return "can't create invoice for customer #". $self->custnum. ": $error";
1465 my $invnum = $cust_bill->invnum;
1467 foreach $cust_bill_pkg ( @cust_bill_pkg ) {
1469 $cust_bill_pkg->invnum($invnum);
1470 $error = $cust_bill_pkg->insert;
1472 $dbh->rollback if $oldAutoCommit;
1473 return "can't create invoice line item for customer #". $self->custnum.
1478 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1482 =item collect OPTIONS
1484 (Attempt to) collect money for this customer's outstanding invoices (see
1485 L<FS::cust_bill>). Usually used after the bill method.
1487 Depending on the value of `payby', this may print or email an invoice (I<BILL>,
1488 I<DCRD>, or I<DCHK>), charge a credit card (I<CARD>), charge via electronic
1489 check/ACH (I<CHEK>), or just add any necessary (pseudo-)payment (I<COMP>).
1491 Most actions are now triggered by invoice events; see L<FS::part_bill_event>
1492 and the invoice events web interface.
1494 If there is an error, returns the error, otherwise returns false.
1496 Options are passed as name-value pairs.
1498 Currently available options are:
1500 invoice_time - Use this time when deciding when to print invoices and
1501 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>
1502 for conversion functions.
1504 retry - Retry card/echeck/LEC transactions even when not scheduled by invoice
1507 retry_card - Deprecated alias for 'retry'
1509 batch_card - This option is deprecated. See the invoice events web interface
1510 to control whether cards are batched or run against a realtime gateway.
1512 report_badcard - This option is deprecated.
1514 force_print - This option is deprecated; see the invoice events web interface.
1516 quiet - set true to surpress email card/ACH decline notices.
1521 my( $self, %options ) = @_;
1522 my $invoice_time = $options{'invoice_time'} || time;
1525 local $SIG{HUP} = 'IGNORE';
1526 local $SIG{INT} = 'IGNORE';
1527 local $SIG{QUIT} = 'IGNORE';
1528 local $SIG{TERM} = 'IGNORE';
1529 local $SIG{TSTP} = 'IGNORE';
1530 local $SIG{PIPE} = 'IGNORE';
1532 my $oldAutoCommit = $FS::UID::AutoCommit;
1533 local $FS::UID::AutoCommit = 0;
1536 $self->select_for_update; #mutex
1538 my $balance = $self->balance;
1539 warn "collect customer". $self->custnum. ": balance $balance" if $DEBUG;
1540 unless ( $balance > 0 ) { #redundant?????
1541 $dbh->rollback if $oldAutoCommit; #hmm
1545 if ( exists($options{'retry_card'}) ) {
1546 carp 'retry_card option passed to collect is deprecated; use retry';
1547 $options{'retry'} ||= $options{'retry_card'};
1549 if ( exists($options{'retry'}) && $options{'retry'} ) {
1550 my $error = $self->retry_realtime;
1552 $dbh->rollback if $oldAutoCommit;
1557 foreach my $cust_bill ( $self->open_cust_bill ) {
1559 # don't try to charge for the same invoice if it's already in a batch
1560 #next if qsearchs( 'cust_pay_batch', { 'invnum' => $cust_bill->invnum } );
1562 last if $self->balance <= 0;
1564 warn "invnum ". $cust_bill->invnum. " (owed ". $cust_bill->owed. ")"
1567 foreach my $part_bill_event (
1568 sort { $a->seconds <=> $b->seconds
1569 || $a->weight <=> $b->weight
1570 || $a->eventpart <=> $b->eventpart }
1571 grep { $_->seconds <= ( $invoice_time - $cust_bill->_date )
1572 && ! qsearch( 'cust_bill_event', {
1573 'invnum' => $cust_bill->invnum,
1574 'eventpart' => $_->eventpart,
1578 qsearch('part_bill_event', { 'payby' => $self->payby,
1579 'disabled' => '', } )
1582 last if $cust_bill->owed <= 0 # don't run subsequent events if owed<=0
1583 || $self->balance <= 0; # or if balance<=0
1585 warn "calling invoice event (". $part_bill_event->eventcode. ")\n"
1587 my $cust_main = $self; #for callback
1591 local $realtime_bop_decline_quiet = 1 if $options{'quiet'};
1592 $error = eval $part_bill_event->eventcode;
1596 my $statustext = '';
1600 } elsif ( $error ) {
1602 $statustext = $error;
1607 #add cust_bill_event
1608 my $cust_bill_event = new FS::cust_bill_event {
1609 'invnum' => $cust_bill->invnum,
1610 'eventpart' => $part_bill_event->eventpart,
1611 #'_date' => $invoice_time,
1613 'status' => $status,
1614 'statustext' => $statustext,
1616 $error = $cust_bill_event->insert;
1618 #$dbh->rollback if $oldAutoCommit;
1619 #return "error: $error";
1621 # gah, even with transactions.
1622 $dbh->commit if $oldAutoCommit; #well.
1623 my $e = 'WARNING: Event run but database not updated - '.
1624 'error inserting cust_bill_event, invnum #'. $cust_bill->invnum.
1625 ', eventpart '. $part_bill_event->eventpart.
1636 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1641 =item retry_realtime
1643 Schedules realtime credit card / electronic check / LEC billing events for
1644 for retry. Useful if card information has changed or manual retry is desired.
1645 The 'collect' method must be called to actually retry the transaction.
1647 Implementation details: For each of this customer's open invoices, changes
1648 the status of the first "done" (with statustext error) realtime processing
1653 sub retry_realtime {
1656 local $SIG{HUP} = 'IGNORE';
1657 local $SIG{INT} = 'IGNORE';
1658 local $SIG{QUIT} = 'IGNORE';
1659 local $SIG{TERM} = 'IGNORE';
1660 local $SIG{TSTP} = 'IGNORE';
1661 local $SIG{PIPE} = 'IGNORE';
1663 my $oldAutoCommit = $FS::UID::AutoCommit;
1664 local $FS::UID::AutoCommit = 0;
1667 foreach my $cust_bill (
1668 grep { $_->cust_bill_event }
1669 $self->open_cust_bill
1671 my @cust_bill_event =
1672 sort { $a->part_bill_event->seconds <=> $b->part_bill_event->seconds }
1674 #$_->part_bill_event->plan eq 'realtime-card'
1675 $_->part_bill_event->eventcode =~
1676 /\$cust_bill\->realtime_(card|ach|lec)/
1677 && $_->status eq 'done'
1680 $cust_bill->cust_bill_event;
1681 next unless @cust_bill_event;
1682 my $error = $cust_bill_event[0]->retry;
1684 $dbh->rollback if $oldAutoCommit;
1685 return "error scheduling invoice event for retry: $error";
1690 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1695 =item realtime_bop METHOD AMOUNT [ OPTION => VALUE ... ]
1697 Runs a realtime credit card, ACH (electronic check) or phone bill transaction
1698 via a Business::OnlinePayment realtime gateway. See
1699 L<http://420.am/business-onlinepayment> for supported gateways.
1701 Available methods are: I<CC>, I<ECHECK> and I<LEC>
1703 Available options are: I<description>, I<invnum>, I<quiet>
1705 The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
1706 I<zip>, I<payinfo> and I<paydate> are also available. Any of these options,
1707 if set, will override the value from the customer record.
1709 I<description> is a free-text field passed to the gateway. It defaults to
1710 "Internet services".
1712 If an I<invnum> is specified, this payment (if sucessful) is applied to the
1713 specified invoice. If you don't specify an I<invnum> you might want to
1714 call the B<apply_payments> method.
1716 I<quiet> can be set true to surpress email decline notices.
1718 (moved from cust_bill) (probably should get realtime_{card,ach,lec} here too)
1723 my( $self, $method, $amount, %options ) = @_;
1725 warn "$self $method $amount\n";
1726 warn " $_ => $options{$_}\n" foreach keys %options;
1729 $options{'description'} ||= 'Internet services';
1732 die "Real-time processing not enabled\n"
1733 unless $conf->exists('business-onlinepayment');
1734 eval "use Business::OnlinePayment";
1738 $self->set( $_ => $options{$_} )
1739 foreach grep { exists($options{$_}) }
1740 qw( payname address1 address2 city state zip payinfo paydate paycvv);
1743 my $bop_config = 'business-onlinepayment';
1744 $bop_config .= '-ach'
1745 if $method eq 'ECHECK' && $conf->exists($bop_config. '-ach');
1746 my ( $processor, $login, $password, $action, @bop_options ) =
1747 $conf->config($bop_config);
1748 $action ||= 'normal authorization';
1749 pop @bop_options if scalar(@bop_options) % 2 && $bop_options[-1] =~ /^\s*$/;
1750 die "No real-time processor is enabled - ".
1751 "did you set the business-onlinepayment configuration value?\n"
1756 my $address = $self->address1;
1757 $address .= ", ". $self->address2 if $self->address2;
1759 my($payname, $payfirst, $paylast);
1760 if ( $self->payname && $method ne 'ECHECK' ) {
1761 $payname = $self->payname;
1762 $payname =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
1763 or return "Illegal payname $payname";
1764 ($payfirst, $paylast) = ($1, $2);
1766 $payfirst = $self->getfield('first');
1767 $paylast = $self->getfield('last');
1768 $payname = "$payfirst $paylast";
1771 my @invoicing_list = grep { $_ ne 'POST' } $self->invoicing_list;
1772 if ( $conf->exists('emailinvoiceauto')
1773 || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
1774 push @invoicing_list, $self->all_emails;
1776 my $email = $invoicing_list[0];
1779 if ( $method eq 'CC' ) {
1781 $content{card_number} = $self->payinfo;
1782 $self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
1783 $content{expiration} = "$2/$1";
1785 $content{cvv2} = $self->paycvv
1786 if defined $self->dbdef_table->column('paycvv')
1787 && length($self->paycvv);
1789 $content{recurring_billing} = 'YES'
1790 if qsearch('cust_pay', { 'custnum' => $self->custnum,
1792 'payinfo' => $self->payinfo, } );
1794 } elsif ( $method eq 'ECHECK' ) {
1795 my($account_number,$routing_code) = $self->payinfo;
1796 ( $content{account_number}, $content{routing_code} ) =
1797 split('@', $self->payinfo);
1798 $content{bank_name} = $self->payname;
1799 $content{account_type} = 'CHECKING';
1800 $content{account_name} = $payname;
1801 $content{customer_org} = $self->company ? 'B' : 'I';
1802 $content{customer_ssn} = $self->ss;
1803 } elsif ( $method eq 'LEC' ) {
1804 $content{phone} = $self->payinfo;
1809 my( $action1, $action2 ) = split(/\s*\,\s*/, $action );
1812 new Business::OnlinePayment( $processor, @bop_options );
1813 $transaction->content(
1816 'password' => $password,
1817 'action' => $action1,
1818 'description' => $options{'description'},
1819 'amount' => $amount,
1820 'invoice_number' => $options{'invnum'},
1821 'customer_id' => $self->custnum,
1822 'last_name' => $paylast,
1823 'first_name' => $payfirst,
1825 'address' => $address,
1826 'city' => $self->city,
1827 'state' => $self->state,
1828 'zip' => $self->zip,
1829 'country' => $self->country,
1830 'referer' => 'http://cleanwhisker.420.am/',
1832 'phone' => $self->daytime || $self->night,
1835 $transaction->submit();
1837 if ( $transaction->is_success() && $action2 ) {
1838 my $auth = $transaction->authorization;
1839 my $ordernum = $transaction->can('order_number')
1840 ? $transaction->order_number
1844 new Business::OnlinePayment( $processor, @bop_options );
1851 password => $password,
1852 order_number => $ordernum,
1854 authorization => $auth,
1855 description => $options{'description'},
1858 foreach my $field (qw( authorization_source_code returned_ACI transaction_identifier validation_code
1859 transaction_sequence_num local_transaction_date
1860 local_transaction_time AVS_result_code )) {
1861 $capture{$field} = $transaction->$field() if $transaction->can($field);
1864 $capture->content( %capture );
1868 unless ( $capture->is_success ) {
1869 my $e = "Authorization sucessful but capture failed, custnum #".
1870 $self->custnum. ': '. $capture->result_code.
1871 ": ". $capture->error_message;
1878 #remove paycvv after initial transaction
1879 #false laziness w/misc/process/payment.cgi - check both to make sure working
1881 if ( defined $self->dbdef_table->column('paycvv')
1882 && length($self->paycvv)
1883 && ! grep { $_ eq cardtype($self->payinfo) } $conf->config('cvv-save')
1884 && ! length($options{'paycvv'})
1886 my $new = new FS::cust_main { $self->hash };
1888 my $error = $new->replace($self);
1890 warn "error removing cvv: $error\n";
1895 if ( $transaction->is_success() ) {
1897 my %method2payby = (
1903 my $cust_pay = new FS::cust_pay ( {
1904 'custnum' => $self->custnum,
1905 'invnum' => $options{'invnum'},
1908 'payby' => $method2payby{$method},
1909 'payinfo' => $self->payinfo,
1910 'paybatch' => "$processor:". $transaction->authorization,
1912 my $error = $cust_pay->insert;
1914 $cust_pay->invnum(''); #try again with no specific invnum
1915 my $error2 = $cust_pay->insert;
1917 # gah, even with transactions.
1918 my $e = 'WARNING: Card/ACH debited but database not updated - '.
1919 "error inserting payment ($processor): $error2".
1920 " (previously tried insert with invnum #$options{'invnum'}" .
1926 return ''; #no error
1930 my $perror = "$processor error: ". $transaction->error_message;
1932 if ( !$options{'quiet'} && !$realtime_bop_decline_quiet
1933 && $conf->exists('emaildecline')
1934 && grep { $_ ne 'POST' } $self->invoicing_list
1935 && ! grep { $transaction->error_message =~ /$_/ }
1936 $conf->config('emaildecline-exclude')
1938 my @templ = $conf->config('declinetemplate');
1939 my $template = new Text::Template (
1941 SOURCE => [ map "$_\n", @templ ],
1942 ) or return "($perror) can't create template: $Text::Template::ERROR";
1943 $template->compile()
1944 or return "($perror) can't compile template: $Text::Template::ERROR";
1946 my $templ_hash = { error => $transaction->error_message };
1948 my $error = send_email(
1949 'from' => $conf->config('invoice_from'),
1950 'to' => [ grep { $_ ne 'POST' } $self->invoicing_list ],
1951 'subject' => 'Your payment could not be processed',
1952 'body' => [ $template->fill_in(HASH => $templ_hash) ],
1955 $perror .= " (also received error sending decline notification: $error)"
1967 Returns the total owed for this customer on all invoices
1968 (see L<FS::cust_bill/owed>).
1974 $self->total_owed_date(2145859200); #12/31/2037
1977 =item total_owed_date TIME
1979 Returns the total owed for this customer on all invoices with date earlier than
1980 TIME. TIME is specified as a UNIX timestamp; see L<perlfunc/"time">). Also
1981 see L<Time::Local> and L<Date::Parse> for conversion functions.
1985 sub total_owed_date {
1989 foreach my $cust_bill (
1990 grep { $_->_date <= $time }
1991 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
1993 $total_bill += $cust_bill->owed;
1995 sprintf( "%.2f", $total_bill );
1998 =item apply_credits OPTION => VALUE ...
2000 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
2001 to outstanding invoice balances in chronological order (or reverse
2002 chronological order if the I<order> option is set to B<newest>) and returns the
2003 value of any remaining unapplied credits available for refund (see
2004 L<FS::cust_refund>).
2012 return 0 unless $self->total_credited;
2014 my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
2015 qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
2017 my @invoices = $self->open_cust_bill;
2018 @invoices = sort { $b->_date <=> $a->_date } @invoices
2019 if defined($opt{'order'}) && $opt{'order'} eq 'newest';
2022 foreach my $cust_bill ( @invoices ) {
2025 if ( !defined($credit) || $credit->credited == 0) {
2026 $credit = pop @credits or last;
2029 if ($cust_bill->owed >= $credit->credited) {
2030 $amount=$credit->credited;
2032 $amount=$cust_bill->owed;
2035 my $cust_credit_bill = new FS::cust_credit_bill ( {
2036 'crednum' => $credit->crednum,
2037 'invnum' => $cust_bill->invnum,
2038 'amount' => $amount,
2040 my $error = $cust_credit_bill->insert;
2041 die $error if $error;
2043 redo if ($cust_bill->owed > 0);
2047 return $self->total_credited;
2050 =item apply_payments
2052 Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
2053 to outstanding invoice balances in chronological order.
2055 #and returns the value of any remaining unapplied payments.
2059 sub apply_payments {
2064 my @payments = sort { $b->_date <=> $a->_date } ( grep { $_->unapplied > 0 }
2065 qsearch('cust_pay', { 'custnum' => $self->custnum } ) );
2067 my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
2068 qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
2072 foreach my $cust_bill ( @invoices ) {
2075 if ( !defined($payment) || $payment->unapplied == 0 ) {
2076 $payment = pop @payments or last;
2079 if ( $cust_bill->owed >= $payment->unapplied ) {
2080 $amount = $payment->unapplied;
2082 $amount = $cust_bill->owed;
2085 my $cust_bill_pay = new FS::cust_bill_pay ( {
2086 'paynum' => $payment->paynum,
2087 'invnum' => $cust_bill->invnum,
2088 'amount' => $amount,
2090 my $error = $cust_bill_pay->insert;
2091 die $error if $error;
2093 redo if ( $cust_bill->owed > 0);
2097 return $self->total_unapplied_payments;
2100 =item total_credited
2102 Returns the total outstanding credit (see L<FS::cust_credit>) for this
2103 customer. See L<FS::cust_credit/credited>.
2107 sub total_credited {
2109 my $total_credit = 0;
2110 foreach my $cust_credit ( qsearch('cust_credit', {
2111 'custnum' => $self->custnum,
2113 $total_credit += $cust_credit->credited;
2115 sprintf( "%.2f", $total_credit );
2118 =item total_unapplied_payments
2120 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
2121 See L<FS::cust_pay/unapplied>.
2125 sub total_unapplied_payments {
2127 my $total_unapplied = 0;
2128 foreach my $cust_pay ( qsearch('cust_pay', {
2129 'custnum' => $self->custnum,
2131 $total_unapplied += $cust_pay->unapplied;
2133 sprintf( "%.2f", $total_unapplied );
2138 Returns the balance for this customer (total_owed minus total_credited
2139 minus total_unapplied_payments).
2146 $self->total_owed - $self->total_credited - $self->total_unapplied_payments
2150 =item balance_date TIME
2152 Returns the balance for this customer, only considering invoices with date
2153 earlier than TIME (total_owed_date minus total_credited minus
2154 total_unapplied_payments). TIME is specified as a UNIX timestamp; see
2155 L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion
2164 $self->total_owed_date($time)
2165 - $self->total_credited
2166 - $self->total_unapplied_payments
2170 =item paydate_monthyear
2172 Returns a two-element list consisting of the month and year of this customer's
2173 paydate (credit card expiration date for CARD customers)
2177 sub paydate_monthyear {
2179 if ( $self->paydate =~ /^(\d{4})-(\d{1,2})-\d{1,2}$/ ) { #Pg date format
2181 } elsif ( $self->paydate =~ /^(\d{1,2})-(\d{1,2}-)?(\d{4}$)/ ) {
2188 =item payinfo_masked
2190 Returns a "masked" payinfo field with all but the last four characters replaced
2191 by 'x'es. Useful for displaying credit cards.
2195 sub payinfo_masked {
2197 my $payinfo = $self->payinfo;
2198 'x'x(length($payinfo)-4). substr($payinfo,(length($payinfo)-4));
2201 =item invoicing_list [ ARRAYREF ]
2203 If an arguement is given, sets these email addresses as invoice recipients
2204 (see L<FS::cust_main_invoice>). Errors are not fatal and are not reported
2205 (except as warnings), so use check_invoicing_list first.
2207 Returns a list of email addresses (with svcnum entries expanded).
2209 Note: You can clear the invoicing list by passing an empty ARRAYREF. You can
2210 check it without disturbing anything by passing nothing.
2212 This interface may change in the future.
2216 sub invoicing_list {
2217 my( $self, $arrayref ) = @_;
2219 my @cust_main_invoice;
2220 if ( $self->custnum ) {
2221 @cust_main_invoice =
2222 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
2224 @cust_main_invoice = ();
2226 foreach my $cust_main_invoice ( @cust_main_invoice ) {
2227 #warn $cust_main_invoice->destnum;
2228 unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
2229 #warn $cust_main_invoice->destnum;
2230 my $error = $cust_main_invoice->delete;
2231 warn $error if $error;
2234 if ( $self->custnum ) {
2235 @cust_main_invoice =
2236 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
2238 @cust_main_invoice = ();
2240 my %seen = map { $_->address => 1 } @cust_main_invoice;
2241 foreach my $address ( @{$arrayref} ) {
2242 next if exists $seen{$address} && $seen{$address};
2243 $seen{$address} = 1;
2244 my $cust_main_invoice = new FS::cust_main_invoice ( {
2245 'custnum' => $self->custnum,
2248 my $error = $cust_main_invoice->insert;
2249 warn $error if $error;
2252 if ( $self->custnum ) {
2254 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
2260 =item check_invoicing_list ARRAYREF
2262 Checks these arguements as valid input for the invoicing_list method. If there
2263 is an error, returns the error, otherwise returns false.
2267 sub check_invoicing_list {
2268 my( $self, $arrayref ) = @_;
2269 foreach my $address ( @{$arrayref} ) {
2270 my $cust_main_invoice = new FS::cust_main_invoice ( {
2271 'custnum' => $self->custnum,
2274 my $error = $self->custnum
2275 ? $cust_main_invoice->check
2276 : $cust_main_invoice->checkdest
2278 return $error if $error;
2283 =item set_default_invoicing_list
2285 Sets the invoicing list to all accounts associated with this customer,
2286 overwriting any previous invoicing list.
2290 sub set_default_invoicing_list {
2292 $self->invoicing_list($self->all_emails);
2297 Returns the email addresses of all accounts provisioned for this customer.
2304 foreach my $cust_pkg ( $self->all_pkgs ) {
2305 my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
2307 map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
2308 grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
2310 $list{$_}=1 foreach map { $_->email } @svc_acct;
2315 =item invoicing_list_addpost
2317 Adds postal invoicing to this customer. If this customer is already configured
2318 to receive postal invoices, does nothing.
2322 sub invoicing_list_addpost {
2324 return if grep { $_ eq 'POST' } $self->invoicing_list;
2325 my @invoicing_list = $self->invoicing_list;
2326 push @invoicing_list, 'POST';
2327 $self->invoicing_list(\@invoicing_list);
2330 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
2332 Returns an array of customers referred by this customer (referral_custnum set
2333 to this custnum). If DEPTH is given, recurses up to the given depth, returning
2334 customers referred by customers referred by this customer and so on, inclusive.
2335 The default behavior is DEPTH 1 (no recursion).
2339 sub referral_cust_main {
2341 my $depth = @_ ? shift : 1;
2342 my $exclude = @_ ? shift : {};
2345 map { $exclude->{$_->custnum}++; $_; }
2346 grep { ! $exclude->{ $_->custnum } }
2347 qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
2351 map { $_->referral_cust_main($depth-1, $exclude) }
2358 =item referral_cust_main_ncancelled
2360 Same as referral_cust_main, except only returns customers with uncancelled
2365 sub referral_cust_main_ncancelled {
2367 grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
2370 =item referral_cust_pkg [ DEPTH ]
2372 Like referral_cust_main, except returns a flat list of all unsuspended (and
2373 uncancelled) packages for each customer. The number of items in this list may
2374 be useful for comission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
2378 sub referral_cust_pkg {
2380 my $depth = @_ ? shift : 1;
2382 map { $_->unsuspended_pkgs }
2383 grep { $_->unsuspended_pkgs }
2384 $self->referral_cust_main($depth);
2387 =item credit AMOUNT, REASON
2389 Applies a credit to this customer. If there is an error, returns the error,
2390 otherwise returns false.
2395 my( $self, $amount, $reason ) = @_;
2396 my $cust_credit = new FS::cust_credit {
2397 'custnum' => $self->custnum,
2398 'amount' => $amount,
2399 'reason' => $reason,
2401 $cust_credit->insert;
2404 =item charge AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
2406 Creates a one-time charge for this customer. If there is an error, returns
2407 the error, otherwise returns false.
2412 my ( $self, $amount ) = ( shift, shift );
2413 my $pkg = @_ ? shift : 'One-time charge';
2414 my $comment = @_ ? shift : '$'. sprintf("%.2f",$amount);
2415 my $taxclass = @_ ? shift : '';
2417 local $SIG{HUP} = 'IGNORE';
2418 local $SIG{INT} = 'IGNORE';
2419 local $SIG{QUIT} = 'IGNORE';
2420 local $SIG{TERM} = 'IGNORE';
2421 local $SIG{TSTP} = 'IGNORE';
2422 local $SIG{PIPE} = 'IGNORE';
2424 my $oldAutoCommit = $FS::UID::AutoCommit;
2425 local $FS::UID::AutoCommit = 0;
2428 my $part_pkg = new FS::part_pkg ( {
2430 'comment' => $comment,
2435 'taxclass' => $taxclass,
2438 my $error = $part_pkg->insert;
2440 $dbh->rollback if $oldAutoCommit;
2444 my $pkgpart = $part_pkg->pkgpart;
2445 my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
2446 unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
2447 my $type_pkgs = new FS::type_pkgs \%type_pkgs;
2448 $error = $type_pkgs->insert;
2450 $dbh->rollback if $oldAutoCommit;
2455 my $cust_pkg = new FS::cust_pkg ( {
2456 'custnum' => $self->custnum,
2457 'pkgpart' => $pkgpart,
2460 $error = $cust_pkg->insert;
2462 $dbh->rollback if $oldAutoCommit;
2466 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2473 Returns all the invoices (see L<FS::cust_bill>) for this customer.
2479 sort { $a->_date <=> $b->_date }
2480 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
2483 =item open_cust_bill
2485 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
2490 sub open_cust_bill {
2492 grep { $_->owed > 0 } $self->cust_bill;
2497 Returns all the credits (see L<FS::cust_credit>) for this customer.
2503 sort { $a->_date <=> $b->_date }
2504 qsearch( 'cust_credit', { 'custnum' => $self->custnum } )
2509 Returns all the payments (see L<FS::cust_pay>) for this customer.
2515 sort { $a->_date <=> $b->_date }
2516 qsearch( 'cust_pay', { 'custnum' => $self->custnum } )
2521 Returns all the refunds (see L<FS::cust_refund>) for this customer.
2527 sort { $a->_date <=> $b->_date }
2528 qsearch( 'cust_refund', { 'custnum' => $self->custnum } )
2531 =item select_for_update
2533 Selects this record with the SQL "FOR UPDATE" command. This can be useful as
2538 sub select_for_update {
2540 qsearch('cust_main', { 'custnum' => $self->custnum }, '*', 'FOR UPDATE' );
2545 Returns a name string for this customer, either "Company (Last, First)" or
2552 my $name = $self->get('last'). ', '. $self->first;
2553 $name = $self->company. " ($name)" if $self->company;
2559 Returns a status string for this customer, currently:
2563 =item prospect - No packages have ever been ordered
2565 =item active - One or more recurring packages is active
2567 =item suspended - All non-cancelled recurring packages are suspended
2569 =item cancelled - All recurring packages are cancelled
2577 for my $status (qw( prospect active suspended cancelled )) {
2578 my $method = $status.'_sql';
2579 my $numnum = ( my $sql = $self->$method() ) =~ s/cust_main\.custnum/?/g;
2580 my $sth = dbh->prepare("SELECT $sql") or die dbh->errstr;
2581 $sth->execute( ($self->custnum) x $numnum ) or die $sth->errstr;
2582 return $status if $sth->fetchrow_arrayref->[0];
2588 Returns a hex triplet color string for this customer's status.
2593 'prospect' => '000000',
2594 'active' => '00CC00',
2595 'suspended' => 'FF9900',
2596 'cancelled' => 'FF0000',
2600 $statuscolor{$self->status};
2605 =head1 CLASS METHODS
2611 Returns an SQL expression identifying prospective cust_main records (customers
2612 with no packages ever ordered)
2616 sub prospect_sql { "
2617 0 = ( SELECT COUNT(*) FROM cust_pkg
2618 WHERE cust_pkg.custnum = cust_main.custnum
2624 Returns an SQL expression identifying active cust_main records.
2629 0 < ( SELECT COUNT(*) FROM cust_pkg
2630 WHERE cust_pkg.custnum = cust_main.custnum
2631 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
2632 AND ( cust_pkg.susp IS NULL OR cust_pkg.susp = 0 )
2639 Returns an SQL expression identifying suspended cust_main records.
2643 sub suspended_sql { susp_sql(@_); }
2645 0 < ( SELECT COUNT(*) FROM cust_pkg
2646 WHERE cust_pkg.custnum = cust_main.custnum
2647 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
2649 AND 0 = ( SELECT COUNT(*) FROM cust_pkg
2650 WHERE cust_pkg.custnum = cust_main.custnum
2651 AND ( cust_pkg.susp IS NULL OR cust_pkg.susp = 0 )
2658 Returns an SQL expression identifying cancelled cust_main records.
2662 sub cancelled_sql { cancel_sql(@_); }
2664 0 < ( SELECT COUNT(*) FROM cust_pkg
2665 WHERE cust_pkg.custnum = cust_main.custnum
2667 AND 0 = ( SELECT COUNT(*) FROM cust_pkg
2668 WHERE cust_pkg.custnum = cust_main.custnum
2669 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
2679 =item check_and_rebuild_fuzzyfiles
2683 sub check_and_rebuild_fuzzyfiles {
2684 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2685 -e "$dir/cust_main.last" && -e "$dir/cust_main.company"
2686 or &rebuild_fuzzyfiles;
2689 =item rebuild_fuzzyfiles
2693 sub rebuild_fuzzyfiles {
2695 use Fcntl qw(:flock);
2697 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2701 open(LASTLOCK,">>$dir/cust_main.last")
2702 or die "can't open $dir/cust_main.last: $!";
2703 flock(LASTLOCK,LOCK_EX)
2704 or die "can't lock $dir/cust_main.last: $!";
2706 my @all_last = map $_->getfield('last'), qsearch('cust_main', {});
2708 grep $_, map $_->getfield('ship_last'), qsearch('cust_main',{})
2709 if defined dbdef->table('cust_main')->column('ship_last');
2711 open (LASTCACHE,">$dir/cust_main.last.tmp")
2712 or die "can't open $dir/cust_main.last.tmp: $!";
2713 print LASTCACHE join("\n", @all_last), "\n";
2714 close LASTCACHE or die "can't close $dir/cust_main.last.tmp: $!";
2716 rename "$dir/cust_main.last.tmp", "$dir/cust_main.last";
2721 open(COMPANYLOCK,">>$dir/cust_main.company")
2722 or die "can't open $dir/cust_main.company: $!";
2723 flock(COMPANYLOCK,LOCK_EX)
2724 or die "can't lock $dir/cust_main.company: $!";
2726 my @all_company = grep $_ ne '', map $_->company, qsearch('cust_main',{});
2728 grep $_ ne '', map $_->ship_company, qsearch('cust_main', {})
2729 if defined dbdef->table('cust_main')->column('ship_last');
2731 open (COMPANYCACHE,">$dir/cust_main.company.tmp")
2732 or die "can't open $dir/cust_main.company.tmp: $!";
2733 print COMPANYCACHE join("\n", @all_company), "\n";
2734 close COMPANYCACHE or die "can't close $dir/cust_main.company.tmp: $!";
2736 rename "$dir/cust_main.company.tmp", "$dir/cust_main.company";
2746 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2747 open(LASTCACHE,"<$dir/cust_main.last")
2748 or die "can't open $dir/cust_main.last: $!";
2749 my @array = map { chomp; $_; } <LASTCACHE>;
2759 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2760 open(COMPANYCACHE,"<$dir/cust_main.company")
2761 or die "can't open $dir/cust_main.last: $!";
2762 my @array = map { chomp; $_; } <COMPANYCACHE>;
2767 =item append_fuzzyfiles LASTNAME COMPANY
2771 sub append_fuzzyfiles {
2772 my( $last, $company ) = @_;
2774 &check_and_rebuild_fuzzyfiles;
2776 use Fcntl qw(:flock);
2778 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2782 open(LAST,">>$dir/cust_main.last")
2783 or die "can't open $dir/cust_main.last: $!";
2785 or die "can't lock $dir/cust_main.last: $!";
2787 print LAST "$last\n";
2790 or die "can't unlock $dir/cust_main.last: $!";
2796 open(COMPANY,">>$dir/cust_main.company")
2797 or die "can't open $dir/cust_main.company: $!";
2798 flock(COMPANY,LOCK_EX)
2799 or die "can't lock $dir/cust_main.company: $!";
2801 print COMPANY "$company\n";
2803 flock(COMPANY,LOCK_UN)
2804 or die "can't unlock $dir/cust_main.company: $!";
2818 #warn join('-',keys %$param);
2819 my $fh = $param->{filehandle};
2820 my $agentnum = $param->{agentnum};
2821 my $refnum = $param->{refnum};
2822 my $pkgpart = $param->{pkgpart};
2823 my @fields = @{$param->{fields}};
2825 eval "use Date::Parse;";
2827 eval "use Text::CSV_XS;";
2830 my $csv = new Text::CSV_XS;
2837 local $SIG{HUP} = 'IGNORE';
2838 local $SIG{INT} = 'IGNORE';
2839 local $SIG{QUIT} = 'IGNORE';
2840 local $SIG{TERM} = 'IGNORE';
2841 local $SIG{TSTP} = 'IGNORE';
2842 local $SIG{PIPE} = 'IGNORE';
2844 my $oldAutoCommit = $FS::UID::AutoCommit;
2845 local $FS::UID::AutoCommit = 0;
2848 #while ( $columns = $csv->getline($fh) ) {
2850 while ( defined($line=<$fh>) ) {
2852 $csv->parse($line) or do {
2853 $dbh->rollback if $oldAutoCommit;
2854 return "can't parse: ". $csv->error_input();
2857 my @columns = $csv->fields();
2858 #warn join('-',@columns);
2861 agentnum => $agentnum,
2863 country => $conf->config('countrydefault') || 'US',
2864 payby => 'BILL', #default
2865 paydate => '12/2037', #default
2867 my $billtime = time;
2868 my %cust_pkg = ( pkgpart => $pkgpart );
2869 foreach my $field ( @fields ) {
2870 if ( $field =~ /^cust_pkg\.(setup|bill|susp|expire|cancel)$/ ) {
2871 #$cust_pkg{$1} = str2time( shift @$columns );
2872 if ( $1 eq 'setup' ) {
2873 $billtime = str2time(shift @columns);
2875 $cust_pkg{$1} = str2time( shift @columns );
2878 #$cust_main{$field} = shift @$columns;
2879 $cust_main{$field} = shift @columns;
2883 my $cust_pkg = new FS::cust_pkg ( \%cust_pkg ) if $pkgpart;
2884 my $cust_main = new FS::cust_main ( \%cust_main );
2886 tie my %hash, 'Tie::RefHash'; #this part is important
2887 $hash{$cust_pkg} = [] if $pkgpart;
2888 my $error = $cust_main->insert( \%hash );
2891 $dbh->rollback if $oldAutoCommit;
2892 return "can't insert customer for $line: $error";
2895 #false laziness w/bill.cgi
2896 $error = $cust_main->bill( 'time' => $billtime );
2898 $dbh->rollback if $oldAutoCommit;
2899 return "can't bill customer for $line: $error";
2902 $cust_main->apply_payments;
2903 $cust_main->apply_credits;
2905 $error = $cust_main->collect();
2907 $dbh->rollback if $oldAutoCommit;
2908 return "can't collect customer for $line: $error";
2914 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2916 return "Empty file!" unless $imported;
2928 #warn join('-',keys %$param);
2929 my $fh = $param->{filehandle};
2930 my @fields = @{$param->{fields}};
2932 eval "use Date::Parse;";
2934 eval "use Text::CSV_XS;";
2937 my $csv = new Text::CSV_XS;
2944 local $SIG{HUP} = 'IGNORE';
2945 local $SIG{INT} = 'IGNORE';
2946 local $SIG{QUIT} = 'IGNORE';
2947 local $SIG{TERM} = 'IGNORE';
2948 local $SIG{TSTP} = 'IGNORE';
2949 local $SIG{PIPE} = 'IGNORE';
2951 my $oldAutoCommit = $FS::UID::AutoCommit;
2952 local $FS::UID::AutoCommit = 0;
2955 #while ( $columns = $csv->getline($fh) ) {
2957 while ( defined($line=<$fh>) ) {
2959 $csv->parse($line) or do {
2960 $dbh->rollback if $oldAutoCommit;
2961 return "can't parse: ". $csv->error_input();
2964 my @columns = $csv->fields();
2965 #warn join('-',@columns);
2968 foreach my $field ( @fields ) {
2969 $row{$field} = shift @columns;
2972 my $cust_main = qsearchs('cust_main', { 'custnum' => $row{'custnum'} } );
2973 unless ( $cust_main ) {
2974 $dbh->rollback if $oldAutoCommit;
2975 return "unknown custnum $row{'custnum'}";
2978 if ( $row{'amount'} > 0 ) {
2979 my $error = $cust_main->charge($row{'amount'}, $row{'pkg'});
2981 $dbh->rollback if $oldAutoCommit;
2985 } elsif ( $row{'amount'} < 0 ) {
2986 my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ),
2989 $dbh->rollback if $oldAutoCommit;
2999 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3001 return "Empty file!" unless $imported;
3013 The delete method should possibly take an FS::cust_main object reference
3014 instead of a scalar customer number.
3016 Bill and collect options should probably be passed as references instead of a
3019 There should probably be a configuration file with a list of allowed credit
3022 No multiple currency support (probably a larger project than just this module).
3024 payinfo_masked false laziness with cust_pay.pm and cust_refund.pm
3028 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
3029 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
3030 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.