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 cancel [ OPTION => VALUE ... ]
1033 Cancels all uncancelled packages (see L<FS::cust_pkg>) for this customer.
1035 Available options are: I<quiet>
1037 I<quiet> can be set true to supress email cancellation notices.
1039 Always returns a list: an empty list on success or a list of errors.
1045 grep { $_ } map { $_->cancel(@_) } $self->ncancelled_pkgs;
1050 Returns the agent (see L<FS::agent>) for this customer.
1056 qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
1061 Generates invoices (see L<FS::cust_bill>) for this customer. Usually used in
1062 conjunction with the collect method.
1064 Options are passed as name-value pairs.
1066 Currently available options are:
1068 resetup - if set true, re-charges setup fees.
1070 time - bills the customer as if it were that time. Specified as a UNIX
1071 timestamp; see L<perlfunc/"time">). Also see L<Time::Local> and
1072 L<Date::Parse> for conversion functions. For example:
1076 $cust_main->bill( 'time' => str2time('April 20th, 2001') );
1079 If there is an error, returns the error, otherwise returns false.
1084 my( $self, %options ) = @_;
1085 my $time = $options{'time'} || time;
1090 local $SIG{HUP} = 'IGNORE';
1091 local $SIG{INT} = 'IGNORE';
1092 local $SIG{QUIT} = 'IGNORE';
1093 local $SIG{TERM} = 'IGNORE';
1094 local $SIG{TSTP} = 'IGNORE';
1095 local $SIG{PIPE} = 'IGNORE';
1097 my $oldAutoCommit = $FS::UID::AutoCommit;
1098 local $FS::UID::AutoCommit = 0;
1101 $self->select_for_update; #mutex
1103 # find the packages which are due for billing, find out how much they are
1104 # & generate invoice database.
1106 my( $total_setup, $total_recur ) = ( 0, 0 );
1107 #my( $taxable_setup, $taxable_recur ) = ( 0, 0 );
1108 my @cust_bill_pkg = ();
1110 #my $taxable_charged = 0;##
1115 foreach my $cust_pkg (
1116 qsearch('cust_pkg', { 'custnum' => $self->custnum } )
1119 #NO!! next if $cust_pkg->cancel;
1120 next if $cust_pkg->getfield('cancel');
1122 #? to avoid use of uninitialized value errors... ?
1123 $cust_pkg->setfield('bill', '')
1124 unless defined($cust_pkg->bill);
1126 my $part_pkg = $cust_pkg->part_pkg;
1128 #so we don't modify cust_pkg record unnecessarily
1129 my $cust_pkg_mod_flag = 0;
1130 my %hash = $cust_pkg->hash;
1131 my $old_cust_pkg = new FS::cust_pkg \%hash;
1137 if ( !$cust_pkg->setup || $options{'resetup'} ) {
1138 my $setup_prog = $part_pkg->getfield('setup');
1139 $setup_prog =~ /^(.*)$/ or do {
1140 $dbh->rollback if $oldAutoCommit;
1141 return "Illegal setup for pkgpart ". $part_pkg->pkgpart.
1145 $setup_prog = '0' if $setup_prog =~ /^\s*$/;
1147 #my $cpt = new Safe;
1148 ##$cpt->permit(); #what is necessary?
1149 #$cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
1150 #$setup = $cpt->reval($setup_prog);
1151 $setup = eval $setup_prog;
1152 unless ( defined($setup) ) {
1153 $dbh->rollback if $oldAutoCommit;
1154 return "Error eval-ing part_pkg->setup pkgpart ". $part_pkg->pkgpart.
1155 "(expression $setup_prog): $@";
1157 $cust_pkg->setfield('setup', $time) unless $cust_pkg->setup;
1158 $cust_pkg_mod_flag=1;
1164 if ( $part_pkg->getfield('freq') ne '0' &&
1165 ! $cust_pkg->getfield('susp') &&
1166 ( $cust_pkg->getfield('bill') || 0 ) <= $time
1168 my $recur_prog = $part_pkg->getfield('recur');
1169 $recur_prog =~ /^(.*)$/ or do {
1170 $dbh->rollback if $oldAutoCommit;
1171 return "Illegal recur for pkgpart ". $part_pkg->pkgpart.
1175 $recur_prog = '0' if $recur_prog =~ /^\s*$/;
1177 # shared with $recur_prog
1178 $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
1180 #my $cpt = new Safe;
1181 ##$cpt->permit(); #what is necessary?
1182 #$cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
1183 #$recur = $cpt->reval($recur_prog);
1184 $recur = eval $recur_prog;
1185 unless ( defined($recur) ) {
1186 $dbh->rollback if $oldAutoCommit;
1187 return "Error eval-ing part_pkg->recur pkgpart ". $part_pkg->pkgpart.
1188 "(expression $recur_prog): $@";
1190 #change this bit to use Date::Manip? CAREFUL with timezones (see
1191 # mailing list archive)
1192 my ($sec,$min,$hour,$mday,$mon,$year) =
1193 (localtime($sdate) )[0,1,2,3,4,5];
1195 #pro-rating magic - if $recur_prog fiddles $sdate, want to use that
1196 # only for figuring next bill date, nothing else, so, reset $sdate again
1198 $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
1199 $cust_pkg->last_bill($sdate)
1200 if $cust_pkg->dbdef_table->column('last_bill');
1202 if ( $part_pkg->freq =~ /^\d+$/ ) {
1203 $mon += $part_pkg->freq;
1204 until ( $mon < 12 ) { $mon -= 12; $year++; }
1205 } elsif ( $part_pkg->freq =~ /^(\d+)w$/ ) {
1207 $mday += $weeks * 7;
1208 } elsif ( $part_pkg->freq =~ /^(\d+)d$/ ) {
1212 $dbh->rollback if $oldAutoCommit;
1213 return "unparsable frequency: ". $part_pkg->freq;
1215 $cust_pkg->setfield('bill',
1216 timelocal_nocheck($sec,$min,$hour,$mday,$mon,$year));
1217 $cust_pkg_mod_flag = 1;
1220 warn "\$setup is undefined" unless defined($setup);
1221 warn "\$recur is undefined" unless defined($recur);
1222 warn "\$cust_pkg->bill is undefined" unless defined($cust_pkg->bill);
1224 if ( $cust_pkg_mod_flag ) {
1225 $error=$cust_pkg->replace($old_cust_pkg);
1226 if ( $error ) { #just in case
1227 $dbh->rollback if $oldAutoCommit;
1228 return "Error modifying pkgnum ". $cust_pkg->pkgnum. ": $error";
1230 $setup = sprintf( "%.2f", $setup );
1231 $recur = sprintf( "%.2f", $recur );
1232 if ( $setup < 0 && ! $conf->exists('allow_negative_charges') ) {
1233 $dbh->rollback if $oldAutoCommit;
1234 return "negative setup $setup for pkgnum ". $cust_pkg->pkgnum;
1236 if ( $recur < 0 && ! $conf->exists('allow_negative_charges') ) {
1237 $dbh->rollback if $oldAutoCommit;
1238 return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum;
1240 if ( $setup != 0 || $recur != 0 ) {
1241 my $cust_bill_pkg = new FS::cust_bill_pkg ({
1242 'pkgnum' => $cust_pkg->pkgnum,
1246 'edate' => $cust_pkg->bill,
1247 'details' => \@details,
1249 push @cust_bill_pkg, $cust_bill_pkg;
1250 $total_setup += $setup;
1251 $total_recur += $recur;
1253 unless ( $self->tax =~ /Y/i || $self->payby eq 'COMP' ) {
1255 my @taxes = qsearch( 'cust_main_county', {
1256 'state' => $self->state,
1257 'county' => $self->county,
1258 'country' => $self->country,
1259 'taxclass' => $part_pkg->taxclass,
1262 @taxes = qsearch( 'cust_main_county', {
1263 'state' => $self->state,
1264 'county' => $self->county,
1265 'country' => $self->country,
1270 #one more try at a whole-country tax rate
1272 @taxes = qsearch( 'cust_main_county', {
1275 'country' => $self->country,
1280 # maybe eliminate this entirely, along with all the 0% records
1282 $dbh->rollback if $oldAutoCommit;
1284 "fatal: can't find tax rate for state/county/country/taxclass ".
1285 join('/', ( map $self->$_(), qw(state county country) ),
1286 $part_pkg->taxclass ). "\n";
1289 foreach my $tax ( @taxes ) {
1291 my $taxable_charged = 0;
1292 $taxable_charged += $setup
1293 unless $part_pkg->setuptax =~ /^Y$/i
1294 || $tax->setuptax =~ /^Y$/i;
1295 $taxable_charged += $recur
1296 unless $part_pkg->recurtax =~ /^Y$/i
1297 || $tax->recurtax =~ /^Y$/i;
1298 next unless $taxable_charged;
1300 if ( $tax->exempt_amount > 0 ) {
1301 my ($mon,$year) = (localtime($sdate) )[4,5];
1303 my $freq = $part_pkg->freq || 1;
1304 if ( $freq !~ /(\d+)$/ ) {
1305 $dbh->rollback if $oldAutoCommit;
1306 return "daily/weekly package definitions not (yet?)".
1307 " compatible with monthly tax exemptions";
1309 my $taxable_per_month = sprintf("%.2f", $taxable_charged / $freq );
1310 foreach my $which_month ( 1 .. $freq ) {
1312 'custnum' => $self->custnum,
1313 'taxnum' => $tax->taxnum,
1314 'year' => 1900+$year,
1317 #until ( $mon < 12 ) { $mon -= 12; $year++; }
1318 until ( $mon < 13 ) { $mon -= 12; $year++; }
1319 my $cust_tax_exempt =
1320 qsearchs('cust_tax_exempt', \%hash)
1321 || new FS::cust_tax_exempt( { %hash, 'amount' => 0 } );
1322 my $remaining_exemption = sprintf("%.2f",
1323 $tax->exempt_amount - $cust_tax_exempt->amount );
1324 if ( $remaining_exemption > 0 ) {
1325 my $addl = $remaining_exemption > $taxable_per_month
1326 ? $taxable_per_month
1327 : $remaining_exemption;
1328 $taxable_charged -= $addl;
1329 my $new_cust_tax_exempt = new FS::cust_tax_exempt ( {
1330 $cust_tax_exempt->hash,
1332 sprintf("%.2f", $cust_tax_exempt->amount + $addl),
1334 $error = $new_cust_tax_exempt->exemptnum
1335 ? $new_cust_tax_exempt->replace($cust_tax_exempt)
1336 : $new_cust_tax_exempt->insert;
1338 $dbh->rollback if $oldAutoCommit;
1339 return "fatal: can't update cust_tax_exempt: $error";
1342 } # if $remaining_exemption > 0
1344 } #foreach $which_month
1346 } #if $tax->exempt_amount
1348 $taxable_charged = sprintf( "%.2f", $taxable_charged);
1350 #$tax += $taxable_charged * $cust_main_county->tax / 100
1351 $tax{ $tax->taxname || 'Tax' } +=
1352 $taxable_charged * $tax->tax / 100
1354 } #foreach my $tax ( @taxes )
1356 } #unless $self->tax =~ /Y/i || $self->payby eq 'COMP'
1358 } #if $setup != 0 || $recur != 0
1360 } #if $cust_pkg_mod_flag
1362 } #foreach my $cust_pkg
1364 my $charged = sprintf( "%.2f", $total_setup + $total_recur );
1365 # my $taxable_charged = sprintf( "%.2f", $taxable_setup + $taxable_recur );
1367 unless ( @cust_bill_pkg ) { #don't create invoices with no line items
1368 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1372 # unless ( $self->tax =~ /Y/i
1373 # || $self->payby eq 'COMP'
1374 # || $taxable_charged == 0 ) {
1375 # my $cust_main_county = qsearchs('cust_main_county',{
1376 # 'state' => $self->state,
1377 # 'county' => $self->county,
1378 # 'country' => $self->country,
1379 # } ) or die "fatal: can't find tax rate for state/county/country ".
1380 # $self->state. "/". $self->county. "/". $self->country. "\n";
1381 # my $tax = sprintf( "%.2f",
1382 # $taxable_charged * ( $cust_main_county->getfield('tax') / 100 )
1385 if ( dbdef->table('cust_bill_pkg')->column('itemdesc') ) { #1.5 schema
1387 foreach my $taxname ( grep { $tax{$_} > 0 } keys %tax ) {
1388 my $tax = sprintf("%.2f", $tax{$taxname} );
1389 $charged = sprintf( "%.2f", $charged+$tax );
1391 my $cust_bill_pkg = new FS::cust_bill_pkg ({
1397 'itemdesc' => $taxname,
1399 push @cust_bill_pkg, $cust_bill_pkg;
1402 } else { #1.4 schema
1405 foreach ( values %tax ) { $tax += $_ };
1406 $tax = sprintf("%.2f", $tax);
1408 $charged = sprintf( "%.2f", $charged+$tax );
1410 my $cust_bill_pkg = new FS::cust_bill_pkg ({
1417 push @cust_bill_pkg, $cust_bill_pkg;
1422 my $cust_bill = new FS::cust_bill ( {
1423 'custnum' => $self->custnum,
1425 'charged' => $charged,
1427 $error = $cust_bill->insert;
1429 $dbh->rollback if $oldAutoCommit;
1430 return "can't create invoice for customer #". $self->custnum. ": $error";
1433 my $invnum = $cust_bill->invnum;
1435 foreach $cust_bill_pkg ( @cust_bill_pkg ) {
1437 $cust_bill_pkg->invnum($invnum);
1438 $error = $cust_bill_pkg->insert;
1440 $dbh->rollback if $oldAutoCommit;
1441 return "can't create invoice line item for customer #". $self->custnum.
1446 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1450 =item collect OPTIONS
1452 (Attempt to) collect money for this customer's outstanding invoices (see
1453 L<FS::cust_bill>). Usually used after the bill method.
1455 Depending on the value of `payby', this may print or email an invoice (I<BILL>,
1456 I<DCRD>, or I<DCHK>), charge a credit card (I<CARD>), charge via electronic
1457 check/ACH (I<CHEK>), or just add any necessary (pseudo-)payment (I<COMP>).
1459 Most actions are now triggered by invoice events; see L<FS::part_bill_event>
1460 and the invoice events web interface.
1462 If there is an error, returns the error, otherwise returns false.
1464 Options are passed as name-value pairs.
1466 Currently available options are:
1468 invoice_time - Use this time when deciding when to print invoices and
1469 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>
1470 for conversion functions.
1472 retry - Retry card/echeck/LEC transactions even when not scheduled by invoice
1475 retry_card - Deprecated alias for 'retry'
1477 batch_card - This option is deprecated. See the invoice events web interface
1478 to control whether cards are batched or run against a realtime gateway.
1480 report_badcard - This option is deprecated.
1482 force_print - This option is deprecated; see the invoice events web interface.
1484 quiet - set true to surpress email card/ACH decline notices.
1489 my( $self, %options ) = @_;
1490 my $invoice_time = $options{'invoice_time'} || time;
1493 local $SIG{HUP} = 'IGNORE';
1494 local $SIG{INT} = 'IGNORE';
1495 local $SIG{QUIT} = 'IGNORE';
1496 local $SIG{TERM} = 'IGNORE';
1497 local $SIG{TSTP} = 'IGNORE';
1498 local $SIG{PIPE} = 'IGNORE';
1500 my $oldAutoCommit = $FS::UID::AutoCommit;
1501 local $FS::UID::AutoCommit = 0;
1504 $self->select_for_update; #mutex
1506 my $balance = $self->balance;
1507 warn "collect customer". $self->custnum. ": balance $balance" if $DEBUG;
1508 unless ( $balance > 0 ) { #redundant?????
1509 $dbh->rollback if $oldAutoCommit; #hmm
1513 if ( exists($options{'retry_card'}) ) {
1514 carp 'retry_card option passed to collect is deprecated; use retry';
1515 $options{'retry'} ||= $options{'retry_card'};
1517 if ( exists($options{'retry'}) && $options{'retry'} ) {
1518 my $error = $self->retry_realtime;
1520 $dbh->rollback if $oldAutoCommit;
1525 foreach my $cust_bill ( $self->open_cust_bill ) {
1527 # don't try to charge for the same invoice if it's already in a batch
1528 #next if qsearchs( 'cust_pay_batch', { 'invnum' => $cust_bill->invnum } );
1530 last if $self->balance <= 0;
1532 warn "invnum ". $cust_bill->invnum. " (owed ". $cust_bill->owed. ")"
1535 foreach my $part_bill_event (
1536 sort { $a->seconds <=> $b->seconds
1537 || $a->weight <=> $b->weight
1538 || $a->eventpart <=> $b->eventpart }
1539 grep { $_->seconds <= ( $invoice_time - $cust_bill->_date )
1540 && ! qsearchs( 'cust_bill_event', {
1541 'invnum' => $cust_bill->invnum,
1542 'eventpart' => $_->eventpart,
1546 qsearch('part_bill_event', { 'payby' => $self->payby,
1547 'disabled' => '', } )
1550 last if $cust_bill->owed <= 0 # don't run subsequent events if owed<=0
1551 || $self->balance <= 0; # or if balance<=0
1553 warn "calling invoice event (". $part_bill_event->eventcode. ")\n"
1555 my $cust_main = $self; #for callback
1559 local $realtime_bop_decline_quiet = 1 if $options{'quiet'};
1560 $error = eval $part_bill_event->eventcode;
1564 my $statustext = '';
1568 } elsif ( $error ) {
1570 $statustext = $error;
1575 #add cust_bill_event
1576 my $cust_bill_event = new FS::cust_bill_event {
1577 'invnum' => $cust_bill->invnum,
1578 'eventpart' => $part_bill_event->eventpart,
1579 #'_date' => $invoice_time,
1581 'status' => $status,
1582 'statustext' => $statustext,
1584 $error = $cust_bill_event->insert;
1586 #$dbh->rollback if $oldAutoCommit;
1587 #return "error: $error";
1589 # gah, even with transactions.
1590 $dbh->commit if $oldAutoCommit; #well.
1591 my $e = 'WARNING: Event run but database not updated - '.
1592 'error inserting cust_bill_event, invnum #'. $cust_bill->invnum.
1593 ', eventpart '. $part_bill_event->eventpart.
1604 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1609 =item retry_realtime
1611 Schedules realtime credit card / electronic check / LEC billing events for
1612 for retry. Useful if card information has changed or manual retry is desired.
1613 The 'collect' method must be called to actually retry the transaction.
1615 Implementation details: For each of this customer's open invoices, changes
1616 the status of the first "done" (with statustext error) realtime processing
1621 sub retry_realtime {
1624 local $SIG{HUP} = 'IGNORE';
1625 local $SIG{INT} = 'IGNORE';
1626 local $SIG{QUIT} = 'IGNORE';
1627 local $SIG{TERM} = 'IGNORE';
1628 local $SIG{TSTP} = 'IGNORE';
1629 local $SIG{PIPE} = 'IGNORE';
1631 my $oldAutoCommit = $FS::UID::AutoCommit;
1632 local $FS::UID::AutoCommit = 0;
1635 foreach my $cust_bill (
1636 grep { $_->cust_bill_event }
1637 $self->open_cust_bill
1639 my @cust_bill_event =
1640 sort { $a->part_bill_event->seconds <=> $b->part_bill_event->seconds }
1642 #$_->part_bill_event->plan eq 'realtime-card'
1643 $_->part_bill_event->eventcode =~
1644 /\$cust_bill\->realtime_(card|ach|lec)/
1645 && $_->status eq 'done'
1648 $cust_bill->cust_bill_event;
1649 next unless @cust_bill_event;
1650 my $error = $cust_bill_event[0]->retry;
1652 $dbh->rollback if $oldAutoCommit;
1653 return "error scheduling invoice event for retry: $error";
1658 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1663 =item realtime_bop METHOD AMOUNT [ OPTION => VALUE ... ]
1665 Runs a realtime credit card, ACH (electronic check) or phone bill transaction
1666 via a Business::OnlinePayment realtime gateway. See
1667 L<http://420.am/business-onlinepayment> for supported gateways.
1669 Available methods are: I<CC>, I<ECHECK> and I<LEC>
1671 Available options are: I<description>, I<invnum>, I<quiet>
1673 The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
1674 I<zip>, I<payinfo> and I<paydate> are also available. Any of these options,
1675 if set, will override the value from the customer record.
1677 I<description> is a free-text field passed to the gateway. It defaults to
1678 "Internet services".
1680 If an I<invnum> is specified, this payment (if sucessful) is applied to the
1681 specified invoice. If you don't specify an I<invnum> you might want to
1682 call the B<apply_payments> method.
1684 I<quiet> can be set true to surpress email decline notices.
1686 (moved from cust_bill) (probably should get realtime_{card,ach,lec} here too)
1691 my( $self, $method, $amount, %options ) = @_;
1693 warn "$self $method $amount\n";
1694 warn " $_ => $options{$_}\n" foreach keys %options;
1697 $options{'description'} ||= 'Internet services';
1700 die "Real-time processing not enabled\n"
1701 unless $conf->exists('business-onlinepayment');
1702 eval "use Business::OnlinePayment";
1706 $self->set( $_ => $options{$_} )
1707 foreach grep { exists($options{$_}) }
1708 qw( payname address1 address2 city state zip payinfo paydate paycvv);
1711 my $bop_config = 'business-onlinepayment';
1712 $bop_config .= '-ach'
1713 if $method eq 'ECHECK' && $conf->exists($bop_config. '-ach');
1714 my ( $processor, $login, $password, $action, @bop_options ) =
1715 $conf->config($bop_config);
1716 $action ||= 'normal authorization';
1717 pop @bop_options if scalar(@bop_options) % 2 && $bop_options[-1] =~ /^\s*$/;
1718 die "No real-time processor is enabled - ".
1719 "did you set the business-onlinepayment configuration value?\n"
1724 my $address = $self->address1;
1725 $address .= ", ". $self->address2 if $self->address2;
1727 my($payname, $payfirst, $paylast);
1728 if ( $self->payname && $method ne 'ECHECK' ) {
1729 $payname = $self->payname;
1730 $payname =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
1731 or return "Illegal payname $payname";
1732 ($payfirst, $paylast) = ($1, $2);
1734 $payfirst = $self->getfield('first');
1735 $paylast = $self->getfield('last');
1736 $payname = "$payfirst $paylast";
1739 my @invoicing_list = grep { $_ ne 'POST' } $self->invoicing_list;
1740 if ( $conf->exists('emailinvoiceauto')
1741 || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
1742 push @invoicing_list, $self->all_emails;
1744 my $email = $invoicing_list[0];
1747 if ( $method eq 'CC' ) {
1749 $content{card_number} = $self->payinfo;
1750 $self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
1751 $content{expiration} = "$2/$1";
1753 $content{cvv2} = $self->paycvv
1754 if defined $self->dbdef_table->column('paycvv')
1755 && length($self->paycvv);
1757 $content{recurring_billing} = 'YES'
1758 if qsearch('cust_pay', { 'custnum' => $self->custnum,
1760 'payinfo' => $self->payinfo, } );
1762 } elsif ( $method eq 'ECHECK' ) {
1763 my($account_number,$routing_code) = $self->payinfo;
1764 ( $content{account_number}, $content{routing_code} ) =
1765 split('@', $self->payinfo);
1766 $content{bank_name} = $self->payname;
1767 $content{account_type} = 'CHECKING';
1768 $content{account_name} = $payname;
1769 $content{customer_org} = $self->company ? 'B' : 'I';
1770 $content{customer_ssn} = $self->ss;
1771 } elsif ( $method eq 'LEC' ) {
1772 $content{phone} = $self->payinfo;
1777 my( $action1, $action2 ) = split(/\s*\,\s*/, $action );
1780 new Business::OnlinePayment( $processor, @bop_options );
1781 $transaction->content(
1784 'password' => $password,
1785 'action' => $action1,
1786 'description' => $options{'description'},
1787 'amount' => $amount,
1788 'invoice_number' => $options{'invnum'},
1789 'customer_id' => $self->custnum,
1790 'last_name' => $paylast,
1791 'first_name' => $payfirst,
1793 'address' => $address,
1794 'city' => $self->city,
1795 'state' => $self->state,
1796 'zip' => $self->zip,
1797 'country' => $self->country,
1798 'referer' => 'http://cleanwhisker.420.am/',
1800 'phone' => $self->daytime || $self->night,
1803 $transaction->submit();
1805 if ( $transaction->is_success() && $action2 ) {
1806 my $auth = $transaction->authorization;
1807 my $ordernum = $transaction->can('order_number')
1808 ? $transaction->order_number
1812 new Business::OnlinePayment( $processor, @bop_options );
1819 password => $password,
1820 order_number => $ordernum,
1822 authorization => $auth,
1823 description => $options{'description'},
1826 foreach my $field (qw( authorization_source_code returned_ACI transaction_identifier validation_code
1827 transaction_sequence_num local_transaction_date
1828 local_transaction_time AVS_result_code )) {
1829 $capture{$field} = $transaction->$field() if $transaction->can($field);
1832 $capture->content( %capture );
1836 unless ( $capture->is_success ) {
1837 my $e = "Authorization sucessful but capture failed, custnum #".
1838 $self->custnum. ': '. $capture->result_code.
1839 ": ". $capture->error_message;
1846 #remove paycvv after initial transaction
1847 #false laziness w/misc/process/payment.cgi - check both to make sure working
1849 if ( defined $self->dbdef_table->column('paycvv')
1850 && length($self->paycvv)
1851 && ! grep { $_ eq cardtype($self->payinfo) } $conf->config('cvv-save')
1852 && ! length($options{'paycvv'})
1854 my $new = new FS::cust_main { $self->hash };
1856 my $error = $new->replace($self);
1858 warn "error removing cvv: $error\n";
1863 if ( $transaction->is_success() ) {
1865 my %method2payby = (
1871 my $cust_pay = new FS::cust_pay ( {
1872 'custnum' => $self->custnum,
1873 'invnum' => $options{'invnum'},
1876 'payby' => $method2payby{$method},
1877 'payinfo' => $self->payinfo,
1878 'paybatch' => "$processor:". $transaction->authorization,
1880 my $error = $cust_pay->insert;
1882 $cust_pay->invnum(''); #try again with no specific invnum
1883 my $error2 = $cust_pay->insert;
1885 # gah, even with transactions.
1886 my $e = 'WARNING: Card/ACH debited but database not updated - '.
1887 "error inserting payment ($processor): $error2".
1888 " (previously tried insert with invnum #$options{'invnum'}" .
1894 return ''; #no error
1898 my $perror = "$processor error: ". $transaction->error_message;
1900 if ( !$options{'quiet'} && !$realtime_bop_decline_quiet
1901 && $conf->exists('emaildecline')
1902 && grep { $_ ne 'POST' } $self->invoicing_list
1903 && ! grep { $transaction->error_message =~ /$_/ }
1904 $conf->config('emaildecline-exclude')
1906 my @templ = $conf->config('declinetemplate');
1907 my $template = new Text::Template (
1909 SOURCE => [ map "$_\n", @templ ],
1910 ) or return "($perror) can't create template: $Text::Template::ERROR";
1911 $template->compile()
1912 or return "($perror) can't compile template: $Text::Template::ERROR";
1914 my $templ_hash = { error => $transaction->error_message };
1916 my $error = send_email(
1917 'from' => $conf->config('invoice_from'),
1918 'to' => [ grep { $_ ne 'POST' } $self->invoicing_list ],
1919 'subject' => 'Your payment could not be processed',
1920 'body' => [ $template->fill_in(HASH => $templ_hash) ],
1923 $perror .= " (also received error sending decline notification: $error)"
1935 Returns the total owed for this customer on all invoices
1936 (see L<FS::cust_bill/owed>).
1942 $self->total_owed_date(2145859200); #12/31/2037
1945 =item total_owed_date TIME
1947 Returns the total owed for this customer on all invoices with date earlier than
1948 TIME. TIME is specified as a UNIX timestamp; see L<perlfunc/"time">). Also
1949 see L<Time::Local> and L<Date::Parse> for conversion functions.
1953 sub total_owed_date {
1957 foreach my $cust_bill (
1958 grep { $_->_date <= $time }
1959 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
1961 $total_bill += $cust_bill->owed;
1963 sprintf( "%.2f", $total_bill );
1968 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
1969 to outstanding invoice balances in chronological order and returns the value
1970 of any remaining unapplied credits available for refund
1971 (see L<FS::cust_refund>).
1978 return 0 unless $self->total_credited;
1980 my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
1981 qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
1983 my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
1984 qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
1988 foreach my $cust_bill ( @invoices ) {
1991 if ( !defined($credit) || $credit->credited == 0) {
1992 $credit = pop @credits or last;
1995 if ($cust_bill->owed >= $credit->credited) {
1996 $amount=$credit->credited;
1998 $amount=$cust_bill->owed;
2001 my $cust_credit_bill = new FS::cust_credit_bill ( {
2002 'crednum' => $credit->crednum,
2003 'invnum' => $cust_bill->invnum,
2004 'amount' => $amount,
2006 my $error = $cust_credit_bill->insert;
2007 die $error if $error;
2009 redo if ($cust_bill->owed > 0);
2013 return $self->total_credited;
2016 =item apply_payments
2018 Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
2019 to outstanding invoice balances in chronological order.
2021 #and returns the value of any remaining unapplied payments.
2025 sub apply_payments {
2030 my @payments = sort { $b->_date <=> $a->_date } ( grep { $_->unapplied > 0 }
2031 qsearch('cust_pay', { 'custnum' => $self->custnum } ) );
2033 my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
2034 qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
2038 foreach my $cust_bill ( @invoices ) {
2041 if ( !defined($payment) || $payment->unapplied == 0 ) {
2042 $payment = pop @payments or last;
2045 if ( $cust_bill->owed >= $payment->unapplied ) {
2046 $amount = $payment->unapplied;
2048 $amount = $cust_bill->owed;
2051 my $cust_bill_pay = new FS::cust_bill_pay ( {
2052 'paynum' => $payment->paynum,
2053 'invnum' => $cust_bill->invnum,
2054 'amount' => $amount,
2056 my $error = $cust_bill_pay->insert;
2057 die $error if $error;
2059 redo if ( $cust_bill->owed > 0);
2063 return $self->total_unapplied_payments;
2066 =item total_credited
2068 Returns the total outstanding credit (see L<FS::cust_credit>) for this
2069 customer. See L<FS::cust_credit/credited>.
2073 sub total_credited {
2075 my $total_credit = 0;
2076 foreach my $cust_credit ( qsearch('cust_credit', {
2077 'custnum' => $self->custnum,
2079 $total_credit += $cust_credit->credited;
2081 sprintf( "%.2f", $total_credit );
2084 =item total_unapplied_payments
2086 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
2087 See L<FS::cust_pay/unapplied>.
2091 sub total_unapplied_payments {
2093 my $total_unapplied = 0;
2094 foreach my $cust_pay ( qsearch('cust_pay', {
2095 'custnum' => $self->custnum,
2097 $total_unapplied += $cust_pay->unapplied;
2099 sprintf( "%.2f", $total_unapplied );
2104 Returns the balance for this customer (total_owed minus total_credited
2105 minus total_unapplied_payments).
2112 $self->total_owed - $self->total_credited - $self->total_unapplied_payments
2116 =item balance_date TIME
2118 Returns the balance for this customer, only considering invoices with date
2119 earlier than TIME (total_owed_date minus total_credited minus
2120 total_unapplied_payments). TIME is specified as a UNIX timestamp; see
2121 L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion
2130 $self->total_owed_date($time)
2131 - $self->total_credited
2132 - $self->total_unapplied_payments
2136 =item paydate_monthyear
2138 Returns a two-element list consisting of the month and year of this customer's
2139 paydate (credit card expiration date for CARD customers)
2143 sub paydate_monthyear {
2145 if ( $self->paydate =~ /^(\d{4})-(\d{2})-\d{2}$/ ) { #Pg date format
2147 } elsif ( $self->paydate =~ /^(\d{1,2})-(\d{1,2}-)?(\d{4}$)/ ) {
2154 =item payinfo_masked
2156 Returns a "masked" payinfo field with all but the last four characters replaced
2157 by 'x'es. Useful for displaying credit cards.
2161 sub payinfo_masked {
2163 my $payinfo = $self->payinfo;
2164 'x'x(length($payinfo)-4). substr($payinfo,(length($payinfo)-4));
2167 =item invoicing_list [ ARRAYREF ]
2169 If an arguement is given, sets these email addresses as invoice recipients
2170 (see L<FS::cust_main_invoice>). Errors are not fatal and are not reported
2171 (except as warnings), so use check_invoicing_list first.
2173 Returns a list of email addresses (with svcnum entries expanded).
2175 Note: You can clear the invoicing list by passing an empty ARRAYREF. You can
2176 check it without disturbing anything by passing nothing.
2178 This interface may change in the future.
2182 sub invoicing_list {
2183 my( $self, $arrayref ) = @_;
2185 my @cust_main_invoice;
2186 if ( $self->custnum ) {
2187 @cust_main_invoice =
2188 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
2190 @cust_main_invoice = ();
2192 foreach my $cust_main_invoice ( @cust_main_invoice ) {
2193 #warn $cust_main_invoice->destnum;
2194 unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
2195 #warn $cust_main_invoice->destnum;
2196 my $error = $cust_main_invoice->delete;
2197 warn $error if $error;
2200 if ( $self->custnum ) {
2201 @cust_main_invoice =
2202 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
2204 @cust_main_invoice = ();
2206 my %seen = map { $_->address => 1 } @cust_main_invoice;
2207 foreach my $address ( @{$arrayref} ) {
2208 next if exists $seen{$address} && $seen{$address};
2209 $seen{$address} = 1;
2210 my $cust_main_invoice = new FS::cust_main_invoice ( {
2211 'custnum' => $self->custnum,
2214 my $error = $cust_main_invoice->insert;
2215 warn $error if $error;
2218 if ( $self->custnum ) {
2220 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
2226 =item check_invoicing_list ARRAYREF
2228 Checks these arguements as valid input for the invoicing_list method. If there
2229 is an error, returns the error, otherwise returns false.
2233 sub check_invoicing_list {
2234 my( $self, $arrayref ) = @_;
2235 foreach my $address ( @{$arrayref} ) {
2236 my $cust_main_invoice = new FS::cust_main_invoice ( {
2237 'custnum' => $self->custnum,
2240 my $error = $self->custnum
2241 ? $cust_main_invoice->check
2242 : $cust_main_invoice->checkdest
2244 return $error if $error;
2249 =item set_default_invoicing_list
2251 Sets the invoicing list to all accounts associated with this customer,
2252 overwriting any previous invoicing list.
2256 sub set_default_invoicing_list {
2258 $self->invoicing_list($self->all_emails);
2263 Returns the email addresses of all accounts provisioned for this customer.
2270 foreach my $cust_pkg ( $self->all_pkgs ) {
2271 my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
2273 map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
2274 grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
2276 $list{$_}=1 foreach map { $_->email } @svc_acct;
2281 =item invoicing_list_addpost
2283 Adds postal invoicing to this customer. If this customer is already configured
2284 to receive postal invoices, does nothing.
2288 sub invoicing_list_addpost {
2290 return if grep { $_ eq 'POST' } $self->invoicing_list;
2291 my @invoicing_list = $self->invoicing_list;
2292 push @invoicing_list, 'POST';
2293 $self->invoicing_list(\@invoicing_list);
2296 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
2298 Returns an array of customers referred by this customer (referral_custnum set
2299 to this custnum). If DEPTH is given, recurses up to the given depth, returning
2300 customers referred by customers referred by this customer and so on, inclusive.
2301 The default behavior is DEPTH 1 (no recursion).
2305 sub referral_cust_main {
2307 my $depth = @_ ? shift : 1;
2308 my $exclude = @_ ? shift : {};
2311 map { $exclude->{$_->custnum}++; $_; }
2312 grep { ! $exclude->{ $_->custnum } }
2313 qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
2317 map { $_->referral_cust_main($depth-1, $exclude) }
2324 =item referral_cust_main_ncancelled
2326 Same as referral_cust_main, except only returns customers with uncancelled
2331 sub referral_cust_main_ncancelled {
2333 grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
2336 =item referral_cust_pkg [ DEPTH ]
2338 Like referral_cust_main, except returns a flat list of all unsuspended (and
2339 uncancelled) packages for each customer. The number of items in this list may
2340 be useful for comission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
2344 sub referral_cust_pkg {
2346 my $depth = @_ ? shift : 1;
2348 map { $_->unsuspended_pkgs }
2349 grep { $_->unsuspended_pkgs }
2350 $self->referral_cust_main($depth);
2353 =item credit AMOUNT, REASON
2355 Applies a credit to this customer. If there is an error, returns the error,
2356 otherwise returns false.
2361 my( $self, $amount, $reason ) = @_;
2362 my $cust_credit = new FS::cust_credit {
2363 'custnum' => $self->custnum,
2364 'amount' => $amount,
2365 'reason' => $reason,
2367 $cust_credit->insert;
2370 =item charge AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
2372 Creates a one-time charge for this customer. If there is an error, returns
2373 the error, otherwise returns false.
2378 my ( $self, $amount ) = ( shift, shift );
2379 my $pkg = @_ ? shift : 'One-time charge';
2380 my $comment = @_ ? shift : '$'. sprintf("%.2f",$amount);
2381 my $taxclass = @_ ? shift : '';
2383 local $SIG{HUP} = 'IGNORE';
2384 local $SIG{INT} = 'IGNORE';
2385 local $SIG{QUIT} = 'IGNORE';
2386 local $SIG{TERM} = 'IGNORE';
2387 local $SIG{TSTP} = 'IGNORE';
2388 local $SIG{PIPE} = 'IGNORE';
2390 my $oldAutoCommit = $FS::UID::AutoCommit;
2391 local $FS::UID::AutoCommit = 0;
2394 my $part_pkg = new FS::part_pkg ( {
2396 'comment' => $comment,
2401 'taxclass' => $taxclass,
2404 my $error = $part_pkg->insert;
2406 $dbh->rollback if $oldAutoCommit;
2410 my $pkgpart = $part_pkg->pkgpart;
2411 my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
2412 unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
2413 my $type_pkgs = new FS::type_pkgs \%type_pkgs;
2414 $error = $type_pkgs->insert;
2416 $dbh->rollback if $oldAutoCommit;
2421 my $cust_pkg = new FS::cust_pkg ( {
2422 'custnum' => $self->custnum,
2423 'pkgpart' => $pkgpart,
2426 $error = $cust_pkg->insert;
2428 $dbh->rollback if $oldAutoCommit;
2432 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2439 Returns all the invoices (see L<FS::cust_bill>) for this customer.
2445 sort { $a->_date <=> $b->_date }
2446 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
2449 =item open_cust_bill
2451 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
2456 sub open_cust_bill {
2458 grep { $_->owed > 0 } $self->cust_bill;
2463 Returns all the credits (see L<FS::cust_credit>) for this customer.
2469 sort { $a->_date <=> $b->_date }
2470 qsearch( 'cust_credit', { 'custnum' => $self->custnum } )
2475 Returns all the payments (see L<FS::cust_pay>) for this customer.
2481 sort { $a->_date <=> $b->_date }
2482 qsearch( 'cust_pay', { 'custnum' => $self->custnum } )
2487 Returns all the refunds (see L<FS::cust_refund>) for this customer.
2493 sort { $a->_date <=> $b->_date }
2494 qsearch( 'cust_refund', { 'custnum' => $self->custnum } )
2497 =item select_for_update
2499 Selects this record with the SQL "FOR UPDATE" command. This can be useful as
2504 sub select_for_update {
2506 qsearch('cust_main', { 'custnum' => $self->custnum }, '*', 'FOR UPDATE' );
2515 =item check_and_rebuild_fuzzyfiles
2519 sub check_and_rebuild_fuzzyfiles {
2520 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2521 -e "$dir/cust_main.last" && -e "$dir/cust_main.company"
2522 or &rebuild_fuzzyfiles;
2525 =item rebuild_fuzzyfiles
2529 sub rebuild_fuzzyfiles {
2531 use Fcntl qw(:flock);
2533 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2537 open(LASTLOCK,">>$dir/cust_main.last")
2538 or die "can't open $dir/cust_main.last: $!";
2539 flock(LASTLOCK,LOCK_EX)
2540 or die "can't lock $dir/cust_main.last: $!";
2542 my @all_last = map $_->getfield('last'), qsearch('cust_main', {});
2544 grep $_, map $_->getfield('ship_last'), qsearch('cust_main',{})
2545 if defined dbdef->table('cust_main')->column('ship_last');
2547 open (LASTCACHE,">$dir/cust_main.last.tmp")
2548 or die "can't open $dir/cust_main.last.tmp: $!";
2549 print LASTCACHE join("\n", @all_last), "\n";
2550 close LASTCACHE or die "can't close $dir/cust_main.last.tmp: $!";
2552 rename "$dir/cust_main.last.tmp", "$dir/cust_main.last";
2557 open(COMPANYLOCK,">>$dir/cust_main.company")
2558 or die "can't open $dir/cust_main.company: $!";
2559 flock(COMPANYLOCK,LOCK_EX)
2560 or die "can't lock $dir/cust_main.company: $!";
2562 my @all_company = grep $_ ne '', map $_->company, qsearch('cust_main',{});
2564 grep $_ ne '', map $_->ship_company, qsearch('cust_main', {})
2565 if defined dbdef->table('cust_main')->column('ship_last');
2567 open (COMPANYCACHE,">$dir/cust_main.company.tmp")
2568 or die "can't open $dir/cust_main.company.tmp: $!";
2569 print COMPANYCACHE join("\n", @all_company), "\n";
2570 close COMPANYCACHE or die "can't close $dir/cust_main.company.tmp: $!";
2572 rename "$dir/cust_main.company.tmp", "$dir/cust_main.company";
2582 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2583 open(LASTCACHE,"<$dir/cust_main.last")
2584 or die "can't open $dir/cust_main.last: $!";
2585 my @array = map { chomp; $_; } <LASTCACHE>;
2595 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2596 open(COMPANYCACHE,"<$dir/cust_main.company")
2597 or die "can't open $dir/cust_main.last: $!";
2598 my @array = map { chomp; $_; } <COMPANYCACHE>;
2603 =item append_fuzzyfiles LASTNAME COMPANY
2607 sub append_fuzzyfiles {
2608 my( $last, $company ) = @_;
2610 &check_and_rebuild_fuzzyfiles;
2612 use Fcntl qw(:flock);
2614 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2618 open(LAST,">>$dir/cust_main.last")
2619 or die "can't open $dir/cust_main.last: $!";
2621 or die "can't lock $dir/cust_main.last: $!";
2623 print LAST "$last\n";
2626 or die "can't unlock $dir/cust_main.last: $!";
2632 open(COMPANY,">>$dir/cust_main.company")
2633 or die "can't open $dir/cust_main.company: $!";
2634 flock(COMPANY,LOCK_EX)
2635 or die "can't lock $dir/cust_main.company: $!";
2637 print COMPANY "$company\n";
2639 flock(COMPANY,LOCK_UN)
2640 or die "can't unlock $dir/cust_main.company: $!";
2654 #warn join('-',keys %$param);
2655 my $fh = $param->{filehandle};
2656 my $agentnum = $param->{agentnum};
2657 my $refnum = $param->{refnum};
2658 my $pkgpart = $param->{pkgpart};
2659 my @fields = @{$param->{fields}};
2661 eval "use Date::Parse;";
2663 eval "use Text::CSV_XS;";
2666 my $csv = new Text::CSV_XS;
2673 local $SIG{HUP} = 'IGNORE';
2674 local $SIG{INT} = 'IGNORE';
2675 local $SIG{QUIT} = 'IGNORE';
2676 local $SIG{TERM} = 'IGNORE';
2677 local $SIG{TSTP} = 'IGNORE';
2678 local $SIG{PIPE} = 'IGNORE';
2680 my $oldAutoCommit = $FS::UID::AutoCommit;
2681 local $FS::UID::AutoCommit = 0;
2684 #while ( $columns = $csv->getline($fh) ) {
2686 while ( defined($line=<$fh>) ) {
2688 $csv->parse($line) or do {
2689 $dbh->rollback if $oldAutoCommit;
2690 return "can't parse: ". $csv->error_input();
2693 my @columns = $csv->fields();
2694 #warn join('-',@columns);
2697 agentnum => $agentnum,
2699 country => 'US', #default
2700 payby => 'BILL', #default
2701 paydate => '12/2037', #default
2703 my $billtime = time;
2704 my %cust_pkg = ( pkgpart => $pkgpart );
2705 foreach my $field ( @fields ) {
2706 if ( $field =~ /^cust_pkg\.(setup|bill|susp|expire|cancel)$/ ) {
2707 #$cust_pkg{$1} = str2time( shift @$columns );
2708 if ( $1 eq 'setup' ) {
2709 $billtime = str2time(shift @columns);
2711 $cust_pkg{$1} = str2time( shift @columns );
2714 #$cust_main{$field} = shift @$columns;
2715 $cust_main{$field} = shift @columns;
2719 my $cust_pkg = new FS::cust_pkg ( \%cust_pkg ) if $pkgpart;
2720 my $cust_main = new FS::cust_main ( \%cust_main );
2722 tie my %hash, 'Tie::RefHash'; #this part is important
2723 $hash{$cust_pkg} = [] if $pkgpart;
2724 my $error = $cust_main->insert( \%hash );
2727 $dbh->rollback if $oldAutoCommit;
2728 return "can't insert customer for $line: $error";
2731 #false laziness w/bill.cgi
2732 $error = $cust_main->bill( 'time' => $billtime );
2734 $dbh->rollback if $oldAutoCommit;
2735 return "can't bill customer for $line: $error";
2738 $cust_main->apply_payments;
2739 $cust_main->apply_credits;
2741 $error = $cust_main->collect();
2743 $dbh->rollback if $oldAutoCommit;
2744 return "can't collect customer for $line: $error";
2750 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2752 return "Empty file!" unless $imported;
2764 #warn join('-',keys %$param);
2765 my $fh = $param->{filehandle};
2766 my @fields = @{$param->{fields}};
2768 eval "use Date::Parse;";
2770 eval "use Text::CSV_XS;";
2773 my $csv = new Text::CSV_XS;
2780 local $SIG{HUP} = 'IGNORE';
2781 local $SIG{INT} = 'IGNORE';
2782 local $SIG{QUIT} = 'IGNORE';
2783 local $SIG{TERM} = 'IGNORE';
2784 local $SIG{TSTP} = 'IGNORE';
2785 local $SIG{PIPE} = 'IGNORE';
2787 my $oldAutoCommit = $FS::UID::AutoCommit;
2788 local $FS::UID::AutoCommit = 0;
2791 #while ( $columns = $csv->getline($fh) ) {
2793 while ( defined($line=<$fh>) ) {
2795 $csv->parse($line) or do {
2796 $dbh->rollback if $oldAutoCommit;
2797 return "can't parse: ". $csv->error_input();
2800 my @columns = $csv->fields();
2801 #warn join('-',@columns);
2804 foreach my $field ( @fields ) {
2805 $row{$field} = shift @columns;
2808 my $cust_main = qsearchs('cust_main', { 'custnum' => $row{'custnum'} } );
2809 unless ( $cust_main ) {
2810 $dbh->rollback if $oldAutoCommit;
2811 return "unknown custnum $row{'custnum'}";
2814 if ( $row{'amount'} > 0 ) {
2815 my $error = $cust_main->charge($row{'amount'}, $row{'pkg'});
2817 $dbh->rollback if $oldAutoCommit;
2821 } elsif ( $row{'amount'} < 0 ) {
2822 my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ),
2825 $dbh->rollback if $oldAutoCommit;
2835 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2837 return "Empty file!" unless $imported;
2849 The delete method should possibly take an FS::cust_main object reference
2850 instead of a scalar customer number.
2852 Bill and collect options should probably be passed as references instead of a
2855 There should probably be a configuration file with a list of allowed credit
2858 No multiple currency support (probably a larger project than just this module).
2860 payinfo_masked false laziness with cust_pay.pm and cust_refund.pm
2864 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
2865 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
2866 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.