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 my ( $hashref, $cache ) = @_;
81 if ( exists $hashref->{'pkgnum'} ) {
82 # #@{ $self->{'_pkgnum'} } = ();
83 my $subcache = $cache->subcache( 'pkgnum', 'cust_pkg', $hashref->{custnum});
84 $self->{'_pkgnum'} = $subcache;
85 #push @{ $self->{'_pkgnum'} },
86 FS::cust_pkg->new_or_cached($hashref, $subcache) if $hashref->{pkgnum};
92 FS::cust_main - Object methods for cust_main records
98 $record = new FS::cust_main \%hash;
99 $record = new FS::cust_main { 'column' => 'value' };
101 $error = $record->insert;
103 $error = $new_record->replace($old_record);
105 $error = $record->delete;
107 $error = $record->check;
109 @cust_pkg = $record->all_pkgs;
111 @cust_pkg = $record->ncancelled_pkgs;
113 @cust_pkg = $record->suspended_pkgs;
115 $error = $record->bill;
116 $error = $record->bill %options;
117 $error = $record->bill 'time' => $time;
119 $error = $record->collect;
120 $error = $record->collect %options;
121 $error = $record->collect 'invoice_time' => $time,
122 'batch_card' => 'yes',
123 'report_badcard' => 'yes',
128 An FS::cust_main object represents a customer. FS::cust_main inherits from
129 FS::Record. The following fields are currently supported:
133 =item custnum - primary key (assigned automatically for new customers)
135 =item agentnum - agent (see L<FS::agent>)
137 =item refnum - referral (see L<FS::part_referral>)
143 =item ss - social security number (optional)
145 =item company - (optional)
149 =item address2 - (optional)
153 =item county - (optional, see L<FS::cust_main_county>)
155 =item state - (see L<FS::cust_main_county>)
159 =item country - (see L<FS::cust_main_county>)
161 =item daytime - phone (optional)
163 =item night - phone (optional)
165 =item fax - phone (optional)
167 =item ship_first - name
169 =item ship_last - name
171 =item ship_company - (optional)
175 =item ship_address2 - (optional)
179 =item ship_county - (optional, see L<FS::cust_main_county>)
181 =item ship_state - (see L<FS::cust_main_county>)
185 =item ship_country - (see L<FS::cust_main_county>)
187 =item ship_daytime - phone (optional)
189 =item ship_night - phone (optional)
191 =item ship_fax - phone (optional)
193 =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)
195 =item payinfo - card number, P.O., comp issuer (4-8 lowercase alphanumerics; think username) or prepayment identifier (see L<FS::prepay_credit>)
197 =item paydate - expiration date, mm/yyyy, m/yyyy, mm/yy or m/yy
199 =item payname - name on card or billing name
201 =item tax - tax exempt, empty or `Y'
203 =item otaker - order taker (assigned automatically, see L<FS::UID>)
205 =item comments - comments (optional)
215 Creates a new customer. To add the customer to the database, see L<"insert">.
217 Note that this stores the hash reference, not a distinct copy of the hash it
218 points to. You can ask the object for a copy with the I<hash> method.
222 sub table { 'cust_main'; }
224 =item insert [ CUST_PKG_HASHREF [ , INVOICING_LIST_ARYREF ] ]
226 Adds this customer to the database. If there is an error, returns the error,
227 otherwise returns false.
229 CUST_PKG_HASHREF: If you pass a Tie::RefHash data structure to the insert
230 method containing FS::cust_pkg and FS::svc_I<tablename> objects, all records
231 are inserted atomicly, or the transaction is rolled back. Passing an empty
232 hash reference is equivalent to not supplying this parameter. There should be
233 a better explanation of this, but until then, here's an example:
236 tie %hash, 'Tie::RefHash'; #this part is important
238 $cust_pkg => [ $svc_acct ],
241 $cust_main->insert( \%hash );
243 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
244 be set as the invoicing list (see L<"invoicing_list">). Errors return as
245 expected and rollback the entire transaction; it is not necessary to call
246 check_invoicing_list first. The invoicing_list is set after the records in the
247 CUST_PKG_HASHREF above are inserted, so it is now possible to set an
248 invoicing_list destination to the newly-created svc_acct. Here's an example:
250 $cust_main->insert( {}, [ $email, 'POST' ] );
258 local $SIG{HUP} = 'IGNORE';
259 local $SIG{INT} = 'IGNORE';
260 local $SIG{QUIT} = 'IGNORE';
261 local $SIG{TERM} = 'IGNORE';
262 local $SIG{TSTP} = 'IGNORE';
263 local $SIG{PIPE} = 'IGNORE';
265 my $oldAutoCommit = $FS::UID::AutoCommit;
266 local $FS::UID::AutoCommit = 0;
271 if ( $self->payby eq 'PREPAY' ) {
272 $self->payby('BILL');
273 my $prepay_credit = qsearchs(
275 { 'identifier' => $self->payinfo },
279 warn "WARNING: can't find pre-found prepay_credit: ". $self->payinfo
280 unless $prepay_credit;
281 $amount = $prepay_credit->amount;
282 $seconds = $prepay_credit->seconds;
283 my $error = $prepay_credit->delete;
285 $dbh->rollback if $oldAutoCommit;
286 return "removing prepay_credit (transaction rolled back): $error";
290 my $error = $self->SUPER::insert;
292 $dbh->rollback if $oldAutoCommit;
293 return "inserting cust_main record (transaction rolled back): $error";
296 if ( @param ) { # CUST_PKG_HASHREF
297 my $cust_pkgs = shift @param;
298 foreach my $cust_pkg ( keys %$cust_pkgs ) {
299 $cust_pkg->custnum( $self->custnum );
300 $error = $cust_pkg->insert;
302 $dbh->rollback if $oldAutoCommit;
303 return "inserting cust_pkg (transaction rolled back): $error";
305 foreach my $svc_something ( @{$cust_pkgs->{$cust_pkg}} ) {
306 $svc_something->pkgnum( $cust_pkg->pkgnum );
307 if ( $seconds && $svc_something->isa('FS::svc_acct') ) {
308 $svc_something->seconds( $svc_something->seconds + $seconds );
311 $error = $svc_something->insert;
313 $dbh->rollback if $oldAutoCommit;
314 return "inserting svc_ (transaction rolled back): $error";
321 $dbh->rollback if $oldAutoCommit;
322 return "No svc_acct record to apply pre-paid time";
325 if ( @param ) { # INVOICING_LIST_ARYREF
326 my $invoicing_list = shift @param;
327 $error = $self->check_invoicing_list( $invoicing_list );
329 $dbh->rollback if $oldAutoCommit;
330 return "checking invoicing_list (transaction rolled back): $error";
332 $self->invoicing_list( $invoicing_list );
336 my $cust_credit = new FS::cust_credit {
337 'custnum' => $self->custnum,
340 $error = $cust_credit->insert;
342 $dbh->rollback if $oldAutoCommit;
343 return "inserting credit (transaction rolled back): $error";
347 my $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
348 $error = $queue->insert($self->getfield('last'), $self->company);
350 $dbh->rollback if $oldAutoCommit;
351 return "queueing job (transaction rolled back): $error";
354 if ( defined $self->dbdef_table->column('ship_last') && $self->ship_last ) {
355 $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
356 $error = $queue->insert($self->getfield('last'), $self->company);
358 $dbh->rollback if $oldAutoCommit;
359 return "queueing job (transaction rolled back): $error";
363 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
368 =item delete NEW_CUSTNUM
370 This deletes the customer. If there is an error, returns the error, otherwise
373 This will completely remove all traces of the customer record. This is not
374 what you want when a customer cancels service; for that, cancel all of the
375 customer's packages (see L<FS::cust_pkg/cancel>).
377 If the customer has any uncancelled packages, you need to pass a new (valid)
378 customer number for those packages to be transferred to. Cancelled packages
379 will be deleted. Did I mention that this is NOT what you want when a customer
380 cancels service and that you really should be looking see L<FS::cust_pkg/cancel>?
382 You can't delete a customer with invoices (see L<FS::cust_bill>),
383 or credits (see L<FS::cust_credit>) or payments (see L<FS::cust_pay>).
390 local $SIG{HUP} = 'IGNORE';
391 local $SIG{INT} = 'IGNORE';
392 local $SIG{QUIT} = 'IGNORE';
393 local $SIG{TERM} = 'IGNORE';
394 local $SIG{TSTP} = 'IGNORE';
395 local $SIG{PIPE} = 'IGNORE';
397 my $oldAutoCommit = $FS::UID::AutoCommit;
398 local $FS::UID::AutoCommit = 0;
401 if ( qsearch( 'cust_bill', { 'custnum' => $self->custnum } ) ) {
402 $dbh->rollback if $oldAutoCommit;
403 return "Can't delete a customer with invoices";
405 if ( qsearch( 'cust_credit', { 'custnum' => $self->custnum } ) ) {
406 $dbh->rollback if $oldAutoCommit;
407 return "Can't delete a customer with credits";
409 if ( qsearch( 'cust_pay', { 'custnum' => $self->custnum } ) ) {
410 $dbh->rollback if $oldAutoCommit;
411 return "Can't delete a customer with payments";
414 my @cust_pkg = $self->ncancelled_pkgs;
416 my $new_custnum = shift;
417 unless ( qsearchs( 'cust_main', { 'custnum' => $new_custnum } ) ) {
418 $dbh->rollback if $oldAutoCommit;
419 return "Invalid new customer number: $new_custnum";
421 foreach my $cust_pkg ( @cust_pkg ) {
422 my %hash = $cust_pkg->hash;
423 $hash{'custnum'} = $new_custnum;
424 my $new_cust_pkg = new FS::cust_pkg ( \%hash );
425 my $error = $new_cust_pkg->replace($cust_pkg);
427 $dbh->rollback if $oldAutoCommit;
432 my @cancelled_cust_pkg = $self->all_pkgs;
433 foreach my $cust_pkg ( @cancelled_cust_pkg ) {
434 my $error = $cust_pkg->delete;
436 $dbh->rollback if $oldAutoCommit;
441 foreach my $cust_main_invoice (
442 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } )
444 my $error = $cust_main_invoice->delete;
446 $dbh->rollback if $oldAutoCommit;
451 my $error = $self->SUPER::delete;
453 $dbh->rollback if $oldAutoCommit;
457 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
462 =item replace OLD_RECORD [ INVOICING_LIST_ARYREF ]
464 Replaces the OLD_RECORD with this one in the database. If there is an error,
465 returns the error, otherwise returns false.
467 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
468 be set as the invoicing list (see L<"invoicing_list">). Errors return as
469 expected and rollback the entire transaction; it is not necessary to call
470 check_invoicing_list first. Here's an example:
472 $new_cust_main->replace( $old_cust_main, [ $email, 'POST' ] );
481 local $SIG{HUP} = 'IGNORE';
482 local $SIG{INT} = 'IGNORE';
483 local $SIG{QUIT} = 'IGNORE';
484 local $SIG{TERM} = 'IGNORE';
485 local $SIG{TSTP} = 'IGNORE';
486 local $SIG{PIPE} = 'IGNORE';
488 my $oldAutoCommit = $FS::UID::AutoCommit;
489 local $FS::UID::AutoCommit = 0;
492 my $error = $self->SUPER::replace($old);
495 $dbh->rollback if $oldAutoCommit;
499 if ( @param ) { # INVOICING_LIST_ARYREF
500 my $invoicing_list = shift @param;
501 $error = $self->check_invoicing_list( $invoicing_list );
503 $dbh->rollback if $oldAutoCommit;
506 $self->invoicing_list( $invoicing_list );
509 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
516 Checks all fields to make sure this is a valid customer record. If there is
517 an error, returns the error, otherwise returns false. Called by the insert
526 $self->ut_numbern('custnum')
527 || $self->ut_number('agentnum')
528 || $self->ut_number('refnum')
529 || $self->ut_name('last')
530 || $self->ut_name('first')
531 || $self->ut_textn('company')
532 || $self->ut_text('address1')
533 || $self->ut_textn('address2')
534 || $self->ut_text('city')
535 || $self->ut_textn('county')
536 || $self->ut_textn('state')
537 || $self->ut_country('country')
538 || $self->ut_anything('comments')
539 || $self->ut_numbern('referral_custnum')
541 #barf. need message catalogs. i18n. etc.
542 $error .= "Please select a referral."
543 if $error =~ /^Illegal or empty \(numeric\) refnum: /;
544 return $error if $error;
546 return "Unknown agent"
547 unless qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
549 return "Unknown referral"
550 unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } );
552 return "Unknown referring custnum ". $self->referral_custnum
553 unless ! $self->referral_custnum
554 || qsearchs( 'cust_main', { 'custnum' => $self->referral_custnum } );
556 if ( $self->ss eq '' ) {
561 $ss =~ /^(\d{3})(\d{2})(\d{4})$/
562 or return "Illegal social security number: ". $self->ss;
563 $self->ss("$1-$2-$3");
566 unless ( qsearchs('cust_main_county', {
567 'country' => $self->country,
570 return "Unknown state/county/country: ".
571 $self->state. "/". $self->county. "/". $self->country
572 unless qsearchs('cust_main_county',{
573 'state' => $self->state,
574 'county' => $self->county,
575 'country' => $self->country,
580 $self->ut_phonen('daytime', $self->country)
581 || $self->ut_phonen('night', $self->country)
582 || $self->ut_phonen('fax', $self->country)
583 || $self->ut_zip('zip', $self->country)
585 return $error if $error;
588 last first company address1 address2 city county state zip
589 country daytime night fax
592 if ( defined $self->dbdef_table->column('ship_last') ) {
593 if ( grep { $self->getfield($_) ne $self->getfield("ship_$_") } @addfields
594 && grep $self->getfield("ship_$_"), grep $_ ne 'state', @addfields
598 $self->ut_name('ship_last')
599 || $self->ut_name('ship_first')
600 || $self->ut_textn('ship_company')
601 || $self->ut_text('ship_address1')
602 || $self->ut_textn('ship_address2')
603 || $self->ut_text('ship_city')
604 || $self->ut_textn('ship_county')
605 || $self->ut_textn('ship_state')
606 || $self->ut_country('ship_country')
608 return $error if $error;
610 #false laziness with above
611 unless ( qsearchs('cust_main_county', {
612 'country' => $self->ship_country,
615 return "Unknown ship_state/ship_county/ship_country: ".
616 $self->ship_state. "/". $self->ship_county. "/". $self->ship_country
617 unless qsearchs('cust_main_county',{
618 'state' => $self->ship_state,
619 'county' => $self->ship_county,
620 'country' => $self->ship_country,
626 $self->ut_phonen('ship_daytime', $self->ship_country)
627 || $self->ut_phonen('ship_night', $self->ship_country)
628 || $self->ut_phonen('ship_fax', $self->ship_country)
629 || $self->ut_zip('ship_zip', $self->ship_country)
631 return $error if $error;
633 } else { # ship_ info eq billing info, so don't store dup info in database
634 $self->setfield("ship_$_", '')
635 foreach qw( last first company address1 address2 city county state zip
636 country daytime night fax );
640 $self->payby =~ /^(CARD|BILL|COMP|PREPAY)$/
641 or return "Illegal payby: ". $self->payby;
644 if ( $self->payby eq 'CARD' ) {
646 my $payinfo = $self->payinfo;
648 $payinfo =~ /^(\d{13,16})$/
649 or return "Illegal credit card number: ". $self->payinfo;
651 $self->payinfo($payinfo);
653 or return "Illegal credit card number: ". $self->payinfo;
654 return "Unknown card type" if cardtype($self->payinfo) eq "Unknown";
656 } elsif ( $self->payby eq 'BILL' ) {
658 $error = $self->ut_textn('payinfo');
659 return "Illegal P.O. number: ". $self->payinfo if $error;
661 } elsif ( $self->payby eq 'COMP' ) {
663 $error = $self->ut_textn('payinfo');
664 return "Illegal comp account issuer: ". $self->payinfo if $error;
666 } elsif ( $self->payby eq 'PREPAY' ) {
668 my $payinfo = $self->payinfo;
669 $payinfo =~ s/\W//g; #anything else would just confuse things
670 $self->payinfo($payinfo);
671 $error = $self->ut_alpha('payinfo');
672 return "Illegal prepayment identifier: ". $self->payinfo if $error;
673 return "Unknown prepayment identifier"
674 unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } );
678 if ( $self->paydate eq '' || $self->paydate eq '-' ) {
679 return "Expriation date required"
680 unless $self->payby eq 'BILL' || $self->payby eq 'PREPAY';
683 $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/
684 or return "Illegal expiration date: ". $self->paydate;
685 if ( length($2) == 4 ) {
686 $self->paydate("$2-$1-01");
688 $self->paydate("20$2-$1-01");
692 if ( $self->payname eq '' ) {
693 $self->payname( $self->first. " ". $self->getfield('last') );
695 $self->payname =~ /^([\w \,\.\-\']+)$/
696 or return "Illegal billing name: ". $self->payname;
700 $self->tax =~ /^(Y?)$/ or return "Illegal tax: ". $self->tax;
703 $self->otaker(getotaker);
710 Returns all packages (see L<FS::cust_pkg>) for this customer.
716 if ( $self->{'_pkgnum'} ) {
717 values %{ $self->{'_pkgnum'}->cache };
719 qsearch( 'cust_pkg', { 'custnum' => $self->custnum });
723 =item ncancelled_pkgs
725 Returns all non-cancelled packages (see L<FS::cust_pkg>) for this customer.
729 sub ncancelled_pkgs {
731 if ( $self->{'_pkgnum'} ) {
732 grep { ! $_->getfield('cancel') } values %{ $self->{'_pkgnum'}->cache };
734 @{ [ # force list context
735 qsearch( 'cust_pkg', {
736 'custnum' => $self->custnum,
739 qsearch( 'cust_pkg', {
740 'custnum' => $self->custnum,
749 Returns all suspended packages (see L<FS::cust_pkg>) for this customer.
755 grep { $_->susp } $self->ncancelled_pkgs;
758 =item unflagged_suspended_pkgs
760 Returns all unflagged suspended packages (see L<FS::cust_pkg>) for this
761 customer (thouse packages without the `manual_flag' set).
765 sub unflagged_suspended_pkgs {
767 return $self->suspended_pkgs
768 unless dbdef->table('cust_pkg')->column('manual_flag');
769 grep { ! $_->manual_flag } $self->suspended_pkgs;
772 =item unsuspended_pkgs
774 Returns all unsuspended (and uncancelled) packages (see L<FS::cust_pkg>) for
779 sub unsuspended_pkgs {
781 grep { ! $_->susp } $self->ncancelled_pkgs;
786 Unsuspends all unflagged suspended packages (see L</unflagged_suspended_pkgs>
787 and L<FS::cust_pkg>) for this customer. Always returns a list: an empty list
788 on success or a list of errors.
794 grep { $_->unsuspend } $self->suspended_pkgs;
799 Suspends all unsuspended packages (see L<FS::cust_pkg>) for this customer.
800 Always returns a list: an empty list on success or a list of errors.
806 grep { $_->suspend } $self->unsuspended_pkgs;
811 Generates invoices (see L<FS::cust_bill>) for this customer. Usually used in
812 conjunction with the collect method.
814 Options are passed as name-value pairs.
816 The only currently available option is `time', which bills the customer as if
817 it were that time. It is specified as a UNIX timestamp; see
818 L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion
819 functions. For example:
823 $cust_main->bill( 'time' => str2time('April 20th, 2001') );
825 If there is an error, returns the error, otherwise returns false.
830 my( $self, %options ) = @_;
831 my $time = $options{'time'} || time;
836 local $SIG{HUP} = 'IGNORE';
837 local $SIG{INT} = 'IGNORE';
838 local $SIG{QUIT} = 'IGNORE';
839 local $SIG{TERM} = 'IGNORE';
840 local $SIG{TSTP} = 'IGNORE';
841 local $SIG{PIPE} = 'IGNORE';
843 my $oldAutoCommit = $FS::UID::AutoCommit;
844 local $FS::UID::AutoCommit = 0;
847 # find the packages which are due for billing, find out how much they are
848 # & generate invoice database.
850 my( $total_setup, $total_recur ) = ( 0, 0 );
851 my( $taxable_setup, $taxable_recur ) = ( 0, 0 );
852 my @cust_bill_pkg = ();
854 foreach my $cust_pkg (
855 qsearch('cust_pkg',{'custnum'=> $self->getfield('custnum') } )
858 next if $cust_pkg->getfield('cancel');
860 #? to avoid use of uninitialized value errors... ?
861 $cust_pkg->setfield('bill', '')
862 unless defined($cust_pkg->bill);
864 my $part_pkg = qsearchs( 'part_pkg', { 'pkgpart' => $cust_pkg->pkgpart } );
866 #so we don't modify cust_pkg record unnecessarily
867 my $cust_pkg_mod_flag = 0;
868 my %hash = $cust_pkg->hash;
869 my $old_cust_pkg = new FS::cust_pkg \%hash;
873 unless ( $cust_pkg->setup ) {
874 my $setup_prog = $part_pkg->getfield('setup');
875 $setup_prog =~ /^(.*)$/ or do {
876 $dbh->rollback if $oldAutoCommit;
877 return "Illegal setup for pkgpart ". $part_pkg->pkgpart.
883 ##$cpt->permit(); #what is necessary?
884 #$cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
885 #$setup = $cpt->reval($setup_prog);
886 $setup = eval $setup_prog;
887 unless ( defined($setup) ) {
888 $dbh->rollback if $oldAutoCommit;
889 return "Error eval-ing part_pkg->setup pkgpart ". $part_pkg->pkgpart.
890 "(expression $setup_prog): $@";
892 $cust_pkg->setfield('setup',$time);
893 $cust_pkg_mod_flag=1;
899 if ( $part_pkg->getfield('freq') > 0 &&
900 ! $cust_pkg->getfield('susp') &&
901 ( $cust_pkg->getfield('bill') || 0 ) < $time
903 my $recur_prog = $part_pkg->getfield('recur');
904 $recur_prog =~ /^(.*)$/ or do {
905 $dbh->rollback if $oldAutoCommit;
906 return "Illegal recur for pkgpart ". $part_pkg->pkgpart.
912 ##$cpt->permit(); #what is necessary?
913 #$cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
914 #$recur = $cpt->reval($recur_prog);
915 $recur = eval $recur_prog;
916 unless ( defined($recur) ) {
917 $dbh->rollback if $oldAutoCommit;
918 return "Error eval-ing part_pkg->recur pkgpart ". $part_pkg->pkgpart.
919 "(expression $recur_prog): $@";
921 #change this bit to use Date::Manip? CAREFUL with timezones (see
922 # mailing list archive)
923 #$sdate=$cust_pkg->bill || time;
924 #$sdate=$cust_pkg->bill || $time;
925 $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
926 my ($sec,$min,$hour,$mday,$mon,$year) =
927 (localtime($sdate) )[0,1,2,3,4,5];
928 $mon += $part_pkg->getfield('freq');
929 until ( $mon < 12 ) { $mon -= 12; $year++; }
930 $cust_pkg->setfield('bill',
931 timelocal($sec,$min,$hour,$mday,$mon,$year));
932 $cust_pkg_mod_flag = 1;
935 warn "\$setup is undefined" unless defined($setup);
936 warn "\$recur is undefined" unless defined($recur);
937 warn "\$cust_pkg->bill is undefined" unless defined($cust_pkg->bill);
939 if ( $cust_pkg_mod_flag ) {
940 $error=$cust_pkg->replace($old_cust_pkg);
941 if ( $error ) { #just in case
942 $dbh->rollback if $oldAutoCommit;
943 return "Error modifying pkgnum ". $cust_pkg->pkgnum. ": $error";
945 $setup = sprintf( "%.2f", $setup );
946 $recur = sprintf( "%.2f", $recur );
948 $dbh->rollback if $oldAutoCommit;
949 return "negative setup $setup for pkgnum ". $cust_pkg->pkgnum;
952 $dbh->rollback if $oldAutoCommit;
953 return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum;
955 if ( $setup > 0 || $recur > 0 ) {
956 my $cust_bill_pkg = new FS::cust_bill_pkg ({
957 'pkgnum' => $cust_pkg->pkgnum,
961 'edate' => $cust_pkg->bill,
963 push @cust_bill_pkg, $cust_bill_pkg;
964 $total_setup += $setup;
965 $total_recur += $recur;
966 $taxable_setup += $setup
967 unless $part_pkg->dbdef_table->column('setuptax')
968 || $part_pkg->setuptax =~ /^Y$/i;
969 $taxable_recur += $recur
970 unless $part_pkg->dbdef_table->column('recurtax')
971 || $part_pkg->recurtax =~ /^Y$/i;
977 my $charged = sprintf( "%.2f", $total_setup + $total_recur );
978 my $taxable_charged = sprintf( "%.2f", $taxable_setup + $taxable_recur );
980 unless ( @cust_bill_pkg ) {
981 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
985 unless ( $self->tax =~ /Y/i
986 || $self->payby eq 'COMP'
987 || $taxable_charged == 0 ) {
988 my $cust_main_county = qsearchs('cust_main_county',{
989 'state' => $self->state,
990 'county' => $self->county,
991 'country' => $self->country,
993 my $tax = sprintf( "%.2f",
994 $taxable_charged * ( $cust_main_county->getfield('tax') / 100 )
998 $charged = sprintf( "%.2f", $charged+$tax );
1000 my $cust_bill_pkg = new FS::cust_bill_pkg ({
1007 push @cust_bill_pkg, $cust_bill_pkg;
1011 my $cust_bill = new FS::cust_bill ( {
1012 'custnum' => $self->custnum,
1014 'charged' => $charged,
1016 $error = $cust_bill->insert;
1018 $dbh->rollback if $oldAutoCommit;
1019 return "can't create invoice for customer #". $self->custnum. ": $error";
1022 my $invnum = $cust_bill->invnum;
1024 foreach $cust_bill_pkg ( @cust_bill_pkg ) {
1025 #warn $cust_bill_pkg->invnum($invnum);
1026 $error = $cust_bill_pkg->insert;
1028 $dbh->rollback if $oldAutoCommit;
1029 return "can't create invoice line item for customer #". $self->custnum.
1034 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1038 =item collect OPTIONS
1040 (Attempt to) collect money for this customer's outstanding invoices (see
1041 L<FS::cust_bill>). Usually used after the bill method.
1043 Depending on the value of `payby', this may print an invoice (`BILL'), charge
1044 a credit card (`CARD'), or just add any necessary (pseudo-)payment (`COMP').
1046 If there is an error, returns the error, otherwise returns false.
1048 Options are passed as name-value pairs.
1050 Currently available options are:
1052 invoice_time - Use this time when deciding when to print invoices and
1053 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>
1054 for conversion functions.
1056 batch_card - Set this true to batch cards (see L<FS::cust_pay_batch>). By
1057 default, cards are processed immediately, which will generate an error if
1058 CyberCash is not installed.
1060 report_badcard - Set this true if you want bad card transactions to
1061 return an error. By default, they don't.
1066 my( $self, %options ) = @_;
1067 my $invoice_time = $options{'invoice_time'} || time;
1070 local $SIG{HUP} = 'IGNORE';
1071 local $SIG{INT} = 'IGNORE';
1072 local $SIG{QUIT} = 'IGNORE';
1073 local $SIG{TERM} = 'IGNORE';
1074 local $SIG{TSTP} = 'IGNORE';
1075 local $SIG{PIPE} = 'IGNORE';
1077 my $oldAutoCommit = $FS::UID::AutoCommit;
1078 local $FS::UID::AutoCommit = 0;
1081 my $balance = $self->balance;
1082 warn "collect: balance $balance" if $Debug;
1083 unless ( $balance > 0 ) { #redundant?????
1084 $dbh->rollback if $oldAutoCommit; #hmm
1088 foreach my $cust_bill (
1089 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
1092 #this has to be before next's
1093 my $amount = sprintf( "%.2f", $balance < $cust_bill->owed
1097 $balance = sprintf( "%.2f", $balance - $amount );
1099 next unless $cust_bill->owed > 0;
1101 # don't try to charge for the same invoice if it's already in a batch
1102 next if qsearchs( 'cust_pay_batch', { 'invnum' => $cust_bill->invnum } );
1104 warn "invnum ". $cust_bill->invnum. " (owed ". $cust_bill->owed. ", amount $amount, balance $balance)" if $Debug;
1106 next unless $amount > 0;
1108 if ( $self->payby eq 'BILL' ) {
1111 my $since = $invoice_time - ( $cust_bill->_date || 0 );
1112 #warn "$invoice_time ", $cust_bill->_date, " $since";
1113 if ( $since >= 0 #don't print future invoices
1114 && ( $cust_bill->printed * 2592000 ) <= $since
1117 #my @print_text = $cust_bill->print_text; #( date )
1118 my @invoicing_list = $self->invoicing_list;
1119 if ( grep { $_ ne 'POST' } @invoicing_list ) { #email invoice
1120 $ENV{SMTPHOSTS} = $smtpmachine;
1121 $ENV{MAILADDRESS} = $invoice_from;
1122 my $header = new Mail::Header ( [
1123 "From: $invoice_from",
1124 "To: ". join(', ', grep { $_ ne 'POST' } @invoicing_list ),
1125 "Sender: $invoice_from",
1126 "Reply-To: $invoice_from",
1127 "Date: ". time2str("%a, %d %b %Y %X %z", time),
1130 my $message = new Mail::Internet (
1131 'Header' => $header,
1132 'Body' => [ $cust_bill->print_text ], #( date)
1134 $message->smtpsend or die "Can't send invoice email!"; #die? warn?
1136 } elsif ( ! @invoicing_list || grep { $_ eq 'POST' } @invoicing_list ) {
1137 open(LPR, "|$lpr") or die "Can't open pipe to $lpr: $!";
1138 print LPR $cust_bill->print_text; #( date )
1140 or die $! ? "Error closing $lpr: $!"
1141 : "Exit status $? from $lpr";
1144 my %hash = $cust_bill->hash;
1146 my $new_cust_bill = new FS::cust_bill(\%hash);
1147 my $error = $new_cust_bill->replace($cust_bill);
1148 warn "Error updating $cust_bill->printed: $error" if $error;
1152 } elsif ( $self->payby eq 'COMP' ) {
1153 my $cust_pay = new FS::cust_pay ( {
1154 'invnum' => $cust_bill->invnum,
1158 'payinfo' => $self->payinfo,
1161 my $error = $cust_pay->insert;
1163 $dbh->rollback if $oldAutoCommit;
1164 return 'Error COMPing invnum #'. $cust_bill->invnum. ": $error";
1168 } elsif ( $self->payby eq 'CARD' ) {
1170 if ( $options{'batch_card'} ne 'yes' ) {
1172 unless ( $processor ) {
1173 $dbh->rollback if $oldAutoCommit;
1174 return "Real time card processing not enabled!";
1177 my $address = $self->address1;
1178 $address .= ", ". $self->address2 if $self->address2;
1181 #$self->paydate =~ /^(\d+)\/\d*(\d{2})$/;
1182 $self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
1185 if ( $processor eq 'cybercash3.2' ) {
1187 #fix exp. date for cybercash
1188 #$self->paydate =~ /^(\d+)\/\d*(\d{2})$/;
1189 $self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
1192 my $paybatch = $cust_bill->invnum.
1193 '-' . time2str("%y%m%d%H%M%S", time);
1195 my $payname = $self->payname ||
1196 $self->getfield('first'). ' '. $self->getfield('last');
1199 my $country = $self->country eq 'US' ? 'USA' : $self->country;
1201 my @full_xaction = ( $xaction,
1202 'Order-ID' => $paybatch,
1203 'Amount' => "usd $amount",
1204 'Card-Number' => $self->getfield('payinfo'),
1205 'Card-Name' => $payname,
1206 'Card-Address' => $address,
1207 'Card-City' => $self->getfield('city'),
1208 'Card-State' => $self->getfield('state'),
1209 'Card-Zip' => $self->getfield('zip'),
1210 'Card-Country' => $country,
1215 %result = &CCMckDirectLib3_2::SendCC2_1Server(@full_xaction);
1217 #if ( $result{'MActionCode'} == 7 ) { #cybercash smps v.1.1.3
1218 #if ( $result{'action-code'} == 7 ) { #cybercash smps v.2.1
1219 if ( $result{'MStatus'} eq 'success' ) { #cybercash smps v.2 or 3
1220 my $cust_pay = new FS::cust_pay ( {
1221 'invnum' => $cust_bill->invnum,
1225 'payinfo' => $self->payinfo,
1226 'paybatch' => "$processor:$paybatch",
1228 my $error = $cust_pay->insert;
1230 # gah, even with transactions.
1231 $dbh->commit if $oldAutoCommit; #well.
1232 my $e = 'WARNING: Card debited but database not updated - '.
1233 'error applying payment, invnum #' . $cust_bill->invnum.
1234 " (CyberCash Order-ID $paybatch): $error";
1238 } elsif ( $result{'Mstatus'} ne 'failure-bad-money'
1239 || $options{'report_badcard'} ) {
1240 $dbh->commit if $oldAutoCommit;
1241 return 'Cybercash error, invnum #' .
1242 $cust_bill->invnum. ':'. $result{'MErrMsg'};
1244 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1248 } elsif ( $processor =~ /^Business::OnlinePayment::(.*)$/ ) {
1250 my $bop_processor = $1;
1252 my($payname, $payfirst, $paylast);
1253 if ( $self->payname ) {
1254 $payname = $self->payname;
1255 $payname =~ /^\s*([\w \,\.\-\']*\w)?\s+([\w\,\.\-\']+)$/
1257 $dbh->rollback if $oldAutoCommit;
1258 return "Illegal payname $payname";
1260 ($payfirst, $paylast) = ($1, $2);
1262 $payfirst = $self->getfield('first');
1263 $paylast = $self->getfield('first');
1264 $payname = "$payfirst $paylast";
1267 my @invoicing_list = grep { $_ ne 'POST' } $self->invoicing_list;
1268 if ( $conf->exists('emailinvoiceauto')
1269 || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
1270 push @invoicing_list, $self->default_invoicing_list;
1272 my $email = $invoicing_list[0];
1274 my( $action1, $action2 ) = split(/\s*\,\s*/, $bop_action );
1277 new Business::OnlinePayment( $bop_processor, @bop_options );
1278 $transaction->content(
1280 'login' => $bop_login,
1281 'password' => $bop_password,
1282 'action' => $action1,
1283 'description' => 'Internet Services',
1284 'amount' => $amount,
1285 'invoice_number' => $cust_bill->invnum,
1286 'customer_id' => $self->custnum,
1287 'last_name' => $paylast,
1288 'first_name' => $payfirst,
1290 'address' => $address,
1291 'city' => $self->city,
1292 'state' => $self->state,
1293 'zip' => $self->zip,
1294 'country' => $self->country,
1295 'card_number' => $self->payinfo,
1296 'expiration' => $exp,
1297 'referer' => 'http://cleanwhisker.420.am/',
1300 $transaction->submit();
1302 if ( $transaction->is_success() && $action2 ) {
1303 my $auth = $transaction->authorization;
1304 my $ordernum = $transaction->order_number;
1305 #warn "********* $auth ***********\n";
1306 #warn "********* $ordernum ***********\n";
1308 new Business::OnlinePayment( $bop_processor, @bop_options );
1312 login => $bop_login,
1313 password => $bop_password,
1314 order_number => $ordernum,
1316 authorization => $auth,
1317 description => 'Internet Services',
1322 unless ( $capture->is_success ) {
1323 my $e = "Authorization sucessful but capture failed, invnum #".
1324 $cust_bill->invnum. ': '. $capture->result_code.
1325 ": ". $capture->error_message;
1332 if ( $transaction->is_success() ) {
1334 my $cust_pay = new FS::cust_pay ( {
1335 'invnum' => $cust_bill->invnum,
1339 'payinfo' => $self->payinfo,
1340 'paybatch' => "$processor:". $transaction->authorization,
1342 my $error = $cust_pay->insert;
1344 # gah, even with transactions.
1345 $dbh->commit if $oldAutoCommit; #well.
1346 my $e = 'WARNING: Card debited but database not updated - '.
1347 'error applying payment, invnum #' . $cust_bill->invnum.
1348 " ($processor): $error";
1352 } elsif ( $options{'report_badcard'} ) {
1353 $dbh->commit if $oldAutoCommit;
1354 return "$processor error, invnum #". $cust_bill->invnum. ': '.
1355 $transaction->result_code. ": ". $transaction->error_message;
1357 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1362 $dbh->rollback if $oldAutoCommit;
1363 return "Unknown real-time processor $processor\n";
1366 } else { #batch card
1368 my $cust_pay_batch = new FS::cust_pay_batch ( {
1369 'invnum' => $cust_bill->getfield('invnum'),
1370 'custnum' => $self->getfield('custnum'),
1371 'last' => $self->getfield('last'),
1372 'first' => $self->getfield('first'),
1373 'address1' => $self->getfield('address1'),
1374 'address2' => $self->getfield('address2'),
1375 'city' => $self->getfield('city'),
1376 'state' => $self->getfield('state'),
1377 'zip' => $self->getfield('zip'),
1378 'country' => $self->getfield('country'),
1380 'cardnum' => $self->getfield('payinfo'),
1381 'exp' => $self->getfield('paydate'),
1382 'payname' => $self->getfield('payname'),
1383 'amount' => $amount,
1385 my $error = $cust_pay_batch->insert;
1387 $dbh->rollback if $oldAutoCommit;
1388 return "Error adding to cust_pay_batch: $error";
1394 $dbh->rollback if $oldAutoCommit;
1395 return "Unknown payment type ". $self->payby;
1399 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1406 Returns the total owed for this customer on all invoices
1407 (see L<FS::cust_bill/owed>).
1414 foreach my $cust_bill ( qsearch('cust_bill', {
1415 'custnum' => $self->custnum,
1417 $total_bill += $cust_bill->owed;
1419 sprintf( "%.2f", $total_bill );
1424 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
1425 to outstanding invoice balances in chronological order and returns the value
1426 of any remaining unapplied credits available for refund
1427 (see L<FS::cust_refund>).
1434 return 0 unless $self->total_credited;
1436 my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
1437 qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
1439 my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
1440 qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
1444 foreach my $cust_bill ( @invoices ) {
1447 if ( !defined($credit) || $credit->credited == 0) {
1448 $credit = pop @credits or last;
1451 if ($cust_bill->owed >= $credit->credited) {
1452 $amount=$credit->credited;
1454 $amount=$cust_bill->owed;
1457 my $cust_credit_bill = new FS::cust_credit_bill ( {
1458 'crednum' => $credit->crednum,
1459 'invnum' => $cust_bill->invnum,
1460 'amount' => $amount,
1462 my $error = $cust_credit_bill->insert;
1463 die $error if $error;
1465 redo if ($cust_bill->owed > 0);
1469 return $self->total_credited;
1472 =item apply_payments
1474 Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
1475 to outstanding invoice balances in chronological order.
1477 #and returns the value of any remaining unapplied payments.
1481 sub apply_payments {
1486 my @payments = sort { $b->_date <=> $a->_date } ( grep { $_->unapplied > 0 }
1487 qsearch('cust_pay', { 'custnum' => $self->custnum } ) );
1489 my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
1490 qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
1494 foreach my $cust_bill ( @invoices ) {
1497 if ( !defined($payment) || $payment->unapplied == 0 ) {
1498 $payment = pop @payments or last;
1501 if ( $cust_bill->owed >= $payment->unapplied ) {
1502 $amount = $payment->unapplied;
1504 $amount = $cust_bill->owed;
1507 my $cust_bill_pay = new FS::cust_bill_pay ( {
1508 'paynum' => $payment->paynum,
1509 'invnum' => $cust_bill->invnum,
1510 'amount' => $amount,
1512 my $error = $cust_bill_pay->insert;
1513 die $error if $error;
1515 redo if ( $cust_bill->owed > 0);
1519 return $self->total_unapplied_payments;
1522 =item total_credited
1524 Returns the total outstanding credit (see L<FS::cust_credit>) for this
1525 customer. See L<FS::cust_credit/credited>.
1529 sub total_credited {
1531 my $total_credit = 0;
1532 foreach my $cust_credit ( qsearch('cust_credit', {
1533 'custnum' => $self->custnum,
1535 $total_credit += $cust_credit->credited;
1537 sprintf( "%.2f", $total_credit );
1540 =item total_unapplied_payments
1542 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
1543 See L<FS::cust_pay/unapplied>.
1547 sub total_unapplied_payments {
1549 my $total_unapplied = 0;
1550 foreach my $cust_pay ( qsearch('cust_pay', {
1551 'custnum' => $self->custnum,
1553 $total_unapplied += $cust_pay->unapplied;
1555 sprintf( "%.2f", $total_unapplied );
1560 Returns the balance for this customer (total_owed minus total_credited
1561 minus total_unapplied_payments).
1568 $self->total_owed - $self->total_credited - $self->total_unapplied_payments
1572 =item invoicing_list [ ARRAYREF ]
1574 If an arguement is given, sets these email addresses as invoice recipients
1575 (see L<FS::cust_main_invoice>). Errors are not fatal and are not reported
1576 (except as warnings), so use check_invoicing_list first.
1578 Returns a list of email addresses (with svcnum entries expanded).
1580 Note: You can clear the invoicing list by passing an empty ARRAYREF. You can
1581 check it without disturbing anything by passing nothing.
1583 This interface may change in the future.
1587 sub invoicing_list {
1588 my( $self, $arrayref ) = @_;
1590 my @cust_main_invoice;
1591 if ( $self->custnum ) {
1592 @cust_main_invoice =
1593 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1595 @cust_main_invoice = ();
1597 foreach my $cust_main_invoice ( @cust_main_invoice ) {
1598 #warn $cust_main_invoice->destnum;
1599 unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
1600 #warn $cust_main_invoice->destnum;
1601 my $error = $cust_main_invoice->delete;
1602 warn $error if $error;
1605 if ( $self->custnum ) {
1606 @cust_main_invoice =
1607 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1609 @cust_main_invoice = ();
1611 my %seen = map { $_->address => 1 } @cust_main_invoice;
1612 foreach my $address ( @{$arrayref} ) {
1613 #unless ( grep { $address eq $_->address } @cust_main_invoice ) {
1614 next if exists $seen{$address} && $seen{$address};
1615 $seen{$address} = 1;
1616 my $cust_main_invoice = new FS::cust_main_invoice ( {
1617 'custnum' => $self->custnum,
1620 my $error = $cust_main_invoice->insert;
1621 warn $error if $error;
1624 if ( $self->custnum ) {
1626 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1632 =item check_invoicing_list ARRAYREF
1634 Checks these arguements as valid input for the invoicing_list method. If there
1635 is an error, returns the error, otherwise returns false.
1639 sub check_invoicing_list {
1640 my( $self, $arrayref ) = @_;
1641 foreach my $address ( @{$arrayref} ) {
1642 my $cust_main_invoice = new FS::cust_main_invoice ( {
1643 'custnum' => $self->custnum,
1646 my $error = $self->custnum
1647 ? $cust_main_invoice->check
1648 : $cust_main_invoice->checkdest
1650 return $error if $error;
1655 =item default_invoicing_list
1657 Returns the email addresses of any
1661 sub default_invoicing_list {
1664 foreach my $cust_pkg ( $self->all_pkgs ) {
1665 my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
1667 map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
1668 grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
1670 push @list, map { $_->email } @svc_acct;
1672 $self->invoicing_list(\@list);
1675 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
1677 Returns an array of customers referred by this customer (referral_custnum set
1678 to this custnum). If DEPTH is given, recurses up to the given depth, returning
1679 customers referred by customers referred by this customer and so on, inclusive.
1680 The default behavior is DEPTH 1 (no recursion).
1684 sub referral_cust_main {
1686 my $depth = @_ ? shift : 1;
1687 my $exclude = @_ ? shift : {};
1690 map { $exclude->{$_->custnum}++; $_; }
1691 grep { ! $exclude->{ $_->custnum } }
1692 qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
1696 map { $_->referral_cust_main($depth-1, $exclude) }
1703 =item referral_cust_pkg [ DEPTH ]
1705 Like referral_cust_main, except returns a flat list of all unsuspended packages
1706 for each customer. The number of items in this list may be useful for
1707 comission calculations (perhaps after a grep).
1711 sub referral_cust_pkg {
1713 my $depth = @_ ? shift : 1;
1715 map { $_->unsuspended_pkgs }
1716 grep { $_->unsuspended_pkgs }
1717 $self->referral_cust_main($depth);
1720 =item credit AMOUNT, REASON
1722 Applies a credit to this customer. If there is an error, returns the error,
1723 otherwise returns false.
1728 my( $self, $amount, $reason ) = @_;
1729 my $cust_credit = new FS::cust_credit {
1730 'custnum' => $self->custnum,
1731 'amount' => $amount,
1732 'reason' => $reason,
1734 $cust_credit->insert;
1743 =item check_and_rebuild_fuzzyfiles
1747 sub check_and_rebuild_fuzzyfiles {
1748 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1749 -e "$dir/cust_main.last" && -e "$dir/cust_main.company"
1750 or &rebuild_fuzzyfiles;
1753 =item rebuild_fuzzyfiles
1757 sub rebuild_fuzzyfiles {
1759 use Fcntl qw(:flock);
1761 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1765 open(LASTLOCK,">>$dir/cust_main.last")
1766 or die "can't open $dir/cust_main.last: $!";
1767 flock(LASTLOCK,LOCK_EX)
1768 or die "can't lock $dir/cust_main.last: $!";
1770 my @all_last = map $_->getfield('last'), qsearch('cust_main', {});
1772 grep $_, map $_->getfield('ship_last'), qsearch('cust_main',{})
1773 if defined dbdef->table('cust_main')->column('ship_last');
1775 open (LASTCACHE,">$dir/cust_main.last.tmp")
1776 or die "can't open $dir/cust_main.last.tmp: $!";
1777 print LASTCACHE join("\n", @all_last), "\n";
1778 close LASTCACHE or die "can't close $dir/cust_main.last.tmp: $!";
1780 rename "$dir/cust_main.last.tmp", "$dir/cust_main.last";
1785 open(COMPANYLOCK,">>$dir/cust_main.company")
1786 or die "can't open $dir/cust_main.company: $!";
1787 flock(COMPANYLOCK,LOCK_EX)
1788 or die "can't lock $dir/cust_main.company: $!";
1790 my @all_company = grep $_ ne '', map $_->company, qsearch('cust_main',{});
1792 grep $_ ne '', map $_->ship_company, qsearch('cust_main', {})
1793 if defined dbdef->table('cust_main')->column('ship_last');
1795 open (COMPANYCACHE,">$dir/cust_main.company.tmp")
1796 or die "can't open $dir/cust_main.company.tmp: $!";
1797 print COMPANYCACHE join("\n", @all_company), "\n";
1798 close COMPANYCACHE or die "can't close $dir/cust_main.company.tmp: $!";
1800 rename "$dir/cust_main.company.tmp", "$dir/cust_main.company";
1810 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1811 open(LASTCACHE,"<$dir/cust_main.last")
1812 or die "can't open $dir/cust_main.last: $!";
1813 my @array = map { chomp; $_; } <LASTCACHE>;
1823 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1824 open(COMPANYCACHE,"<$dir/cust_main.company")
1825 or die "can't open $dir/cust_main.last: $!";
1826 my @array = map { chomp; $_; } <COMPANYCACHE>;
1831 =item append_fuzzyfiles LASTNAME COMPANY
1835 sub append_fuzzyfiles {
1836 my( $last, $company ) = @_;
1838 &check_and_rebuild_fuzzyfiles;
1840 use Fcntl qw(:flock);
1842 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1846 open(LAST,">>$dir/cust_main.last")
1847 or die "can't open $dir/cust_main.last: $!";
1849 or die "can't lock $dir/cust_main.last: $!";
1851 print LAST "$last\n";
1854 or die "can't unlock $dir/cust_main.last: $!";
1860 open(COMPANY,">>$dir/cust_main.company")
1861 or die "can't open $dir/cust_main.company: $!";
1862 flock(COMPANY,LOCK_EX)
1863 or die "can't lock $dir/cust_main.company: $!";
1865 print COMPANY "$company\n";
1867 flock(COMPANY,LOCK_UN)
1868 or die "can't unlock $dir/cust_main.company: $!";
1878 $Id: cust_main.pm,v 1.46 2001-11-05 11:55:04 ivan Exp $
1884 The delete method should possibly take an FS::cust_main object reference
1885 instead of a scalar customer number.
1887 Bill and collect options should probably be passed as references instead of a
1890 CyberCash v2 forces us to define some variables in package main.
1892 There should probably be a configuration file with a list of allowed credit
1895 No multiple currency support (probably a larger project than just this module).
1899 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
1900 L<FS::cust_pay_batch>, L<FS::agent>, L<FS::part_referral>,
1901 L<FS::cust_main_county>, L<FS::cust_main_invoice>,
1902 L<FS::UID>, schema.html from the base documentation.