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{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 # find the packages which are due for billing, find out how much they are
1102 # & generate invoice database.
1104 my( $total_setup, $total_recur ) = ( 0, 0 );
1105 #my( $taxable_setup, $taxable_recur ) = ( 0, 0 );
1106 my @cust_bill_pkg = ();
1108 #my $taxable_charged = 0;##
1113 foreach my $cust_pkg (
1114 qsearch('cust_pkg', { 'custnum' => $self->custnum } )
1117 #NO!! next if $cust_pkg->cancel;
1118 next if $cust_pkg->getfield('cancel');
1120 #? to avoid use of uninitialized value errors... ?
1121 $cust_pkg->setfield('bill', '')
1122 unless defined($cust_pkg->bill);
1124 my $part_pkg = $cust_pkg->part_pkg;
1126 #so we don't modify cust_pkg record unnecessarily
1127 my $cust_pkg_mod_flag = 0;
1128 my %hash = $cust_pkg->hash;
1129 my $old_cust_pkg = new FS::cust_pkg \%hash;
1135 if ( !$cust_pkg->setup || $options{'resetup'} ) {
1136 my $setup_prog = $part_pkg->getfield('setup');
1137 $setup_prog =~ /^(.*)$/ or do {
1138 $dbh->rollback if $oldAutoCommit;
1139 return "Illegal setup for pkgpart ". $part_pkg->pkgpart.
1143 $setup_prog = '0' if $setup_prog =~ /^\s*$/;
1145 #my $cpt = new Safe;
1146 ##$cpt->permit(); #what is necessary?
1147 #$cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
1148 #$setup = $cpt->reval($setup_prog);
1149 $setup = eval $setup_prog;
1150 unless ( defined($setup) ) {
1151 $dbh->rollback if $oldAutoCommit;
1152 return "Error eval-ing part_pkg->setup pkgpart ". $part_pkg->pkgpart.
1153 "(expression $setup_prog): $@";
1155 $cust_pkg->setfield('setup', $time) unless $cust_pkg->setup;
1156 $cust_pkg_mod_flag=1;
1162 if ( $part_pkg->getfield('freq') ne '0' &&
1163 ! $cust_pkg->getfield('susp') &&
1164 ( $cust_pkg->getfield('bill') || 0 ) <= $time
1166 my $recur_prog = $part_pkg->getfield('recur');
1167 $recur_prog =~ /^(.*)$/ or do {
1168 $dbh->rollback if $oldAutoCommit;
1169 return "Illegal recur for pkgpart ". $part_pkg->pkgpart.
1173 $recur_prog = '0' if $recur_prog =~ /^\s*$/;
1175 # shared with $recur_prog
1176 $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
1178 #my $cpt = new Safe;
1179 ##$cpt->permit(); #what is necessary?
1180 #$cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
1181 #$recur = $cpt->reval($recur_prog);
1182 $recur = eval $recur_prog;
1183 unless ( defined($recur) ) {
1184 $dbh->rollback if $oldAutoCommit;
1185 return "Error eval-ing part_pkg->recur pkgpart ". $part_pkg->pkgpart.
1186 "(expression $recur_prog): $@";
1188 #change this bit to use Date::Manip? CAREFUL with timezones (see
1189 # mailing list archive)
1190 my ($sec,$min,$hour,$mday,$mon,$year) =
1191 (localtime($sdate) )[0,1,2,3,4,5];
1193 #pro-rating magic - if $recur_prog fiddles $sdate, want to use that
1194 # only for figuring next bill date, nothing else, so, reset $sdate again
1196 $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
1197 $cust_pkg->last_bill($sdate)
1198 if $cust_pkg->dbdef_table->column('last_bill');
1200 if ( $part_pkg->freq =~ /^\d+$/ ) {
1201 $mon += $part_pkg->freq;
1202 until ( $mon < 12 ) { $mon -= 12; $year++; }
1203 } elsif ( $part_pkg->freq =~ /^(\d+)w$/ ) {
1205 $mday += $weeks * 7;
1206 } elsif ( $part_pkg->freq =~ /^(\d+)d$/ ) {
1210 $dbh->rollback if $oldAutoCommit;
1211 return "unparsable frequency: ". $part_pkg->freq;
1213 $cust_pkg->setfield('bill',
1214 timelocal_nocheck($sec,$min,$hour,$mday,$mon,$year));
1215 $cust_pkg_mod_flag = 1;
1218 warn "\$setup is undefined" unless defined($setup);
1219 warn "\$recur is undefined" unless defined($recur);
1220 warn "\$cust_pkg->bill is undefined" unless defined($cust_pkg->bill);
1222 if ( $cust_pkg_mod_flag ) {
1223 $error=$cust_pkg->replace($old_cust_pkg);
1224 if ( $error ) { #just in case
1225 $dbh->rollback if $oldAutoCommit;
1226 return "Error modifying pkgnum ". $cust_pkg->pkgnum. ": $error";
1228 $setup = sprintf( "%.2f", $setup );
1229 $recur = sprintf( "%.2f", $recur );
1230 if ( $setup < 0 && ! $conf->exists('allow_negative_charges') ) {
1231 $dbh->rollback if $oldAutoCommit;
1232 return "negative setup $setup for pkgnum ". $cust_pkg->pkgnum;
1234 if ( $recur < 0 && ! $conf->exists('allow_negative_charges') ) {
1235 $dbh->rollback if $oldAutoCommit;
1236 return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum;
1238 if ( $setup != 0 || $recur != 0 ) {
1239 my $cust_bill_pkg = new FS::cust_bill_pkg ({
1240 'pkgnum' => $cust_pkg->pkgnum,
1244 'edate' => $cust_pkg->bill,
1245 'details' => \@details,
1247 push @cust_bill_pkg, $cust_bill_pkg;
1248 $total_setup += $setup;
1249 $total_recur += $recur;
1251 unless ( $self->tax =~ /Y/i || $self->payby eq 'COMP' ) {
1253 my @taxes = qsearch( 'cust_main_county', {
1254 'state' => $self->state,
1255 'county' => $self->county,
1256 'country' => $self->country,
1257 'taxclass' => $part_pkg->taxclass,
1260 @taxes = qsearch( 'cust_main_county', {
1261 'state' => $self->state,
1262 'county' => $self->county,
1263 'country' => $self->country,
1268 #one more try at a whole-country tax rate
1270 @taxes = qsearch( 'cust_main_county', {
1273 'country' => $self->country,
1278 # maybe eliminate this entirely, along with all the 0% records
1280 $dbh->rollback if $oldAutoCommit;
1282 "fatal: can't find tax rate for state/county/country/taxclass ".
1283 join('/', ( map $self->$_(), qw(state county country) ),
1284 $part_pkg->taxclass ). "\n";
1287 foreach my $tax ( @taxes ) {
1289 my $taxable_charged = 0;
1290 $taxable_charged += $setup
1291 unless $part_pkg->setuptax =~ /^Y$/i
1292 || $tax->setuptax =~ /^Y$/i;
1293 $taxable_charged += $recur
1294 unless $part_pkg->recurtax =~ /^Y$/i
1295 || $tax->recurtax =~ /^Y$/i;
1296 next unless $taxable_charged;
1298 if ( $tax->exempt_amount > 0 ) {
1299 my ($mon,$year) = (localtime($sdate) )[4,5];
1301 my $freq = $part_pkg->freq || 1;
1302 if ( $freq !~ /(\d+)$/ ) {
1303 $dbh->rollback if $oldAutoCommit;
1304 return "daily/weekly package definitions not (yet?)".
1305 " compatible with monthly tax exemptions";
1307 my $taxable_per_month = sprintf("%.2f", $taxable_charged / $freq );
1308 foreach my $which_month ( 1 .. $freq ) {
1310 'custnum' => $self->custnum,
1311 'taxnum' => $tax->taxnum,
1312 'year' => 1900+$year,
1315 #until ( $mon < 12 ) { $mon -= 12; $year++; }
1316 until ( $mon < 13 ) { $mon -= 12; $year++; }
1317 my $cust_tax_exempt =
1318 qsearchs('cust_tax_exempt', \%hash)
1319 || new FS::cust_tax_exempt( { %hash, 'amount' => 0 } );
1320 my $remaining_exemption = sprintf("%.2f",
1321 $tax->exempt_amount - $cust_tax_exempt->amount );
1322 if ( $remaining_exemption > 0 ) {
1323 my $addl = $remaining_exemption > $taxable_per_month
1324 ? $taxable_per_month
1325 : $remaining_exemption;
1326 $taxable_charged -= $addl;
1327 my $new_cust_tax_exempt = new FS::cust_tax_exempt ( {
1328 $cust_tax_exempt->hash,
1330 sprintf("%.2f", $cust_tax_exempt->amount + $addl),
1332 $error = $new_cust_tax_exempt->exemptnum
1333 ? $new_cust_tax_exempt->replace($cust_tax_exempt)
1334 : $new_cust_tax_exempt->insert;
1336 $dbh->rollback if $oldAutoCommit;
1337 return "fatal: can't update cust_tax_exempt: $error";
1340 } # if $remaining_exemption > 0
1342 } #foreach $which_month
1344 } #if $tax->exempt_amount
1346 $taxable_charged = sprintf( "%.2f", $taxable_charged);
1348 #$tax += $taxable_charged * $cust_main_county->tax / 100
1349 $tax{ $tax->taxname || 'Tax' } +=
1350 $taxable_charged * $tax->tax / 100
1352 } #foreach my $tax ( @taxes )
1354 } #unless $self->tax =~ /Y/i || $self->payby eq 'COMP'
1356 } #if $setup != 0 || $recur != 0
1358 } #if $cust_pkg_mod_flag
1360 } #foreach my $cust_pkg
1362 my $charged = sprintf( "%.2f", $total_setup + $total_recur );
1363 # my $taxable_charged = sprintf( "%.2f", $taxable_setup + $taxable_recur );
1365 unless ( @cust_bill_pkg ) { #don't create invoices with no line items
1366 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1370 # unless ( $self->tax =~ /Y/i
1371 # || $self->payby eq 'COMP'
1372 # || $taxable_charged == 0 ) {
1373 # my $cust_main_county = qsearchs('cust_main_county',{
1374 # 'state' => $self->state,
1375 # 'county' => $self->county,
1376 # 'country' => $self->country,
1377 # } ) or die "fatal: can't find tax rate for state/county/country ".
1378 # $self->state. "/". $self->county. "/". $self->country. "\n";
1379 # my $tax = sprintf( "%.2f",
1380 # $taxable_charged * ( $cust_main_county->getfield('tax') / 100 )
1383 if ( dbdef->table('cust_bill_pkg')->column('itemdesc') ) { #1.5 schema
1385 foreach my $taxname ( grep { $tax{$_} > 0 } keys %tax ) {
1386 my $tax = sprintf("%.2f", $tax{$taxname} );
1387 $charged = sprintf( "%.2f", $charged+$tax );
1389 my $cust_bill_pkg = new FS::cust_bill_pkg ({
1395 'itemdesc' => $taxname,
1397 push @cust_bill_pkg, $cust_bill_pkg;
1400 } else { #1.4 schema
1403 foreach ( values %tax ) { $tax += $_ };
1404 $tax = sprintf("%.2f", $tax);
1406 $charged = sprintf( "%.2f", $charged+$tax );
1408 my $cust_bill_pkg = new FS::cust_bill_pkg ({
1415 push @cust_bill_pkg, $cust_bill_pkg;
1420 my $cust_bill = new FS::cust_bill ( {
1421 'custnum' => $self->custnum,
1423 'charged' => $charged,
1425 $error = $cust_bill->insert;
1427 $dbh->rollback if $oldAutoCommit;
1428 return "can't create invoice for customer #". $self->custnum. ": $error";
1431 my $invnum = $cust_bill->invnum;
1433 foreach $cust_bill_pkg ( @cust_bill_pkg ) {
1435 $cust_bill_pkg->invnum($invnum);
1436 $error = $cust_bill_pkg->insert;
1438 $dbh->rollback if $oldAutoCommit;
1439 return "can't create invoice line item for customer #". $self->custnum.
1444 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1448 =item collect OPTIONS
1450 (Attempt to) collect money for this customer's outstanding invoices (see
1451 L<FS::cust_bill>). Usually used after the bill method.
1453 Depending on the value of `payby', this may print or email an invoice (I<BILL>,
1454 I<DCRD>, or I<DCHK>), charge a credit card (I<CARD>), charge via electronic
1455 check/ACH (I<CHEK>), or just add any necessary (pseudo-)payment (I<COMP>).
1457 Most actions are now triggered by invoice events; see L<FS::part_bill_event>
1458 and the invoice events web interface.
1460 If there is an error, returns the error, otherwise returns false.
1462 Options are passed as name-value pairs.
1464 Currently available options are:
1466 invoice_time - Use this time when deciding when to print invoices and
1467 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>
1468 for conversion functions.
1470 retry - Retry card/echeck/LEC transactions even when not scheduled by invoice
1473 retry_card - Deprecated alias for 'retry'
1475 batch_card - This option is deprecated. See the invoice events web interface
1476 to control whether cards are batched or run against a realtime gateway.
1478 report_badcard - This option is deprecated.
1480 force_print - This option is deprecated; see the invoice events web interface.
1482 quiet - set true to surpress email card/ACH decline notices.
1487 my( $self, %options ) = @_;
1488 my $invoice_time = $options{'invoice_time'} || time;
1491 local $SIG{HUP} = 'IGNORE';
1492 local $SIG{INT} = 'IGNORE';
1493 local $SIG{QUIT} = 'IGNORE';
1494 local $SIG{TERM} = 'IGNORE';
1495 local $SIG{TSTP} = 'IGNORE';
1496 local $SIG{PIPE} = 'IGNORE';
1498 my $oldAutoCommit = $FS::UID::AutoCommit;
1499 local $FS::UID::AutoCommit = 0;
1502 my $balance = $self->balance;
1503 warn "collect customer". $self->custnum. ": balance $balance" if $DEBUG;
1504 unless ( $balance > 0 ) { #redundant?????
1505 $dbh->rollback if $oldAutoCommit; #hmm
1509 if ( exists($options{'retry_card'}) ) {
1510 carp 'retry_card option passed to collect is deprecated; use retry';
1511 $options{'retry'} ||= $options{'retry_card'};
1513 if ( exists($options{'retry'}) && $options{'retry'} ) {
1514 my $error = $self->retry_realtime;
1516 $dbh->rollback if $oldAutoCommit;
1521 foreach my $cust_bill ( $self->open_cust_bill ) {
1523 # don't try to charge for the same invoice if it's already in a batch
1524 #next if qsearchs( 'cust_pay_batch', { 'invnum' => $cust_bill->invnum } );
1526 last if $self->balance <= 0;
1528 warn "invnum ". $cust_bill->invnum. " (owed ". $cust_bill->owed. ")"
1531 foreach my $part_bill_event (
1532 sort { $a->seconds <=> $b->seconds
1533 || $a->weight <=> $b->weight
1534 || $a->eventpart <=> $b->eventpart }
1535 grep { $_->seconds <= ( $invoice_time - $cust_bill->_date )
1536 && ! qsearchs( 'cust_bill_event', {
1537 'invnum' => $cust_bill->invnum,
1538 'eventpart' => $_->eventpart,
1542 qsearch('part_bill_event', { 'payby' => $self->payby,
1543 'disabled' => '', } )
1546 last if $cust_bill->owed <= 0 # don't run subsequent events if owed<=0
1547 || $self->balance <= 0; # or if balance<=0
1549 warn "calling invoice event (". $part_bill_event->eventcode. ")\n"
1551 my $cust_main = $self; #for callback
1555 local $realtime_bop_decline_quiet = 1 if $options{'quiet'};
1556 $error = eval $part_bill_event->eventcode;
1560 my $statustext = '';
1564 } elsif ( $error ) {
1566 $statustext = $error;
1571 #add cust_bill_event
1572 my $cust_bill_event = new FS::cust_bill_event {
1573 'invnum' => $cust_bill->invnum,
1574 'eventpart' => $part_bill_event->eventpart,
1575 #'_date' => $invoice_time,
1577 'status' => $status,
1578 'statustext' => $statustext,
1580 $error = $cust_bill_event->insert;
1582 #$dbh->rollback if $oldAutoCommit;
1583 #return "error: $error";
1585 # gah, even with transactions.
1586 $dbh->commit if $oldAutoCommit; #well.
1587 my $e = 'WARNING: Event run but database not updated - '.
1588 'error inserting cust_bill_event, invnum #'. $cust_bill->invnum.
1589 ', eventpart '. $part_bill_event->eventpart.
1600 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1605 =item retry_realtime
1607 Schedules realtime credit card / electronic check / LEC billing events for
1608 for retry. Useful if card information has changed or manual retry is desired.
1609 The 'collect' method must be called to actually retry the transaction.
1611 Implementation details: For each of this customer's open invoices, changes
1612 the status of the first "done" (with statustext error) realtime processing
1617 sub retry_realtime {
1620 local $SIG{HUP} = 'IGNORE';
1621 local $SIG{INT} = 'IGNORE';
1622 local $SIG{QUIT} = 'IGNORE';
1623 local $SIG{TERM} = 'IGNORE';
1624 local $SIG{TSTP} = 'IGNORE';
1625 local $SIG{PIPE} = 'IGNORE';
1627 my $oldAutoCommit = $FS::UID::AutoCommit;
1628 local $FS::UID::AutoCommit = 0;
1631 foreach my $cust_bill (
1632 grep { $_->cust_bill_event }
1633 $self->open_cust_bill
1635 my @cust_bill_event =
1636 sort { $a->part_bill_event->seconds <=> $b->part_bill_event->seconds }
1638 #$_->part_bill_event->plan eq 'realtime-card'
1639 $_->part_bill_event->eventcode =~
1640 /\$cust_bill\->realtime_(card|ach|lec)/
1641 && $_->status eq 'done'
1644 $cust_bill->cust_bill_event;
1645 next unless @cust_bill_event;
1646 my $error = $cust_bill_event[0]->retry;
1648 $dbh->rollback if $oldAutoCommit;
1649 return "error scheduling invoice event for retry: $error";
1654 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1659 =item realtime_bop METHOD AMOUNT [ OPTION => VALUE ... ]
1661 Runs a realtime credit card, ACH (electronic check) or phone bill transaction
1662 via a Business::OnlinePayment realtime gateway. See
1663 L<http://420.am/business-onlinepayment> for supported gateways.
1665 Available methods are: I<CC>, I<ECHECK> and I<LEC>
1667 Available options are: I<description>, I<invnum>, I<quiet>
1669 The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
1670 I<zip>, I<payinfo> and I<paydate> are also available. Any of these options,
1671 if set, will override the value from the customer record.
1673 I<description> is a free-text field passed to the gateway. It defaults to
1674 "Internet services".
1676 If an I<invnum> is specified, this payment (if sucessful) is applied to the
1677 specified invoice. If you don't specify an I<invnum> you might want to
1678 call the B<apply_payments> method.
1680 I<quiet> can be set true to surpress email decline notices.
1682 (moved from cust_bill) (probably should get realtime_{card,ach,lec} here too)
1687 my( $self, $method, $amount, %options ) = @_;
1689 warn "$self $method $amount\n";
1690 warn " $_ => $options{$_}\n" foreach keys %options;
1693 $options{'description'} ||= 'Internet services';
1696 die "Real-time processing not enabled\n"
1697 unless $conf->exists('business-onlinepayment');
1698 eval "use Business::OnlinePayment";
1702 $self->set( $_ => $options{$_} )
1703 foreach grep { exists($options{$_}) }
1704 qw( payname address1 address2 city state zip payinfo paydate paycvv);
1707 my $bop_config = 'business-onlinepayment';
1708 $bop_config .= '-ach'
1709 if $method eq 'ECHECK' && $conf->exists($bop_config. '-ach');
1710 my ( $processor, $login, $password, $action, @bop_options ) =
1711 $conf->config($bop_config);
1712 $action ||= 'normal authorization';
1713 pop @bop_options if scalar(@bop_options) % 2 && $bop_options[-1] =~ /^\s*$/;
1714 die "No real-time processor is enabled - ".
1715 "did you set the business-onlinepayment configuration value?\n"
1720 my $address = $self->address1;
1721 $address .= ", ". $self->address2 if $self->address2;
1723 my($payname, $payfirst, $paylast);
1724 if ( $self->payname && $method ne 'ECHECK' ) {
1725 $payname = $self->payname;
1726 $payname =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
1727 or return "Illegal payname $payname";
1728 ($payfirst, $paylast) = ($1, $2);
1730 $payfirst = $self->getfield('first');
1731 $paylast = $self->getfield('last');
1732 $payname = "$payfirst $paylast";
1735 my @invoicing_list = grep { $_ ne 'POST' } $self->invoicing_list;
1736 if ( $conf->exists('emailinvoiceauto')
1737 || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
1738 push @invoicing_list, $self->all_emails;
1740 my $email = $invoicing_list[0];
1743 if ( $method eq 'CC' ) {
1745 $content{card_number} = $self->payinfo;
1746 $self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
1747 $content{expiration} = "$2/$1";
1749 $content{cvv2} = $self->paycvv
1750 if defined $self->dbdef_table->column('paycvv')
1751 && length($self->paycvv);
1753 $content{recurring_billing} = 'YES'
1754 if qsearch('cust_pay', { 'custnum' => $self->custnum,
1756 'payinfo' => $self->payinfo, } );
1758 } elsif ( $method eq 'ECHECK' ) {
1759 my($account_number,$routing_code) = $self->payinfo;
1760 ( $content{account_number}, $content{routing_code} ) =
1761 split('@', $self->payinfo);
1762 $content{bank_name} = $self->payname;
1763 $content{account_type} = 'CHECKING';
1764 $content{account_name} = $payname;
1765 $content{customer_org} = $self->company ? 'B' : 'I';
1766 $content{customer_ssn} = $self->ss;
1767 } elsif ( $method eq 'LEC' ) {
1768 $content{phone} = $self->payinfo;
1773 my( $action1, $action2 ) = split(/\s*\,\s*/, $action );
1776 new Business::OnlinePayment( $processor, @bop_options );
1777 $transaction->content(
1780 'password' => $password,
1781 'action' => $action1,
1782 'description' => $options{'description'},
1783 'amount' => $amount,
1784 'invoice_number' => $options{'invnum'},
1785 'customer_id' => $self->custnum,
1786 'last_name' => $paylast,
1787 'first_name' => $payfirst,
1789 'address' => $address,
1790 'city' => $self->city,
1791 'state' => $self->state,
1792 'zip' => $self->zip,
1793 'country' => $self->country,
1794 'referer' => 'http://cleanwhisker.420.am/',
1796 'phone' => $self->daytime || $self->night,
1799 $transaction->submit();
1801 if ( $transaction->is_success() && $action2 ) {
1802 my $auth = $transaction->authorization;
1803 my $ordernum = $transaction->can('order_number')
1804 ? $transaction->order_number
1808 new Business::OnlinePayment( $processor, @bop_options );
1815 password => $password,
1816 order_number => $ordernum,
1818 authorization => $auth,
1819 description => $options{'description'},
1822 foreach my $field (qw( authorization_source_code returned_ACI transaction_identifier validation_code
1823 transaction_sequence_num local_transaction_date
1824 local_transaction_time AVS_result_code )) {
1825 $capture{$field} = $transaction->$field() if $transaction->can($field);
1828 $capture->content( %capture );
1832 unless ( $capture->is_success ) {
1833 my $e = "Authorization sucessful but capture failed, custnum #".
1834 $self->custnum. ': '. $capture->result_code.
1835 ": ". $capture->error_message;
1842 #remove paycvv after initial transaction
1843 #false laziness w/misc/process/payment.cgi - check both to make sure working
1845 if ( defined $self->dbdef_table->column('paycvv')
1846 && length($self->paycvv)
1847 && ! grep { $_ eq cardtype($self->payinfo) } $conf->config('cvv-save')
1848 && ! length($options{'paycvv'})
1850 my $new = new FS::cust_main { $self->hash };
1852 my $error = $new->replace($self);
1854 warn "error removing cvv: $error\n";
1859 if ( $transaction->is_success() ) {
1861 my %method2payby = (
1867 my $cust_pay = new FS::cust_pay ( {
1868 'custnum' => $self->custnum,
1869 'invnum' => $options{'invnum'},
1872 'payby' => $method2payby{$method},
1873 'payinfo' => $self->payinfo,
1874 'paybatch' => "$processor:". $transaction->authorization,
1876 my $error = $cust_pay->insert;
1878 # gah, even with transactions.
1879 my $e = 'WARNING: Card/ACH debited but database not updated - '.
1880 'error applying payment, invnum #' . $self->invnum.
1881 " ($processor): $error";
1890 my $perror = "$processor error: ". $transaction->error_message;
1892 if ( !$options{'quiet'} && !$realtime_bop_decline_quiet
1893 && $conf->exists('emaildecline')
1894 && grep { $_ ne 'POST' } $self->invoicing_list
1895 && ! grep { $transaction->error_message =~ /$_/ }
1896 $conf->config('emaildecline-exclude')
1898 my @templ = $conf->config('declinetemplate');
1899 my $template = new Text::Template (
1901 SOURCE => [ map "$_\n", @templ ],
1902 ) or return "($perror) can't create template: $Text::Template::ERROR";
1903 $template->compile()
1904 or return "($perror) can't compile template: $Text::Template::ERROR";
1906 my $templ_hash = { error => $transaction->error_message };
1908 my $error = send_email(
1909 'from' => $conf->config('invoice_from'),
1910 'to' => [ grep { $_ ne 'POST' } $self->invoicing_list ],
1911 'subject' => 'Your payment could not be processed',
1912 'body' => [ $template->fill_in(HASH => $templ_hash) ],
1915 $perror .= " (also received error sending decline notification: $error)"
1927 Returns the total owed for this customer on all invoices
1928 (see L<FS::cust_bill/owed>).
1934 $self->total_owed_date(2145859200); #12/31/2037
1937 =item total_owed_date TIME
1939 Returns the total owed for this customer on all invoices with date earlier than
1940 TIME. TIME is specified as a UNIX timestamp; see L<perlfunc/"time">). Also
1941 see L<Time::Local> and L<Date::Parse> for conversion functions.
1945 sub total_owed_date {
1949 foreach my $cust_bill (
1950 grep { $_->_date <= $time }
1951 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
1953 $total_bill += $cust_bill->owed;
1955 sprintf( "%.2f", $total_bill );
1960 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
1961 to outstanding invoice balances in chronological order and returns the value
1962 of any remaining unapplied credits available for refund
1963 (see L<FS::cust_refund>).
1970 return 0 unless $self->total_credited;
1972 my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
1973 qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
1975 my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
1976 qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
1980 foreach my $cust_bill ( @invoices ) {
1983 if ( !defined($credit) || $credit->credited == 0) {
1984 $credit = pop @credits or last;
1987 if ($cust_bill->owed >= $credit->credited) {
1988 $amount=$credit->credited;
1990 $amount=$cust_bill->owed;
1993 my $cust_credit_bill = new FS::cust_credit_bill ( {
1994 'crednum' => $credit->crednum,
1995 'invnum' => $cust_bill->invnum,
1996 'amount' => $amount,
1998 my $error = $cust_credit_bill->insert;
1999 die $error if $error;
2001 redo if ($cust_bill->owed > 0);
2005 return $self->total_credited;
2008 =item apply_payments
2010 Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
2011 to outstanding invoice balances in chronological order.
2013 #and returns the value of any remaining unapplied payments.
2017 sub apply_payments {
2022 my @payments = sort { $b->_date <=> $a->_date } ( grep { $_->unapplied > 0 }
2023 qsearch('cust_pay', { 'custnum' => $self->custnum } ) );
2025 my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
2026 qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
2030 foreach my $cust_bill ( @invoices ) {
2033 if ( !defined($payment) || $payment->unapplied == 0 ) {
2034 $payment = pop @payments or last;
2037 if ( $cust_bill->owed >= $payment->unapplied ) {
2038 $amount = $payment->unapplied;
2040 $amount = $cust_bill->owed;
2043 my $cust_bill_pay = new FS::cust_bill_pay ( {
2044 'paynum' => $payment->paynum,
2045 'invnum' => $cust_bill->invnum,
2046 'amount' => $amount,
2048 my $error = $cust_bill_pay->insert;
2049 die $error if $error;
2051 redo if ( $cust_bill->owed > 0);
2055 return $self->total_unapplied_payments;
2058 =item total_credited
2060 Returns the total outstanding credit (see L<FS::cust_credit>) for this
2061 customer. See L<FS::cust_credit/credited>.
2065 sub total_credited {
2067 my $total_credit = 0;
2068 foreach my $cust_credit ( qsearch('cust_credit', {
2069 'custnum' => $self->custnum,
2071 $total_credit += $cust_credit->credited;
2073 sprintf( "%.2f", $total_credit );
2076 =item total_unapplied_payments
2078 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
2079 See L<FS::cust_pay/unapplied>.
2083 sub total_unapplied_payments {
2085 my $total_unapplied = 0;
2086 foreach my $cust_pay ( qsearch('cust_pay', {
2087 'custnum' => $self->custnum,
2089 $total_unapplied += $cust_pay->unapplied;
2091 sprintf( "%.2f", $total_unapplied );
2096 Returns the balance for this customer (total_owed minus total_credited
2097 minus total_unapplied_payments).
2104 $self->total_owed - $self->total_credited - $self->total_unapplied_payments
2108 =item balance_date TIME
2110 Returns the balance for this customer, only considering invoices with date
2111 earlier than TIME (total_owed_date minus total_credited minus
2112 total_unapplied_payments). TIME is specified as a UNIX timestamp; see
2113 L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion
2122 $self->total_owed_date($time)
2123 - $self->total_credited
2124 - $self->total_unapplied_payments
2128 =item paydate_monthyear
2130 Returns a two-element list consisting of the month and year of this customer's
2131 paydate (credit card expiration date for CARD customers)
2135 sub paydate_monthyear {
2137 if ( $self->paydate =~ /^(\d{4})-(\d{2})-\d{2}$/ ) { #Pg date format
2139 } elsif ( $self->paydate =~ /^(\d{1,2})-(\d{1,2}-)?(\d{4}$)/ ) {
2146 =item invoicing_list [ ARRAYREF ]
2148 If an arguement is given, sets these email addresses as invoice recipients
2149 (see L<FS::cust_main_invoice>). Errors are not fatal and are not reported
2150 (except as warnings), so use check_invoicing_list first.
2152 Returns a list of email addresses (with svcnum entries expanded).
2154 Note: You can clear the invoicing list by passing an empty ARRAYREF. You can
2155 check it without disturbing anything by passing nothing.
2157 This interface may change in the future.
2161 sub invoicing_list {
2162 my( $self, $arrayref ) = @_;
2164 my @cust_main_invoice;
2165 if ( $self->custnum ) {
2166 @cust_main_invoice =
2167 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
2169 @cust_main_invoice = ();
2171 foreach my $cust_main_invoice ( @cust_main_invoice ) {
2172 #warn $cust_main_invoice->destnum;
2173 unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
2174 #warn $cust_main_invoice->destnum;
2175 my $error = $cust_main_invoice->delete;
2176 warn $error if $error;
2179 if ( $self->custnum ) {
2180 @cust_main_invoice =
2181 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
2183 @cust_main_invoice = ();
2185 my %seen = map { $_->address => 1 } @cust_main_invoice;
2186 foreach my $address ( @{$arrayref} ) {
2187 next if exists $seen{$address} && $seen{$address};
2188 $seen{$address} = 1;
2189 my $cust_main_invoice = new FS::cust_main_invoice ( {
2190 'custnum' => $self->custnum,
2193 my $error = $cust_main_invoice->insert;
2194 warn $error if $error;
2197 if ( $self->custnum ) {
2199 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
2205 =item check_invoicing_list ARRAYREF
2207 Checks these arguements as valid input for the invoicing_list method. If there
2208 is an error, returns the error, otherwise returns false.
2212 sub check_invoicing_list {
2213 my( $self, $arrayref ) = @_;
2214 foreach my $address ( @{$arrayref} ) {
2215 my $cust_main_invoice = new FS::cust_main_invoice ( {
2216 'custnum' => $self->custnum,
2219 my $error = $self->custnum
2220 ? $cust_main_invoice->check
2221 : $cust_main_invoice->checkdest
2223 return $error if $error;
2228 =item set_default_invoicing_list
2230 Sets the invoicing list to all accounts associated with this customer,
2231 overwriting any previous invoicing list.
2235 sub set_default_invoicing_list {
2237 $self->invoicing_list($self->all_emails);
2242 Returns the email addresses of all accounts provisioned for this customer.
2249 foreach my $cust_pkg ( $self->all_pkgs ) {
2250 my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
2252 map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
2253 grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
2255 $list{$_}=1 foreach map { $_->email } @svc_acct;
2260 =item invoicing_list_addpost
2262 Adds postal invoicing to this customer. If this customer is already configured
2263 to receive postal invoices, does nothing.
2267 sub invoicing_list_addpost {
2269 return if grep { $_ eq 'POST' } $self->invoicing_list;
2270 my @invoicing_list = $self->invoicing_list;
2271 push @invoicing_list, 'POST';
2272 $self->invoicing_list(\@invoicing_list);
2275 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
2277 Returns an array of customers referred by this customer (referral_custnum set
2278 to this custnum). If DEPTH is given, recurses up to the given depth, returning
2279 customers referred by customers referred by this customer and so on, inclusive.
2280 The default behavior is DEPTH 1 (no recursion).
2284 sub referral_cust_main {
2286 my $depth = @_ ? shift : 1;
2287 my $exclude = @_ ? shift : {};
2290 map { $exclude->{$_->custnum}++; $_; }
2291 grep { ! $exclude->{ $_->custnum } }
2292 qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
2296 map { $_->referral_cust_main($depth-1, $exclude) }
2303 =item referral_cust_main_ncancelled
2305 Same as referral_cust_main, except only returns customers with uncancelled
2310 sub referral_cust_main_ncancelled {
2312 grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
2315 =item referral_cust_pkg [ DEPTH ]
2317 Like referral_cust_main, except returns a flat list of all unsuspended (and
2318 uncancelled) packages for each customer. The number of items in this list may
2319 be useful for comission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
2323 sub referral_cust_pkg {
2325 my $depth = @_ ? shift : 1;
2327 map { $_->unsuspended_pkgs }
2328 grep { $_->unsuspended_pkgs }
2329 $self->referral_cust_main($depth);
2332 =item credit AMOUNT, REASON
2334 Applies a credit to this customer. If there is an error, returns the error,
2335 otherwise returns false.
2340 my( $self, $amount, $reason ) = @_;
2341 my $cust_credit = new FS::cust_credit {
2342 'custnum' => $self->custnum,
2343 'amount' => $amount,
2344 'reason' => $reason,
2346 $cust_credit->insert;
2349 =item charge AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
2351 Creates a one-time charge for this customer. If there is an error, returns
2352 the error, otherwise returns false.
2357 my ( $self, $amount ) = ( shift, shift );
2358 my $pkg = @_ ? shift : 'One-time charge';
2359 my $comment = @_ ? shift : '$'. sprintf("%.2f",$amount);
2360 my $taxclass = @_ ? shift : '';
2362 local $SIG{HUP} = 'IGNORE';
2363 local $SIG{INT} = 'IGNORE';
2364 local $SIG{QUIT} = 'IGNORE';
2365 local $SIG{TERM} = 'IGNORE';
2366 local $SIG{TSTP} = 'IGNORE';
2367 local $SIG{PIPE} = 'IGNORE';
2369 my $oldAutoCommit = $FS::UID::AutoCommit;
2370 local $FS::UID::AutoCommit = 0;
2373 my $part_pkg = new FS::part_pkg ( {
2375 'comment' => $comment,
2380 'taxclass' => $taxclass,
2383 my $error = $part_pkg->insert;
2385 $dbh->rollback if $oldAutoCommit;
2389 my $pkgpart = $part_pkg->pkgpart;
2390 my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
2391 unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
2392 my $type_pkgs = new FS::type_pkgs \%type_pkgs;
2393 $error = $type_pkgs->insert;
2395 $dbh->rollback if $oldAutoCommit;
2400 my $cust_pkg = new FS::cust_pkg ( {
2401 'custnum' => $self->custnum,
2402 'pkgpart' => $pkgpart,
2405 $error = $cust_pkg->insert;
2407 $dbh->rollback if $oldAutoCommit;
2411 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2418 Returns all the invoices (see L<FS::cust_bill>) for this customer.
2424 sort { $a->_date <=> $b->_date }
2425 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
2428 =item open_cust_bill
2430 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
2435 sub open_cust_bill {
2437 grep { $_->owed > 0 } $self->cust_bill;
2442 Returns all the credits (see L<FS::cust_credit>) for this customer.
2448 sort { $a->_date <=> $b->_date }
2449 qsearch( 'cust_credit', { 'custnum' => $self->custnum } )
2454 Returns all the payments (see L<FS::cust_pay>) for this customer.
2460 sort { $a->_date <=> $b->_date }
2461 qsearch( 'cust_pay', { 'custnum' => $self->custnum } )
2466 Returns all the refunds (see L<FS::cust_refund>) for this customer.
2472 sort { $a->_date <=> $b->_date }
2473 qsearch( 'cust_refund', { 'custnum' => $self->custnum } )
2482 =item check_and_rebuild_fuzzyfiles
2486 sub check_and_rebuild_fuzzyfiles {
2487 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2488 -e "$dir/cust_main.last" && -e "$dir/cust_main.company"
2489 or &rebuild_fuzzyfiles;
2492 =item rebuild_fuzzyfiles
2496 sub rebuild_fuzzyfiles {
2498 use Fcntl qw(:flock);
2500 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2504 open(LASTLOCK,">>$dir/cust_main.last")
2505 or die "can't open $dir/cust_main.last: $!";
2506 flock(LASTLOCK,LOCK_EX)
2507 or die "can't lock $dir/cust_main.last: $!";
2509 my @all_last = map $_->getfield('last'), qsearch('cust_main', {});
2511 grep $_, map $_->getfield('ship_last'), qsearch('cust_main',{})
2512 if defined dbdef->table('cust_main')->column('ship_last');
2514 open (LASTCACHE,">$dir/cust_main.last.tmp")
2515 or die "can't open $dir/cust_main.last.tmp: $!";
2516 print LASTCACHE join("\n", @all_last), "\n";
2517 close LASTCACHE or die "can't close $dir/cust_main.last.tmp: $!";
2519 rename "$dir/cust_main.last.tmp", "$dir/cust_main.last";
2524 open(COMPANYLOCK,">>$dir/cust_main.company")
2525 or die "can't open $dir/cust_main.company: $!";
2526 flock(COMPANYLOCK,LOCK_EX)
2527 or die "can't lock $dir/cust_main.company: $!";
2529 my @all_company = grep $_ ne '', map $_->company, qsearch('cust_main',{});
2531 grep $_ ne '', map $_->ship_company, qsearch('cust_main', {})
2532 if defined dbdef->table('cust_main')->column('ship_last');
2534 open (COMPANYCACHE,">$dir/cust_main.company.tmp")
2535 or die "can't open $dir/cust_main.company.tmp: $!";
2536 print COMPANYCACHE join("\n", @all_company), "\n";
2537 close COMPANYCACHE or die "can't close $dir/cust_main.company.tmp: $!";
2539 rename "$dir/cust_main.company.tmp", "$dir/cust_main.company";
2549 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2550 open(LASTCACHE,"<$dir/cust_main.last")
2551 or die "can't open $dir/cust_main.last: $!";
2552 my @array = map { chomp; $_; } <LASTCACHE>;
2562 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2563 open(COMPANYCACHE,"<$dir/cust_main.company")
2564 or die "can't open $dir/cust_main.last: $!";
2565 my @array = map { chomp; $_; } <COMPANYCACHE>;
2570 =item append_fuzzyfiles LASTNAME COMPANY
2574 sub append_fuzzyfiles {
2575 my( $last, $company ) = @_;
2577 &check_and_rebuild_fuzzyfiles;
2579 use Fcntl qw(:flock);
2581 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2585 open(LAST,">>$dir/cust_main.last")
2586 or die "can't open $dir/cust_main.last: $!";
2588 or die "can't lock $dir/cust_main.last: $!";
2590 print LAST "$last\n";
2593 or die "can't unlock $dir/cust_main.last: $!";
2599 open(COMPANY,">>$dir/cust_main.company")
2600 or die "can't open $dir/cust_main.company: $!";
2601 flock(COMPANY,LOCK_EX)
2602 or die "can't lock $dir/cust_main.company: $!";
2604 print COMPANY "$company\n";
2606 flock(COMPANY,LOCK_UN)
2607 or die "can't unlock $dir/cust_main.company: $!";
2621 #warn join('-',keys %$param);
2622 my $fh = $param->{filehandle};
2623 my $agentnum = $param->{agentnum};
2624 my $refnum = $param->{refnum};
2625 my $pkgpart = $param->{pkgpart};
2626 my @fields = @{$param->{fields}};
2628 eval "use Date::Parse;";
2630 eval "use Text::CSV_XS;";
2633 my $csv = new Text::CSV_XS;
2640 local $SIG{HUP} = 'IGNORE';
2641 local $SIG{INT} = 'IGNORE';
2642 local $SIG{QUIT} = 'IGNORE';
2643 local $SIG{TERM} = 'IGNORE';
2644 local $SIG{TSTP} = 'IGNORE';
2645 local $SIG{PIPE} = 'IGNORE';
2647 my $oldAutoCommit = $FS::UID::AutoCommit;
2648 local $FS::UID::AutoCommit = 0;
2651 #while ( $columns = $csv->getline($fh) ) {
2653 while ( defined($line=<$fh>) ) {
2655 $csv->parse($line) or do {
2656 $dbh->rollback if $oldAutoCommit;
2657 return "can't parse: ". $csv->error_input();
2660 my @columns = $csv->fields();
2661 #warn join('-',@columns);
2664 agentnum => $agentnum,
2666 country => 'US', #default
2667 payby => 'BILL', #default
2668 paydate => '12/2037', #default
2670 my $billtime = time;
2671 my %cust_pkg = ( pkgpart => $pkgpart );
2672 foreach my $field ( @fields ) {
2673 if ( $field =~ /^cust_pkg\.(setup|bill|susp|expire|cancel)$/ ) {
2674 #$cust_pkg{$1} = str2time( shift @$columns );
2675 if ( $1 eq 'setup' ) {
2676 $billtime = str2time(shift @columns);
2678 $cust_pkg{$1} = str2time( shift @columns );
2681 #$cust_main{$field} = shift @$columns;
2682 $cust_main{$field} = shift @columns;
2686 my $cust_pkg = new FS::cust_pkg ( \%cust_pkg ) if $pkgpart;
2687 my $cust_main = new FS::cust_main ( \%cust_main );
2689 tie my %hash, 'Tie::RefHash'; #this part is important
2690 $hash{$cust_pkg} = [] if $pkgpart;
2691 my $error = $cust_main->insert( \%hash );
2694 $dbh->rollback if $oldAutoCommit;
2695 return "can't insert customer for $line: $error";
2698 #false laziness w/bill.cgi
2699 $error = $cust_main->bill( 'time' => $billtime );
2701 $dbh->rollback if $oldAutoCommit;
2702 return "can't bill customer for $line: $error";
2705 $cust_main->apply_payments;
2706 $cust_main->apply_credits;
2708 $error = $cust_main->collect();
2710 $dbh->rollback if $oldAutoCommit;
2711 return "can't collect customer for $line: $error";
2717 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2719 return "Empty file!" unless $imported;
2731 #warn join('-',keys %$param);
2732 my $fh = $param->{filehandle};
2733 my @fields = @{$param->{fields}};
2735 eval "use Date::Parse;";
2737 eval "use Text::CSV_XS;";
2740 my $csv = new Text::CSV_XS;
2747 local $SIG{HUP} = 'IGNORE';
2748 local $SIG{INT} = 'IGNORE';
2749 local $SIG{QUIT} = 'IGNORE';
2750 local $SIG{TERM} = 'IGNORE';
2751 local $SIG{TSTP} = 'IGNORE';
2752 local $SIG{PIPE} = 'IGNORE';
2754 my $oldAutoCommit = $FS::UID::AutoCommit;
2755 local $FS::UID::AutoCommit = 0;
2758 #while ( $columns = $csv->getline($fh) ) {
2760 while ( defined($line=<$fh>) ) {
2762 $csv->parse($line) or do {
2763 $dbh->rollback if $oldAutoCommit;
2764 return "can't parse: ". $csv->error_input();
2767 my @columns = $csv->fields();
2768 #warn join('-',@columns);
2771 foreach my $field ( @fields ) {
2772 $row{$field} = shift @columns;
2775 my $cust_main = qsearchs('cust_main', { 'custnum' => $row{'custnum'} } );
2776 unless ( $cust_main ) {
2777 $dbh->rollback if $oldAutoCommit;
2778 return "unknown custnum $row{'custnum'}";
2781 if ( $row{'amount'} > 0 ) {
2782 my $error = $cust_main->charge($row{'amount'}, $row{'pkg'});
2784 $dbh->rollback if $oldAutoCommit;
2788 } elsif ( $row{'amount'} < 0 ) {
2789 my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ),
2792 $dbh->rollback if $oldAutoCommit;
2802 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2804 return "Empty file!" unless $imported;
2816 The delete method should possibly take an FS::cust_main object reference
2817 instead of a scalar customer number.
2819 Bill and collect options should probably be passed as references instead of a
2822 There should probably be a configuration file with a list of allowed credit
2825 No multiple currency support (probably a larger project than just this module).
2829 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
2830 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
2831 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.