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 @cust_bill_pkg = ();
818 foreach my $cust_pkg (
819 qsearch('cust_pkg',{'custnum'=> $self->getfield('custnum') } )
822 next if $cust_pkg->getfield('cancel');
824 #? to avoid use of uninitialized value errors... ?
825 $cust_pkg->setfield('bill', '')
826 unless defined($cust_pkg->bill);
828 my $part_pkg = qsearchs( 'part_pkg', { 'pkgpart' => $cust_pkg->pkgpart } );
830 #so we don't modify cust_pkg record unnecessarily
831 my $cust_pkg_mod_flag = 0;
832 my %hash = $cust_pkg->hash;
833 my $old_cust_pkg = new FS::cust_pkg \%hash;
837 unless ( $cust_pkg->setup ) {
838 my $setup_prog = $part_pkg->getfield('setup');
839 $setup_prog =~ /^(.*)$/ or do {
840 $dbh->rollback if $oldAutoCommit;
841 return "Illegal setup for pkgpart ". $part_pkg->pkgpart.
847 ##$cpt->permit(); #what is necessary?
848 #$cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
849 #$setup = $cpt->reval($setup_prog);
850 $setup = eval $setup_prog;
851 unless ( defined($setup) ) {
852 $dbh->rollback if $oldAutoCommit;
853 return "Error reval-ing part_pkg->setup pkgpart ". $part_pkg->pkgpart.
856 $cust_pkg->setfield('setup',$time);
857 $cust_pkg_mod_flag=1;
863 if ( $part_pkg->getfield('freq') > 0 &&
864 ! $cust_pkg->getfield('susp') &&
865 ( $cust_pkg->getfield('bill') || 0 ) < $time
867 my $recur_prog = $part_pkg->getfield('recur');
868 $recur_prog =~ /^(.*)$/ or do {
869 $dbh->rollback if $oldAutoCommit;
870 return "Illegal recur for pkgpart ". $part_pkg->pkgpart.
876 ##$cpt->permit(); #what is necessary?
877 #$cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
878 #$recur = $cpt->reval($recur_prog);
879 $recur = eval $recur_prog;
880 unless ( defined($recur) ) {
881 $dbh->rollback if $oldAutoCommit;
882 return "Error reval-ing part_pkg->recur pkgpart ".
883 $part_pkg->pkgpart. ": $@";
885 #change this bit to use Date::Manip? CAREFUL with timezones (see
886 # mailing list archive)
887 #$sdate=$cust_pkg->bill || time;
888 #$sdate=$cust_pkg->bill || $time;
889 $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
890 my ($sec,$min,$hour,$mday,$mon,$year) =
891 (localtime($sdate) )[0,1,2,3,4,5];
892 $mon += $part_pkg->getfield('freq');
893 until ( $mon < 12 ) { $mon -= 12; $year++; }
894 $cust_pkg->setfield('bill',
895 timelocal($sec,$min,$hour,$mday,$mon,$year));
896 $cust_pkg_mod_flag = 1;
899 warn "\$setup is undefined" unless defined($setup);
900 warn "\$recur is undefined" unless defined($recur);
901 warn "\$cust_pkg->bill is undefined" unless defined($cust_pkg->bill);
903 if ( $cust_pkg_mod_flag ) {
904 $error=$cust_pkg->replace($old_cust_pkg);
905 if ( $error ) { #just in case
906 $dbh->rollback if $oldAutoCommit;
907 return "Error modifying pkgnum ". $cust_pkg->pkgnum. ": $error";
909 $setup = sprintf( "%.2f", $setup );
910 $recur = sprintf( "%.2f", $recur );
912 $dbh->rollback if $oldAutoCommit;
913 return "negative setup $setup for pkgnum ". $cust_pkg->pkgnum;
916 $dbh->rollback if $oldAutoCommit;
917 return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum;
919 if ( $setup > 0 || $recur > 0 ) {
920 my $cust_bill_pkg = new FS::cust_bill_pkg ({
921 'pkgnum' => $cust_pkg->pkgnum,
925 'edate' => $cust_pkg->bill,
927 push @cust_bill_pkg, $cust_bill_pkg;
928 $total_setup += $setup;
929 $total_recur += $recur;
935 my $charged = sprintf( "%.2f", $total_setup + $total_recur );
937 unless ( @cust_bill_pkg ) {
938 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
942 unless ( $self->tax =~ /Y/i || $self->payby eq 'COMP' ) {
943 my $cust_main_county = qsearchs('cust_main_county',{
944 'state' => $self->state,
945 'county' => $self->county,
946 'country' => $self->country,
948 my $tax = sprintf( "%.2f",
949 $charged * ( $cust_main_county->getfield('tax') / 100 )
951 $charged = sprintf( "%.2f", $charged+$tax );
953 my $cust_bill_pkg = new FS::cust_bill_pkg ({
960 push @cust_bill_pkg, $cust_bill_pkg;
963 my $cust_bill = new FS::cust_bill ( {
964 'custnum' => $self->custnum,
966 'charged' => $charged,
968 $error = $cust_bill->insert;
970 $dbh->rollback if $oldAutoCommit;
971 return "can't create invoice for customer #". $self->custnum. ": $error";
974 my $invnum = $cust_bill->invnum;
976 foreach $cust_bill_pkg ( @cust_bill_pkg ) {
977 warn $cust_bill_pkg->invnum($invnum);
978 $error = $cust_bill_pkg->insert;
980 $dbh->rollback if $oldAutoCommit;
981 return "can't create invoice line item for customer #". $self->custnum.
986 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
990 =item collect OPTIONS
992 (Attempt to) collect money for this customer's outstanding invoices (see
993 L<FS::cust_bill>). Usually used after the bill method.
995 Depending on the value of `payby', this may print an invoice (`BILL'), charge
996 a credit card (`CARD'), or just add any necessary (pseudo-)payment (`COMP').
998 If there is an error, returns the error, otherwise returns false.
1000 Options are passed as name-value pairs.
1002 Currently available options are:
1004 invoice_time - Use this time when deciding when to print invoices and
1005 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>
1006 for conversion functions.
1008 batch_card - Set this true to batch cards (see L<FS::cust_pay_batch>). By
1009 default, cards are processed immediately, which will generate an error if
1010 CyberCash is not installed.
1012 report_badcard - Set this true if you want bad card transactions to
1013 return an error. By default, they don't.
1018 my( $self, %options ) = @_;
1019 my $invoice_time = $options{'invoice_time'} || time;
1022 local $SIG{HUP} = 'IGNORE';
1023 local $SIG{INT} = 'IGNORE';
1024 local $SIG{QUIT} = 'IGNORE';
1025 local $SIG{TERM} = 'IGNORE';
1026 local $SIG{TSTP} = 'IGNORE';
1027 local $SIG{PIPE} = 'IGNORE';
1029 my $oldAutoCommit = $FS::UID::AutoCommit;
1030 local $FS::UID::AutoCommit = 0;
1033 my $balance = $self->balance;
1034 warn "collect: balance $balance" if $Debug;
1035 unless ( $balance > 0 ) { #redundant?????
1036 $dbh->rollback if $oldAutoCommit; #hmm
1040 foreach my $cust_bill (
1041 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
1044 #this has to be before next's
1045 my $amount = sprintf( "%.2f", $balance < $cust_bill->owed
1049 $balance = sprintf( "%.2f", $balance - $amount );
1051 next unless $cust_bill->owed > 0;
1053 # don't try to charge for the same invoice if it's already in a batch
1054 next if qsearchs( 'cust_pay_batch', { 'invnum' => $cust_bill->invnum } );
1056 warn "invnum ". $cust_bill->invnum. " (owed ". $cust_bill->owed. ", amount $amount, balance $balance)" if $Debug;
1058 next unless $amount > 0;
1060 if ( $self->payby eq 'BILL' ) {
1063 my $since = $invoice_time - ( $cust_bill->_date || 0 );
1064 #warn "$invoice_time ", $cust_bill->_date, " $since";
1065 if ( $since >= 0 #don't print future invoices
1066 && ( $cust_bill->printed * 2592000 ) <= $since
1069 #my @print_text = $cust_bill->print_text; #( date )
1070 my @invoicing_list = $self->invoicing_list;
1071 if ( grep { $_ ne 'POST' } @invoicing_list ) { #email invoice
1072 $ENV{SMTPHOSTS} = $smtpmachine;
1073 $ENV{MAILADDRESS} = $invoice_from;
1074 my $header = new Mail::Header ( [
1075 "From: $invoice_from",
1076 "To: ". join(', ', grep { $_ ne 'POST' } @invoicing_list ),
1077 "Sender: $invoice_from",
1078 "Reply-To: $invoice_from",
1079 "Date: ". time2str("%a, %d %b %Y %X %z", time),
1082 my $message = new Mail::Internet (
1083 'Header' => $header,
1084 'Body' => [ $cust_bill->print_text ], #( date)
1086 $message->smtpsend or die "Can't send invoice email!"; #die? warn?
1088 } elsif ( ! @invoicing_list || grep { $_ eq 'POST' } @invoicing_list ) {
1089 open(LPR, "|$lpr") or die "Can't open pipe to $lpr: $!";
1090 print LPR $cust_bill->print_text; #( date )
1092 or die $! ? "Error closing $lpr: $!"
1093 : "Exit status $? from $lpr";
1096 my %hash = $cust_bill->hash;
1098 my $new_cust_bill = new FS::cust_bill(\%hash);
1099 my $error = $new_cust_bill->replace($cust_bill);
1100 warn "Error updating $cust_bill->printed: $error" if $error;
1104 } elsif ( $self->payby eq 'COMP' ) {
1105 my $cust_pay = new FS::cust_pay ( {
1106 'invnum' => $cust_bill->invnum,
1110 'payinfo' => $self->payinfo,
1113 my $error = $cust_pay->insert;
1115 $dbh->rollback if $oldAutoCommit;
1116 return 'Error COMPing invnum #'. $cust_bill->invnum. ": $error";
1120 } elsif ( $self->payby eq 'CARD' ) {
1122 if ( $options{'batch_card'} ne 'yes' ) {
1124 unless ( $processor ) {
1125 $dbh->rollback if $oldAutoCommit;
1126 return "Real time card processing not enabled!";
1129 my $address = $self->address1;
1130 $address .= ", ". $self->address2 if $self->address2;
1133 #$self->paydate =~ /^(\d+)\/\d*(\d{2})$/;
1134 $self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
1137 if ( $processor eq 'cybercash3.2' ) {
1139 #fix exp. date for cybercash
1140 #$self->paydate =~ /^(\d+)\/\d*(\d{2})$/;
1141 $self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
1144 my $paybatch = $cust_bill->invnum.
1145 '-' . time2str("%y%m%d%H%M%S", time);
1147 my $payname = $self->payname ||
1148 $self->getfield('first'). ' '. $self->getfield('last');
1151 my $country = $self->country eq 'US' ? 'USA' : $self->country;
1153 my @full_xaction = ( $xaction,
1154 'Order-ID' => $paybatch,
1155 'Amount' => "usd $amount",
1156 'Card-Number' => $self->getfield('payinfo'),
1157 'Card-Name' => $payname,
1158 'Card-Address' => $address,
1159 'Card-City' => $self->getfield('city'),
1160 'Card-State' => $self->getfield('state'),
1161 'Card-Zip' => $self->getfield('zip'),
1162 'Card-Country' => $country,
1167 %result = &CCMckDirectLib3_2::SendCC2_1Server(@full_xaction);
1169 #if ( $result{'MActionCode'} == 7 ) { #cybercash smps v.1.1.3
1170 #if ( $result{'action-code'} == 7 ) { #cybercash smps v.2.1
1171 if ( $result{'MStatus'} eq 'success' ) { #cybercash smps v.2 or 3
1172 my $cust_pay = new FS::cust_pay ( {
1173 'invnum' => $cust_bill->invnum,
1177 'payinfo' => $self->payinfo,
1178 'paybatch' => "$processor:$paybatch",
1180 my $error = $cust_pay->insert;
1182 # gah, even with transactions.
1183 $dbh->commit if $oldAutoCommit; #well.
1184 my $e = 'WARNING: Card debited but database not updated - '.
1185 'error applying payment, invnum #' . $cust_bill->invnum.
1186 " (CyberCash Order-ID $paybatch): $error";
1190 } elsif ( $result{'Mstatus'} ne 'failure-bad-money'
1191 || $options{'report_badcard'} ) {
1192 $dbh->commit if $oldAutoCommit;
1193 return 'Cybercash error, invnum #' .
1194 $cust_bill->invnum. ':'. $result{'MErrMsg'};
1196 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1200 } elsif ( $processor =~ /^Business::OnlinePayment::(.*)$/ ) {
1202 my $bop_processor = $1;
1204 my($payname, $payfirst, $paylast);
1205 if ( $self->payname ) {
1206 $payname = $self->payname;
1207 $payname =~ /^\s*([\w \,\.\-\']*\w)?\s+([\w\,\.\-\']+)$/
1209 $dbh->rollback if $oldAutoCommit;
1210 return "Illegal payname $payname";
1212 ($payfirst, $paylast) = ($1, $2);
1214 $payfirst = $self->getfield('first');
1215 $paylast = $self->getfield('first');
1216 $payname = "$payfirst $paylast";
1219 my @invoicing_list = grep { $_ ne 'POST' } $self->invoicing_list;
1220 if ( $conf->exists('emailinvoiceauto')
1221 || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
1222 push @invoicing_list, $self->default_invoicing_list;
1224 my $email = $invoicing_list[0];
1226 my( $action1, $action2 ) = split(/\s*\,\s*/, $bop_action );
1229 new Business::OnlinePayment( $bop_processor, @bop_options );
1230 $transaction->content(
1232 'login' => $bop_login,
1233 'password' => $bop_password,
1234 'action' => $action1,
1235 'description' => 'Internet Services',
1236 'amount' => $amount,
1237 'invoice_number' => $cust_bill->invnum,
1238 'customer_id' => $self->custnum,
1239 'last_name' => $paylast,
1240 'first_name' => $payfirst,
1242 'address' => $address,
1243 'city' => $self->city,
1244 'state' => $self->state,
1245 'zip' => $self->zip,
1246 'country' => $self->country,
1247 'card_number' => $self->payinfo,
1248 'expiration' => $exp,
1249 'referer' => 'http://cleanwhisker.420.am/',
1252 $transaction->submit();
1254 if ( $transaction->is_success() && $action2 ) {
1255 my $auth = $transaction->authorization;
1256 my $ordernum = $transaction->order_number;
1257 #warn "********* $auth ***********\n";
1258 #warn "********* $ordernum ***********\n";
1260 new Business::OnlinePayment( $bop_processor, @bop_options );
1264 login => $bop_login,
1265 password => $bop_password,
1266 order_number => $ordernum,
1268 authorization => $auth,
1269 description => 'Internet Services',
1274 unless ( $capture->is_success ) {
1275 my $e = "Authorization sucessful but capture failed, invnum #".
1276 $cust_bill->invnum. ': '. $capture->result_code.
1277 ": ". $capture->error_message;
1284 if ( $transaction->is_success() ) {
1286 my $cust_pay = new FS::cust_pay ( {
1287 'invnum' => $cust_bill->invnum,
1291 'payinfo' => $self->payinfo,
1292 'paybatch' => "$processor:". $transaction->authorization,
1294 my $error = $cust_pay->insert;
1296 # gah, even with transactions.
1297 $dbh->commit if $oldAutoCommit; #well.
1298 my $e = 'WARNING: Card debited but database not updated - '.
1299 'error applying payment, invnum #' . $cust_bill->invnum.
1300 " ($processor): $error";
1304 } elsif ( $options{'report_badcard'} ) {
1305 $dbh->commit if $oldAutoCommit;
1306 return "$processor error, invnum #". $cust_bill->invnum. ': '.
1307 $transaction->result_code. ": ". $transaction->error_message;
1309 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1314 $dbh->rollback if $oldAutoCommit;
1315 return "Unknown real-time processor $processor\n";
1318 } else { #batch card
1320 my $cust_pay_batch = new FS::cust_pay_batch ( {
1321 'invnum' => $cust_bill->getfield('invnum'),
1322 'custnum' => $self->getfield('custnum'),
1323 'last' => $self->getfield('last'),
1324 'first' => $self->getfield('first'),
1325 'address1' => $self->getfield('address1'),
1326 'address2' => $self->getfield('address2'),
1327 'city' => $self->getfield('city'),
1328 'state' => $self->getfield('state'),
1329 'zip' => $self->getfield('zip'),
1330 'country' => $self->getfield('country'),
1332 'cardnum' => $self->getfield('payinfo'),
1333 'exp' => $self->getfield('paydate'),
1334 'payname' => $self->getfield('payname'),
1335 'amount' => $amount,
1337 my $error = $cust_pay_batch->insert;
1339 $dbh->rollback if $oldAutoCommit;
1340 return "Error adding to cust_pay_batch: $error";
1346 $dbh->rollback if $oldAutoCommit;
1347 return "Unknown payment type ". $self->payby;
1351 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1358 Returns the total owed for this customer on all invoices
1359 (see L<FS::cust_bill/owed>).
1366 foreach my $cust_bill ( qsearch('cust_bill', {
1367 'custnum' => $self->custnum,
1369 $total_bill += $cust_bill->owed;
1371 sprintf( "%.2f", $total_bill );
1376 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
1377 to outstanding invoice balances in chronological order and returns the value
1378 of any remaining unapplied credits available for refund
1379 (see L<FS::cust_refund>).
1386 return 0 unless $self->total_credited;
1388 my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
1389 qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
1391 my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
1392 qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
1396 foreach my $cust_bill ( @invoices ) {
1399 if ( !defined($credit) || $credit->credited == 0) {
1400 $credit = pop @credits or last;
1403 if ($cust_bill->owed >= $credit->credited) {
1404 $amount=$credit->credited;
1406 $amount=$cust_bill->owed;
1409 my $cust_credit_bill = new FS::cust_credit_bill ( {
1410 'crednum' => $credit->crednum,
1411 'invnum' => $cust_bill->invnum,
1412 'amount' => $amount,
1414 my $error = $cust_credit_bill->insert;
1415 die $error if $error;
1417 redo if ($cust_bill->owed > 0);
1421 return $self->total_credited;
1424 =item apply_payments
1426 Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
1427 to outstanding invoice balances in chronological order.
1429 #and returns the value of any remaining unapplied payments.
1433 sub apply_payments {
1438 my @payments = sort { $b->_date <=> $a->_date } ( grep { $_->unapplied > 0 }
1439 qsearch('cust_pay', { 'custnum' => $self->custnum } ) );
1441 my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
1442 qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
1446 foreach my $cust_bill ( @invoices ) {
1449 if ( !defined($payment) || $payment->unapplied == 0 ) {
1450 $payment = pop @payments or last;
1453 if ( $cust_bill->owed >= $payment->unapplied ) {
1454 $amount = $payment->unapplied;
1456 $amount = $cust_bill->owed;
1459 my $cust_bill_pay = new FS::cust_bill_pay ( {
1460 'paynum' => $payment->paynum,
1461 'invnum' => $cust_bill->invnum,
1462 'amount' => $amount,
1464 my $error = $cust_bill_pay->insert;
1465 die $error if $error;
1467 redo if ( $cust_bill->owed > 0);
1471 return $self->total_unapplied_payments;
1474 =item total_credited
1476 Returns the total outstanding credit (see L<FS::cust_credit>) for this
1477 customer. See L<FS::cust_credit/credited>.
1481 sub total_credited {
1483 my $total_credit = 0;
1484 foreach my $cust_credit ( qsearch('cust_credit', {
1485 'custnum' => $self->custnum,
1487 $total_credit += $cust_credit->credited;
1489 sprintf( "%.2f", $total_credit );
1492 =item total_unapplied_payments
1494 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
1495 See L<FS::cust_pay/unapplied>.
1499 sub total_unapplied_payments {
1501 my $total_unapplied = 0;
1502 foreach my $cust_pay ( qsearch('cust_pay', {
1503 'custnum' => $self->custnum,
1505 $total_unapplied += $cust_pay->unapplied;
1507 sprintf( "%.2f", $total_unapplied );
1512 Returns the balance for this customer (total_owed minus total_credited
1513 minus total_unapplied_payments).
1520 $self->total_owed - $self->total_credited - $self->total_unapplied_payments
1524 =item invoicing_list [ ARRAYREF ]
1526 If an arguement is given, sets these email addresses as invoice recipients
1527 (see L<FS::cust_main_invoice>). Errors are not fatal and are not reported
1528 (except as warnings), so use check_invoicing_list first.
1530 Returns a list of email addresses (with svcnum entries expanded).
1532 Note: You can clear the invoicing list by passing an empty ARRAYREF. You can
1533 check it without disturbing anything by passing nothing.
1535 This interface may change in the future.
1539 sub invoicing_list {
1540 my( $self, $arrayref ) = @_;
1542 my @cust_main_invoice;
1543 if ( $self->custnum ) {
1544 @cust_main_invoice =
1545 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1547 @cust_main_invoice = ();
1549 foreach my $cust_main_invoice ( @cust_main_invoice ) {
1550 #warn $cust_main_invoice->destnum;
1551 unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
1552 #warn $cust_main_invoice->destnum;
1553 my $error = $cust_main_invoice->delete;
1554 warn $error if $error;
1557 if ( $self->custnum ) {
1558 @cust_main_invoice =
1559 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1561 @cust_main_invoice = ();
1563 my %seen = map { $_->address => 1 } @cust_main_invoice;
1564 foreach my $address ( @{$arrayref} ) {
1565 #unless ( grep { $address eq $_->address } @cust_main_invoice ) {
1566 next if exists $seen{$address} && $seen{$address};
1567 $seen{$address} = 1;
1568 my $cust_main_invoice = new FS::cust_main_invoice ( {
1569 'custnum' => $self->custnum,
1572 my $error = $cust_main_invoice->insert;
1573 warn $error if $error;
1576 if ( $self->custnum ) {
1578 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1584 =item check_invoicing_list ARRAYREF
1586 Checks these arguements as valid input for the invoicing_list method. If there
1587 is an error, returns the error, otherwise returns false.
1591 sub check_invoicing_list {
1592 my( $self, $arrayref ) = @_;
1593 foreach my $address ( @{$arrayref} ) {
1594 my $cust_main_invoice = new FS::cust_main_invoice ( {
1595 'custnum' => $self->custnum,
1598 my $error = $self->custnum
1599 ? $cust_main_invoice->check
1600 : $cust_main_invoice->checkdest
1602 return $error if $error;
1607 =item default_invoicing_list
1609 Returns the email addresses of any
1613 sub default_invoicing_list {
1616 foreach my $cust_pkg ( $self->all_pkgs ) {
1617 my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
1619 map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
1620 grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
1622 push @list, map { $_->email } @svc_acct;
1624 $self->invoicing_list(\@list);
1627 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
1629 Returns an array of customers referred by this customer (referral_custnum set
1630 to this custnum). If DEPTH is given, recurses up to the given depth, returning
1631 customers referred by customers referred by this customer and so on, inclusive.
1632 The default behavior is DEPTH 1 (no recursion).
1636 sub referral_cust_main {
1638 my $depth = @_ ? shift : 1;
1639 my $exclude = @_ ? shift : {};
1642 map { $exclude->{$_->custnum}++; $_; }
1643 grep { ! $exclude->{ $_->custnum } }
1644 qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
1648 map { $_->referral_cust_main($depth-1, $exclude) }
1655 =item referral_cust_pkg [ DEPTH ]
1657 Like referral_cust_main, except returns a flat list of all unsuspended packages
1658 for each customer. The number of items in this list may be useful for
1659 comission calculations (perhaps after a grep).
1663 sub referral_cust_pkg {
1665 my $depth = @_ ? shift : 1;
1667 map { $_->unsuspended_pkgs }
1668 grep { $_->unsuspended_pkgs }
1669 $self->referral_cust_main($depth);
1672 =item credit AMOUNT, REASON
1674 Applies a credit to this customer. If there is an error, returns the error,
1675 otherwise returns false.
1680 my( $self, $amount, $reason ) = @_;
1681 my $cust_credit = new FS::cust_credit {
1682 'custnum' => $self->custnum,
1683 'amount' => $amount,
1684 'reason' => $reason,
1686 $cust_credit->insert;
1695 =item check_and_rebuild_fuzzyfiles
1699 sub check_and_rebuild_fuzzyfiles {
1700 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1701 -e "$dir/cust_main.last" && -e "$dir/cust_main.company"
1702 or &rebuild_fuzzyfiles;
1705 =item rebuild_fuzzyfiles
1709 sub rebuild_fuzzyfiles {
1711 use Fcntl qw(:flock);
1713 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1717 open(LASTLOCK,">>$dir/cust_main.last")
1718 or die "can't open $dir/cust_main.last: $!";
1719 flock(LASTLOCK,LOCK_EX)
1720 or die "can't lock $dir/cust_main.last: $!";
1722 my @all_last = map $_->getfield('last'), qsearch('cust_main', {});
1724 grep $_, map $_->getfield('ship_last'), qsearch('cust_main',{})
1725 if defined dbdef->table('cust_main')->column('ship_last');
1727 open (LASTCACHE,">$dir/cust_main.last.tmp")
1728 or die "can't open $dir/cust_main.last.tmp: $!";
1729 print LASTCACHE join("\n", @all_last), "\n";
1730 close LASTCACHE or die "can't close $dir/cust_main.last.tmp: $!";
1732 rename "$dir/cust_main.last.tmp", "$dir/cust_main.last";
1737 open(COMPANYLOCK,">>$dir/cust_main.company")
1738 or die "can't open $dir/cust_main.company: $!";
1739 flock(COMPANYLOCK,LOCK_EX)
1740 or die "can't lock $dir/cust_main.company: $!";
1742 my @all_company = grep $_ ne '', map $_->company, qsearch('cust_main',{});
1744 grep $_ ne '', map $_->ship_company, qsearch('cust_main', {})
1745 if defined dbdef->table('cust_main')->column('ship_last');
1747 open (COMPANYCACHE,">$dir/cust_main.company.tmp")
1748 or die "can't open $dir/cust_main.company.tmp: $!";
1749 print COMPANYCACHE join("\n", @all_company), "\n";
1750 close COMPANYCACHE or die "can't close $dir/cust_main.company.tmp: $!";
1752 rename "$dir/cust_main.company.tmp", "$dir/cust_main.company";
1762 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1763 open(LASTCACHE,"<$dir/cust_main.last")
1764 or die "can't open $dir/cust_main.last: $!";
1765 my @array = map { chomp; $_; } <LASTCACHE>;
1775 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1776 open(COMPANYCACHE,"<$dir/cust_main.company")
1777 or die "can't open $dir/cust_main.last: $!";
1778 my @array = map { chomp; $_; } <COMPANYCACHE>;
1783 =item append_fuzzyfiles LASTNAME COMPANY
1787 sub append_fuzzyfiles {
1788 my( $last, $company ) = @_;
1790 &check_and_rebuild_fuzzyfiles;
1792 use Fcntl qw(:flock);
1794 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1798 open(LAST,">>$dir/cust_main.last")
1799 or die "can't open $dir/cust_main.last: $!";
1801 or die "can't lock $dir/cust_main.last: $!";
1803 print LAST "$last\n";
1806 or die "can't unlock $dir/cust_main.last: $!";
1812 open(COMPANY,">>$dir/cust_main.company")
1813 or die "can't open $dir/cust_main.company: $!";
1814 flock(COMPANY,LOCK_EX)
1815 or die "can't lock $dir/cust_main.company: $!";
1817 print COMPANY "$company\n";
1819 flock(COMPANY,LOCK_UN)
1820 or die "can't unlock $dir/cust_main.company: $!";
1830 $Id: cust_main.pm,v 1.41 2001-10-15 12:16:42 ivan Exp $
1836 The delete method should possibly take an FS::cust_main object reference
1837 instead of a scalar customer number.
1839 Bill and collect options should probably be passed as references instead of a
1842 CyberCash v2 forces us to define some variables in package main.
1844 There should probably be a configuration file with a list of allowed credit
1847 No multiple currency support (probably a larger project than just this module).
1851 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
1852 L<FS::cust_pay_batch>, L<FS::agent>, L<FS::part_referral>,
1853 L<FS::cust_main_county>, L<FS::cust_main_invoice>,
1854 L<FS::UID>, schema.html from the base documentation.