4 use vars qw( @ISA $conf $lpr $processor $xaction $E_NoErr $invoice_from
5 $smtpmachine $Debug $bop_processor $bop_login $bop_password
6 $bop_action @bop_options);
14 use Business::CreditCard;
15 use FS::UID qw( getotaker dbh );
16 use FS::Record qw( qsearchs qsearch dbdef );
19 use FS::cust_bill_pkg;
22 use FS::cust_pay_batch;
23 use FS::part_referral;
24 use FS::cust_main_county;
26 use FS::cust_main_invoice;
27 use FS::cust_credit_bill;
28 use FS::cust_bill_pay;
29 use FS::prepay_credit;
32 @ISA = qw( FS::Record );
37 #ask FS::UID to run this stuff for us later
38 $FS::UID::callback{'FS::cust_main'} = sub {
40 $lpr = $conf->config('lpr');
41 $invoice_from = $conf->config('invoice_from');
42 $smtpmachine = $conf->config('smtpmachine');
44 if ( $conf->exists('cybercash3.2') ) {
46 #qw($MCKversion %Config InitConfig CCError CCDebug CCDebug2);
47 require CCMckDirectLib3_2;
49 require CCMckErrno3_2;
50 #qw(MCKGetErrorMessage $E_NoErr);
51 import CCMckErrno3_2 qw($E_NoErr);
54 ($merchant_conf,$xaction)= $conf->config('cybercash3.2');
55 my $status = &CCMckLib3_2::InitConfig($merchant_conf);
56 if ( $status != $E_NoErr ) {
57 warn "CCMckLib3_2::InitConfig error:\n";
58 foreach my $key (keys %CCMckLib3_2::Config) {
59 warn " $key => $CCMckLib3_2::Config{$key}\n"
61 my($errmsg) = &CCMckErrno3_2::MCKGetErrorMessage($status);
62 die "CCMckLib3_2::InitConfig fatal error: $errmsg\n";
64 $processor='cybercash3.2';
65 } elsif ( $conf->exists('business-onlinepayment') ) {
71 ) = $conf->config('business-onlinepayment');
72 $bop_action ||= 'normal authorization';
73 eval "use Business::OnlinePayment";
74 $processor="Business::OnlinePayment::$bop_processor";
80 FS::cust_main - Object methods for cust_main records
86 $record = new FS::cust_main \%hash;
87 $record = new FS::cust_main { 'column' => 'value' };
89 $error = $record->insert;
91 $error = $new_record->replace($old_record);
93 $error = $record->delete;
95 $error = $record->check;
97 @cust_pkg = $record->all_pkgs;
99 @cust_pkg = $record->ncancelled_pkgs;
101 @cust_pkg = $record->suspended_pkgs;
103 $error = $record->bill;
104 $error = $record->bill %options;
105 $error = $record->bill 'time' => $time;
107 $error = $record->collect;
108 $error = $record->collect %options;
109 $error = $record->collect 'invoice_time' => $time,
110 'batch_card' => 'yes',
111 'report_badcard' => 'yes',
116 An FS::cust_main object represents a customer. FS::cust_main inherits from
117 FS::Record. The following fields are currently supported:
121 =item custnum - primary key (assigned automatically for new customers)
123 =item agentnum - agent (see L<FS::agent>)
125 =item refnum - referral (see L<FS::part_referral>)
131 =item ss - social security number (optional)
133 =item company - (optional)
137 =item address2 - (optional)
141 =item county - (optional, see L<FS::cust_main_county>)
143 =item state - (see L<FS::cust_main_county>)
147 =item country - (see L<FS::cust_main_county>)
149 =item daytime - phone (optional)
151 =item night - phone (optional)
153 =item fax - phone (optional)
155 =item ship_first - name
157 =item ship_last - name
159 =item ship_company - (optional)
163 =item ship_address2 - (optional)
167 =item ship_county - (optional, see L<FS::cust_main_county>)
169 =item ship_state - (see L<FS::cust_main_county>)
173 =item ship_country - (see L<FS::cust_main_county>)
175 =item ship_daytime - phone (optional)
177 =item ship_night - phone (optional)
179 =item ship_fax - phone (optional)
181 =item payby - `CARD' (credit cards), `BILL' (billing), `COMP' (free), or `PREPAY' (special billing type: applies a credit - see L<FS::prepay_credit> and sets billing type to BILL)
183 =item payinfo - card number, P.O., comp issuer (4-8 lowercase alphanumerics; think username) or prepayment identifier (see L<FS::prepay_credit>)
185 =item paydate - expiration date, mm/yyyy, m/yyyy, mm/yy or m/yy
187 =item payname - name on card or billing name
189 =item tax - tax exempt, empty or `Y'
191 =item otaker - order taker (assigned automatically, see L<FS::UID>)
193 =item comments - comments (optional)
203 Creates a new customer. To add the customer to the database, see L<"insert">.
205 Note that this stores the hash reference, not a distinct copy of the hash it
206 points to. You can ask the object for a copy with the I<hash> method.
210 sub table { 'cust_main'; }
212 =item insert [ CUST_PKG_HASHREF [ , INVOICING_LIST_ARYREF ] ]
214 Adds this customer to the database. If there is an error, returns the error,
215 otherwise returns false.
217 CUST_PKG_HASHREF: If you pass a Tie::RefHash data structure to the insert
218 method containing FS::cust_pkg and FS::svc_I<tablename> objects, all records
219 are inserted atomicly, or the transaction is rolled back. Passing an empty
220 hash reference is equivalent to not supplying this parameter. There should be
221 a better explanation of this, but until then, here's an example:
224 tie %hash, 'Tie::RefHash'; #this part is important
226 $cust_pkg => [ $svc_acct ],
229 $cust_main->insert( \%hash );
231 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
232 be set as the invoicing list (see L<"invoicing_list">). Errors return as
233 expected and rollback the entire transaction; it is not necessary to call
234 check_invoicing_list first. The invoicing_list is set after the records in the
235 CUST_PKG_HASHREF above are inserted, so it is now possible to set an
236 invoicing_list destination to the newly-created svc_acct. Here's an example:
238 $cust_main->insert( {}, [ $email, 'POST' ] );
246 local $SIG{HUP} = 'IGNORE';
247 local $SIG{INT} = 'IGNORE';
248 local $SIG{QUIT} = 'IGNORE';
249 local $SIG{TERM} = 'IGNORE';
250 local $SIG{TSTP} = 'IGNORE';
251 local $SIG{PIPE} = 'IGNORE';
253 my $oldAutoCommit = $FS::UID::AutoCommit;
254 local $FS::UID::AutoCommit = 0;
259 if ( $self->payby eq 'PREPAY' ) {
260 $self->payby('BILL');
261 my $prepay_credit = qsearchs(
263 { 'identifier' => $self->payinfo },
267 warn "WARNING: can't find pre-found prepay_credit: ". $self->payinfo
268 unless $prepay_credit;
269 $amount = $prepay_credit->amount;
270 $seconds = $prepay_credit->seconds;
271 my $error = $prepay_credit->delete;
273 $dbh->rollback if $oldAutoCommit;
274 return "removing prepay_credit (transaction rolled back): $error";
278 my $error = $self->SUPER::insert;
280 $dbh->rollback if $oldAutoCommit;
281 return "inserting cust_main record (transaction rolled back): $error";
284 if ( @param ) { # CUST_PKG_HASHREF
285 my $cust_pkgs = shift @param;
286 foreach my $cust_pkg ( keys %$cust_pkgs ) {
287 $cust_pkg->custnum( $self->custnum );
288 $error = $cust_pkg->insert;
290 $dbh->rollback if $oldAutoCommit;
291 return "inserting cust_pkg (transaction rolled back): $error";
293 foreach my $svc_something ( @{$cust_pkgs->{$cust_pkg}} ) {
294 $svc_something->pkgnum( $cust_pkg->pkgnum );
295 if ( $seconds && $svc_something->isa('FS::svc_acct') ) {
296 $svc_something->seconds( $svc_something->seconds + $seconds );
299 $error = $svc_something->insert;
301 $dbh->rollback if $oldAutoCommit;
302 return "inserting svc_ (transaction rolled back): $error";
309 $dbh->rollback if $oldAutoCommit;
310 return "No svc_acct record to apply pre-paid time";
313 if ( @param ) { # INVOICING_LIST_ARYREF
314 my $invoicing_list = shift @param;
315 $error = $self->check_invoicing_list( $invoicing_list );
317 $dbh->rollback if $oldAutoCommit;
318 return "checking invoicing_list (transaction rolled back): $error";
320 $self->invoicing_list( $invoicing_list );
324 my $cust_credit = new FS::cust_credit {
325 'custnum' => $self->custnum,
328 $error = $cust_credit->insert;
330 $dbh->rollback if $oldAutoCommit;
331 return "inserting credit (transaction rolled back): $error";
335 my $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
336 $error = $queue->insert($self->getfield('last'), $self->company);
338 $dbh->rollback if $oldAutoCommit;
339 return "queueing job (transaction rolled back): $error";
342 if ( defined $self->dbdef_table->column('ship_last') && $self->ship_last ) {
343 $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
344 $error = $queue->insert($self->getfield('last'), $self->company);
346 $dbh->rollback if $oldAutoCommit;
347 return "queueing job (transaction rolled back): $error";
351 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
356 =item delete NEW_CUSTNUM
358 This deletes the customer. If there is an error, returns the error, otherwise
361 This will completely remove all traces of the customer record. This is not
362 what you want when a customer cancels service; for that, cancel all of the
363 customer's packages (see L<FS::cust_pkg/cancel>).
365 If the customer has any packages, you need to pass a new (valid) customer
366 number for those packages to be transferred to.
368 You can't delete a customer with invoices (see L<FS::cust_bill>),
369 or credits (see L<FS::cust_credit>).
376 local $SIG{HUP} = 'IGNORE';
377 local $SIG{INT} = 'IGNORE';
378 local $SIG{QUIT} = 'IGNORE';
379 local $SIG{TERM} = 'IGNORE';
380 local $SIG{TSTP} = 'IGNORE';
381 local $SIG{PIPE} = 'IGNORE';
383 my $oldAutoCommit = $FS::UID::AutoCommit;
384 local $FS::UID::AutoCommit = 0;
387 if ( qsearch( 'cust_bill', { 'custnum' => $self->custnum } ) ) {
388 $dbh->rollback if $oldAutoCommit;
389 return "Can't delete a customer with invoices";
391 if ( qsearch( 'cust_credit', { 'custnum' => $self->custnum } ) ) {
392 $dbh->rollback if $oldAutoCommit;
393 return "Can't delete a customer with credits";
396 my @cust_pkg = qsearch( 'cust_pkg', { 'custnum' => $self->custnum } );
398 my $new_custnum = shift;
399 unless ( qsearchs( 'cust_main', { 'custnum' => $new_custnum } ) ) {
400 $dbh->rollback if $oldAutoCommit;
401 return "Invalid new customer number: $new_custnum";
403 foreach my $cust_pkg ( @cust_pkg ) {
404 my %hash = $cust_pkg->hash;
405 $hash{'custnum'} = $new_custnum;
406 my $new_cust_pkg = new FS::cust_pkg ( \%hash );
407 my $error = $new_cust_pkg->replace($cust_pkg);
409 $dbh->rollback if $oldAutoCommit;
414 foreach my $cust_main_invoice (
415 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } )
417 my $error = $cust_main_invoice->delete;
419 $dbh->rollback if $oldAutoCommit;
424 my $error = $self->SUPER::delete;
426 $dbh->rollback if $oldAutoCommit;
430 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
435 =item replace OLD_RECORD [ INVOICING_LIST_ARYREF ]
437 Replaces the OLD_RECORD with this one in the database. If there is an error,
438 returns the error, otherwise returns false.
440 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
441 be set as the invoicing list (see L<"invoicing_list">). Errors return as
442 expected and rollback the entire transaction; it is not necessary to call
443 check_invoicing_list first. Here's an example:
445 $new_cust_main->replace( $old_cust_main, [ $email, 'POST' ] );
454 local $SIG{HUP} = 'IGNORE';
455 local $SIG{INT} = 'IGNORE';
456 local $SIG{QUIT} = 'IGNORE';
457 local $SIG{TERM} = 'IGNORE';
458 local $SIG{TSTP} = 'IGNORE';
459 local $SIG{PIPE} = 'IGNORE';
461 my $oldAutoCommit = $FS::UID::AutoCommit;
462 local $FS::UID::AutoCommit = 0;
465 my $error = $self->SUPER::replace($old);
468 $dbh->rollback if $oldAutoCommit;
472 if ( @param ) { # INVOICING_LIST_ARYREF
473 my $invoicing_list = shift @param;
474 $error = $self->check_invoicing_list( $invoicing_list );
476 $dbh->rollback if $oldAutoCommit;
479 $self->invoicing_list( $invoicing_list );
482 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
489 Checks all fields to make sure this is a valid customer record. If there is
490 an error, returns the error, otherwise returns false. Called by the insert
499 $self->ut_numbern('custnum')
500 || $self->ut_number('agentnum')
501 || $self->ut_number('refnum')
502 || $self->ut_name('last')
503 || $self->ut_name('first')
504 || $self->ut_textn('company')
505 || $self->ut_text('address1')
506 || $self->ut_textn('address2')
507 || $self->ut_text('city')
508 || $self->ut_textn('county')
509 || $self->ut_textn('state')
510 || $self->ut_country('country')
511 || $self->ut_anything('comments')
512 || $self->ut_numbern('referral_custnum')
514 #barf. need message catalogs. i18n. etc.
515 $error .= "Please select a referral."
516 if $error =~ /^Illegal or empty \(numeric\) refnum: /;
517 return $error if $error;
519 return "Unknown agent"
520 unless qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
522 return "Unknown referral"
523 unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } );
525 return "Unknown referring custnum ". $self->referral_custnum
526 unless ! $self->referral_custnum
527 || qsearchs( 'cust_main', { 'custnum' => $self->referral_custnum } );
529 if ( $self->ss eq '' ) {
534 $ss =~ /^(\d{3})(\d{2})(\d{4})$/
535 or return "Illegal social security number: ". $self->ss;
536 $self->ss("$1-$2-$3");
539 unless ( qsearchs('cust_main_county', {
540 'country' => $self->country,
543 return "Unknown state/county/country: ".
544 $self->state. "/". $self->county. "/". $self->country
545 unless qsearchs('cust_main_county',{
546 'state' => $self->state,
547 'county' => $self->county,
548 'country' => $self->country,
553 $self->ut_phonen('daytime', $self->country)
554 || $self->ut_phonen('night', $self->country)
555 || $self->ut_phonen('fax', $self->country)
556 || $self->ut_zip('zip', $self->country)
558 return $error if $error;
561 last first company address1 address2 city county state zip
562 country daytime night fax
565 if ( defined $self->dbdef_table->column('ship_last') ) {
566 if ( grep { $self->getfield($_) ne $self->getfield("ship_$_") } @addfields
567 && grep $self->getfield("ship_$_"), grep $_ ne 'state', @addfields
571 $self->ut_name('ship_last')
572 || $self->ut_name('ship_first')
573 || $self->ut_textn('ship_company')
574 || $self->ut_text('ship_address1')
575 || $self->ut_textn('ship_address2')
576 || $self->ut_text('ship_city')
577 || $self->ut_textn('ship_county')
578 || $self->ut_textn('ship_state')
579 || $self->ut_country('ship_country')
581 return $error if $error;
583 #false laziness with above
584 unless ( qsearchs('cust_main_county', {
585 'country' => $self->ship_country,
588 return "Unknown ship_state/ship_county/ship_country: ".
589 $self->ship_state. "/". $self->ship_county. "/". $self->ship_country
590 unless qsearchs('cust_main_county',{
591 'state' => $self->ship_state,
592 'county' => $self->ship_county,
593 'country' => $self->ship_country,
599 $self->ut_phonen('ship_daytime', $self->ship_country)
600 || $self->ut_phonen('ship_night', $self->ship_country)
601 || $self->ut_phonen('ship_fax', $self->ship_country)
602 || $self->ut_zip('ship_zip', $self->ship_country)
604 return $error if $error;
606 } else { # ship_ info eq billing info, so don't store dup info in database
607 $self->setfield("ship_$_", '')
608 foreach qw( last first company address1 address2 city county state zip
609 country daytime night fax );
613 $self->payby =~ /^(CARD|BILL|COMP|PREPAY)$/
614 or return "Illegal payby: ". $self->payby;
617 if ( $self->payby eq 'CARD' ) {
619 my $payinfo = $self->payinfo;
621 $payinfo =~ /^(\d{13,16})$/
622 or return "Illegal credit card number: ". $self->payinfo;
624 $self->payinfo($payinfo);
626 or return "Illegal credit card number: ". $self->payinfo;
627 return "Unknown card type" if cardtype($self->payinfo) eq "Unknown";
629 } elsif ( $self->payby eq 'BILL' ) {
631 $error = $self->ut_textn('payinfo');
632 return "Illegal P.O. number: ". $self->payinfo if $error;
634 } elsif ( $self->payby eq 'COMP' ) {
636 $error = $self->ut_textn('payinfo');
637 return "Illegal comp account issuer: ". $self->payinfo if $error;
639 } elsif ( $self->payby eq 'PREPAY' ) {
641 my $payinfo = $self->payinfo;
642 $payinfo =~ s/\W//g; #anything else would just confuse things
643 $self->payinfo($payinfo);
644 $error = $self->ut_alpha('payinfo');
645 return "Illegal prepayment identifier: ". $self->payinfo if $error;
646 return "Unknown prepayment identifier"
647 unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } );
651 if ( $self->paydate eq '' || $self->paydate eq '-' ) {
652 return "Expriation date required"
653 unless $self->payby eq 'BILL' || $self->payby eq 'PREPAY';
656 $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/
657 or return "Illegal expiration date: ". $self->paydate;
658 if ( length($2) == 4 ) {
659 $self->paydate("$2-$1-01");
661 $self->paydate("20$2-$1-01");
665 if ( $self->payname eq '' ) {
666 $self->payname( $self->first. " ". $self->getfield('last') );
668 $self->payname =~ /^([\w \,\.\-\']+)$/
669 or return "Illegal billing name: ". $self->payname;
673 $self->tax =~ /^(Y?)$/ or return "Illegal tax: ". $self->tax;
676 $self->otaker(getotaker);
683 Returns all packages (see L<FS::cust_pkg>) for this customer.
689 qsearch( 'cust_pkg', { 'custnum' => $self->custnum });
692 =item ncancelled_pkgs
694 Returns all non-cancelled packages (see L<FS::cust_pkg>) for this customer.
698 sub ncancelled_pkgs {
700 @{ [ # force list context
701 qsearch( 'cust_pkg', {
702 'custnum' => $self->custnum,
705 qsearch( 'cust_pkg', {
706 'custnum' => $self->custnum,
714 Returns all suspended packages (see L<FS::cust_pkg>) for this customer.
720 grep { $_->susp } $self->ncancelled_pkgs;
723 =item unflagged_suspended_pkgs
725 Returns all unflagged suspended packages (see L<FS::cust_pkg>) for this
726 customer (thouse packages without the `manual_flag' set).
730 sub unflagged_suspended_pkgs {
732 return $self->suspended_pkgs
733 unless dbdef->table('cust_pkg')->column('manual_flag');
734 grep { ! $_->manual_flag } $self->suspended_pkgs;
737 =item unsuspended_pkgs
739 Returns all unsuspended (and uncancelled) packages (see L<FS::cust_pkg>) for
744 sub unsuspended_pkgs {
746 grep { ! $_->susp } $self->ncancelled_pkgs;
751 Unsuspends all unflagged suspended packages (see L</unflagged_suspended_pkgs>
752 and L<FS::cust_pkg>) for this customer. Always returns a list: an empty list
753 on success or a list of errors.
759 grep { $_->unsuspend } $self->suspended_pkgs;
764 Suspends all unsuspended packages (see L<FS::cust_pkg>) for this customer.
765 Always returns a list: an empty list on success or a list of errors.
771 grep { $_->suspend } $self->unsuspended_pkgs;
776 Generates invoices (see L<FS::cust_bill>) for this customer. Usually used in
777 conjunction with the collect method.
779 Options are passed as name-value pairs.
781 The only currently available option is `time', which bills the customer as if
782 it were that time. It is specified as a UNIX timestamp; see
783 L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion
784 functions. For example:
788 $cust_main->bill( 'time' => str2time('April 20th, 2001') );
790 If there is an error, returns the error, otherwise returns false.
795 my( $self, %options ) = @_;
796 my $time = $options{'time'} || time;
801 local $SIG{HUP} = 'IGNORE';
802 local $SIG{INT} = 'IGNORE';
803 local $SIG{QUIT} = 'IGNORE';
804 local $SIG{TERM} = 'IGNORE';
805 local $SIG{TSTP} = 'IGNORE';
806 local $SIG{PIPE} = 'IGNORE';
808 my $oldAutoCommit = $FS::UID::AutoCommit;
809 local $FS::UID::AutoCommit = 0;
812 # find the packages which are due for billing, find out how much they are
813 # & generate invoice database.
815 my( $total_setup, $total_recur ) = ( 0, 0 );
816 my( $taxable_setup, $taxable_recur ) = ( 0, 0 );
817 my @cust_bill_pkg = ();
819 foreach my $cust_pkg (
820 qsearch('cust_pkg',{'custnum'=> $self->getfield('custnum') } )
823 next if $cust_pkg->getfield('cancel');
825 #? to avoid use of uninitialized value errors... ?
826 $cust_pkg->setfield('bill', '')
827 unless defined($cust_pkg->bill);
829 my $part_pkg = qsearchs( 'part_pkg', { 'pkgpart' => $cust_pkg->pkgpart } );
831 #so we don't modify cust_pkg record unnecessarily
832 my $cust_pkg_mod_flag = 0;
833 my %hash = $cust_pkg->hash;
834 my $old_cust_pkg = new FS::cust_pkg \%hash;
838 unless ( $cust_pkg->setup ) {
839 my $setup_prog = $part_pkg->getfield('setup');
840 $setup_prog =~ /^(.*)$/ or do {
841 $dbh->rollback if $oldAutoCommit;
842 return "Illegal setup for pkgpart ". $part_pkg->pkgpart.
848 ##$cpt->permit(); #what is necessary?
849 #$cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
850 #$setup = $cpt->reval($setup_prog);
851 $setup = eval $setup_prog;
852 unless ( defined($setup) ) {
853 $dbh->rollback if $oldAutoCommit;
854 return "Error reval-ing part_pkg->setup pkgpart ". $part_pkg->pkgpart.
857 $cust_pkg->setfield('setup',$time);
858 $cust_pkg_mod_flag=1;
864 if ( $part_pkg->getfield('freq') > 0 &&
865 ! $cust_pkg->getfield('susp') &&
866 ( $cust_pkg->getfield('bill') || 0 ) < $time
868 my $recur_prog = $part_pkg->getfield('recur');
869 $recur_prog =~ /^(.*)$/ or do {
870 $dbh->rollback if $oldAutoCommit;
871 return "Illegal recur for pkgpart ". $part_pkg->pkgpart.
877 ##$cpt->permit(); #what is necessary?
878 #$cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
879 #$recur = $cpt->reval($recur_prog);
880 $recur = eval $recur_prog;
881 unless ( defined($recur) ) {
882 $dbh->rollback if $oldAutoCommit;
883 return "Error reval-ing part_pkg->recur pkgpart ".
884 $part_pkg->pkgpart. ": $@";
886 #change this bit to use Date::Manip? CAREFUL with timezones (see
887 # mailing list archive)
888 #$sdate=$cust_pkg->bill || time;
889 #$sdate=$cust_pkg->bill || $time;
890 $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
891 my ($sec,$min,$hour,$mday,$mon,$year) =
892 (localtime($sdate) )[0,1,2,3,4,5];
893 $mon += $part_pkg->getfield('freq');
894 until ( $mon < 12 ) { $mon -= 12; $year++; }
895 $cust_pkg->setfield('bill',
896 timelocal($sec,$min,$hour,$mday,$mon,$year));
897 $cust_pkg_mod_flag = 1;
900 warn "\$setup is undefined" unless defined($setup);
901 warn "\$recur is undefined" unless defined($recur);
902 warn "\$cust_pkg->bill is undefined" unless defined($cust_pkg->bill);
904 if ( $cust_pkg_mod_flag ) {
905 $error=$cust_pkg->replace($old_cust_pkg);
906 if ( $error ) { #just in case
907 $dbh->rollback if $oldAutoCommit;
908 return "Error modifying pkgnum ". $cust_pkg->pkgnum. ": $error";
910 $setup = sprintf( "%.2f", $setup );
911 $recur = sprintf( "%.2f", $recur );
913 $dbh->rollback if $oldAutoCommit;
914 return "negative setup $setup for pkgnum ". $cust_pkg->pkgnum;
917 $dbh->rollback if $oldAutoCommit;
918 return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum;
920 if ( $setup > 0 || $recur > 0 ) {
921 my $cust_bill_pkg = new FS::cust_bill_pkg ({
922 'pkgnum' => $cust_pkg->pkgnum,
926 'edate' => $cust_pkg->bill,
928 push @cust_bill_pkg, $cust_bill_pkg;
929 $total_setup += $setup;
930 $total_recur += $recur;
931 $taxable_setup += $setup
932 unless $part_pkg->dbdef_table->column('setuptax')
933 || $part_pkg->setuptax =~ /^Y$/i;
934 $taxable_recur += $recur
935 unless $part_pkg->dbdef_table->column('recurtax')
936 || $part_pkg->recurtax =~ /^Y$/i;
942 my $charged = sprintf( "%.2f", $total_setup + $total_recur );
943 my $taxable_charged = sprintf( "%.2f", $taxable_setup + $taxable_recur );
945 unless ( @cust_bill_pkg ) {
946 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
950 unless ( $self->tax =~ /Y/i
951 || $self->payby eq 'COMP'
952 || $taxable_charged == 0 ) {
953 my $cust_main_county = qsearchs('cust_main_county',{
954 'state' => $self->state,
955 'county' => $self->county,
956 'country' => $self->country,
958 my $tax = sprintf( "%.2f",
959 $taxable_charged * ( $cust_main_county->getfield('tax') / 100 )
963 $charged = sprintf( "%.2f", $charged+$tax );
965 my $cust_bill_pkg = new FS::cust_bill_pkg ({
972 push @cust_bill_pkg, $cust_bill_pkg;
976 my $cust_bill = new FS::cust_bill ( {
977 'custnum' => $self->custnum,
979 'charged' => $charged,
981 $error = $cust_bill->insert;
983 $dbh->rollback if $oldAutoCommit;
984 return "can't create invoice for customer #". $self->custnum. ": $error";
987 my $invnum = $cust_bill->invnum;
989 foreach $cust_bill_pkg ( @cust_bill_pkg ) {
990 warn $cust_bill_pkg->invnum($invnum);
991 $error = $cust_bill_pkg->insert;
993 $dbh->rollback if $oldAutoCommit;
994 return "can't create invoice line item for customer #". $self->custnum.
999 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1003 =item collect OPTIONS
1005 (Attempt to) collect money for this customer's outstanding invoices (see
1006 L<FS::cust_bill>). Usually used after the bill method.
1008 Depending on the value of `payby', this may print an invoice (`BILL'), charge
1009 a credit card (`CARD'), or just add any necessary (pseudo-)payment (`COMP').
1011 If there is an error, returns the error, otherwise returns false.
1013 Options are passed as name-value pairs.
1015 Currently available options are:
1017 invoice_time - Use this time when deciding when to print invoices and
1018 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>
1019 for conversion functions.
1021 batch_card - Set this true to batch cards (see L<FS::cust_pay_batch>). By
1022 default, cards are processed immediately, which will generate an error if
1023 CyberCash is not installed.
1025 report_badcard - Set this true if you want bad card transactions to
1026 return an error. By default, they don't.
1031 my( $self, %options ) = @_;
1032 my $invoice_time = $options{'invoice_time'} || time;
1035 local $SIG{HUP} = 'IGNORE';
1036 local $SIG{INT} = 'IGNORE';
1037 local $SIG{QUIT} = 'IGNORE';
1038 local $SIG{TERM} = 'IGNORE';
1039 local $SIG{TSTP} = 'IGNORE';
1040 local $SIG{PIPE} = 'IGNORE';
1042 my $oldAutoCommit = $FS::UID::AutoCommit;
1043 local $FS::UID::AutoCommit = 0;
1046 my $balance = $self->balance;
1047 warn "collect: balance $balance" if $Debug;
1048 unless ( $balance > 0 ) { #redundant?????
1049 $dbh->rollback if $oldAutoCommit; #hmm
1053 foreach my $cust_bill (
1054 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
1057 #this has to be before next's
1058 my $amount = sprintf( "%.2f", $balance < $cust_bill->owed
1062 $balance = sprintf( "%.2f", $balance - $amount );
1064 next unless $cust_bill->owed > 0;
1066 # don't try to charge for the same invoice if it's already in a batch
1067 next if qsearchs( 'cust_pay_batch', { 'invnum' => $cust_bill->invnum } );
1069 warn "invnum ". $cust_bill->invnum. " (owed ". $cust_bill->owed. ", amount $amount, balance $balance)" if $Debug;
1071 next unless $amount > 0;
1073 if ( $self->payby eq 'BILL' ) {
1076 my $since = $invoice_time - ( $cust_bill->_date || 0 );
1077 #warn "$invoice_time ", $cust_bill->_date, " $since";
1078 if ( $since >= 0 #don't print future invoices
1079 && ( $cust_bill->printed * 2592000 ) <= $since
1082 #my @print_text = $cust_bill->print_text; #( date )
1083 my @invoicing_list = $self->invoicing_list;
1084 if ( grep { $_ ne 'POST' } @invoicing_list ) { #email invoice
1085 $ENV{SMTPHOSTS} = $smtpmachine;
1086 $ENV{MAILADDRESS} = $invoice_from;
1087 my $header = new Mail::Header ( [
1088 "From: $invoice_from",
1089 "To: ". join(', ', grep { $_ ne 'POST' } @invoicing_list ),
1090 "Sender: $invoice_from",
1091 "Reply-To: $invoice_from",
1092 "Date: ". time2str("%a, %d %b %Y %X %z", time),
1095 my $message = new Mail::Internet (
1096 'Header' => $header,
1097 'Body' => [ $cust_bill->print_text ], #( date)
1099 $message->smtpsend or die "Can't send invoice email!"; #die? warn?
1101 } elsif ( ! @invoicing_list || grep { $_ eq 'POST' } @invoicing_list ) {
1102 open(LPR, "|$lpr") or die "Can't open pipe to $lpr: $!";
1103 print LPR $cust_bill->print_text; #( date )
1105 or die $! ? "Error closing $lpr: $!"
1106 : "Exit status $? from $lpr";
1109 my %hash = $cust_bill->hash;
1111 my $new_cust_bill = new FS::cust_bill(\%hash);
1112 my $error = $new_cust_bill->replace($cust_bill);
1113 warn "Error updating $cust_bill->printed: $error" if $error;
1117 } elsif ( $self->payby eq 'COMP' ) {
1118 my $cust_pay = new FS::cust_pay ( {
1119 'invnum' => $cust_bill->invnum,
1123 'payinfo' => $self->payinfo,
1126 my $error = $cust_pay->insert;
1128 $dbh->rollback if $oldAutoCommit;
1129 return 'Error COMPing invnum #'. $cust_bill->invnum. ": $error";
1133 } elsif ( $self->payby eq 'CARD' ) {
1135 if ( $options{'batch_card'} ne 'yes' ) {
1137 unless ( $processor ) {
1138 $dbh->rollback if $oldAutoCommit;
1139 return "Real time card processing not enabled!";
1142 my $address = $self->address1;
1143 $address .= ", ". $self->address2 if $self->address2;
1146 #$self->paydate =~ /^(\d+)\/\d*(\d{2})$/;
1147 $self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
1150 if ( $processor eq 'cybercash3.2' ) {
1152 #fix exp. date for cybercash
1153 #$self->paydate =~ /^(\d+)\/\d*(\d{2})$/;
1154 $self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
1157 my $paybatch = $cust_bill->invnum.
1158 '-' . time2str("%y%m%d%H%M%S", time);
1160 my $payname = $self->payname ||
1161 $self->getfield('first'). ' '. $self->getfield('last');
1164 my $country = $self->country eq 'US' ? 'USA' : $self->country;
1166 my @full_xaction = ( $xaction,
1167 'Order-ID' => $paybatch,
1168 'Amount' => "usd $amount",
1169 'Card-Number' => $self->getfield('payinfo'),
1170 'Card-Name' => $payname,
1171 'Card-Address' => $address,
1172 'Card-City' => $self->getfield('city'),
1173 'Card-State' => $self->getfield('state'),
1174 'Card-Zip' => $self->getfield('zip'),
1175 'Card-Country' => $country,
1180 %result = &CCMckDirectLib3_2::SendCC2_1Server(@full_xaction);
1182 #if ( $result{'MActionCode'} == 7 ) { #cybercash smps v.1.1.3
1183 #if ( $result{'action-code'} == 7 ) { #cybercash smps v.2.1
1184 if ( $result{'MStatus'} eq 'success' ) { #cybercash smps v.2 or 3
1185 my $cust_pay = new FS::cust_pay ( {
1186 'invnum' => $cust_bill->invnum,
1190 'payinfo' => $self->payinfo,
1191 'paybatch' => "$processor:$paybatch",
1193 my $error = $cust_pay->insert;
1195 # gah, even with transactions.
1196 $dbh->commit if $oldAutoCommit; #well.
1197 my $e = 'WARNING: Card debited but database not updated - '.
1198 'error applying payment, invnum #' . $cust_bill->invnum.
1199 " (CyberCash Order-ID $paybatch): $error";
1203 } elsif ( $result{'Mstatus'} ne 'failure-bad-money'
1204 || $options{'report_badcard'} ) {
1205 $dbh->commit if $oldAutoCommit;
1206 return 'Cybercash error, invnum #' .
1207 $cust_bill->invnum. ':'. $result{'MErrMsg'};
1209 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1213 } elsif ( $processor =~ /^Business::OnlinePayment::(.*)$/ ) {
1215 my $bop_processor = $1;
1217 my($payname, $payfirst, $paylast);
1218 if ( $self->payname ) {
1219 $payname = $self->payname;
1220 $payname =~ /^\s*([\w \,\.\-\']*\w)?\s+([\w\,\.\-\']+)$/
1222 $dbh->rollback if $oldAutoCommit;
1223 return "Illegal payname $payname";
1225 ($payfirst, $paylast) = ($1, $2);
1227 $payfirst = $self->getfield('first');
1228 $paylast = $self->getfield('first');
1229 $payname = "$payfirst $paylast";
1232 my @invoicing_list = grep { $_ ne 'POST' } $self->invoicing_list;
1233 if ( $conf->exists('emailinvoiceauto')
1234 || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
1235 push @invoicing_list, $self->default_invoicing_list;
1237 my $email = $invoicing_list[0];
1239 my( $action1, $action2 ) = split(/\s*\,\s*/, $bop_action );
1242 new Business::OnlinePayment( $bop_processor, @bop_options );
1243 $transaction->content(
1245 'login' => $bop_login,
1246 'password' => $bop_password,
1247 'action' => $action1,
1248 'description' => 'Internet Services',
1249 'amount' => $amount,
1250 'invoice_number' => $cust_bill->invnum,
1251 'customer_id' => $self->custnum,
1252 'last_name' => $paylast,
1253 'first_name' => $payfirst,
1255 'address' => $address,
1256 'city' => $self->city,
1257 'state' => $self->state,
1258 'zip' => $self->zip,
1259 'country' => $self->country,
1260 'card_number' => $self->payinfo,
1261 'expiration' => $exp,
1262 'referer' => 'http://cleanwhisker.420.am/',
1265 $transaction->submit();
1267 if ( $transaction->is_success() && $action2 ) {
1268 my $auth = $transaction->authorization;
1269 my $ordernum = $transaction->order_number;
1270 #warn "********* $auth ***********\n";
1271 #warn "********* $ordernum ***********\n";
1273 new Business::OnlinePayment( $bop_processor, @bop_options );
1277 login => $bop_login,
1278 password => $bop_password,
1279 order_number => $ordernum,
1281 authorization => $auth,
1282 description => 'Internet Services',
1287 unless ( $capture->is_success ) {
1288 my $e = "Authorization sucessful but capture failed, invnum #".
1289 $cust_bill->invnum. ': '. $capture->result_code.
1290 ": ". $capture->error_message;
1297 if ( $transaction->is_success() ) {
1299 my $cust_pay = new FS::cust_pay ( {
1300 'invnum' => $cust_bill->invnum,
1304 'payinfo' => $self->payinfo,
1305 'paybatch' => "$processor:". $transaction->authorization,
1307 my $error = $cust_pay->insert;
1309 # gah, even with transactions.
1310 $dbh->commit if $oldAutoCommit; #well.
1311 my $e = 'WARNING: Card debited but database not updated - '.
1312 'error applying payment, invnum #' . $cust_bill->invnum.
1313 " ($processor): $error";
1317 } elsif ( $options{'report_badcard'} ) {
1318 $dbh->commit if $oldAutoCommit;
1319 return "$processor error, invnum #". $cust_bill->invnum. ': '.
1320 $transaction->result_code. ": ". $transaction->error_message;
1322 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1327 $dbh->rollback if $oldAutoCommit;
1328 return "Unknown real-time processor $processor\n";
1331 } else { #batch card
1333 my $cust_pay_batch = new FS::cust_pay_batch ( {
1334 'invnum' => $cust_bill->getfield('invnum'),
1335 'custnum' => $self->getfield('custnum'),
1336 'last' => $self->getfield('last'),
1337 'first' => $self->getfield('first'),
1338 'address1' => $self->getfield('address1'),
1339 'address2' => $self->getfield('address2'),
1340 'city' => $self->getfield('city'),
1341 'state' => $self->getfield('state'),
1342 'zip' => $self->getfield('zip'),
1343 'country' => $self->getfield('country'),
1345 'cardnum' => $self->getfield('payinfo'),
1346 'exp' => $self->getfield('paydate'),
1347 'payname' => $self->getfield('payname'),
1348 'amount' => $amount,
1350 my $error = $cust_pay_batch->insert;
1352 $dbh->rollback if $oldAutoCommit;
1353 return "Error adding to cust_pay_batch: $error";
1359 $dbh->rollback if $oldAutoCommit;
1360 return "Unknown payment type ". $self->payby;
1364 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1371 Returns the total owed for this customer on all invoices
1372 (see L<FS::cust_bill/owed>).
1379 foreach my $cust_bill ( qsearch('cust_bill', {
1380 'custnum' => $self->custnum,
1382 $total_bill += $cust_bill->owed;
1384 sprintf( "%.2f", $total_bill );
1389 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
1390 to outstanding invoice balances in chronological order and returns the value
1391 of any remaining unapplied credits available for refund
1392 (see L<FS::cust_refund>).
1399 return 0 unless $self->total_credited;
1401 my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
1402 qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
1404 my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
1405 qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
1409 foreach my $cust_bill ( @invoices ) {
1412 if ( !defined($credit) || $credit->credited == 0) {
1413 $credit = pop @credits or last;
1416 if ($cust_bill->owed >= $credit->credited) {
1417 $amount=$credit->credited;
1419 $amount=$cust_bill->owed;
1422 my $cust_credit_bill = new FS::cust_credit_bill ( {
1423 'crednum' => $credit->crednum,
1424 'invnum' => $cust_bill->invnum,
1425 'amount' => $amount,
1427 my $error = $cust_credit_bill->insert;
1428 die $error if $error;
1430 redo if ($cust_bill->owed > 0);
1434 return $self->total_credited;
1437 =item apply_payments
1439 Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
1440 to outstanding invoice balances in chronological order.
1442 #and returns the value of any remaining unapplied payments.
1446 sub apply_payments {
1451 my @payments = sort { $b->_date <=> $a->_date } ( grep { $_->unapplied > 0 }
1452 qsearch('cust_pay', { 'custnum' => $self->custnum } ) );
1454 my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
1455 qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
1459 foreach my $cust_bill ( @invoices ) {
1462 if ( !defined($payment) || $payment->unapplied == 0 ) {
1463 $payment = pop @payments or last;
1466 if ( $cust_bill->owed >= $payment->unapplied ) {
1467 $amount = $payment->unapplied;
1469 $amount = $cust_bill->owed;
1472 my $cust_bill_pay = new FS::cust_bill_pay ( {
1473 'paynum' => $payment->paynum,
1474 'invnum' => $cust_bill->invnum,
1475 'amount' => $amount,
1477 my $error = $cust_bill_pay->insert;
1478 die $error if $error;
1480 redo if ( $cust_bill->owed > 0);
1484 return $self->total_unapplied_payments;
1487 =item total_credited
1489 Returns the total outstanding credit (see L<FS::cust_credit>) for this
1490 customer. See L<FS::cust_credit/credited>.
1494 sub total_credited {
1496 my $total_credit = 0;
1497 foreach my $cust_credit ( qsearch('cust_credit', {
1498 'custnum' => $self->custnum,
1500 $total_credit += $cust_credit->credited;
1502 sprintf( "%.2f", $total_credit );
1505 =item total_unapplied_payments
1507 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
1508 See L<FS::cust_pay/unapplied>.
1512 sub total_unapplied_payments {
1514 my $total_unapplied = 0;
1515 foreach my $cust_pay ( qsearch('cust_pay', {
1516 'custnum' => $self->custnum,
1518 $total_unapplied += $cust_pay->unapplied;
1520 sprintf( "%.2f", $total_unapplied );
1525 Returns the balance for this customer (total_owed minus total_credited
1526 minus total_unapplied_payments).
1533 $self->total_owed - $self->total_credited - $self->total_unapplied_payments
1537 =item invoicing_list [ ARRAYREF ]
1539 If an arguement is given, sets these email addresses as invoice recipients
1540 (see L<FS::cust_main_invoice>). Errors are not fatal and are not reported
1541 (except as warnings), so use check_invoicing_list first.
1543 Returns a list of email addresses (with svcnum entries expanded).
1545 Note: You can clear the invoicing list by passing an empty ARRAYREF. You can
1546 check it without disturbing anything by passing nothing.
1548 This interface may change in the future.
1552 sub invoicing_list {
1553 my( $self, $arrayref ) = @_;
1555 my @cust_main_invoice;
1556 if ( $self->custnum ) {
1557 @cust_main_invoice =
1558 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1560 @cust_main_invoice = ();
1562 foreach my $cust_main_invoice ( @cust_main_invoice ) {
1563 #warn $cust_main_invoice->destnum;
1564 unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
1565 #warn $cust_main_invoice->destnum;
1566 my $error = $cust_main_invoice->delete;
1567 warn $error if $error;
1570 if ( $self->custnum ) {
1571 @cust_main_invoice =
1572 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1574 @cust_main_invoice = ();
1576 my %seen = map { $_->address => 1 } @cust_main_invoice;
1577 foreach my $address ( @{$arrayref} ) {
1578 #unless ( grep { $address eq $_->address } @cust_main_invoice ) {
1579 next if exists $seen{$address} && $seen{$address};
1580 $seen{$address} = 1;
1581 my $cust_main_invoice = new FS::cust_main_invoice ( {
1582 'custnum' => $self->custnum,
1585 my $error = $cust_main_invoice->insert;
1586 warn $error if $error;
1589 if ( $self->custnum ) {
1591 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1597 =item check_invoicing_list ARRAYREF
1599 Checks these arguements as valid input for the invoicing_list method. If there
1600 is an error, returns the error, otherwise returns false.
1604 sub check_invoicing_list {
1605 my( $self, $arrayref ) = @_;
1606 foreach my $address ( @{$arrayref} ) {
1607 my $cust_main_invoice = new FS::cust_main_invoice ( {
1608 'custnum' => $self->custnum,
1611 my $error = $self->custnum
1612 ? $cust_main_invoice->check
1613 : $cust_main_invoice->checkdest
1615 return $error if $error;
1620 =item default_invoicing_list
1622 Returns the email addresses of any
1626 sub default_invoicing_list {
1629 foreach my $cust_pkg ( $self->all_pkgs ) {
1630 my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
1632 map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
1633 grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
1635 push @list, map { $_->email } @svc_acct;
1637 $self->invoicing_list(\@list);
1640 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
1642 Returns an array of customers referred by this customer (referral_custnum set
1643 to this custnum). If DEPTH is given, recurses up to the given depth, returning
1644 customers referred by customers referred by this customer and so on, inclusive.
1645 The default behavior is DEPTH 1 (no recursion).
1649 sub referral_cust_main {
1651 my $depth = @_ ? shift : 1;
1652 my $exclude = @_ ? shift : {};
1655 map { $exclude->{$_->custnum}++; $_; }
1656 grep { ! $exclude->{ $_->custnum } }
1657 qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
1661 map { $_->referral_cust_main($depth-1, $exclude) }
1668 =item referral_cust_pkg [ DEPTH ]
1670 Like referral_cust_main, except returns a flat list of all unsuspended packages
1671 for each customer. The number of items in this list may be useful for
1672 comission calculations (perhaps after a grep).
1676 sub referral_cust_pkg {
1678 my $depth = @_ ? shift : 1;
1680 map { $_->unsuspended_pkgs }
1681 grep { $_->unsuspended_pkgs }
1682 $self->referral_cust_main($depth);
1685 =item credit AMOUNT, REASON
1687 Applies a credit to this customer. If there is an error, returns the error,
1688 otherwise returns false.
1693 my( $self, $amount, $reason ) = @_;
1694 my $cust_credit = new FS::cust_credit {
1695 'custnum' => $self->custnum,
1696 'amount' => $amount,
1697 'reason' => $reason,
1699 $cust_credit->insert;
1708 =item check_and_rebuild_fuzzyfiles
1712 sub check_and_rebuild_fuzzyfiles {
1713 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1714 -e "$dir/cust_main.last" && -e "$dir/cust_main.company"
1715 or &rebuild_fuzzyfiles;
1718 =item rebuild_fuzzyfiles
1722 sub rebuild_fuzzyfiles {
1724 use Fcntl qw(:flock);
1726 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1730 open(LASTLOCK,">>$dir/cust_main.last")
1731 or die "can't open $dir/cust_main.last: $!";
1732 flock(LASTLOCK,LOCK_EX)
1733 or die "can't lock $dir/cust_main.last: $!";
1735 my @all_last = map $_->getfield('last'), qsearch('cust_main', {});
1737 grep $_, map $_->getfield('ship_last'), qsearch('cust_main',{})
1738 if defined dbdef->table('cust_main')->column('ship_last');
1740 open (LASTCACHE,">$dir/cust_main.last.tmp")
1741 or die "can't open $dir/cust_main.last.tmp: $!";
1742 print LASTCACHE join("\n", @all_last), "\n";
1743 close LASTCACHE or die "can't close $dir/cust_main.last.tmp: $!";
1745 rename "$dir/cust_main.last.tmp", "$dir/cust_main.last";
1750 open(COMPANYLOCK,">>$dir/cust_main.company")
1751 or die "can't open $dir/cust_main.company: $!";
1752 flock(COMPANYLOCK,LOCK_EX)
1753 or die "can't lock $dir/cust_main.company: $!";
1755 my @all_company = grep $_ ne '', map $_->company, qsearch('cust_main',{});
1757 grep $_ ne '', map $_->ship_company, qsearch('cust_main', {})
1758 if defined dbdef->table('cust_main')->column('ship_last');
1760 open (COMPANYCACHE,">$dir/cust_main.company.tmp")
1761 or die "can't open $dir/cust_main.company.tmp: $!";
1762 print COMPANYCACHE join("\n", @all_company), "\n";
1763 close COMPANYCACHE or die "can't close $dir/cust_main.company.tmp: $!";
1765 rename "$dir/cust_main.company.tmp", "$dir/cust_main.company";
1775 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1776 open(LASTCACHE,"<$dir/cust_main.last")
1777 or die "can't open $dir/cust_main.last: $!";
1778 my @array = map { chomp; $_; } <LASTCACHE>;
1788 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1789 open(COMPANYCACHE,"<$dir/cust_main.company")
1790 or die "can't open $dir/cust_main.last: $!";
1791 my @array = map { chomp; $_; } <COMPANYCACHE>;
1796 =item append_fuzzyfiles LASTNAME COMPANY
1800 sub append_fuzzyfiles {
1801 my( $last, $company ) = @_;
1803 &check_and_rebuild_fuzzyfiles;
1805 use Fcntl qw(:flock);
1807 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1811 open(LAST,">>$dir/cust_main.last")
1812 or die "can't open $dir/cust_main.last: $!";
1814 or die "can't lock $dir/cust_main.last: $!";
1816 print LAST "$last\n";
1819 or die "can't unlock $dir/cust_main.last: $!";
1825 open(COMPANY,">>$dir/cust_main.company")
1826 or die "can't open $dir/cust_main.company: $!";
1827 flock(COMPANY,LOCK_EX)
1828 or die "can't lock $dir/cust_main.company: $!";
1830 print COMPANY "$company\n";
1832 flock(COMPANY,LOCK_UN)
1833 or die "can't unlock $dir/cust_main.company: $!";
1843 $Id: cust_main.pm,v 1.42 2001-10-20 12:17:59 ivan Exp $
1849 The delete method should possibly take an FS::cust_main object reference
1850 instead of a scalar customer number.
1852 Bill and collect options should probably be passed as references instead of a
1855 CyberCash v2 forces us to define some variables in package main.
1857 There should probably be a configuration file with a list of allowed credit
1860 No multiple currency support (probably a larger project than just this module).
1864 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
1865 L<FS::cust_pay_batch>, L<FS::agent>, L<FS::part_referral>,
1866 L<FS::cust_main_county>, L<FS::cust_main_invoice>,
1867 L<FS::UID>, schema.html from the base documentation.