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 uncancelled packages, you need to pass a new (valid)
366 customer number for those packages to be transferred to. Cancelled packages
367 will be deleted. Did I mention that this is NOT what you want when a customer
368 cancels service and that you really should be looking see L<FS::cust_pkg/cancel>?
370 You can't delete a customer with invoices (see L<FS::cust_bill>),
371 or credits (see L<FS::cust_credit>) or payments (see L<FS::cust_pay>).
378 local $SIG{HUP} = 'IGNORE';
379 local $SIG{INT} = 'IGNORE';
380 local $SIG{QUIT} = 'IGNORE';
381 local $SIG{TERM} = 'IGNORE';
382 local $SIG{TSTP} = 'IGNORE';
383 local $SIG{PIPE} = 'IGNORE';
385 my $oldAutoCommit = $FS::UID::AutoCommit;
386 local $FS::UID::AutoCommit = 0;
389 if ( qsearch( 'cust_bill', { 'custnum' => $self->custnum } ) ) {
390 $dbh->rollback if $oldAutoCommit;
391 return "Can't delete a customer with invoices";
393 if ( qsearch( 'cust_credit', { 'custnum' => $self->custnum } ) ) {
394 $dbh->rollback if $oldAutoCommit;
395 return "Can't delete a customer with credits";
397 if ( qsearch( 'cust_pay', { 'custnum' => $self->custnum } ) ) {
398 $dbh->rollback if $oldAutoCommit;
399 return "Can't delete a customer with payments";
402 my @cust_pkg = $self->ncancelled_pkgs;
404 my $new_custnum = shift;
405 unless ( qsearchs( 'cust_main', { 'custnum' => $new_custnum } ) ) {
406 $dbh->rollback if $oldAutoCommit;
407 return "Invalid new customer number: $new_custnum";
409 foreach my $cust_pkg ( @cust_pkg ) {
410 my %hash = $cust_pkg->hash;
411 $hash{'custnum'} = $new_custnum;
412 my $new_cust_pkg = new FS::cust_pkg ( \%hash );
413 my $error = $new_cust_pkg->replace($cust_pkg);
415 $dbh->rollback if $oldAutoCommit;
420 my @cancelled_cust_pkg = $self->all_pkgs;
421 foreach my $cust_pkg ( @cancelled_cust_pkg ) {
422 my $error = $cust_pkg->delete;
424 $dbh->rollback if $oldAutoCommit;
429 foreach my $cust_main_invoice (
430 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } )
432 my $error = $cust_main_invoice->delete;
434 $dbh->rollback if $oldAutoCommit;
439 my $error = $self->SUPER::delete;
441 $dbh->rollback if $oldAutoCommit;
445 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
450 =item replace OLD_RECORD [ INVOICING_LIST_ARYREF ]
452 Replaces the OLD_RECORD with this one in the database. If there is an error,
453 returns the error, otherwise returns false.
455 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
456 be set as the invoicing list (see L<"invoicing_list">). Errors return as
457 expected and rollback the entire transaction; it is not necessary to call
458 check_invoicing_list first. Here's an example:
460 $new_cust_main->replace( $old_cust_main, [ $email, 'POST' ] );
469 local $SIG{HUP} = 'IGNORE';
470 local $SIG{INT} = 'IGNORE';
471 local $SIG{QUIT} = 'IGNORE';
472 local $SIG{TERM} = 'IGNORE';
473 local $SIG{TSTP} = 'IGNORE';
474 local $SIG{PIPE} = 'IGNORE';
476 my $oldAutoCommit = $FS::UID::AutoCommit;
477 local $FS::UID::AutoCommit = 0;
480 my $error = $self->SUPER::replace($old);
483 $dbh->rollback if $oldAutoCommit;
487 if ( @param ) { # INVOICING_LIST_ARYREF
488 my $invoicing_list = shift @param;
489 $error = $self->check_invoicing_list( $invoicing_list );
491 $dbh->rollback if $oldAutoCommit;
494 $self->invoicing_list( $invoicing_list );
497 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
504 Checks all fields to make sure this is a valid customer record. If there is
505 an error, returns the error, otherwise returns false. Called by the insert
514 $self->ut_numbern('custnum')
515 || $self->ut_number('agentnum')
516 || $self->ut_number('refnum')
517 || $self->ut_name('last')
518 || $self->ut_name('first')
519 || $self->ut_textn('company')
520 || $self->ut_text('address1')
521 || $self->ut_textn('address2')
522 || $self->ut_text('city')
523 || $self->ut_textn('county')
524 || $self->ut_textn('state')
525 || $self->ut_country('country')
526 || $self->ut_anything('comments')
527 || $self->ut_numbern('referral_custnum')
529 #barf. need message catalogs. i18n. etc.
530 $error .= "Please select a referral."
531 if $error =~ /^Illegal or empty \(numeric\) refnum: /;
532 return $error if $error;
534 return "Unknown agent"
535 unless qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
537 return "Unknown referral"
538 unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } );
540 return "Unknown referring custnum ". $self->referral_custnum
541 unless ! $self->referral_custnum
542 || qsearchs( 'cust_main', { 'custnum' => $self->referral_custnum } );
544 if ( $self->ss eq '' ) {
549 $ss =~ /^(\d{3})(\d{2})(\d{4})$/
550 or return "Illegal social security number: ". $self->ss;
551 $self->ss("$1-$2-$3");
554 unless ( qsearchs('cust_main_county', {
555 'country' => $self->country,
558 return "Unknown state/county/country: ".
559 $self->state. "/". $self->county. "/". $self->country
560 unless qsearchs('cust_main_county',{
561 'state' => $self->state,
562 'county' => $self->county,
563 'country' => $self->country,
568 $self->ut_phonen('daytime', $self->country)
569 || $self->ut_phonen('night', $self->country)
570 || $self->ut_phonen('fax', $self->country)
571 || $self->ut_zip('zip', $self->country)
573 return $error if $error;
576 last first company address1 address2 city county state zip
577 country daytime night fax
580 if ( defined $self->dbdef_table->column('ship_last') ) {
581 if ( grep { $self->getfield($_) ne $self->getfield("ship_$_") } @addfields
582 && grep $self->getfield("ship_$_"), grep $_ ne 'state', @addfields
586 $self->ut_name('ship_last')
587 || $self->ut_name('ship_first')
588 || $self->ut_textn('ship_company')
589 || $self->ut_text('ship_address1')
590 || $self->ut_textn('ship_address2')
591 || $self->ut_text('ship_city')
592 || $self->ut_textn('ship_county')
593 || $self->ut_textn('ship_state')
594 || $self->ut_country('ship_country')
596 return $error if $error;
598 #false laziness with above
599 unless ( qsearchs('cust_main_county', {
600 'country' => $self->ship_country,
603 return "Unknown ship_state/ship_county/ship_country: ".
604 $self->ship_state. "/". $self->ship_county. "/". $self->ship_country
605 unless qsearchs('cust_main_county',{
606 'state' => $self->ship_state,
607 'county' => $self->ship_county,
608 'country' => $self->ship_country,
614 $self->ut_phonen('ship_daytime', $self->ship_country)
615 || $self->ut_phonen('ship_night', $self->ship_country)
616 || $self->ut_phonen('ship_fax', $self->ship_country)
617 || $self->ut_zip('ship_zip', $self->ship_country)
619 return $error if $error;
621 } else { # ship_ info eq billing info, so don't store dup info in database
622 $self->setfield("ship_$_", '')
623 foreach qw( last first company address1 address2 city county state zip
624 country daytime night fax );
628 $self->payby =~ /^(CARD|BILL|COMP|PREPAY)$/
629 or return "Illegal payby: ". $self->payby;
632 if ( $self->payby eq 'CARD' ) {
634 my $payinfo = $self->payinfo;
636 $payinfo =~ /^(\d{13,16})$/
637 or return "Illegal credit card number: ". $self->payinfo;
639 $self->payinfo($payinfo);
641 or return "Illegal credit card number: ". $self->payinfo;
642 return "Unknown card type" if cardtype($self->payinfo) eq "Unknown";
644 } elsif ( $self->payby eq 'BILL' ) {
646 $error = $self->ut_textn('payinfo');
647 return "Illegal P.O. number: ". $self->payinfo if $error;
649 } elsif ( $self->payby eq 'COMP' ) {
651 $error = $self->ut_textn('payinfo');
652 return "Illegal comp account issuer: ". $self->payinfo if $error;
654 } elsif ( $self->payby eq 'PREPAY' ) {
656 my $payinfo = $self->payinfo;
657 $payinfo =~ s/\W//g; #anything else would just confuse things
658 $self->payinfo($payinfo);
659 $error = $self->ut_alpha('payinfo');
660 return "Illegal prepayment identifier: ". $self->payinfo if $error;
661 return "Unknown prepayment identifier"
662 unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } );
666 if ( $self->paydate eq '' || $self->paydate eq '-' ) {
667 return "Expriation date required"
668 unless $self->payby eq 'BILL' || $self->payby eq 'PREPAY';
671 $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/
672 or return "Illegal expiration date: ". $self->paydate;
673 if ( length($2) == 4 ) {
674 $self->paydate("$2-$1-01");
676 $self->paydate("20$2-$1-01");
680 if ( $self->payname eq '' ) {
681 $self->payname( $self->first. " ". $self->getfield('last') );
683 $self->payname =~ /^([\w \,\.\-\']+)$/
684 or return "Illegal billing name: ". $self->payname;
688 $self->tax =~ /^(Y?)$/ or return "Illegal tax: ". $self->tax;
691 $self->otaker(getotaker);
698 Returns all packages (see L<FS::cust_pkg>) for this customer.
704 qsearch( 'cust_pkg', { 'custnum' => $self->custnum });
707 =item ncancelled_pkgs
709 Returns all non-cancelled packages (see L<FS::cust_pkg>) for this customer.
713 sub ncancelled_pkgs {
715 @{ [ # force list context
716 qsearch( 'cust_pkg', {
717 'custnum' => $self->custnum,
720 qsearch( 'cust_pkg', {
721 'custnum' => $self->custnum,
729 Returns all suspended packages (see L<FS::cust_pkg>) for this customer.
735 grep { $_->susp } $self->ncancelled_pkgs;
738 =item unflagged_suspended_pkgs
740 Returns all unflagged suspended packages (see L<FS::cust_pkg>) for this
741 customer (thouse packages without the `manual_flag' set).
745 sub unflagged_suspended_pkgs {
747 return $self->suspended_pkgs
748 unless dbdef->table('cust_pkg')->column('manual_flag');
749 grep { ! $_->manual_flag } $self->suspended_pkgs;
752 =item unsuspended_pkgs
754 Returns all unsuspended (and uncancelled) packages (see L<FS::cust_pkg>) for
759 sub unsuspended_pkgs {
761 grep { ! $_->susp } $self->ncancelled_pkgs;
766 Unsuspends all unflagged suspended packages (see L</unflagged_suspended_pkgs>
767 and L<FS::cust_pkg>) for this customer. Always returns a list: an empty list
768 on success or a list of errors.
774 grep { $_->unsuspend } $self->suspended_pkgs;
779 Suspends all unsuspended packages (see L<FS::cust_pkg>) for this customer.
780 Always returns a list: an empty list on success or a list of errors.
786 grep { $_->suspend } $self->unsuspended_pkgs;
791 Generates invoices (see L<FS::cust_bill>) for this customer. Usually used in
792 conjunction with the collect method.
794 Options are passed as name-value pairs.
796 The only currently available option is `time', which bills the customer as if
797 it were that time. It is specified as a UNIX timestamp; see
798 L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion
799 functions. For example:
803 $cust_main->bill( 'time' => str2time('April 20th, 2001') );
805 If there is an error, returns the error, otherwise returns false.
810 my( $self, %options ) = @_;
811 my $time = $options{'time'} || time;
816 local $SIG{HUP} = 'IGNORE';
817 local $SIG{INT} = 'IGNORE';
818 local $SIG{QUIT} = 'IGNORE';
819 local $SIG{TERM} = 'IGNORE';
820 local $SIG{TSTP} = 'IGNORE';
821 local $SIG{PIPE} = 'IGNORE';
823 my $oldAutoCommit = $FS::UID::AutoCommit;
824 local $FS::UID::AutoCommit = 0;
827 # find the packages which are due for billing, find out how much they are
828 # & generate invoice database.
830 my( $total_setup, $total_recur ) = ( 0, 0 );
831 my( $taxable_setup, $taxable_recur ) = ( 0, 0 );
832 my @cust_bill_pkg = ();
834 foreach my $cust_pkg (
835 qsearch('cust_pkg',{'custnum'=> $self->getfield('custnum') } )
838 next if $cust_pkg->getfield('cancel');
840 #? to avoid use of uninitialized value errors... ?
841 $cust_pkg->setfield('bill', '')
842 unless defined($cust_pkg->bill);
844 my $part_pkg = qsearchs( 'part_pkg', { 'pkgpart' => $cust_pkg->pkgpart } );
846 #so we don't modify cust_pkg record unnecessarily
847 my $cust_pkg_mod_flag = 0;
848 my %hash = $cust_pkg->hash;
849 my $old_cust_pkg = new FS::cust_pkg \%hash;
853 unless ( $cust_pkg->setup ) {
854 my $setup_prog = $part_pkg->getfield('setup');
855 $setup_prog =~ /^(.*)$/ or do {
856 $dbh->rollback if $oldAutoCommit;
857 return "Illegal setup for pkgpart ". $part_pkg->pkgpart.
863 ##$cpt->permit(); #what is necessary?
864 #$cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
865 #$setup = $cpt->reval($setup_prog);
866 $setup = eval $setup_prog;
867 unless ( defined($setup) ) {
868 $dbh->rollback if $oldAutoCommit;
869 return "Error reval-ing part_pkg->setup pkgpart ". $part_pkg->pkgpart.
872 $cust_pkg->setfield('setup',$time);
873 $cust_pkg_mod_flag=1;
879 if ( $part_pkg->getfield('freq') > 0 &&
880 ! $cust_pkg->getfield('susp') &&
881 ( $cust_pkg->getfield('bill') || 0 ) < $time
883 my $recur_prog = $part_pkg->getfield('recur');
884 $recur_prog =~ /^(.*)$/ or do {
885 $dbh->rollback if $oldAutoCommit;
886 return "Illegal recur for pkgpart ". $part_pkg->pkgpart.
892 ##$cpt->permit(); #what is necessary?
893 #$cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
894 #$recur = $cpt->reval($recur_prog);
895 $recur = eval $recur_prog;
896 unless ( defined($recur) ) {
897 $dbh->rollback if $oldAutoCommit;
898 return "Error reval-ing part_pkg->recur pkgpart ".
899 $part_pkg->pkgpart. ": $@";
901 #change this bit to use Date::Manip? CAREFUL with timezones (see
902 # mailing list archive)
903 #$sdate=$cust_pkg->bill || time;
904 #$sdate=$cust_pkg->bill || $time;
905 $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
906 my ($sec,$min,$hour,$mday,$mon,$year) =
907 (localtime($sdate) )[0,1,2,3,4,5];
908 $mon += $part_pkg->getfield('freq');
909 until ( $mon < 12 ) { $mon -= 12; $year++; }
910 $cust_pkg->setfield('bill',
911 timelocal($sec,$min,$hour,$mday,$mon,$year));
912 $cust_pkg_mod_flag = 1;
915 warn "\$setup is undefined" unless defined($setup);
916 warn "\$recur is undefined" unless defined($recur);
917 warn "\$cust_pkg->bill is undefined" unless defined($cust_pkg->bill);
919 if ( $cust_pkg_mod_flag ) {
920 $error=$cust_pkg->replace($old_cust_pkg);
921 if ( $error ) { #just in case
922 $dbh->rollback if $oldAutoCommit;
923 return "Error modifying pkgnum ". $cust_pkg->pkgnum. ": $error";
925 $setup = sprintf( "%.2f", $setup );
926 $recur = sprintf( "%.2f", $recur );
928 $dbh->rollback if $oldAutoCommit;
929 return "negative setup $setup for pkgnum ". $cust_pkg->pkgnum;
932 $dbh->rollback if $oldAutoCommit;
933 return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum;
935 if ( $setup > 0 || $recur > 0 ) {
936 my $cust_bill_pkg = new FS::cust_bill_pkg ({
937 'pkgnum' => $cust_pkg->pkgnum,
941 'edate' => $cust_pkg->bill,
943 push @cust_bill_pkg, $cust_bill_pkg;
944 $total_setup += $setup;
945 $total_recur += $recur;
946 $taxable_setup += $setup
947 unless $part_pkg->dbdef_table->column('setuptax')
948 || $part_pkg->setuptax =~ /^Y$/i;
949 $taxable_recur += $recur
950 unless $part_pkg->dbdef_table->column('recurtax')
951 || $part_pkg->recurtax =~ /^Y$/i;
957 my $charged = sprintf( "%.2f", $total_setup + $total_recur );
958 my $taxable_charged = sprintf( "%.2f", $taxable_setup + $taxable_recur );
960 unless ( @cust_bill_pkg ) {
961 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
965 unless ( $self->tax =~ /Y/i
966 || $self->payby eq 'COMP'
967 || $taxable_charged == 0 ) {
968 my $cust_main_county = qsearchs('cust_main_county',{
969 'state' => $self->state,
970 'county' => $self->county,
971 'country' => $self->country,
973 my $tax = sprintf( "%.2f",
974 $taxable_charged * ( $cust_main_county->getfield('tax') / 100 )
978 $charged = sprintf( "%.2f", $charged+$tax );
980 my $cust_bill_pkg = new FS::cust_bill_pkg ({
987 push @cust_bill_pkg, $cust_bill_pkg;
991 my $cust_bill = new FS::cust_bill ( {
992 'custnum' => $self->custnum,
994 'charged' => $charged,
996 $error = $cust_bill->insert;
998 $dbh->rollback if $oldAutoCommit;
999 return "can't create invoice for customer #". $self->custnum. ": $error";
1002 my $invnum = $cust_bill->invnum;
1004 foreach $cust_bill_pkg ( @cust_bill_pkg ) {
1005 warn $cust_bill_pkg->invnum($invnum);
1006 $error = $cust_bill_pkg->insert;
1008 $dbh->rollback if $oldAutoCommit;
1009 return "can't create invoice line item for customer #". $self->custnum.
1014 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1018 =item collect OPTIONS
1020 (Attempt to) collect money for this customer's outstanding invoices (see
1021 L<FS::cust_bill>). Usually used after the bill method.
1023 Depending on the value of `payby', this may print an invoice (`BILL'), charge
1024 a credit card (`CARD'), or just add any necessary (pseudo-)payment (`COMP').
1026 If there is an error, returns the error, otherwise returns false.
1028 Options are passed as name-value pairs.
1030 Currently available options are:
1032 invoice_time - Use this time when deciding when to print invoices and
1033 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>
1034 for conversion functions.
1036 batch_card - Set this true to batch cards (see L<FS::cust_pay_batch>). By
1037 default, cards are processed immediately, which will generate an error if
1038 CyberCash is not installed.
1040 report_badcard - Set this true if you want bad card transactions to
1041 return an error. By default, they don't.
1046 my( $self, %options ) = @_;
1047 my $invoice_time = $options{'invoice_time'} || time;
1050 local $SIG{HUP} = 'IGNORE';
1051 local $SIG{INT} = 'IGNORE';
1052 local $SIG{QUIT} = 'IGNORE';
1053 local $SIG{TERM} = 'IGNORE';
1054 local $SIG{TSTP} = 'IGNORE';
1055 local $SIG{PIPE} = 'IGNORE';
1057 my $oldAutoCommit = $FS::UID::AutoCommit;
1058 local $FS::UID::AutoCommit = 0;
1061 my $balance = $self->balance;
1062 warn "collect: balance $balance" if $Debug;
1063 unless ( $balance > 0 ) { #redundant?????
1064 $dbh->rollback if $oldAutoCommit; #hmm
1068 foreach my $cust_bill (
1069 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
1072 #this has to be before next's
1073 my $amount = sprintf( "%.2f", $balance < $cust_bill->owed
1077 $balance = sprintf( "%.2f", $balance - $amount );
1079 next unless $cust_bill->owed > 0;
1081 # don't try to charge for the same invoice if it's already in a batch
1082 next if qsearchs( 'cust_pay_batch', { 'invnum' => $cust_bill->invnum } );
1084 warn "invnum ". $cust_bill->invnum. " (owed ". $cust_bill->owed. ", amount $amount, balance $balance)" if $Debug;
1086 next unless $amount > 0;
1088 if ( $self->payby eq 'BILL' ) {
1091 my $since = $invoice_time - ( $cust_bill->_date || 0 );
1092 #warn "$invoice_time ", $cust_bill->_date, " $since";
1093 if ( $since >= 0 #don't print future invoices
1094 && ( $cust_bill->printed * 2592000 ) <= $since
1097 #my @print_text = $cust_bill->print_text; #( date )
1098 my @invoicing_list = $self->invoicing_list;
1099 if ( grep { $_ ne 'POST' } @invoicing_list ) { #email invoice
1100 $ENV{SMTPHOSTS} = $smtpmachine;
1101 $ENV{MAILADDRESS} = $invoice_from;
1102 my $header = new Mail::Header ( [
1103 "From: $invoice_from",
1104 "To: ". join(', ', grep { $_ ne 'POST' } @invoicing_list ),
1105 "Sender: $invoice_from",
1106 "Reply-To: $invoice_from",
1107 "Date: ". time2str("%a, %d %b %Y %X %z", time),
1110 my $message = new Mail::Internet (
1111 'Header' => $header,
1112 'Body' => [ $cust_bill->print_text ], #( date)
1114 $message->smtpsend or die "Can't send invoice email!"; #die? warn?
1116 } elsif ( ! @invoicing_list || grep { $_ eq 'POST' } @invoicing_list ) {
1117 open(LPR, "|$lpr") or die "Can't open pipe to $lpr: $!";
1118 print LPR $cust_bill->print_text; #( date )
1120 or die $! ? "Error closing $lpr: $!"
1121 : "Exit status $? from $lpr";
1124 my %hash = $cust_bill->hash;
1126 my $new_cust_bill = new FS::cust_bill(\%hash);
1127 my $error = $new_cust_bill->replace($cust_bill);
1128 warn "Error updating $cust_bill->printed: $error" if $error;
1132 } elsif ( $self->payby eq 'COMP' ) {
1133 my $cust_pay = new FS::cust_pay ( {
1134 'invnum' => $cust_bill->invnum,
1138 'payinfo' => $self->payinfo,
1141 my $error = $cust_pay->insert;
1143 $dbh->rollback if $oldAutoCommit;
1144 return 'Error COMPing invnum #'. $cust_bill->invnum. ": $error";
1148 } elsif ( $self->payby eq 'CARD' ) {
1150 if ( $options{'batch_card'} ne 'yes' ) {
1152 unless ( $processor ) {
1153 $dbh->rollback if $oldAutoCommit;
1154 return "Real time card processing not enabled!";
1157 my $address = $self->address1;
1158 $address .= ", ". $self->address2 if $self->address2;
1161 #$self->paydate =~ /^(\d+)\/\d*(\d{2})$/;
1162 $self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
1165 if ( $processor eq 'cybercash3.2' ) {
1167 #fix exp. date for cybercash
1168 #$self->paydate =~ /^(\d+)\/\d*(\d{2})$/;
1169 $self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
1172 my $paybatch = $cust_bill->invnum.
1173 '-' . time2str("%y%m%d%H%M%S", time);
1175 my $payname = $self->payname ||
1176 $self->getfield('first'). ' '. $self->getfield('last');
1179 my $country = $self->country eq 'US' ? 'USA' : $self->country;
1181 my @full_xaction = ( $xaction,
1182 'Order-ID' => $paybatch,
1183 'Amount' => "usd $amount",
1184 'Card-Number' => $self->getfield('payinfo'),
1185 'Card-Name' => $payname,
1186 'Card-Address' => $address,
1187 'Card-City' => $self->getfield('city'),
1188 'Card-State' => $self->getfield('state'),
1189 'Card-Zip' => $self->getfield('zip'),
1190 'Card-Country' => $country,
1195 %result = &CCMckDirectLib3_2::SendCC2_1Server(@full_xaction);
1197 #if ( $result{'MActionCode'} == 7 ) { #cybercash smps v.1.1.3
1198 #if ( $result{'action-code'} == 7 ) { #cybercash smps v.2.1
1199 if ( $result{'MStatus'} eq 'success' ) { #cybercash smps v.2 or 3
1200 my $cust_pay = new FS::cust_pay ( {
1201 'invnum' => $cust_bill->invnum,
1205 'payinfo' => $self->payinfo,
1206 'paybatch' => "$processor:$paybatch",
1208 my $error = $cust_pay->insert;
1210 # gah, even with transactions.
1211 $dbh->commit if $oldAutoCommit; #well.
1212 my $e = 'WARNING: Card debited but database not updated - '.
1213 'error applying payment, invnum #' . $cust_bill->invnum.
1214 " (CyberCash Order-ID $paybatch): $error";
1218 } elsif ( $result{'Mstatus'} ne 'failure-bad-money'
1219 || $options{'report_badcard'} ) {
1220 $dbh->commit if $oldAutoCommit;
1221 return 'Cybercash error, invnum #' .
1222 $cust_bill->invnum. ':'. $result{'MErrMsg'};
1224 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1228 } elsif ( $processor =~ /^Business::OnlinePayment::(.*)$/ ) {
1230 my $bop_processor = $1;
1232 my($payname, $payfirst, $paylast);
1233 if ( $self->payname ) {
1234 $payname = $self->payname;
1235 $payname =~ /^\s*([\w \,\.\-\']*\w)?\s+([\w\,\.\-\']+)$/
1237 $dbh->rollback if $oldAutoCommit;
1238 return "Illegal payname $payname";
1240 ($payfirst, $paylast) = ($1, $2);
1242 $payfirst = $self->getfield('first');
1243 $paylast = $self->getfield('first');
1244 $payname = "$payfirst $paylast";
1247 my @invoicing_list = grep { $_ ne 'POST' } $self->invoicing_list;
1248 if ( $conf->exists('emailinvoiceauto')
1249 || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
1250 push @invoicing_list, $self->default_invoicing_list;
1252 my $email = $invoicing_list[0];
1254 my( $action1, $action2 ) = split(/\s*\,\s*/, $bop_action );
1257 new Business::OnlinePayment( $bop_processor, @bop_options );
1258 $transaction->content(
1260 'login' => $bop_login,
1261 'password' => $bop_password,
1262 'action' => $action1,
1263 'description' => 'Internet Services',
1264 'amount' => $amount,
1265 'invoice_number' => $cust_bill->invnum,
1266 'customer_id' => $self->custnum,
1267 'last_name' => $paylast,
1268 'first_name' => $payfirst,
1270 'address' => $address,
1271 'city' => $self->city,
1272 'state' => $self->state,
1273 'zip' => $self->zip,
1274 'country' => $self->country,
1275 'card_number' => $self->payinfo,
1276 'expiration' => $exp,
1277 'referer' => 'http://cleanwhisker.420.am/',
1280 $transaction->submit();
1282 if ( $transaction->is_success() && $action2 ) {
1283 my $auth = $transaction->authorization;
1284 my $ordernum = $transaction->order_number;
1285 #warn "********* $auth ***********\n";
1286 #warn "********* $ordernum ***********\n";
1288 new Business::OnlinePayment( $bop_processor, @bop_options );
1292 login => $bop_login,
1293 password => $bop_password,
1294 order_number => $ordernum,
1296 authorization => $auth,
1297 description => 'Internet Services',
1302 unless ( $capture->is_success ) {
1303 my $e = "Authorization sucessful but capture failed, invnum #".
1304 $cust_bill->invnum. ': '. $capture->result_code.
1305 ": ". $capture->error_message;
1312 if ( $transaction->is_success() ) {
1314 my $cust_pay = new FS::cust_pay ( {
1315 'invnum' => $cust_bill->invnum,
1319 'payinfo' => $self->payinfo,
1320 'paybatch' => "$processor:". $transaction->authorization,
1322 my $error = $cust_pay->insert;
1324 # gah, even with transactions.
1325 $dbh->commit if $oldAutoCommit; #well.
1326 my $e = 'WARNING: Card debited but database not updated - '.
1327 'error applying payment, invnum #' . $cust_bill->invnum.
1328 " ($processor): $error";
1332 } elsif ( $options{'report_badcard'} ) {
1333 $dbh->commit if $oldAutoCommit;
1334 return "$processor error, invnum #". $cust_bill->invnum. ': '.
1335 $transaction->result_code. ": ". $transaction->error_message;
1337 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1342 $dbh->rollback if $oldAutoCommit;
1343 return "Unknown real-time processor $processor\n";
1346 } else { #batch card
1348 my $cust_pay_batch = new FS::cust_pay_batch ( {
1349 'invnum' => $cust_bill->getfield('invnum'),
1350 'custnum' => $self->getfield('custnum'),
1351 'last' => $self->getfield('last'),
1352 'first' => $self->getfield('first'),
1353 'address1' => $self->getfield('address1'),
1354 'address2' => $self->getfield('address2'),
1355 'city' => $self->getfield('city'),
1356 'state' => $self->getfield('state'),
1357 'zip' => $self->getfield('zip'),
1358 'country' => $self->getfield('country'),
1360 'cardnum' => $self->getfield('payinfo'),
1361 'exp' => $self->getfield('paydate'),
1362 'payname' => $self->getfield('payname'),
1363 'amount' => $amount,
1365 my $error = $cust_pay_batch->insert;
1367 $dbh->rollback if $oldAutoCommit;
1368 return "Error adding to cust_pay_batch: $error";
1374 $dbh->rollback if $oldAutoCommit;
1375 return "Unknown payment type ". $self->payby;
1379 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1386 Returns the total owed for this customer on all invoices
1387 (see L<FS::cust_bill/owed>).
1394 foreach my $cust_bill ( qsearch('cust_bill', {
1395 'custnum' => $self->custnum,
1397 $total_bill += $cust_bill->owed;
1399 sprintf( "%.2f", $total_bill );
1404 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
1405 to outstanding invoice balances in chronological order and returns the value
1406 of any remaining unapplied credits available for refund
1407 (see L<FS::cust_refund>).
1414 return 0 unless $self->total_credited;
1416 my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
1417 qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
1419 my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
1420 qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
1424 foreach my $cust_bill ( @invoices ) {
1427 if ( !defined($credit) || $credit->credited == 0) {
1428 $credit = pop @credits or last;
1431 if ($cust_bill->owed >= $credit->credited) {
1432 $amount=$credit->credited;
1434 $amount=$cust_bill->owed;
1437 my $cust_credit_bill = new FS::cust_credit_bill ( {
1438 'crednum' => $credit->crednum,
1439 'invnum' => $cust_bill->invnum,
1440 'amount' => $amount,
1442 my $error = $cust_credit_bill->insert;
1443 die $error if $error;
1445 redo if ($cust_bill->owed > 0);
1449 return $self->total_credited;
1452 =item apply_payments
1454 Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
1455 to outstanding invoice balances in chronological order.
1457 #and returns the value of any remaining unapplied payments.
1461 sub apply_payments {
1466 my @payments = sort { $b->_date <=> $a->_date } ( grep { $_->unapplied > 0 }
1467 qsearch('cust_pay', { 'custnum' => $self->custnum } ) );
1469 my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
1470 qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
1474 foreach my $cust_bill ( @invoices ) {
1477 if ( !defined($payment) || $payment->unapplied == 0 ) {
1478 $payment = pop @payments or last;
1481 if ( $cust_bill->owed >= $payment->unapplied ) {
1482 $amount = $payment->unapplied;
1484 $amount = $cust_bill->owed;
1487 my $cust_bill_pay = new FS::cust_bill_pay ( {
1488 'paynum' => $payment->paynum,
1489 'invnum' => $cust_bill->invnum,
1490 'amount' => $amount,
1492 my $error = $cust_bill_pay->insert;
1493 die $error if $error;
1495 redo if ( $cust_bill->owed > 0);
1499 return $self->total_unapplied_payments;
1502 =item total_credited
1504 Returns the total outstanding credit (see L<FS::cust_credit>) for this
1505 customer. See L<FS::cust_credit/credited>.
1509 sub total_credited {
1511 my $total_credit = 0;
1512 foreach my $cust_credit ( qsearch('cust_credit', {
1513 'custnum' => $self->custnum,
1515 $total_credit += $cust_credit->credited;
1517 sprintf( "%.2f", $total_credit );
1520 =item total_unapplied_payments
1522 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
1523 See L<FS::cust_pay/unapplied>.
1527 sub total_unapplied_payments {
1529 my $total_unapplied = 0;
1530 foreach my $cust_pay ( qsearch('cust_pay', {
1531 'custnum' => $self->custnum,
1533 $total_unapplied += $cust_pay->unapplied;
1535 sprintf( "%.2f", $total_unapplied );
1540 Returns the balance for this customer (total_owed minus total_credited
1541 minus total_unapplied_payments).
1548 $self->total_owed - $self->total_credited - $self->total_unapplied_payments
1552 =item invoicing_list [ ARRAYREF ]
1554 If an arguement is given, sets these email addresses as invoice recipients
1555 (see L<FS::cust_main_invoice>). Errors are not fatal and are not reported
1556 (except as warnings), so use check_invoicing_list first.
1558 Returns a list of email addresses (with svcnum entries expanded).
1560 Note: You can clear the invoicing list by passing an empty ARRAYREF. You can
1561 check it without disturbing anything by passing nothing.
1563 This interface may change in the future.
1567 sub invoicing_list {
1568 my( $self, $arrayref ) = @_;
1570 my @cust_main_invoice;
1571 if ( $self->custnum ) {
1572 @cust_main_invoice =
1573 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1575 @cust_main_invoice = ();
1577 foreach my $cust_main_invoice ( @cust_main_invoice ) {
1578 #warn $cust_main_invoice->destnum;
1579 unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
1580 #warn $cust_main_invoice->destnum;
1581 my $error = $cust_main_invoice->delete;
1582 warn $error if $error;
1585 if ( $self->custnum ) {
1586 @cust_main_invoice =
1587 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1589 @cust_main_invoice = ();
1591 my %seen = map { $_->address => 1 } @cust_main_invoice;
1592 foreach my $address ( @{$arrayref} ) {
1593 #unless ( grep { $address eq $_->address } @cust_main_invoice ) {
1594 next if exists $seen{$address} && $seen{$address};
1595 $seen{$address} = 1;
1596 my $cust_main_invoice = new FS::cust_main_invoice ( {
1597 'custnum' => $self->custnum,
1600 my $error = $cust_main_invoice->insert;
1601 warn $error if $error;
1604 if ( $self->custnum ) {
1606 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1612 =item check_invoicing_list ARRAYREF
1614 Checks these arguements as valid input for the invoicing_list method. If there
1615 is an error, returns the error, otherwise returns false.
1619 sub check_invoicing_list {
1620 my( $self, $arrayref ) = @_;
1621 foreach my $address ( @{$arrayref} ) {
1622 my $cust_main_invoice = new FS::cust_main_invoice ( {
1623 'custnum' => $self->custnum,
1626 my $error = $self->custnum
1627 ? $cust_main_invoice->check
1628 : $cust_main_invoice->checkdest
1630 return $error if $error;
1635 =item default_invoicing_list
1637 Returns the email addresses of any
1641 sub default_invoicing_list {
1644 foreach my $cust_pkg ( $self->all_pkgs ) {
1645 my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
1647 map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
1648 grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
1650 push @list, map { $_->email } @svc_acct;
1652 $self->invoicing_list(\@list);
1655 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
1657 Returns an array of customers referred by this customer (referral_custnum set
1658 to this custnum). If DEPTH is given, recurses up to the given depth, returning
1659 customers referred by customers referred by this customer and so on, inclusive.
1660 The default behavior is DEPTH 1 (no recursion).
1664 sub referral_cust_main {
1666 my $depth = @_ ? shift : 1;
1667 my $exclude = @_ ? shift : {};
1670 map { $exclude->{$_->custnum}++; $_; }
1671 grep { ! $exclude->{ $_->custnum } }
1672 qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
1676 map { $_->referral_cust_main($depth-1, $exclude) }
1683 =item referral_cust_pkg [ DEPTH ]
1685 Like referral_cust_main, except returns a flat list of all unsuspended packages
1686 for each customer. The number of items in this list may be useful for
1687 comission calculations (perhaps after a grep).
1691 sub referral_cust_pkg {
1693 my $depth = @_ ? shift : 1;
1695 map { $_->unsuspended_pkgs }
1696 grep { $_->unsuspended_pkgs }
1697 $self->referral_cust_main($depth);
1700 =item credit AMOUNT, REASON
1702 Applies a credit to this customer. If there is an error, returns the error,
1703 otherwise returns false.
1708 my( $self, $amount, $reason ) = @_;
1709 my $cust_credit = new FS::cust_credit {
1710 'custnum' => $self->custnum,
1711 'amount' => $amount,
1712 'reason' => $reason,
1714 $cust_credit->insert;
1723 =item check_and_rebuild_fuzzyfiles
1727 sub check_and_rebuild_fuzzyfiles {
1728 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1729 -e "$dir/cust_main.last" && -e "$dir/cust_main.company"
1730 or &rebuild_fuzzyfiles;
1733 =item rebuild_fuzzyfiles
1737 sub rebuild_fuzzyfiles {
1739 use Fcntl qw(:flock);
1741 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1745 open(LASTLOCK,">>$dir/cust_main.last")
1746 or die "can't open $dir/cust_main.last: $!";
1747 flock(LASTLOCK,LOCK_EX)
1748 or die "can't lock $dir/cust_main.last: $!";
1750 my @all_last = map $_->getfield('last'), qsearch('cust_main', {});
1752 grep $_, map $_->getfield('ship_last'), qsearch('cust_main',{})
1753 if defined dbdef->table('cust_main')->column('ship_last');
1755 open (LASTCACHE,">$dir/cust_main.last.tmp")
1756 or die "can't open $dir/cust_main.last.tmp: $!";
1757 print LASTCACHE join("\n", @all_last), "\n";
1758 close LASTCACHE or die "can't close $dir/cust_main.last.tmp: $!";
1760 rename "$dir/cust_main.last.tmp", "$dir/cust_main.last";
1765 open(COMPANYLOCK,">>$dir/cust_main.company")
1766 or die "can't open $dir/cust_main.company: $!";
1767 flock(COMPANYLOCK,LOCK_EX)
1768 or die "can't lock $dir/cust_main.company: $!";
1770 my @all_company = grep $_ ne '', map $_->company, qsearch('cust_main',{});
1772 grep $_ ne '', map $_->ship_company, qsearch('cust_main', {})
1773 if defined dbdef->table('cust_main')->column('ship_last');
1775 open (COMPANYCACHE,">$dir/cust_main.company.tmp")
1776 or die "can't open $dir/cust_main.company.tmp: $!";
1777 print COMPANYCACHE join("\n", @all_company), "\n";
1778 close COMPANYCACHE or die "can't close $dir/cust_main.company.tmp: $!";
1780 rename "$dir/cust_main.company.tmp", "$dir/cust_main.company";
1790 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1791 open(LASTCACHE,"<$dir/cust_main.last")
1792 or die "can't open $dir/cust_main.last: $!";
1793 my @array = map { chomp; $_; } <LASTCACHE>;
1803 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1804 open(COMPANYCACHE,"<$dir/cust_main.company")
1805 or die "can't open $dir/cust_main.last: $!";
1806 my @array = map { chomp; $_; } <COMPANYCACHE>;
1811 =item append_fuzzyfiles LASTNAME COMPANY
1815 sub append_fuzzyfiles {
1816 my( $last, $company ) = @_;
1818 &check_and_rebuild_fuzzyfiles;
1820 use Fcntl qw(:flock);
1822 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1826 open(LAST,">>$dir/cust_main.last")
1827 or die "can't open $dir/cust_main.last: $!";
1829 or die "can't lock $dir/cust_main.last: $!";
1831 print LAST "$last\n";
1834 or die "can't unlock $dir/cust_main.last: $!";
1840 open(COMPANY,">>$dir/cust_main.company")
1841 or die "can't open $dir/cust_main.company: $!";
1842 flock(COMPANY,LOCK_EX)
1843 or die "can't lock $dir/cust_main.company: $!";
1845 print COMPANY "$company\n";
1847 flock(COMPANY,LOCK_UN)
1848 or die "can't unlock $dir/cust_main.company: $!";
1858 $Id: cust_main.pm,v 1.44 2001-10-22 08:31:25 ivan Exp $
1864 The delete method should possibly take an FS::cust_main object reference
1865 instead of a scalar customer number.
1867 Bill and collect options should probably be passed as references instead of a
1870 CyberCash v2 forces us to define some variables in package main.
1872 There should probably be a configuration file with a list of allowed credit
1875 No multiple currency support (probably a larger project than just this module).
1879 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
1880 L<FS::cust_pay_batch>, L<FS::agent>, L<FS::part_referral>,
1881 L<FS::cust_main_county>, L<FS::cust_main_invoice>,
1882 L<FS::UID>, schema.html from the base documentation.