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 );
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*$/;
1717 my $address = $self->address1;
1718 $address .= ", ". $self->address2 if $self->address2;
1720 my($payname, $payfirst, $paylast);
1721 if ( $self->payname && $method ne 'ECHECK' ) {
1722 $payname = $self->payname;
1723 $payname =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
1724 or return "Illegal payname $payname";
1725 ($payfirst, $paylast) = ($1, $2);
1727 $payfirst = $self->getfield('first');
1728 $paylast = $self->getfield('last');
1729 $payname = "$payfirst $paylast";
1732 my @invoicing_list = grep { $_ ne 'POST' } $self->invoicing_list;
1733 if ( $conf->exists('emailinvoiceauto')
1734 || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
1735 push @invoicing_list, $self->all_emails;
1737 my $email = $invoicing_list[0];
1740 if ( $method eq 'CC' ) {
1742 $content{card_number} = $self->payinfo;
1743 $self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
1744 $content{expiration} = "$2/$1";
1746 $content{cvv2} = $self->paycvv
1747 if defined $self->dbdef_table->column('paycvv')
1748 && length($self->paycvv);
1750 $content{recurring_billing} = 'YES'
1751 if qsearch('cust_pay', { 'custnum' => $self->custnum,
1753 'payinfo' => $self->payinfo, } );
1755 } elsif ( $method eq 'ECHECK' ) {
1756 my($account_number,$routing_code) = $self->payinfo;
1757 ( $content{account_number}, $content{routing_code} ) =
1758 split('@', $self->payinfo);
1759 $content{bank_name} = $self->payname;
1760 $content{account_type} = 'CHECKING';
1761 $content{account_name} = $payname;
1762 $content{customer_org} = $self->company ? 'B' : 'I';
1763 $content{customer_ssn} = $self->ss;
1764 } elsif ( $method eq 'LEC' ) {
1765 $content{phone} = $self->payinfo;
1770 my( $action1, $action2 ) = split(/\s*\,\s*/, $action );
1773 new Business::OnlinePayment( $processor, @bop_options );
1774 $transaction->content(
1777 'password' => $password,
1778 'action' => $action1,
1779 'description' => $options{'description'},
1780 'amount' => $amount,
1781 'invoice_number' => $options{'invnum'},
1782 'customer_id' => $self->custnum,
1783 'last_name' => $paylast,
1784 'first_name' => $payfirst,
1786 'address' => $address,
1787 'city' => $self->city,
1788 'state' => $self->state,
1789 'zip' => $self->zip,
1790 'country' => $self->country,
1791 'referer' => 'http://cleanwhisker.420.am/',
1793 'phone' => $self->daytime || $self->night,
1796 $transaction->submit();
1798 if ( $transaction->is_success() && $action2 ) {
1799 my $auth = $transaction->authorization;
1800 my $ordernum = $transaction->can('order_number')
1801 ? $transaction->order_number
1805 new Business::OnlinePayment( $processor, @bop_options );
1812 password => $password,
1813 order_number => $ordernum,
1815 authorization => $auth,
1816 description => $options{'description'},
1819 foreach my $field (qw( authorization_source_code returned_ACI transaction_identifier validation_code
1820 transaction_sequence_num local_transaction_date
1821 local_transaction_time AVS_result_code )) {
1822 $capture{$field} = $transaction->$field() if $transaction->can($field);
1825 $capture->content( %capture );
1829 unless ( $capture->is_success ) {
1830 my $e = "Authorization sucessful but capture failed, custnum #".
1831 $self->custnum. ': '. $capture->result_code.
1832 ": ". $capture->error_message;
1839 #remove paycvv after initial transaction
1840 #make this disable-able via a config option if anyone insists?
1841 # (though that probably violates cardholder agreements)
1842 if ( defined $self->dbdef_table->column('paycvv')
1843 && length($self->paycvv)
1844 && ! grep { $_ eq cardtype($self->payinfo) } $conf->config('cvv-save')
1846 my $new = new FS::cust_main { $self->hash };
1848 my $error = $new->replace($self);
1850 warn "error removing cvv: $error\n";
1855 if ( $transaction->is_success() ) {
1857 my %method2payby = (
1863 my $cust_pay = new FS::cust_pay ( {
1864 'custnum' => $self->custnum,
1865 'invnum' => $options{'invnum'},
1868 'payby' => $method2payby{$method},
1869 'payinfo' => $self->payinfo,
1870 'paybatch' => "$processor:". $transaction->authorization,
1872 my $error = $cust_pay->insert;
1874 # gah, even with transactions.
1875 my $e = 'WARNING: Card/ACH debited but database not updated - '.
1876 'error applying payment, invnum #' . $self->invnum.
1877 " ($processor): $error";
1886 my $perror = "$processor error: ". $transaction->error_message;
1888 if ( !$options{'quiet'} && !$realtime_bop_decline_quiet
1889 && $conf->exists('emaildecline')
1890 && grep { $_ ne 'POST' } $self->invoicing_list
1891 && ! grep { $transaction->error_message =~ /$_/ }
1892 $conf->config('emaildecline-exclude')
1894 my @templ = $conf->config('declinetemplate');
1895 my $template = new Text::Template (
1897 SOURCE => [ map "$_\n", @templ ],
1898 ) or return "($perror) can't create template: $Text::Template::ERROR";
1899 $template->compile()
1900 or return "($perror) can't compile template: $Text::Template::ERROR";
1902 my $templ_hash = { error => $transaction->error_message };
1904 my $error = send_email(
1905 'from' => $conf->config('invoice_from'),
1906 'to' => [ grep { $_ ne 'POST' } $self->invoicing_list ],
1907 'subject' => 'Your payment could not be processed',
1908 'body' => [ $template->fill_in(HASH => $templ_hash) ],
1911 $perror .= " (also received error sending decline notification: $error)"
1923 Returns the total owed for this customer on all invoices
1924 (see L<FS::cust_bill/owed>).
1930 $self->total_owed_date(2145859200); #12/31/2037
1933 =item total_owed_date TIME
1935 Returns the total owed for this customer on all invoices with date earlier than
1936 TIME. TIME is specified as a UNIX timestamp; see L<perlfunc/"time">). Also
1937 see L<Time::Local> and L<Date::Parse> for conversion functions.
1941 sub total_owed_date {
1945 foreach my $cust_bill (
1946 grep { $_->_date <= $time }
1947 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
1949 $total_bill += $cust_bill->owed;
1951 sprintf( "%.2f", $total_bill );
1956 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
1957 to outstanding invoice balances in chronological order and returns the value
1958 of any remaining unapplied credits available for refund
1959 (see L<FS::cust_refund>).
1966 return 0 unless $self->total_credited;
1968 my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
1969 qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
1971 my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
1972 qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
1976 foreach my $cust_bill ( @invoices ) {
1979 if ( !defined($credit) || $credit->credited == 0) {
1980 $credit = pop @credits or last;
1983 if ($cust_bill->owed >= $credit->credited) {
1984 $amount=$credit->credited;
1986 $amount=$cust_bill->owed;
1989 my $cust_credit_bill = new FS::cust_credit_bill ( {
1990 'crednum' => $credit->crednum,
1991 'invnum' => $cust_bill->invnum,
1992 'amount' => $amount,
1994 my $error = $cust_credit_bill->insert;
1995 die $error if $error;
1997 redo if ($cust_bill->owed > 0);
2001 return $self->total_credited;
2004 =item apply_payments
2006 Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
2007 to outstanding invoice balances in chronological order.
2009 #and returns the value of any remaining unapplied payments.
2013 sub apply_payments {
2018 my @payments = sort { $b->_date <=> $a->_date } ( grep { $_->unapplied > 0 }
2019 qsearch('cust_pay', { 'custnum' => $self->custnum } ) );
2021 my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
2022 qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
2026 foreach my $cust_bill ( @invoices ) {
2029 if ( !defined($payment) || $payment->unapplied == 0 ) {
2030 $payment = pop @payments or last;
2033 if ( $cust_bill->owed >= $payment->unapplied ) {
2034 $amount = $payment->unapplied;
2036 $amount = $cust_bill->owed;
2039 my $cust_bill_pay = new FS::cust_bill_pay ( {
2040 'paynum' => $payment->paynum,
2041 'invnum' => $cust_bill->invnum,
2042 'amount' => $amount,
2044 my $error = $cust_bill_pay->insert;
2045 die $error if $error;
2047 redo if ( $cust_bill->owed > 0);
2051 return $self->total_unapplied_payments;
2054 =item total_credited
2056 Returns the total outstanding credit (see L<FS::cust_credit>) for this
2057 customer. See L<FS::cust_credit/credited>.
2061 sub total_credited {
2063 my $total_credit = 0;
2064 foreach my $cust_credit ( qsearch('cust_credit', {
2065 'custnum' => $self->custnum,
2067 $total_credit += $cust_credit->credited;
2069 sprintf( "%.2f", $total_credit );
2072 =item total_unapplied_payments
2074 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
2075 See L<FS::cust_pay/unapplied>.
2079 sub total_unapplied_payments {
2081 my $total_unapplied = 0;
2082 foreach my $cust_pay ( qsearch('cust_pay', {
2083 'custnum' => $self->custnum,
2085 $total_unapplied += $cust_pay->unapplied;
2087 sprintf( "%.2f", $total_unapplied );
2092 Returns the balance for this customer (total_owed minus total_credited
2093 minus total_unapplied_payments).
2100 $self->total_owed - $self->total_credited - $self->total_unapplied_payments
2104 =item balance_date TIME
2106 Returns the balance for this customer, only considering invoices with date
2107 earlier than TIME (total_owed_date minus total_credited minus
2108 total_unapplied_payments). TIME is specified as a UNIX timestamp; see
2109 L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion
2118 $self->total_owed_date($time)
2119 - $self->total_credited
2120 - $self->total_unapplied_payments
2124 =item invoicing_list [ ARRAYREF ]
2126 If an arguement is given, sets these email addresses as invoice recipients
2127 (see L<FS::cust_main_invoice>). Errors are not fatal and are not reported
2128 (except as warnings), so use check_invoicing_list first.
2130 Returns a list of email addresses (with svcnum entries expanded).
2132 Note: You can clear the invoicing list by passing an empty ARRAYREF. You can
2133 check it without disturbing anything by passing nothing.
2135 This interface may change in the future.
2139 sub invoicing_list {
2140 my( $self, $arrayref ) = @_;
2142 my @cust_main_invoice;
2143 if ( $self->custnum ) {
2144 @cust_main_invoice =
2145 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
2147 @cust_main_invoice = ();
2149 foreach my $cust_main_invoice ( @cust_main_invoice ) {
2150 #warn $cust_main_invoice->destnum;
2151 unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
2152 #warn $cust_main_invoice->destnum;
2153 my $error = $cust_main_invoice->delete;
2154 warn $error if $error;
2157 if ( $self->custnum ) {
2158 @cust_main_invoice =
2159 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
2161 @cust_main_invoice = ();
2163 my %seen = map { $_->address => 1 } @cust_main_invoice;
2164 foreach my $address ( @{$arrayref} ) {
2165 next if exists $seen{$address} && $seen{$address};
2166 $seen{$address} = 1;
2167 my $cust_main_invoice = new FS::cust_main_invoice ( {
2168 'custnum' => $self->custnum,
2171 my $error = $cust_main_invoice->insert;
2172 warn $error if $error;
2175 if ( $self->custnum ) {
2177 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
2183 =item check_invoicing_list ARRAYREF
2185 Checks these arguements as valid input for the invoicing_list method. If there
2186 is an error, returns the error, otherwise returns false.
2190 sub check_invoicing_list {
2191 my( $self, $arrayref ) = @_;
2192 foreach my $address ( @{$arrayref} ) {
2193 my $cust_main_invoice = new FS::cust_main_invoice ( {
2194 'custnum' => $self->custnum,
2197 my $error = $self->custnum
2198 ? $cust_main_invoice->check
2199 : $cust_main_invoice->checkdest
2201 return $error if $error;
2206 =item set_default_invoicing_list
2208 Sets the invoicing list to all accounts associated with this customer,
2209 overwriting any previous invoicing list.
2213 sub set_default_invoicing_list {
2215 $self->invoicing_list($self->all_emails);
2220 Returns the email addresses of all accounts provisioned for this customer.
2227 foreach my $cust_pkg ( $self->all_pkgs ) {
2228 my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
2230 map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
2231 grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
2233 $list{$_}=1 foreach map { $_->email } @svc_acct;
2238 =item invoicing_list_addpost
2240 Adds postal invoicing to this customer. If this customer is already configured
2241 to receive postal invoices, does nothing.
2245 sub invoicing_list_addpost {
2247 return if grep { $_ eq 'POST' } $self->invoicing_list;
2248 my @invoicing_list = $self->invoicing_list;
2249 push @invoicing_list, 'POST';
2250 $self->invoicing_list(\@invoicing_list);
2253 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
2255 Returns an array of customers referred by this customer (referral_custnum set
2256 to this custnum). If DEPTH is given, recurses up to the given depth, returning
2257 customers referred by customers referred by this customer and so on, inclusive.
2258 The default behavior is DEPTH 1 (no recursion).
2262 sub referral_cust_main {
2264 my $depth = @_ ? shift : 1;
2265 my $exclude = @_ ? shift : {};
2268 map { $exclude->{$_->custnum}++; $_; }
2269 grep { ! $exclude->{ $_->custnum } }
2270 qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
2274 map { $_->referral_cust_main($depth-1, $exclude) }
2281 =item referral_cust_main_ncancelled
2283 Same as referral_cust_main, except only returns customers with uncancelled
2288 sub referral_cust_main_ncancelled {
2290 grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
2293 =item referral_cust_pkg [ DEPTH ]
2295 Like referral_cust_main, except returns a flat list of all unsuspended (and
2296 uncancelled) packages for each customer. The number of items in this list may
2297 be useful for comission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
2301 sub referral_cust_pkg {
2303 my $depth = @_ ? shift : 1;
2305 map { $_->unsuspended_pkgs }
2306 grep { $_->unsuspended_pkgs }
2307 $self->referral_cust_main($depth);
2310 =item credit AMOUNT, REASON
2312 Applies a credit to this customer. If there is an error, returns the error,
2313 otherwise returns false.
2318 my( $self, $amount, $reason ) = @_;
2319 my $cust_credit = new FS::cust_credit {
2320 'custnum' => $self->custnum,
2321 'amount' => $amount,
2322 'reason' => $reason,
2324 $cust_credit->insert;
2327 =item charge AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
2329 Creates a one-time charge for this customer. If there is an error, returns
2330 the error, otherwise returns false.
2335 my ( $self, $amount ) = ( shift, shift );
2336 my $pkg = @_ ? shift : 'One-time charge';
2337 my $comment = @_ ? shift : '$'. sprintf("%.2f",$amount);
2338 my $taxclass = @_ ? shift : '';
2340 local $SIG{HUP} = 'IGNORE';
2341 local $SIG{INT} = 'IGNORE';
2342 local $SIG{QUIT} = 'IGNORE';
2343 local $SIG{TERM} = 'IGNORE';
2344 local $SIG{TSTP} = 'IGNORE';
2345 local $SIG{PIPE} = 'IGNORE';
2347 my $oldAutoCommit = $FS::UID::AutoCommit;
2348 local $FS::UID::AutoCommit = 0;
2351 my $part_pkg = new FS::part_pkg ( {
2353 'comment' => $comment,
2358 'taxclass' => $taxclass,
2361 my $error = $part_pkg->insert;
2363 $dbh->rollback if $oldAutoCommit;
2367 my $pkgpart = $part_pkg->pkgpart;
2368 my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
2369 unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
2370 my $type_pkgs = new FS::type_pkgs \%type_pkgs;
2371 $error = $type_pkgs->insert;
2373 $dbh->rollback if $oldAutoCommit;
2378 my $cust_pkg = new FS::cust_pkg ( {
2379 'custnum' => $self->custnum,
2380 'pkgpart' => $pkgpart,
2383 $error = $cust_pkg->insert;
2385 $dbh->rollback if $oldAutoCommit;
2389 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2396 Returns all the invoices (see L<FS::cust_bill>) for this customer.
2402 sort { $a->_date <=> $b->_date }
2403 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
2406 =item open_cust_bill
2408 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
2413 sub open_cust_bill {
2415 grep { $_->owed > 0 } $self->cust_bill;
2420 Returns all the credits (see L<FS::cust_credit>) for this customer.
2426 sort { $a->_date <=> $b->_date }
2427 qsearch( 'cust_credit', { 'custnum' => $self->custnum } )
2432 Returns all the payments (see L<FS::cust_pay>) for this customer.
2438 sort { $a->_date <=> $b->_date }
2439 qsearch( 'cust_pay', { 'custnum' => $self->custnum } )
2444 Returns all the refunds (see L<FS::cust_refund>) for this customer.
2450 sort { $a->_date <=> $b->_date }
2451 qsearch( 'cust_refund', { 'custnum' => $self->custnum } )
2460 =item check_and_rebuild_fuzzyfiles
2464 sub check_and_rebuild_fuzzyfiles {
2465 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2466 -e "$dir/cust_main.last" && -e "$dir/cust_main.company"
2467 or &rebuild_fuzzyfiles;
2470 =item rebuild_fuzzyfiles
2474 sub rebuild_fuzzyfiles {
2476 use Fcntl qw(:flock);
2478 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2482 open(LASTLOCK,">>$dir/cust_main.last")
2483 or die "can't open $dir/cust_main.last: $!";
2484 flock(LASTLOCK,LOCK_EX)
2485 or die "can't lock $dir/cust_main.last: $!";
2487 my @all_last = map $_->getfield('last'), qsearch('cust_main', {});
2489 grep $_, map $_->getfield('ship_last'), qsearch('cust_main',{})
2490 if defined dbdef->table('cust_main')->column('ship_last');
2492 open (LASTCACHE,">$dir/cust_main.last.tmp")
2493 or die "can't open $dir/cust_main.last.tmp: $!";
2494 print LASTCACHE join("\n", @all_last), "\n";
2495 close LASTCACHE or die "can't close $dir/cust_main.last.tmp: $!";
2497 rename "$dir/cust_main.last.tmp", "$dir/cust_main.last";
2502 open(COMPANYLOCK,">>$dir/cust_main.company")
2503 or die "can't open $dir/cust_main.company: $!";
2504 flock(COMPANYLOCK,LOCK_EX)
2505 or die "can't lock $dir/cust_main.company: $!";
2507 my @all_company = grep $_ ne '', map $_->company, qsearch('cust_main',{});
2509 grep $_ ne '', map $_->ship_company, qsearch('cust_main', {})
2510 if defined dbdef->table('cust_main')->column('ship_last');
2512 open (COMPANYCACHE,">$dir/cust_main.company.tmp")
2513 or die "can't open $dir/cust_main.company.tmp: $!";
2514 print COMPANYCACHE join("\n", @all_company), "\n";
2515 close COMPANYCACHE or die "can't close $dir/cust_main.company.tmp: $!";
2517 rename "$dir/cust_main.company.tmp", "$dir/cust_main.company";
2527 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2528 open(LASTCACHE,"<$dir/cust_main.last")
2529 or die "can't open $dir/cust_main.last: $!";
2530 my @array = map { chomp; $_; } <LASTCACHE>;
2540 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2541 open(COMPANYCACHE,"<$dir/cust_main.company")
2542 or die "can't open $dir/cust_main.last: $!";
2543 my @array = map { chomp; $_; } <COMPANYCACHE>;
2548 =item append_fuzzyfiles LASTNAME COMPANY
2552 sub append_fuzzyfiles {
2553 my( $last, $company ) = @_;
2555 &check_and_rebuild_fuzzyfiles;
2557 use Fcntl qw(:flock);
2559 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2563 open(LAST,">>$dir/cust_main.last")
2564 or die "can't open $dir/cust_main.last: $!";
2566 or die "can't lock $dir/cust_main.last: $!";
2568 print LAST "$last\n";
2571 or die "can't unlock $dir/cust_main.last: $!";
2577 open(COMPANY,">>$dir/cust_main.company")
2578 or die "can't open $dir/cust_main.company: $!";
2579 flock(COMPANY,LOCK_EX)
2580 or die "can't lock $dir/cust_main.company: $!";
2582 print COMPANY "$company\n";
2584 flock(COMPANY,LOCK_UN)
2585 or die "can't unlock $dir/cust_main.company: $!";
2599 #warn join('-',keys %$param);
2600 my $fh = $param->{filehandle};
2601 my $agentnum = $param->{agentnum};
2602 my $refnum = $param->{refnum};
2603 my $pkgpart = $param->{pkgpart};
2604 my @fields = @{$param->{fields}};
2606 eval "use Date::Parse;";
2608 eval "use Text::CSV_XS;";
2611 my $csv = new Text::CSV_XS;
2618 local $SIG{HUP} = 'IGNORE';
2619 local $SIG{INT} = 'IGNORE';
2620 local $SIG{QUIT} = 'IGNORE';
2621 local $SIG{TERM} = 'IGNORE';
2622 local $SIG{TSTP} = 'IGNORE';
2623 local $SIG{PIPE} = 'IGNORE';
2625 my $oldAutoCommit = $FS::UID::AutoCommit;
2626 local $FS::UID::AutoCommit = 0;
2629 #while ( $columns = $csv->getline($fh) ) {
2631 while ( defined($line=<$fh>) ) {
2633 $csv->parse($line) or do {
2634 $dbh->rollback if $oldAutoCommit;
2635 return "can't parse: ". $csv->error_input();
2638 my @columns = $csv->fields();
2639 #warn join('-',@columns);
2642 agentnum => $agentnum,
2644 country => 'US', #default
2645 payby => 'BILL', #default
2646 paydate => '12/2037', #default
2648 my $billtime = time;
2649 my %cust_pkg = ( pkgpart => $pkgpart );
2650 foreach my $field ( @fields ) {
2651 if ( $field =~ /^cust_pkg\.(setup|bill|susp|expire|cancel)$/ ) {
2652 #$cust_pkg{$1} = str2time( shift @$columns );
2653 if ( $1 eq 'setup' ) {
2654 $billtime = str2time(shift @columns);
2656 $cust_pkg{$1} = str2time( shift @columns );
2659 #$cust_main{$field} = shift @$columns;
2660 $cust_main{$field} = shift @columns;
2664 my $cust_pkg = new FS::cust_pkg ( \%cust_pkg ) if $pkgpart;
2665 my $cust_main = new FS::cust_main ( \%cust_main );
2667 tie my %hash, 'Tie::RefHash'; #this part is important
2668 $hash{$cust_pkg} = [] if $pkgpart;
2669 my $error = $cust_main->insert( \%hash );
2672 $dbh->rollback if $oldAutoCommit;
2673 return "can't insert customer for $line: $error";
2676 #false laziness w/bill.cgi
2677 $error = $cust_main->bill( 'time' => $billtime );
2679 $dbh->rollback if $oldAutoCommit;
2680 return "can't bill customer for $line: $error";
2683 $cust_main->apply_payments;
2684 $cust_main->apply_credits;
2686 $error = $cust_main->collect();
2688 $dbh->rollback if $oldAutoCommit;
2689 return "can't collect customer for $line: $error";
2695 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2697 return "Empty file!" unless $imported;
2709 #warn join('-',keys %$param);
2710 my $fh = $param->{filehandle};
2711 my @fields = @{$param->{fields}};
2713 eval "use Date::Parse;";
2715 eval "use Text::CSV_XS;";
2718 my $csv = new Text::CSV_XS;
2725 local $SIG{HUP} = 'IGNORE';
2726 local $SIG{INT} = 'IGNORE';
2727 local $SIG{QUIT} = 'IGNORE';
2728 local $SIG{TERM} = 'IGNORE';
2729 local $SIG{TSTP} = 'IGNORE';
2730 local $SIG{PIPE} = 'IGNORE';
2732 my $oldAutoCommit = $FS::UID::AutoCommit;
2733 local $FS::UID::AutoCommit = 0;
2736 #while ( $columns = $csv->getline($fh) ) {
2738 while ( defined($line=<$fh>) ) {
2740 $csv->parse($line) or do {
2741 $dbh->rollback if $oldAutoCommit;
2742 return "can't parse: ". $csv->error_input();
2745 my @columns = $csv->fields();
2746 #warn join('-',@columns);
2749 foreach my $field ( @fields ) {
2750 $row{$field} = shift @columns;
2753 my $cust_main = qsearchs('cust_main', { 'custnum' => $row{'custnum'} } );
2754 unless ( $cust_main ) {
2755 $dbh->rollback if $oldAutoCommit;
2756 return "unknown custnum $row{'custnum'}";
2759 if ( $row{'amount'} > 0 ) {
2760 my $error = $cust_main->charge($row{'amount'}, $row{'pkg'});
2762 $dbh->rollback if $oldAutoCommit;
2766 } elsif ( $row{'amount'} < 0 ) {
2767 my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ),
2770 $dbh->rollback if $oldAutoCommit;
2780 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2782 return "Empty file!" unless $imported;
2794 The delete method should possibly take an FS::cust_main object reference
2795 instead of a scalar customer number.
2797 Bill and collect options should probably be passed as references instead of a
2800 There should probably be a configuration file with a list of allowed credit
2803 No multiple currency support (probably a larger project than just this module).
2807 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
2808 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
2809 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.