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 $import );
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 );
39 #ask FS::UID to run this stuff for us later
40 $FS::UID::callback{'FS::cust_main'} = sub {
42 $lpr = $conf->config('lpr');
43 $invoice_from = $conf->config('invoice_from');
44 $smtpmachine = $conf->config('smtpmachine');
46 if ( $conf->exists('cybercash3.2') ) {
48 #qw($MCKversion %Config InitConfig CCError CCDebug CCDebug2);
49 require CCMckDirectLib3_2;
51 require CCMckErrno3_2;
52 #qw(MCKGetErrorMessage $E_NoErr);
53 import CCMckErrno3_2 qw($E_NoErr);
56 ($merchant_conf,$xaction)= $conf->config('cybercash3.2');
57 my $status = &CCMckLib3_2::InitConfig($merchant_conf);
58 if ( $status != $E_NoErr ) {
59 warn "CCMckLib3_2::InitConfig error:\n";
60 foreach my $key (keys %CCMckLib3_2::Config) {
61 warn " $key => $CCMckLib3_2::Config{$key}\n"
63 my($errmsg) = &CCMckErrno3_2::MCKGetErrorMessage($status);
64 die "CCMckLib3_2::InitConfig fatal error: $errmsg\n";
66 $processor='cybercash3.2';
67 } elsif ( $conf->exists('business-onlinepayment') ) {
73 ) = $conf->config('business-onlinepayment');
74 $bop_action ||= 'normal authorization';
75 eval "use Business::OnlinePayment";
76 $processor="Business::OnlinePayment::$bop_processor";
82 my ( $hashref, $cache ) = @_;
83 if ( exists $hashref->{'pkgnum'} ) {
84 # #@{ $self->{'_pkgnum'} } = ();
85 my $subcache = $cache->subcache( 'pkgnum', 'cust_pkg', $hashref->{custnum});
86 $self->{'_pkgnum'} = $subcache;
87 #push @{ $self->{'_pkgnum'} },
88 FS::cust_pkg->new_or_cached($hashref, $subcache) if $hashref->{pkgnum};
94 FS::cust_main - Object methods for cust_main records
100 $record = new FS::cust_main \%hash;
101 $record = new FS::cust_main { 'column' => 'value' };
103 $error = $record->insert;
105 $error = $new_record->replace($old_record);
107 $error = $record->delete;
109 $error = $record->check;
111 @cust_pkg = $record->all_pkgs;
113 @cust_pkg = $record->ncancelled_pkgs;
115 @cust_pkg = $record->suspended_pkgs;
117 $error = $record->bill;
118 $error = $record->bill %options;
119 $error = $record->bill 'time' => $time;
121 $error = $record->collect;
122 $error = $record->collect %options;
123 $error = $record->collect 'invoice_time' => $time,
124 'batch_card' => 'yes',
125 'report_badcard' => 'yes',
130 An FS::cust_main object represents a customer. FS::cust_main inherits from
131 FS::Record. The following fields are currently supported:
135 =item custnum - primary key (assigned automatically for new customers)
137 =item agentnum - agent (see L<FS::agent>)
139 =item refnum - referral (see L<FS::part_referral>)
145 =item ss - social security number (optional)
147 =item company - (optional)
151 =item address2 - (optional)
155 =item county - (optional, see L<FS::cust_main_county>)
157 =item state - (see L<FS::cust_main_county>)
161 =item country - (see L<FS::cust_main_county>)
163 =item daytime - phone (optional)
165 =item night - phone (optional)
167 =item fax - phone (optional)
169 =item ship_first - name
171 =item ship_last - name
173 =item ship_company - (optional)
177 =item ship_address2 - (optional)
181 =item ship_county - (optional, see L<FS::cust_main_county>)
183 =item ship_state - (see L<FS::cust_main_county>)
187 =item ship_country - (see L<FS::cust_main_county>)
189 =item ship_daytime - phone (optional)
191 =item ship_night - phone (optional)
193 =item ship_fax - phone (optional)
195 =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)
197 =item payinfo - card number, P.O., comp issuer (4-8 lowercase alphanumerics; think username) or prepayment identifier (see L<FS::prepay_credit>)
199 =item paydate - expiration date, mm/yyyy, m/yyyy, mm/yy or m/yy
201 =item payname - name on card or billing name
203 =item tax - tax exempt, empty or `Y'
205 =item otaker - order taker (assigned automatically, see L<FS::UID>)
207 =item comments - comments (optional)
217 Creates a new customer. To add the customer to the database, see L<"insert">.
219 Note that this stores the hash reference, not a distinct copy of the hash it
220 points to. You can ask the object for a copy with the I<hash> method.
224 sub table { 'cust_main'; }
226 =item insert [ CUST_PKG_HASHREF [ , INVOICING_LIST_ARYREF ] ]
228 Adds this customer to the database. If there is an error, returns the error,
229 otherwise returns false.
231 CUST_PKG_HASHREF: If you pass a Tie::RefHash data structure to the insert
232 method containing FS::cust_pkg and FS::svc_I<tablename> objects, all records
233 are inserted atomicly, or the transaction is rolled back. Passing an empty
234 hash reference is equivalent to not supplying this parameter. There should be
235 a better explanation of this, but until then, here's an example:
238 tie %hash, 'Tie::RefHash'; #this part is important
240 $cust_pkg => [ $svc_acct ],
243 $cust_main->insert( \%hash );
245 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
246 be set as the invoicing list (see L<"invoicing_list">). Errors return as
247 expected and rollback the entire transaction; it is not necessary to call
248 check_invoicing_list first. The invoicing_list is set after the records in the
249 CUST_PKG_HASHREF above are inserted, so it is now possible to set an
250 invoicing_list destination to the newly-created svc_acct. Here's an example:
252 $cust_main->insert( {}, [ $email, 'POST' ] );
260 local $SIG{HUP} = 'IGNORE';
261 local $SIG{INT} = 'IGNORE';
262 local $SIG{QUIT} = 'IGNORE';
263 local $SIG{TERM} = 'IGNORE';
264 local $SIG{TSTP} = 'IGNORE';
265 local $SIG{PIPE} = 'IGNORE';
267 my $oldAutoCommit = $FS::UID::AutoCommit;
268 local $FS::UID::AutoCommit = 0;
273 if ( $self->payby eq 'PREPAY' ) {
274 $self->payby('BILL');
275 my $prepay_credit = qsearchs(
277 { 'identifier' => $self->payinfo },
281 warn "WARNING: can't find pre-found prepay_credit: ". $self->payinfo
282 unless $prepay_credit;
283 $amount = $prepay_credit->amount;
284 $seconds = $prepay_credit->seconds;
285 my $error = $prepay_credit->delete;
287 $dbh->rollback if $oldAutoCommit;
288 return "removing prepay_credit (transaction rolled back): $error";
292 my $error = $self->SUPER::insert;
294 $dbh->rollback if $oldAutoCommit;
295 return "inserting cust_main record (transaction rolled back): $error";
298 if ( @param ) { # CUST_PKG_HASHREF
299 my $cust_pkgs = shift @param;
300 foreach my $cust_pkg ( keys %$cust_pkgs ) {
301 $cust_pkg->custnum( $self->custnum );
302 $error = $cust_pkg->insert;
304 $dbh->rollback if $oldAutoCommit;
305 return "inserting cust_pkg (transaction rolled back): $error";
307 foreach my $svc_something ( @{$cust_pkgs->{$cust_pkg}} ) {
308 $svc_something->pkgnum( $cust_pkg->pkgnum );
309 if ( $seconds && $svc_something->isa('FS::svc_acct') ) {
310 $svc_something->seconds( $svc_something->seconds + $seconds );
313 $error = $svc_something->insert;
315 $dbh->rollback if $oldAutoCommit;
316 return "inserting svc_ (transaction rolled back): $error";
323 $dbh->rollback if $oldAutoCommit;
324 return "No svc_acct record to apply pre-paid time";
327 if ( @param ) { # INVOICING_LIST_ARYREF
328 my $invoicing_list = shift @param;
329 $error = $self->check_invoicing_list( $invoicing_list );
331 $dbh->rollback if $oldAutoCommit;
332 return "checking invoicing_list (transaction rolled back): $error";
334 $self->invoicing_list( $invoicing_list );
338 my $cust_credit = new FS::cust_credit {
339 'custnum' => $self->custnum,
342 $error = $cust_credit->insert;
344 $dbh->rollback if $oldAutoCommit;
345 return "inserting credit (transaction rolled back): $error";
349 my $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
350 $error = $queue->insert($self->getfield('last'), $self->company);
352 $dbh->rollback if $oldAutoCommit;
353 return "queueing job (transaction rolled back): $error";
356 if ( defined $self->dbdef_table->column('ship_last') && $self->ship_last ) {
357 $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
358 $error = $queue->insert($self->getfield('last'), $self->company);
360 $dbh->rollback if $oldAutoCommit;
361 return "queueing job (transaction rolled back): $error";
365 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
370 =item delete NEW_CUSTNUM
372 This deletes the customer. If there is an error, returns the error, otherwise
375 This will completely remove all traces of the customer record. This is not
376 what you want when a customer cancels service; for that, cancel all of the
377 customer's packages (see L<FS::cust_pkg/cancel>).
379 If the customer has any uncancelled packages, you need to pass a new (valid)
380 customer number for those packages to be transferred to. Cancelled packages
381 will be deleted. Did I mention that this is NOT what you want when a customer
382 cancels service and that you really should be looking see L<FS::cust_pkg/cancel>?
384 You can't delete a customer with invoices (see L<FS::cust_bill>),
385 or credits (see L<FS::cust_credit>) or payments (see L<FS::cust_pay>).
392 local $SIG{HUP} = 'IGNORE';
393 local $SIG{INT} = 'IGNORE';
394 local $SIG{QUIT} = 'IGNORE';
395 local $SIG{TERM} = 'IGNORE';
396 local $SIG{TSTP} = 'IGNORE';
397 local $SIG{PIPE} = 'IGNORE';
399 my $oldAutoCommit = $FS::UID::AutoCommit;
400 local $FS::UID::AutoCommit = 0;
403 if ( qsearch( 'cust_bill', { 'custnum' => $self->custnum } ) ) {
404 $dbh->rollback if $oldAutoCommit;
405 return "Can't delete a customer with invoices";
407 if ( qsearch( 'cust_credit', { 'custnum' => $self->custnum } ) ) {
408 $dbh->rollback if $oldAutoCommit;
409 return "Can't delete a customer with credits";
411 if ( qsearch( 'cust_pay', { 'custnum' => $self->custnum } ) ) {
412 $dbh->rollback if $oldAutoCommit;
413 return "Can't delete a customer with payments";
416 my @cust_pkg = $self->ncancelled_pkgs;
418 my $new_custnum = shift;
419 unless ( qsearchs( 'cust_main', { 'custnum' => $new_custnum } ) ) {
420 $dbh->rollback if $oldAutoCommit;
421 return "Invalid new customer number: $new_custnum";
423 foreach my $cust_pkg ( @cust_pkg ) {
424 my %hash = $cust_pkg->hash;
425 $hash{'custnum'} = $new_custnum;
426 my $new_cust_pkg = new FS::cust_pkg ( \%hash );
427 my $error = $new_cust_pkg->replace($cust_pkg);
429 $dbh->rollback if $oldAutoCommit;
434 my @cancelled_cust_pkg = $self->all_pkgs;
435 foreach my $cust_pkg ( @cancelled_cust_pkg ) {
436 my $error = $cust_pkg->delete;
438 $dbh->rollback if $oldAutoCommit;
443 foreach my $cust_main_invoice (
444 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } )
446 my $error = $cust_main_invoice->delete;
448 $dbh->rollback if $oldAutoCommit;
453 my $error = $self->SUPER::delete;
455 $dbh->rollback if $oldAutoCommit;
459 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
464 =item replace OLD_RECORD [ INVOICING_LIST_ARYREF ]
466 Replaces the OLD_RECORD with this one in the database. If there is an error,
467 returns the error, otherwise returns false.
469 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
470 be set as the invoicing list (see L<"invoicing_list">). Errors return as
471 expected and rollback the entire transaction; it is not necessary to call
472 check_invoicing_list first. Here's an example:
474 $new_cust_main->replace( $old_cust_main, [ $email, 'POST' ] );
483 local $SIG{HUP} = 'IGNORE';
484 local $SIG{INT} = 'IGNORE';
485 local $SIG{QUIT} = 'IGNORE';
486 local $SIG{TERM} = 'IGNORE';
487 local $SIG{TSTP} = 'IGNORE';
488 local $SIG{PIPE} = 'IGNORE';
490 my $oldAutoCommit = $FS::UID::AutoCommit;
491 local $FS::UID::AutoCommit = 0;
494 my $error = $self->SUPER::replace($old);
497 $dbh->rollback if $oldAutoCommit;
501 if ( @param ) { # INVOICING_LIST_ARYREF
502 my $invoicing_list = shift @param;
503 $error = $self->check_invoicing_list( $invoicing_list );
505 $dbh->rollback if $oldAutoCommit;
508 $self->invoicing_list( $invoicing_list );
511 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
518 Checks all fields to make sure this is a valid customer record. If there is
519 an error, returns the error, otherwise returns false. Called by the insert
528 $self->ut_numbern('custnum')
529 || $self->ut_number('agentnum')
530 || $self->ut_number('refnum')
531 || $self->ut_name('last')
532 || $self->ut_name('first')
533 || $self->ut_textn('company')
534 || $self->ut_text('address1')
535 || $self->ut_textn('address2')
536 || $self->ut_text('city')
537 || $self->ut_textn('county')
538 || $self->ut_textn('state')
539 || $self->ut_country('country')
540 || $self->ut_anything('comments')
541 || $self->ut_numbern('referral_custnum')
543 #barf. need message catalogs. i18n. etc.
544 $error .= "Please select a referral."
545 if $error =~ /^Illegal or empty \(numeric\) refnum: /;
546 return $error if $error;
548 return "Unknown agent"
549 unless qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
551 return "Unknown referral"
552 unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } );
554 return "Unknown referring custnum ". $self->referral_custnum
555 unless ! $self->referral_custnum
556 || qsearchs( 'cust_main', { 'custnum' => $self->referral_custnum } );
558 if ( $self->ss eq '' ) {
563 $ss =~ /^(\d{3})(\d{2})(\d{4})$/
564 or return "Illegal social security number: ". $self->ss;
565 $self->ss("$1-$2-$3");
569 unless ( qsearchs('cust_main_county', {
570 'country' => $self->country,
573 return "Unknown state/county/country: ".
574 $self->state. "/". $self->county. "/". $self->country
575 unless qsearchs('cust_main_county',{
576 'state' => $self->state,
577 'county' => $self->county,
578 'country' => $self->country,
584 $self->ut_phonen('daytime', $self->country)
585 || $self->ut_phonen('night', $self->country)
586 || $self->ut_phonen('fax', $self->country)
587 || $self->ut_zip('zip', $self->country)
589 return $error if $error;
592 last first company address1 address2 city county state zip
593 country daytime night fax
596 if ( defined $self->dbdef_table->column('ship_last') ) {
597 if ( grep { $self->getfield($_) ne $self->getfield("ship_$_") } @addfields
598 && grep $self->getfield("ship_$_"), grep $_ ne 'state', @addfields
602 $self->ut_name('ship_last')
603 || $self->ut_name('ship_first')
604 || $self->ut_textn('ship_company')
605 || $self->ut_text('ship_address1')
606 || $self->ut_textn('ship_address2')
607 || $self->ut_text('ship_city')
608 || $self->ut_textn('ship_county')
609 || $self->ut_textn('ship_state')
610 || $self->ut_country('ship_country')
612 return $error if $error;
614 #false laziness with above
615 unless ( qsearchs('cust_main_county', {
616 'country' => $self->ship_country,
619 return "Unknown ship_state/ship_county/ship_country: ".
620 $self->ship_state. "/". $self->ship_county. "/". $self->ship_country
621 unless qsearchs('cust_main_county',{
622 'state' => $self->ship_state,
623 'county' => $self->ship_county,
624 'country' => $self->ship_country,
630 $self->ut_phonen('ship_daytime', $self->ship_country)
631 || $self->ut_phonen('ship_night', $self->ship_country)
632 || $self->ut_phonen('ship_fax', $self->ship_country)
633 || $self->ut_zip('ship_zip', $self->ship_country)
635 return $error if $error;
637 } else { # ship_ info eq billing info, so don't store dup info in database
638 $self->setfield("ship_$_", '')
639 foreach qw( last first company address1 address2 city county state zip
640 country daytime night fax );
644 $self->payby =~ /^(CARD|BILL|COMP|PREPAY)$/
645 or return "Illegal payby: ". $self->payby;
648 if ( $self->payby eq 'CARD' ) {
650 my $payinfo = $self->payinfo;
652 $payinfo =~ /^(\d{13,16})$/
653 or return "Illegal credit card number: ". $self->payinfo;
655 $self->payinfo($payinfo);
657 or return "Illegal credit card number: ". $self->payinfo;
658 return "Unknown card type" if cardtype($self->payinfo) eq "Unknown";
660 } elsif ( $self->payby eq 'BILL' ) {
662 $error = $self->ut_textn('payinfo');
663 return "Illegal P.O. number: ". $self->payinfo if $error;
665 } elsif ( $self->payby eq 'COMP' ) {
667 $error = $self->ut_textn('payinfo');
668 return "Illegal comp account issuer: ". $self->payinfo if $error;
670 } elsif ( $self->payby eq 'PREPAY' ) {
672 my $payinfo = $self->payinfo;
673 $payinfo =~ s/\W//g; #anything else would just confuse things
674 $self->payinfo($payinfo);
675 $error = $self->ut_alpha('payinfo');
676 return "Illegal prepayment identifier: ". $self->payinfo if $error;
677 return "Unknown prepayment identifier"
678 unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } );
682 if ( $self->paydate eq '' || $self->paydate eq '-' ) {
683 return "Expriation date required"
684 unless $self->payby eq 'BILL' || $self->payby eq 'PREPAY';
687 $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/
688 or return "Illegal expiration date: ". $self->paydate;
689 if ( length($2) == 4 ) {
690 $self->paydate("$2-$1-01");
692 $self->paydate("20$2-$1-01");
696 if ( $self->payname eq '' ) {
697 $self->payname( $self->first. " ". $self->getfield('last') );
699 $self->payname =~ /^([\w \,\.\-\']+)$/
700 or return "Illegal billing name: ". $self->payname;
704 $self->tax =~ /^(Y?)$/ or return "Illegal tax: ". $self->tax;
707 $self->otaker(getotaker);
714 Returns all packages (see L<FS::cust_pkg>) for this customer.
720 if ( $self->{'_pkgnum'} ) {
721 values %{ $self->{'_pkgnum'}->cache };
723 qsearch( 'cust_pkg', { 'custnum' => $self->custnum });
727 =item ncancelled_pkgs
729 Returns all non-cancelled packages (see L<FS::cust_pkg>) for this customer.
733 sub ncancelled_pkgs {
735 if ( $self->{'_pkgnum'} ) {
736 grep { ! $_->getfield('cancel') } values %{ $self->{'_pkgnum'}->cache };
738 @{ [ # force list context
739 qsearch( 'cust_pkg', {
740 'custnum' => $self->custnum,
743 qsearch( 'cust_pkg', {
744 'custnum' => $self->custnum,
753 Returns all suspended packages (see L<FS::cust_pkg>) for this customer.
759 grep { $_->susp } $self->ncancelled_pkgs;
762 =item unflagged_suspended_pkgs
764 Returns all unflagged suspended packages (see L<FS::cust_pkg>) for this
765 customer (thouse packages without the `manual_flag' set).
769 sub unflagged_suspended_pkgs {
771 return $self->suspended_pkgs
772 unless dbdef->table('cust_pkg')->column('manual_flag');
773 grep { ! $_->manual_flag } $self->suspended_pkgs;
776 =item unsuspended_pkgs
778 Returns all unsuspended (and uncancelled) packages (see L<FS::cust_pkg>) for
783 sub unsuspended_pkgs {
785 grep { ! $_->susp } $self->ncancelled_pkgs;
790 Unsuspends all unflagged suspended packages (see L</unflagged_suspended_pkgs>
791 and L<FS::cust_pkg>) for this customer. Always returns a list: an empty list
792 on success or a list of errors.
798 grep { $_->unsuspend } $self->suspended_pkgs;
803 Suspends all unsuspended packages (see L<FS::cust_pkg>) for this customer.
804 Always returns a list: an empty list on success or a list of errors.
810 grep { $_->suspend } $self->unsuspended_pkgs;
815 Generates invoices (see L<FS::cust_bill>) for this customer. Usually used in
816 conjunction with the collect method.
818 Options are passed as name-value pairs.
820 The only currently available option is `time', which bills the customer as if
821 it were that time. It is specified as a UNIX timestamp; see
822 L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion
823 functions. For example:
827 $cust_main->bill( 'time' => str2time('April 20th, 2001') );
829 If there is an error, returns the error, otherwise returns false.
834 my( $self, %options ) = @_;
835 my $time = $options{'time'} || time;
840 local $SIG{HUP} = 'IGNORE';
841 local $SIG{INT} = 'IGNORE';
842 local $SIG{QUIT} = 'IGNORE';
843 local $SIG{TERM} = 'IGNORE';
844 local $SIG{TSTP} = 'IGNORE';
845 local $SIG{PIPE} = 'IGNORE';
847 my $oldAutoCommit = $FS::UID::AutoCommit;
848 local $FS::UID::AutoCommit = 0;
851 # find the packages which are due for billing, find out how much they are
852 # & generate invoice database.
854 my( $total_setup, $total_recur ) = ( 0, 0 );
855 my( $taxable_setup, $taxable_recur ) = ( 0, 0 );
856 my @cust_bill_pkg = ();
858 foreach my $cust_pkg (
859 qsearch('cust_pkg', { 'custnum' => $self->custnum } )
862 #NO!! next if $cust_pkg->cancel;
863 next if $cust_pkg->getfield('cancel');
865 #? to avoid use of uninitialized value errors... ?
866 $cust_pkg->setfield('bill', '')
867 unless defined($cust_pkg->bill);
869 my $part_pkg = qsearchs( 'part_pkg', { 'pkgpart' => $cust_pkg->pkgpart } );
871 #so we don't modify cust_pkg record unnecessarily
872 my $cust_pkg_mod_flag = 0;
873 my %hash = $cust_pkg->hash;
874 my $old_cust_pkg = new FS::cust_pkg \%hash;
878 unless ( $cust_pkg->setup ) {
879 my $setup_prog = $part_pkg->getfield('setup');
880 $setup_prog =~ /^(.*)$/ or do {
881 $dbh->rollback if $oldAutoCommit;
882 return "Illegal setup for pkgpart ". $part_pkg->pkgpart.
888 ##$cpt->permit(); #what is necessary?
889 #$cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
890 #$setup = $cpt->reval($setup_prog);
891 $setup = eval $setup_prog;
892 unless ( defined($setup) ) {
893 $dbh->rollback if $oldAutoCommit;
894 return "Error eval-ing part_pkg->setup pkgpart ". $part_pkg->pkgpart.
895 "(expression $setup_prog): $@";
897 $cust_pkg->setfield('setup',$time);
898 $cust_pkg_mod_flag=1;
904 if ( $part_pkg->getfield('freq') > 0 &&
905 ! $cust_pkg->getfield('susp') &&
906 ( $cust_pkg->getfield('bill') || 0 ) < $time
908 my $recur_prog = $part_pkg->getfield('recur');
909 $recur_prog =~ /^(.*)$/ or do {
910 $dbh->rollback if $oldAutoCommit;
911 return "Illegal recur for pkgpart ". $part_pkg->pkgpart.
917 ##$cpt->permit(); #what is necessary?
918 #$cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
919 #$recur = $cpt->reval($recur_prog);
920 $recur = eval $recur_prog;
921 unless ( defined($recur) ) {
922 $dbh->rollback if $oldAutoCommit;
923 return "Error eval-ing part_pkg->recur pkgpart ". $part_pkg->pkgpart.
924 "(expression $recur_prog): $@";
926 #change this bit to use Date::Manip? CAREFUL with timezones (see
927 # mailing list archive)
928 #$sdate=$cust_pkg->bill || time;
929 #$sdate=$cust_pkg->bill || $time;
930 $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
931 my ($sec,$min,$hour,$mday,$mon,$year) =
932 (localtime($sdate) )[0,1,2,3,4,5];
933 $mon += $part_pkg->getfield('freq');
934 until ( $mon < 12 ) { $mon -= 12; $year++; }
935 $cust_pkg->setfield('bill',
936 timelocal($sec,$min,$hour,$mday,$mon,$year));
937 $cust_pkg_mod_flag = 1;
940 warn "\$setup is undefined" unless defined($setup);
941 warn "\$recur is undefined" unless defined($recur);
942 warn "\$cust_pkg->bill is undefined" unless defined($cust_pkg->bill);
944 if ( $cust_pkg_mod_flag ) {
945 $error=$cust_pkg->replace($old_cust_pkg);
946 if ( $error ) { #just in case
947 $dbh->rollback if $oldAutoCommit;
948 return "Error modifying pkgnum ". $cust_pkg->pkgnum. ": $error";
950 $setup = sprintf( "%.2f", $setup );
951 $recur = sprintf( "%.2f", $recur );
953 $dbh->rollback if $oldAutoCommit;
954 return "negative setup $setup for pkgnum ". $cust_pkg->pkgnum;
957 $dbh->rollback if $oldAutoCommit;
958 return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum;
960 if ( $setup > 0 || $recur > 0 ) {
961 my $cust_bill_pkg = new FS::cust_bill_pkg ({
962 'pkgnum' => $cust_pkg->pkgnum,
966 'edate' => $cust_pkg->bill,
968 push @cust_bill_pkg, $cust_bill_pkg;
969 $total_setup += $setup;
970 $total_recur += $recur;
971 $taxable_setup += $setup
972 unless $part_pkg->dbdef_table->column('setuptax')
973 || $part_pkg->setuptax =~ /^Y$/i;
974 $taxable_recur += $recur
975 unless $part_pkg->dbdef_table->column('recurtax')
976 || $part_pkg->recurtax =~ /^Y$/i;
982 my $charged = sprintf( "%.2f", $total_setup + $total_recur );
983 my $taxable_charged = sprintf( "%.2f", $taxable_setup + $taxable_recur );
985 unless ( @cust_bill_pkg ) {
986 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
990 unless ( $self->tax =~ /Y/i
991 || $self->payby eq 'COMP'
992 || $taxable_charged == 0 ) {
993 my $cust_main_county = qsearchs('cust_main_county',{
994 'state' => $self->state,
995 'county' => $self->county,
996 'country' => $self->country,
998 my $tax = sprintf( "%.2f",
999 $taxable_charged * ( $cust_main_county->getfield('tax') / 100 )
1003 $charged = sprintf( "%.2f", $charged+$tax );
1005 my $cust_bill_pkg = new FS::cust_bill_pkg ({
1012 push @cust_bill_pkg, $cust_bill_pkg;
1016 my $cust_bill = new FS::cust_bill ( {
1017 'custnum' => $self->custnum,
1019 'charged' => $charged,
1021 $error = $cust_bill->insert;
1023 $dbh->rollback if $oldAutoCommit;
1024 return "can't create invoice for customer #". $self->custnum. ": $error";
1027 my $invnum = $cust_bill->invnum;
1029 foreach $cust_bill_pkg ( @cust_bill_pkg ) {
1031 $cust_bill_pkg->invnum($invnum);
1032 $error = $cust_bill_pkg->insert;
1034 $dbh->rollback if $oldAutoCommit;
1035 return "can't create invoice line item for customer #". $self->custnum.
1040 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1044 =item collect OPTIONS
1046 (Attempt to) collect money for this customer's outstanding invoices (see
1047 L<FS::cust_bill>). Usually used after the bill method.
1049 Depending on the value of `payby', this may print an invoice (`BILL'), charge
1050 a credit card (`CARD'), or just add any necessary (pseudo-)payment (`COMP').
1052 If there is an error, returns the error, otherwise returns false.
1054 Options are passed as name-value pairs.
1056 Currently available options are:
1058 invoice_time - Use this time when deciding when to print invoices and
1059 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>
1060 for conversion functions.
1062 batch_card - Set this true to batch cards (see L<FS::cust_pay_batch>). By
1063 default, cards are processed immediately, which will generate an error if
1064 CyberCash is not installed.
1066 report_badcard - Set this true if you want bad card transactions to
1067 return an error. By default, they don't.
1072 my( $self, %options ) = @_;
1073 my $invoice_time = $options{'invoice_time'} || time;
1076 local $SIG{HUP} = 'IGNORE';
1077 local $SIG{INT} = 'IGNORE';
1078 local $SIG{QUIT} = 'IGNORE';
1079 local $SIG{TERM} = 'IGNORE';
1080 local $SIG{TSTP} = 'IGNORE';
1081 local $SIG{PIPE} = 'IGNORE';
1083 my $oldAutoCommit = $FS::UID::AutoCommit;
1084 local $FS::UID::AutoCommit = 0;
1087 my $balance = $self->balance;
1088 warn "collect: balance $balance" if $Debug;
1089 unless ( $balance > 0 ) { #redundant?????
1090 $dbh->rollback if $oldAutoCommit; #hmm
1094 foreach my $cust_bill (
1095 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
1098 #this has to be before next's
1099 my $amount = sprintf( "%.2f", $balance < $cust_bill->owed
1103 $balance = sprintf( "%.2f", $balance - $amount );
1105 next unless $cust_bill->owed > 0;
1107 # don't try to charge for the same invoice if it's already in a batch
1108 next if qsearchs( 'cust_pay_batch', { 'invnum' => $cust_bill->invnum } );
1110 warn "invnum ". $cust_bill->invnum. " (owed ". $cust_bill->owed. ", amount $amount, balance $balance)" if $Debug;
1112 next unless $amount > 0;
1114 if ( $self->payby eq 'BILL' ) {
1117 my $since = $invoice_time - ( $cust_bill->_date || 0 );
1118 #warn "$invoice_time ", $cust_bill->_date, " $since";
1119 if ( $since >= 0 #don't print future invoices
1120 && ( $cust_bill->printed * 2592000 ) <= $since
1123 #my @print_text = $cust_bill->print_text; #( date )
1124 my @invoicing_list = $self->invoicing_list;
1125 if ( grep { $_ ne 'POST' } @invoicing_list ) { #email invoice
1126 $ENV{SMTPHOSTS} = $smtpmachine;
1127 $ENV{MAILADDRESS} = $invoice_from;
1128 my $header = new Mail::Header ( [
1129 "From: $invoice_from",
1130 "To: ". join(', ', grep { $_ ne 'POST' } @invoicing_list ),
1131 "Sender: $invoice_from",
1132 "Reply-To: $invoice_from",
1133 "Date: ". time2str("%a, %d %b %Y %X %z", time),
1136 my $message = new Mail::Internet (
1137 'Header' => $header,
1138 'Body' => [ $cust_bill->print_text ], #( date)
1140 $message->smtpsend or die "Can't send invoice email!"; #die? warn?
1142 } elsif ( ! @invoicing_list || grep { $_ eq 'POST' } @invoicing_list ) {
1143 open(LPR, "|$lpr") or die "Can't open pipe to $lpr: $!";
1144 print LPR $cust_bill->print_text; #( date )
1146 or die $! ? "Error closing $lpr: $!"
1147 : "Exit status $? from $lpr";
1150 my %hash = $cust_bill->hash;
1152 my $new_cust_bill = new FS::cust_bill(\%hash);
1153 my $error = $new_cust_bill->replace($cust_bill);
1154 warn "Error updating $cust_bill->printed: $error" if $error;
1158 } elsif ( $self->payby eq 'COMP' ) {
1159 my $cust_pay = new FS::cust_pay ( {
1160 'invnum' => $cust_bill->invnum,
1164 'payinfo' => $self->payinfo,
1167 my $error = $cust_pay->insert;
1169 $dbh->rollback if $oldAutoCommit;
1170 return 'Error COMPing invnum #'. $cust_bill->invnum. ": $error";
1174 } elsif ( $self->payby eq 'CARD' ) {
1176 if ( $options{'batch_card'} ne 'yes' ) {
1178 unless ( $processor ) {
1179 $dbh->rollback if $oldAutoCommit;
1180 return "Real time card processing not enabled!";
1183 my $address = $self->address1;
1184 $address .= ", ". $self->address2 if $self->address2;
1187 #$self->paydate =~ /^(\d+)\/\d*(\d{2})$/;
1188 $self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
1191 if ( $processor eq 'cybercash3.2' ) {
1193 #fix exp. date for cybercash
1194 #$self->paydate =~ /^(\d+)\/\d*(\d{2})$/;
1195 $self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
1198 my $paybatch = $cust_bill->invnum.
1199 '-' . time2str("%y%m%d%H%M%S", time);
1201 my $payname = $self->payname ||
1202 $self->getfield('first'). ' '. $self->getfield('last');
1205 my $country = $self->country eq 'US' ? 'USA' : $self->country;
1207 my @full_xaction = ( $xaction,
1208 'Order-ID' => $paybatch,
1209 'Amount' => "usd $amount",
1210 'Card-Number' => $self->getfield('payinfo'),
1211 'Card-Name' => $payname,
1212 'Card-Address' => $address,
1213 'Card-City' => $self->getfield('city'),
1214 'Card-State' => $self->getfield('state'),
1215 'Card-Zip' => $self->getfield('zip'),
1216 'Card-Country' => $country,
1221 %result = &CCMckDirectLib3_2::SendCC2_1Server(@full_xaction);
1223 #if ( $result{'MActionCode'} == 7 ) { #cybercash smps v.1.1.3
1224 #if ( $result{'action-code'} == 7 ) { #cybercash smps v.2.1
1225 if ( $result{'MStatus'} eq 'success' ) { #cybercash smps v.2 or 3
1226 my $cust_pay = new FS::cust_pay ( {
1227 'invnum' => $cust_bill->invnum,
1231 'payinfo' => $self->payinfo,
1232 'paybatch' => "$processor:$paybatch",
1234 my $error = $cust_pay->insert;
1236 # gah, even with transactions.
1237 $dbh->commit if $oldAutoCommit; #well.
1238 my $e = 'WARNING: Card debited but database not updated - '.
1239 'error applying payment, invnum #' . $cust_bill->invnum.
1240 " (CyberCash Order-ID $paybatch): $error";
1244 } elsif ( $result{'Mstatus'} ne 'failure-bad-money'
1245 || $options{'report_badcard'} ) {
1246 $dbh->commit if $oldAutoCommit;
1247 return 'Cybercash error, invnum #' .
1248 $cust_bill->invnum. ':'. $result{'MErrMsg'};
1250 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1254 } elsif ( $processor =~ /^Business::OnlinePayment::(.*)$/ ) {
1256 my $bop_processor = $1;
1258 my($payname, $payfirst, $paylast);
1259 if ( $self->payname ) {
1260 $payname = $self->payname;
1261 $payname =~ /^\s*([\w \,\.\-\']*\w)?\s+([\w\,\.\-\']+)$/
1263 $dbh->rollback if $oldAutoCommit;
1264 return "Illegal payname $payname";
1266 ($payfirst, $paylast) = ($1, $2);
1268 $payfirst = $self->getfield('first');
1269 $paylast = $self->getfield('first');
1270 $payname = "$payfirst $paylast";
1273 my @invoicing_list = grep { $_ ne 'POST' } $self->invoicing_list;
1274 if ( $conf->exists('emailinvoiceauto')
1275 || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
1276 push @invoicing_list, $self->default_invoicing_list;
1278 my $email = $invoicing_list[0];
1280 my( $action1, $action2 ) = split(/\s*\,\s*/, $bop_action );
1283 new Business::OnlinePayment( $bop_processor, @bop_options );
1284 $transaction->content(
1286 'login' => $bop_login,
1287 'password' => $bop_password,
1288 'action' => $action1,
1289 'description' => 'Internet Services',
1290 'amount' => $amount,
1291 'invoice_number' => $cust_bill->invnum,
1292 'customer_id' => $self->custnum,
1293 'last_name' => $paylast,
1294 'first_name' => $payfirst,
1296 'address' => $address,
1297 'city' => $self->city,
1298 'state' => $self->state,
1299 'zip' => $self->zip,
1300 'country' => $self->country,
1301 'card_number' => $self->payinfo,
1302 'expiration' => $exp,
1303 'referer' => 'http://cleanwhisker.420.am/',
1306 $transaction->submit();
1308 if ( $transaction->is_success() && $action2 ) {
1309 my $auth = $transaction->authorization;
1310 my $ordernum = $transaction->order_number;
1311 #warn "********* $auth ***********\n";
1312 #warn "********* $ordernum ***********\n";
1314 new Business::OnlinePayment( $bop_processor, @bop_options );
1318 login => $bop_login,
1319 password => $bop_password,
1320 order_number => $ordernum,
1322 authorization => $auth,
1323 description => 'Internet Services',
1328 unless ( $capture->is_success ) {
1329 my $e = "Authorization sucessful but capture failed, invnum #".
1330 $cust_bill->invnum. ': '. $capture->result_code.
1331 ": ". $capture->error_message;
1338 if ( $transaction->is_success() ) {
1340 my $cust_pay = new FS::cust_pay ( {
1341 'invnum' => $cust_bill->invnum,
1345 'payinfo' => $self->payinfo,
1346 'paybatch' => "$processor:". $transaction->authorization,
1348 my $error = $cust_pay->insert;
1350 # gah, even with transactions.
1351 $dbh->commit if $oldAutoCommit; #well.
1352 my $e = 'WARNING: Card debited but database not updated - '.
1353 'error applying payment, invnum #' . $cust_bill->invnum.
1354 " ($processor): $error";
1358 } elsif ( $options{'report_badcard'} ) {
1359 $dbh->commit if $oldAutoCommit;
1360 return "$processor error, invnum #". $cust_bill->invnum. ': '.
1361 $transaction->result_code. ": ". $transaction->error_message;
1363 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1368 $dbh->rollback if $oldAutoCommit;
1369 return "Unknown real-time processor $processor\n";
1372 } else { #batch card
1374 my $cust_pay_batch = new FS::cust_pay_batch ( {
1375 'invnum' => $cust_bill->getfield('invnum'),
1376 'custnum' => $self->getfield('custnum'),
1377 'last' => $self->getfield('last'),
1378 'first' => $self->getfield('first'),
1379 'address1' => $self->getfield('address1'),
1380 'address2' => $self->getfield('address2'),
1381 'city' => $self->getfield('city'),
1382 'state' => $self->getfield('state'),
1383 'zip' => $self->getfield('zip'),
1384 'country' => $self->getfield('country'),
1386 'cardnum' => $self->getfield('payinfo'),
1387 'exp' => $self->getfield('paydate'),
1388 'payname' => $self->getfield('payname'),
1389 'amount' => $amount,
1391 my $error = $cust_pay_batch->insert;
1393 $dbh->rollback if $oldAutoCommit;
1394 return "Error adding to cust_pay_batch: $error";
1400 $dbh->rollback if $oldAutoCommit;
1401 return "Unknown payment type ". $self->payby;
1405 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1412 Returns the total owed for this customer on all invoices
1413 (see L<FS::cust_bill/owed>).
1420 foreach my $cust_bill ( qsearch('cust_bill', {
1421 'custnum' => $self->custnum,
1423 $total_bill += $cust_bill->owed;
1425 sprintf( "%.2f", $total_bill );
1430 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
1431 to outstanding invoice balances in chronological order and returns the value
1432 of any remaining unapplied credits available for refund
1433 (see L<FS::cust_refund>).
1440 return 0 unless $self->total_credited;
1442 my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
1443 qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
1445 my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
1446 qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
1450 foreach my $cust_bill ( @invoices ) {
1453 if ( !defined($credit) || $credit->credited == 0) {
1454 $credit = pop @credits or last;
1457 if ($cust_bill->owed >= $credit->credited) {
1458 $amount=$credit->credited;
1460 $amount=$cust_bill->owed;
1463 my $cust_credit_bill = new FS::cust_credit_bill ( {
1464 'crednum' => $credit->crednum,
1465 'invnum' => $cust_bill->invnum,
1466 'amount' => $amount,
1468 my $error = $cust_credit_bill->insert;
1469 die $error if $error;
1471 redo if ($cust_bill->owed > 0);
1475 return $self->total_credited;
1478 =item apply_payments
1480 Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
1481 to outstanding invoice balances in chronological order.
1483 #and returns the value of any remaining unapplied payments.
1487 sub apply_payments {
1492 my @payments = sort { $b->_date <=> $a->_date } ( grep { $_->unapplied > 0 }
1493 qsearch('cust_pay', { 'custnum' => $self->custnum } ) );
1495 my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
1496 qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
1500 foreach my $cust_bill ( @invoices ) {
1503 if ( !defined($payment) || $payment->unapplied == 0 ) {
1504 $payment = pop @payments or last;
1507 if ( $cust_bill->owed >= $payment->unapplied ) {
1508 $amount = $payment->unapplied;
1510 $amount = $cust_bill->owed;
1513 my $cust_bill_pay = new FS::cust_bill_pay ( {
1514 'paynum' => $payment->paynum,
1515 'invnum' => $cust_bill->invnum,
1516 'amount' => $amount,
1518 my $error = $cust_bill_pay->insert;
1519 die $error if $error;
1521 redo if ( $cust_bill->owed > 0);
1525 return $self->total_unapplied_payments;
1528 =item total_credited
1530 Returns the total outstanding credit (see L<FS::cust_credit>) for this
1531 customer. See L<FS::cust_credit/credited>.
1535 sub total_credited {
1537 my $total_credit = 0;
1538 foreach my $cust_credit ( qsearch('cust_credit', {
1539 'custnum' => $self->custnum,
1541 $total_credit += $cust_credit->credited;
1543 sprintf( "%.2f", $total_credit );
1546 =item total_unapplied_payments
1548 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
1549 See L<FS::cust_pay/unapplied>.
1553 sub total_unapplied_payments {
1555 my $total_unapplied = 0;
1556 foreach my $cust_pay ( qsearch('cust_pay', {
1557 'custnum' => $self->custnum,
1559 $total_unapplied += $cust_pay->unapplied;
1561 sprintf( "%.2f", $total_unapplied );
1566 Returns the balance for this customer (total_owed minus total_credited
1567 minus total_unapplied_payments).
1574 $self->total_owed - $self->total_credited - $self->total_unapplied_payments
1578 =item invoicing_list [ ARRAYREF ]
1580 If an arguement is given, sets these email addresses as invoice recipients
1581 (see L<FS::cust_main_invoice>). Errors are not fatal and are not reported
1582 (except as warnings), so use check_invoicing_list first.
1584 Returns a list of email addresses (with svcnum entries expanded).
1586 Note: You can clear the invoicing list by passing an empty ARRAYREF. You can
1587 check it without disturbing anything by passing nothing.
1589 This interface may change in the future.
1593 sub invoicing_list {
1594 my( $self, $arrayref ) = @_;
1596 my @cust_main_invoice;
1597 if ( $self->custnum ) {
1598 @cust_main_invoice =
1599 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1601 @cust_main_invoice = ();
1603 foreach my $cust_main_invoice ( @cust_main_invoice ) {
1604 #warn $cust_main_invoice->destnum;
1605 unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
1606 #warn $cust_main_invoice->destnum;
1607 my $error = $cust_main_invoice->delete;
1608 warn $error if $error;
1611 if ( $self->custnum ) {
1612 @cust_main_invoice =
1613 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1615 @cust_main_invoice = ();
1617 my %seen = map { $_->address => 1 } @cust_main_invoice;
1618 foreach my $address ( @{$arrayref} ) {
1619 #unless ( grep { $address eq $_->address } @cust_main_invoice ) {
1620 next if exists $seen{$address} && $seen{$address};
1621 $seen{$address} = 1;
1622 my $cust_main_invoice = new FS::cust_main_invoice ( {
1623 'custnum' => $self->custnum,
1626 my $error = $cust_main_invoice->insert;
1627 warn $error if $error;
1630 if ( $self->custnum ) {
1632 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1638 =item check_invoicing_list ARRAYREF
1640 Checks these arguements as valid input for the invoicing_list method. If there
1641 is an error, returns the error, otherwise returns false.
1645 sub check_invoicing_list {
1646 my( $self, $arrayref ) = @_;
1647 foreach my $address ( @{$arrayref} ) {
1648 my $cust_main_invoice = new FS::cust_main_invoice ( {
1649 'custnum' => $self->custnum,
1652 my $error = $self->custnum
1653 ? $cust_main_invoice->check
1654 : $cust_main_invoice->checkdest
1656 return $error if $error;
1661 =item default_invoicing_list
1663 Returns the email addresses of any
1667 sub default_invoicing_list {
1670 foreach my $cust_pkg ( $self->all_pkgs ) {
1671 my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
1673 map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
1674 grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
1676 push @list, map { $_->email } @svc_acct;
1678 $self->invoicing_list(\@list);
1681 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
1683 Returns an array of customers referred by this customer (referral_custnum set
1684 to this custnum). If DEPTH is given, recurses up to the given depth, returning
1685 customers referred by customers referred by this customer and so on, inclusive.
1686 The default behavior is DEPTH 1 (no recursion).
1690 sub referral_cust_main {
1692 my $depth = @_ ? shift : 1;
1693 my $exclude = @_ ? shift : {};
1696 map { $exclude->{$_->custnum}++; $_; }
1697 grep { ! $exclude->{ $_->custnum } }
1698 qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
1702 map { $_->referral_cust_main($depth-1, $exclude) }
1709 =item referral_cust_pkg [ DEPTH ]
1711 Like referral_cust_main, except returns a flat list of all unsuspended packages
1712 for each customer. The number of items in this list may be useful for
1713 comission calculations (perhaps after a grep).
1717 sub referral_cust_pkg {
1719 my $depth = @_ ? shift : 1;
1721 map { $_->unsuspended_pkgs }
1722 grep { $_->unsuspended_pkgs }
1723 $self->referral_cust_main($depth);
1726 =item credit AMOUNT, REASON
1728 Applies a credit to this customer. If there is an error, returns the error,
1729 otherwise returns false.
1734 my( $self, $amount, $reason ) = @_;
1735 my $cust_credit = new FS::cust_credit {
1736 'custnum' => $self->custnum,
1737 'amount' => $amount,
1738 'reason' => $reason,
1740 $cust_credit->insert;
1749 =item check_and_rebuild_fuzzyfiles
1753 sub check_and_rebuild_fuzzyfiles {
1754 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1755 -e "$dir/cust_main.last" && -e "$dir/cust_main.company"
1756 or &rebuild_fuzzyfiles;
1759 =item rebuild_fuzzyfiles
1763 sub rebuild_fuzzyfiles {
1765 use Fcntl qw(:flock);
1767 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1771 open(LASTLOCK,">>$dir/cust_main.last")
1772 or die "can't open $dir/cust_main.last: $!";
1773 flock(LASTLOCK,LOCK_EX)
1774 or die "can't lock $dir/cust_main.last: $!";
1776 my @all_last = map $_->getfield('last'), qsearch('cust_main', {});
1778 grep $_, map $_->getfield('ship_last'), qsearch('cust_main',{})
1779 if defined dbdef->table('cust_main')->column('ship_last');
1781 open (LASTCACHE,">$dir/cust_main.last.tmp")
1782 or die "can't open $dir/cust_main.last.tmp: $!";
1783 print LASTCACHE join("\n", @all_last), "\n";
1784 close LASTCACHE or die "can't close $dir/cust_main.last.tmp: $!";
1786 rename "$dir/cust_main.last.tmp", "$dir/cust_main.last";
1791 open(COMPANYLOCK,">>$dir/cust_main.company")
1792 or die "can't open $dir/cust_main.company: $!";
1793 flock(COMPANYLOCK,LOCK_EX)
1794 or die "can't lock $dir/cust_main.company: $!";
1796 my @all_company = grep $_ ne '', map $_->company, qsearch('cust_main',{});
1798 grep $_ ne '', map $_->ship_company, qsearch('cust_main', {})
1799 if defined dbdef->table('cust_main')->column('ship_last');
1801 open (COMPANYCACHE,">$dir/cust_main.company.tmp")
1802 or die "can't open $dir/cust_main.company.tmp: $!";
1803 print COMPANYCACHE join("\n", @all_company), "\n";
1804 close COMPANYCACHE or die "can't close $dir/cust_main.company.tmp: $!";
1806 rename "$dir/cust_main.company.tmp", "$dir/cust_main.company";
1816 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1817 open(LASTCACHE,"<$dir/cust_main.last")
1818 or die "can't open $dir/cust_main.last: $!";
1819 my @array = map { chomp; $_; } <LASTCACHE>;
1829 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1830 open(COMPANYCACHE,"<$dir/cust_main.company")
1831 or die "can't open $dir/cust_main.last: $!";
1832 my @array = map { chomp; $_; } <COMPANYCACHE>;
1837 =item append_fuzzyfiles LASTNAME COMPANY
1841 sub append_fuzzyfiles {
1842 my( $last, $company ) = @_;
1844 &check_and_rebuild_fuzzyfiles;
1846 use Fcntl qw(:flock);
1848 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1852 open(LAST,">>$dir/cust_main.last")
1853 or die "can't open $dir/cust_main.last: $!";
1855 or die "can't lock $dir/cust_main.last: $!";
1857 print LAST "$last\n";
1860 or die "can't unlock $dir/cust_main.last: $!";
1866 open(COMPANY,">>$dir/cust_main.company")
1867 or die "can't open $dir/cust_main.company: $!";
1868 flock(COMPANY,LOCK_EX)
1869 or die "can't lock $dir/cust_main.company: $!";
1871 print COMPANY "$company\n";
1873 flock(COMPANY,LOCK_UN)
1874 or die "can't unlock $dir/cust_main.company: $!";
1884 $Id: cust_main.pm,v 1.50 2001-12-16 23:50:10 ivan Exp $
1890 The delete method should possibly take an FS::cust_main object reference
1891 instead of a scalar customer number.
1893 Bill and collect options should probably be passed as references instead of a
1896 CyberCash v2 forces us to define some variables in package main.
1898 There should probably be a configuration file with a list of allowed credit
1901 No multiple currency support (probably a larger project than just this module).
1905 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
1906 L<FS::cust_pay_batch>, L<FS::agent>, L<FS::part_referral>,
1907 L<FS::cust_main_county>, L<FS::cust_main_invoice>,
1908 L<FS::UID>, schema.html from the base documentation.