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 );
2000 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
2001 to outstanding invoice balances in chronological order and returns the value
2002 of any remaining unapplied credits available for refund
2003 (see L<FS::cust_refund>).
2010 return 0 unless $self->total_credited;
2012 my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
2013 qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
2015 my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
2016 qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
2020 foreach my $cust_bill ( @invoices ) {
2023 if ( !defined($credit) || $credit->credited == 0) {
2024 $credit = pop @credits or last;
2027 if ($cust_bill->owed >= $credit->credited) {
2028 $amount=$credit->credited;
2030 $amount=$cust_bill->owed;
2033 my $cust_credit_bill = new FS::cust_credit_bill ( {
2034 'crednum' => $credit->crednum,
2035 'invnum' => $cust_bill->invnum,
2036 'amount' => $amount,
2038 my $error = $cust_credit_bill->insert;
2039 die $error if $error;
2041 redo if ($cust_bill->owed > 0);
2045 return $self->total_credited;
2048 =item apply_payments
2050 Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
2051 to outstanding invoice balances in chronological order.
2053 #and returns the value of any remaining unapplied payments.
2057 sub apply_payments {
2062 my @payments = sort { $b->_date <=> $a->_date } ( grep { $_->unapplied > 0 }
2063 qsearch('cust_pay', { 'custnum' => $self->custnum } ) );
2065 my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
2066 qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
2070 foreach my $cust_bill ( @invoices ) {
2073 if ( !defined($payment) || $payment->unapplied == 0 ) {
2074 $payment = pop @payments or last;
2077 if ( $cust_bill->owed >= $payment->unapplied ) {
2078 $amount = $payment->unapplied;
2080 $amount = $cust_bill->owed;
2083 my $cust_bill_pay = new FS::cust_bill_pay ( {
2084 'paynum' => $payment->paynum,
2085 'invnum' => $cust_bill->invnum,
2086 'amount' => $amount,
2088 my $error = $cust_bill_pay->insert;
2089 die $error if $error;
2091 redo if ( $cust_bill->owed > 0);
2095 return $self->total_unapplied_payments;
2098 =item total_credited
2100 Returns the total outstanding credit (see L<FS::cust_credit>) for this
2101 customer. See L<FS::cust_credit/credited>.
2105 sub total_credited {
2107 my $total_credit = 0;
2108 foreach my $cust_credit ( qsearch('cust_credit', {
2109 'custnum' => $self->custnum,
2111 $total_credit += $cust_credit->credited;
2113 sprintf( "%.2f", $total_credit );
2116 =item total_unapplied_payments
2118 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
2119 See L<FS::cust_pay/unapplied>.
2123 sub total_unapplied_payments {
2125 my $total_unapplied = 0;
2126 foreach my $cust_pay ( qsearch('cust_pay', {
2127 'custnum' => $self->custnum,
2129 $total_unapplied += $cust_pay->unapplied;
2131 sprintf( "%.2f", $total_unapplied );
2136 Returns the balance for this customer (total_owed minus total_credited
2137 minus total_unapplied_payments).
2144 $self->total_owed - $self->total_credited - $self->total_unapplied_payments
2148 =item balance_date TIME
2150 Returns the balance for this customer, only considering invoices with date
2151 earlier than TIME (total_owed_date minus total_credited minus
2152 total_unapplied_payments). TIME is specified as a UNIX timestamp; see
2153 L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion
2162 $self->total_owed_date($time)
2163 - $self->total_credited
2164 - $self->total_unapplied_payments
2168 =item paydate_monthyear
2170 Returns a two-element list consisting of the month and year of this customer's
2171 paydate (credit card expiration date for CARD customers)
2175 sub paydate_monthyear {
2177 if ( $self->paydate =~ /^(\d{4})-(\d{2})-\d{2}$/ ) { #Pg date format
2179 } elsif ( $self->paydate =~ /^(\d{1,2})-(\d{1,2}-)?(\d{4}$)/ ) {
2186 =item payinfo_masked
2188 Returns a "masked" payinfo field with all but the last four characters replaced
2189 by 'x'es. Useful for displaying credit cards.
2193 sub payinfo_masked {
2195 my $payinfo = $self->payinfo;
2196 'x'x(length($payinfo)-4). substr($payinfo,(length($payinfo)-4));
2199 =item invoicing_list [ ARRAYREF ]
2201 If an arguement is given, sets these email addresses as invoice recipients
2202 (see L<FS::cust_main_invoice>). Errors are not fatal and are not reported
2203 (except as warnings), so use check_invoicing_list first.
2205 Returns a list of email addresses (with svcnum entries expanded).
2207 Note: You can clear the invoicing list by passing an empty ARRAYREF. You can
2208 check it without disturbing anything by passing nothing.
2210 This interface may change in the future.
2214 sub invoicing_list {
2215 my( $self, $arrayref ) = @_;
2217 my @cust_main_invoice;
2218 if ( $self->custnum ) {
2219 @cust_main_invoice =
2220 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
2222 @cust_main_invoice = ();
2224 foreach my $cust_main_invoice ( @cust_main_invoice ) {
2225 #warn $cust_main_invoice->destnum;
2226 unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
2227 #warn $cust_main_invoice->destnum;
2228 my $error = $cust_main_invoice->delete;
2229 warn $error if $error;
2232 if ( $self->custnum ) {
2233 @cust_main_invoice =
2234 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
2236 @cust_main_invoice = ();
2238 my %seen = map { $_->address => 1 } @cust_main_invoice;
2239 foreach my $address ( @{$arrayref} ) {
2240 next if exists $seen{$address} && $seen{$address};
2241 $seen{$address} = 1;
2242 my $cust_main_invoice = new FS::cust_main_invoice ( {
2243 'custnum' => $self->custnum,
2246 my $error = $cust_main_invoice->insert;
2247 warn $error if $error;
2250 if ( $self->custnum ) {
2252 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
2258 =item check_invoicing_list ARRAYREF
2260 Checks these arguements as valid input for the invoicing_list method. If there
2261 is an error, returns the error, otherwise returns false.
2265 sub check_invoicing_list {
2266 my( $self, $arrayref ) = @_;
2267 foreach my $address ( @{$arrayref} ) {
2268 my $cust_main_invoice = new FS::cust_main_invoice ( {
2269 'custnum' => $self->custnum,
2272 my $error = $self->custnum
2273 ? $cust_main_invoice->check
2274 : $cust_main_invoice->checkdest
2276 return $error if $error;
2281 =item set_default_invoicing_list
2283 Sets the invoicing list to all accounts associated with this customer,
2284 overwriting any previous invoicing list.
2288 sub set_default_invoicing_list {
2290 $self->invoicing_list($self->all_emails);
2295 Returns the email addresses of all accounts provisioned for this customer.
2302 foreach my $cust_pkg ( $self->all_pkgs ) {
2303 my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
2305 map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
2306 grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
2308 $list{$_}=1 foreach map { $_->email } @svc_acct;
2313 =item invoicing_list_addpost
2315 Adds postal invoicing to this customer. If this customer is already configured
2316 to receive postal invoices, does nothing.
2320 sub invoicing_list_addpost {
2322 return if grep { $_ eq 'POST' } $self->invoicing_list;
2323 my @invoicing_list = $self->invoicing_list;
2324 push @invoicing_list, 'POST';
2325 $self->invoicing_list(\@invoicing_list);
2328 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
2330 Returns an array of customers referred by this customer (referral_custnum set
2331 to this custnum). If DEPTH is given, recurses up to the given depth, returning
2332 customers referred by customers referred by this customer and so on, inclusive.
2333 The default behavior is DEPTH 1 (no recursion).
2337 sub referral_cust_main {
2339 my $depth = @_ ? shift : 1;
2340 my $exclude = @_ ? shift : {};
2343 map { $exclude->{$_->custnum}++; $_; }
2344 grep { ! $exclude->{ $_->custnum } }
2345 qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
2349 map { $_->referral_cust_main($depth-1, $exclude) }
2356 =item referral_cust_main_ncancelled
2358 Same as referral_cust_main, except only returns customers with uncancelled
2363 sub referral_cust_main_ncancelled {
2365 grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
2368 =item referral_cust_pkg [ DEPTH ]
2370 Like referral_cust_main, except returns a flat list of all unsuspended (and
2371 uncancelled) packages for each customer. The number of items in this list may
2372 be useful for comission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
2376 sub referral_cust_pkg {
2378 my $depth = @_ ? shift : 1;
2380 map { $_->unsuspended_pkgs }
2381 grep { $_->unsuspended_pkgs }
2382 $self->referral_cust_main($depth);
2385 =item credit AMOUNT, REASON
2387 Applies a credit to this customer. If there is an error, returns the error,
2388 otherwise returns false.
2393 my( $self, $amount, $reason ) = @_;
2394 my $cust_credit = new FS::cust_credit {
2395 'custnum' => $self->custnum,
2396 'amount' => $amount,
2397 'reason' => $reason,
2399 $cust_credit->insert;
2402 =item charge AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
2404 Creates a one-time charge for this customer. If there is an error, returns
2405 the error, otherwise returns false.
2410 my ( $self, $amount ) = ( shift, shift );
2411 my $pkg = @_ ? shift : 'One-time charge';
2412 my $comment = @_ ? shift : '$'. sprintf("%.2f",$amount);
2413 my $taxclass = @_ ? shift : '';
2415 local $SIG{HUP} = 'IGNORE';
2416 local $SIG{INT} = 'IGNORE';
2417 local $SIG{QUIT} = 'IGNORE';
2418 local $SIG{TERM} = 'IGNORE';
2419 local $SIG{TSTP} = 'IGNORE';
2420 local $SIG{PIPE} = 'IGNORE';
2422 my $oldAutoCommit = $FS::UID::AutoCommit;
2423 local $FS::UID::AutoCommit = 0;
2426 my $part_pkg = new FS::part_pkg ( {
2428 'comment' => $comment,
2433 'taxclass' => $taxclass,
2436 my $error = $part_pkg->insert;
2438 $dbh->rollback if $oldAutoCommit;
2442 my $pkgpart = $part_pkg->pkgpart;
2443 my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
2444 unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
2445 my $type_pkgs = new FS::type_pkgs \%type_pkgs;
2446 $error = $type_pkgs->insert;
2448 $dbh->rollback if $oldAutoCommit;
2453 my $cust_pkg = new FS::cust_pkg ( {
2454 'custnum' => $self->custnum,
2455 'pkgpart' => $pkgpart,
2458 $error = $cust_pkg->insert;
2460 $dbh->rollback if $oldAutoCommit;
2464 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2471 Returns all the invoices (see L<FS::cust_bill>) for this customer.
2477 sort { $a->_date <=> $b->_date }
2478 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
2481 =item open_cust_bill
2483 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
2488 sub open_cust_bill {
2490 grep { $_->owed > 0 } $self->cust_bill;
2495 Returns all the credits (see L<FS::cust_credit>) for this customer.
2501 sort { $a->_date <=> $b->_date }
2502 qsearch( 'cust_credit', { 'custnum' => $self->custnum } )
2507 Returns all the payments (see L<FS::cust_pay>) for this customer.
2513 sort { $a->_date <=> $b->_date }
2514 qsearch( 'cust_pay', { 'custnum' => $self->custnum } )
2519 Returns all the refunds (see L<FS::cust_refund>) for this customer.
2525 sort { $a->_date <=> $b->_date }
2526 qsearch( 'cust_refund', { 'custnum' => $self->custnum } )
2529 =item select_for_update
2531 Selects this record with the SQL "FOR UPDATE" command. This can be useful as
2536 sub select_for_update {
2538 qsearch('cust_main', { 'custnum' => $self->custnum }, '*', 'FOR UPDATE' );
2543 Returns a name string for this customer, either "Company (Last, First)" or
2550 my $name = $self->get('last'). ', '. $self->first;
2551 $name = $self->company. " ($name)" if $self->company;
2557 Returns a status string for this customer, currently:
2561 =item prospect - No packages have ever been ordered
2563 =item active - One or more recurring packages is active
2565 =item suspended - All non-cancelled recurring packages are suspended
2567 =item cancelled - All recurring packages are cancelled
2575 for my $status (qw( prospect active suspended cancelled )) {
2576 my $method = $status.'_sql';
2577 my $numnum = ( my $sql = $self->$method() ) =~ s/cust_main\.custnum/?/g;
2578 my $sth = dbh->prepare("SELECT $sql") or die dbh->errstr;
2579 $sth->execute( ($self->custnum) x $numnum ) or die $sth->errstr;
2580 return $status if $sth->fetchrow_arrayref->[0];
2586 Returns a hex triplet color string for this customer's status.
2591 'prospect' => '000000',
2592 'active' => '00CC00',
2593 'suspended' => 'FF9900',
2594 'cancelled' => 'FF0000',
2598 $statuscolor{$self->status};
2603 =head1 CLASS METHODS
2609 Returns an SQL expression identifying prospective cust_main records (customers
2610 with no packages ever ordered)
2614 sub prospect_sql { "
2615 0 = ( SELECT COUNT(*) FROM cust_pkg
2616 WHERE cust_pkg.custnum = cust_main.custnum
2622 Returns an SQL expression identifying active cust_main records.
2627 0 < ( SELECT COUNT(*) FROM cust_pkg
2628 WHERE cust_pkg.custnum = cust_main.custnum
2629 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
2630 AND ( cust_pkg.susp IS NULL OR cust_pkg.susp = 0 )
2637 Returns an SQL expression identifying suspended cust_main records.
2641 sub suspended_sql { susp_sql(@_); }
2643 0 < ( SELECT COUNT(*) FROM cust_pkg
2644 WHERE cust_pkg.custnum = cust_main.custnum
2645 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
2647 AND 0 = ( SELECT COUNT(*) FROM cust_pkg
2648 WHERE cust_pkg.custnum = cust_main.custnum
2649 AND ( cust_pkg.susp IS NULL OR cust_pkg.susp = 0 )
2656 Returns an SQL expression identifying cancelled cust_main records.
2660 sub cancelled_sql { cancel_sql(@_); }
2662 0 < ( SELECT COUNT(*) FROM cust_pkg
2663 WHERE cust_pkg.custnum = cust_main.custnum
2665 AND 0 = ( SELECT COUNT(*) FROM cust_pkg
2666 WHERE cust_pkg.custnum = cust_main.custnum
2667 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
2677 =item check_and_rebuild_fuzzyfiles
2681 sub check_and_rebuild_fuzzyfiles {
2682 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2683 -e "$dir/cust_main.last" && -e "$dir/cust_main.company"
2684 or &rebuild_fuzzyfiles;
2687 =item rebuild_fuzzyfiles
2691 sub rebuild_fuzzyfiles {
2693 use Fcntl qw(:flock);
2695 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2699 open(LASTLOCK,">>$dir/cust_main.last")
2700 or die "can't open $dir/cust_main.last: $!";
2701 flock(LASTLOCK,LOCK_EX)
2702 or die "can't lock $dir/cust_main.last: $!";
2704 my @all_last = map $_->getfield('last'), qsearch('cust_main', {});
2706 grep $_, map $_->getfield('ship_last'), qsearch('cust_main',{})
2707 if defined dbdef->table('cust_main')->column('ship_last');
2709 open (LASTCACHE,">$dir/cust_main.last.tmp")
2710 or die "can't open $dir/cust_main.last.tmp: $!";
2711 print LASTCACHE join("\n", @all_last), "\n";
2712 close LASTCACHE or die "can't close $dir/cust_main.last.tmp: $!";
2714 rename "$dir/cust_main.last.tmp", "$dir/cust_main.last";
2719 open(COMPANYLOCK,">>$dir/cust_main.company")
2720 or die "can't open $dir/cust_main.company: $!";
2721 flock(COMPANYLOCK,LOCK_EX)
2722 or die "can't lock $dir/cust_main.company: $!";
2724 my @all_company = grep $_ ne '', map $_->company, qsearch('cust_main',{});
2726 grep $_ ne '', map $_->ship_company, qsearch('cust_main', {})
2727 if defined dbdef->table('cust_main')->column('ship_last');
2729 open (COMPANYCACHE,">$dir/cust_main.company.tmp")
2730 or die "can't open $dir/cust_main.company.tmp: $!";
2731 print COMPANYCACHE join("\n", @all_company), "\n";
2732 close COMPANYCACHE or die "can't close $dir/cust_main.company.tmp: $!";
2734 rename "$dir/cust_main.company.tmp", "$dir/cust_main.company";
2744 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2745 open(LASTCACHE,"<$dir/cust_main.last")
2746 or die "can't open $dir/cust_main.last: $!";
2747 my @array = map { chomp; $_; } <LASTCACHE>;
2757 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2758 open(COMPANYCACHE,"<$dir/cust_main.company")
2759 or die "can't open $dir/cust_main.last: $!";
2760 my @array = map { chomp; $_; } <COMPANYCACHE>;
2765 =item append_fuzzyfiles LASTNAME COMPANY
2769 sub append_fuzzyfiles {
2770 my( $last, $company ) = @_;
2772 &check_and_rebuild_fuzzyfiles;
2774 use Fcntl qw(:flock);
2776 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2780 open(LAST,">>$dir/cust_main.last")
2781 or die "can't open $dir/cust_main.last: $!";
2783 or die "can't lock $dir/cust_main.last: $!";
2785 print LAST "$last\n";
2788 or die "can't unlock $dir/cust_main.last: $!";
2794 open(COMPANY,">>$dir/cust_main.company")
2795 or die "can't open $dir/cust_main.company: $!";
2796 flock(COMPANY,LOCK_EX)
2797 or die "can't lock $dir/cust_main.company: $!";
2799 print COMPANY "$company\n";
2801 flock(COMPANY,LOCK_UN)
2802 or die "can't unlock $dir/cust_main.company: $!";
2816 #warn join('-',keys %$param);
2817 my $fh = $param->{filehandle};
2818 my $agentnum = $param->{agentnum};
2819 my $refnum = $param->{refnum};
2820 my $pkgpart = $param->{pkgpart};
2821 my @fields = @{$param->{fields}};
2823 eval "use Date::Parse;";
2825 eval "use Text::CSV_XS;";
2828 my $csv = new Text::CSV_XS;
2835 local $SIG{HUP} = 'IGNORE';
2836 local $SIG{INT} = 'IGNORE';
2837 local $SIG{QUIT} = 'IGNORE';
2838 local $SIG{TERM} = 'IGNORE';
2839 local $SIG{TSTP} = 'IGNORE';
2840 local $SIG{PIPE} = 'IGNORE';
2842 my $oldAutoCommit = $FS::UID::AutoCommit;
2843 local $FS::UID::AutoCommit = 0;
2846 #while ( $columns = $csv->getline($fh) ) {
2848 while ( defined($line=<$fh>) ) {
2850 $csv->parse($line) or do {
2851 $dbh->rollback if $oldAutoCommit;
2852 return "can't parse: ". $csv->error_input();
2855 my @columns = $csv->fields();
2856 #warn join('-',@columns);
2859 agentnum => $agentnum,
2861 country => $conf->config('countrydefault') || 'US',
2862 payby => 'BILL', #default
2863 paydate => '12/2037', #default
2865 my $billtime = time;
2866 my %cust_pkg = ( pkgpart => $pkgpart );
2867 foreach my $field ( @fields ) {
2868 if ( $field =~ /^cust_pkg\.(setup|bill|susp|expire|cancel)$/ ) {
2869 #$cust_pkg{$1} = str2time( shift @$columns );
2870 if ( $1 eq 'setup' ) {
2871 $billtime = str2time(shift @columns);
2873 $cust_pkg{$1} = str2time( shift @columns );
2876 #$cust_main{$field} = shift @$columns;
2877 $cust_main{$field} = shift @columns;
2881 my $cust_pkg = new FS::cust_pkg ( \%cust_pkg ) if $pkgpart;
2882 my $cust_main = new FS::cust_main ( \%cust_main );
2884 tie my %hash, 'Tie::RefHash'; #this part is important
2885 $hash{$cust_pkg} = [] if $pkgpart;
2886 my $error = $cust_main->insert( \%hash );
2889 $dbh->rollback if $oldAutoCommit;
2890 return "can't insert customer for $line: $error";
2893 #false laziness w/bill.cgi
2894 $error = $cust_main->bill( 'time' => $billtime );
2896 $dbh->rollback if $oldAutoCommit;
2897 return "can't bill customer for $line: $error";
2900 $cust_main->apply_payments;
2901 $cust_main->apply_credits;
2903 $error = $cust_main->collect();
2905 $dbh->rollback if $oldAutoCommit;
2906 return "can't collect customer for $line: $error";
2912 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2914 return "Empty file!" unless $imported;
2926 #warn join('-',keys %$param);
2927 my $fh = $param->{filehandle};
2928 my @fields = @{$param->{fields}};
2930 eval "use Date::Parse;";
2932 eval "use Text::CSV_XS;";
2935 my $csv = new Text::CSV_XS;
2942 local $SIG{HUP} = 'IGNORE';
2943 local $SIG{INT} = 'IGNORE';
2944 local $SIG{QUIT} = 'IGNORE';
2945 local $SIG{TERM} = 'IGNORE';
2946 local $SIG{TSTP} = 'IGNORE';
2947 local $SIG{PIPE} = 'IGNORE';
2949 my $oldAutoCommit = $FS::UID::AutoCommit;
2950 local $FS::UID::AutoCommit = 0;
2953 #while ( $columns = $csv->getline($fh) ) {
2955 while ( defined($line=<$fh>) ) {
2957 $csv->parse($line) or do {
2958 $dbh->rollback if $oldAutoCommit;
2959 return "can't parse: ". $csv->error_input();
2962 my @columns = $csv->fields();
2963 #warn join('-',@columns);
2966 foreach my $field ( @fields ) {
2967 $row{$field} = shift @columns;
2970 my $cust_main = qsearchs('cust_main', { 'custnum' => $row{'custnum'} } );
2971 unless ( $cust_main ) {
2972 $dbh->rollback if $oldAutoCommit;
2973 return "unknown custnum $row{'custnum'}";
2976 if ( $row{'amount'} > 0 ) {
2977 my $error = $cust_main->charge($row{'amount'}, $row{'pkg'});
2979 $dbh->rollback if $oldAutoCommit;
2983 } elsif ( $row{'amount'} < 0 ) {
2984 my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ),
2987 $dbh->rollback if $oldAutoCommit;
2997 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2999 return "Empty file!" unless $imported;
3011 The delete method should possibly take an FS::cust_main object reference
3012 instead of a scalar customer number.
3014 Bill and collect options should probably be passed as references instead of a
3017 There should probably be a configuration file with a list of allowed credit
3020 No multiple currency support (probably a larger project than just this module).
3022 payinfo_masked false laziness with cust_pay.pm and cust_refund.pm
3026 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
3027 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
3028 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.