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->getfield('custnum') } )
862 next if $cust_pkg->getfield('cancel');
864 #? to avoid use of uninitialized value errors... ?
865 $cust_pkg->setfield('bill', '')
866 unless defined($cust_pkg->bill);
868 my $part_pkg = qsearchs( 'part_pkg', { 'pkgpart' => $cust_pkg->pkgpart } );
870 #so we don't modify cust_pkg record unnecessarily
871 my $cust_pkg_mod_flag = 0;
872 my %hash = $cust_pkg->hash;
873 my $old_cust_pkg = new FS::cust_pkg \%hash;
877 unless ( $cust_pkg->setup ) {
878 my $setup_prog = $part_pkg->getfield('setup');
879 $setup_prog =~ /^(.*)$/ or do {
880 $dbh->rollback if $oldAutoCommit;
881 return "Illegal setup for pkgpart ". $part_pkg->pkgpart.
887 ##$cpt->permit(); #what is necessary?
888 #$cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
889 #$setup = $cpt->reval($setup_prog);
890 $setup = eval $setup_prog;
891 unless ( defined($setup) ) {
892 $dbh->rollback if $oldAutoCommit;
893 return "Error eval-ing part_pkg->setup pkgpart ". $part_pkg->pkgpart.
894 "(expression $setup_prog): $@";
896 $cust_pkg->setfield('setup',$time);
897 $cust_pkg_mod_flag=1;
903 if ( $part_pkg->getfield('freq') > 0 &&
904 ! $cust_pkg->getfield('susp') &&
905 ( $cust_pkg->getfield('bill') || 0 ) < $time
907 my $recur_prog = $part_pkg->getfield('recur');
908 $recur_prog =~ /^(.*)$/ or do {
909 $dbh->rollback if $oldAutoCommit;
910 return "Illegal recur for pkgpart ". $part_pkg->pkgpart.
916 ##$cpt->permit(); #what is necessary?
917 #$cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
918 #$recur = $cpt->reval($recur_prog);
919 $recur = eval $recur_prog;
920 unless ( defined($recur) ) {
921 $dbh->rollback if $oldAutoCommit;
922 return "Error eval-ing part_pkg->recur pkgpart ". $part_pkg->pkgpart.
923 "(expression $recur_prog): $@";
925 #change this bit to use Date::Manip? CAREFUL with timezones (see
926 # mailing list archive)
927 #$sdate=$cust_pkg->bill || time;
928 #$sdate=$cust_pkg->bill || $time;
929 $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
930 my ($sec,$min,$hour,$mday,$mon,$year) =
931 (localtime($sdate) )[0,1,2,3,4,5];
932 $mon += $part_pkg->getfield('freq');
933 until ( $mon < 12 ) { $mon -= 12; $year++; }
934 $cust_pkg->setfield('bill',
935 timelocal($sec,$min,$hour,$mday,$mon,$year));
936 $cust_pkg_mod_flag = 1;
939 warn "\$setup is undefined" unless defined($setup);
940 warn "\$recur is undefined" unless defined($recur);
941 warn "\$cust_pkg->bill is undefined" unless defined($cust_pkg->bill);
943 if ( $cust_pkg_mod_flag ) {
944 $error=$cust_pkg->replace($old_cust_pkg);
945 if ( $error ) { #just in case
946 $dbh->rollback if $oldAutoCommit;
947 return "Error modifying pkgnum ". $cust_pkg->pkgnum. ": $error";
949 $setup = sprintf( "%.2f", $setup );
950 $recur = sprintf( "%.2f", $recur );
952 $dbh->rollback if $oldAutoCommit;
953 return "negative setup $setup for pkgnum ". $cust_pkg->pkgnum;
956 $dbh->rollback if $oldAutoCommit;
957 return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum;
959 if ( $setup > 0 || $recur > 0 ) {
960 my $cust_bill_pkg = new FS::cust_bill_pkg ({
961 'pkgnum' => $cust_pkg->pkgnum,
965 'edate' => $cust_pkg->bill,
967 push @cust_bill_pkg, $cust_bill_pkg;
968 $total_setup += $setup;
969 $total_recur += $recur;
970 $taxable_setup += $setup
971 unless $part_pkg->dbdef_table->column('setuptax')
972 || $part_pkg->setuptax =~ /^Y$/i;
973 $taxable_recur += $recur
974 unless $part_pkg->dbdef_table->column('recurtax')
975 || $part_pkg->recurtax =~ /^Y$/i;
981 my $charged = sprintf( "%.2f", $total_setup + $total_recur );
982 my $taxable_charged = sprintf( "%.2f", $taxable_setup + $taxable_recur );
984 unless ( @cust_bill_pkg ) {
985 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
989 unless ( $self->tax =~ /Y/i
990 || $self->payby eq 'COMP'
991 || $taxable_charged == 0 ) {
992 my $cust_main_county = qsearchs('cust_main_county',{
993 'state' => $self->state,
994 'county' => $self->county,
995 'country' => $self->country,
997 my $tax = sprintf( "%.2f",
998 $taxable_charged * ( $cust_main_county->getfield('tax') / 100 )
1002 $charged = sprintf( "%.2f", $charged+$tax );
1004 my $cust_bill_pkg = new FS::cust_bill_pkg ({
1011 push @cust_bill_pkg, $cust_bill_pkg;
1015 my $cust_bill = new FS::cust_bill ( {
1016 'custnum' => $self->custnum,
1018 'charged' => $charged,
1020 $error = $cust_bill->insert;
1022 $dbh->rollback if $oldAutoCommit;
1023 return "can't create invoice for customer #". $self->custnum. ": $error";
1026 my $invnum = $cust_bill->invnum;
1028 foreach $cust_bill_pkg ( @cust_bill_pkg ) {
1029 #warn $cust_bill_pkg->invnum($invnum);
1030 $error = $cust_bill_pkg->insert;
1032 $dbh->rollback if $oldAutoCommit;
1033 return "can't create invoice line item for customer #". $self->custnum.
1038 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1042 =item collect OPTIONS
1044 (Attempt to) collect money for this customer's outstanding invoices (see
1045 L<FS::cust_bill>). Usually used after the bill method.
1047 Depending on the value of `payby', this may print an invoice (`BILL'), charge
1048 a credit card (`CARD'), or just add any necessary (pseudo-)payment (`COMP').
1050 If there is an error, returns the error, otherwise returns false.
1052 Options are passed as name-value pairs.
1054 Currently available options are:
1056 invoice_time - Use this time when deciding when to print invoices and
1057 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>
1058 for conversion functions.
1060 batch_card - Set this true to batch cards (see L<FS::cust_pay_batch>). By
1061 default, cards are processed immediately, which will generate an error if
1062 CyberCash is not installed.
1064 report_badcard - Set this true if you want bad card transactions to
1065 return an error. By default, they don't.
1070 my( $self, %options ) = @_;
1071 my $invoice_time = $options{'invoice_time'} || time;
1074 local $SIG{HUP} = 'IGNORE';
1075 local $SIG{INT} = 'IGNORE';
1076 local $SIG{QUIT} = 'IGNORE';
1077 local $SIG{TERM} = 'IGNORE';
1078 local $SIG{TSTP} = 'IGNORE';
1079 local $SIG{PIPE} = 'IGNORE';
1081 my $oldAutoCommit = $FS::UID::AutoCommit;
1082 local $FS::UID::AutoCommit = 0;
1085 my $balance = $self->balance;
1086 warn "collect: balance $balance" if $Debug;
1087 unless ( $balance > 0 ) { #redundant?????
1088 $dbh->rollback if $oldAutoCommit; #hmm
1092 foreach my $cust_bill (
1093 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
1096 #this has to be before next's
1097 my $amount = sprintf( "%.2f", $balance < $cust_bill->owed
1101 $balance = sprintf( "%.2f", $balance - $amount );
1103 next unless $cust_bill->owed > 0;
1105 # don't try to charge for the same invoice if it's already in a batch
1106 next if qsearchs( 'cust_pay_batch', { 'invnum' => $cust_bill->invnum } );
1108 warn "invnum ". $cust_bill->invnum. " (owed ". $cust_bill->owed. ", amount $amount, balance $balance)" if $Debug;
1110 next unless $amount > 0;
1112 if ( $self->payby eq 'BILL' ) {
1115 my $since = $invoice_time - ( $cust_bill->_date || 0 );
1116 #warn "$invoice_time ", $cust_bill->_date, " $since";
1117 if ( $since >= 0 #don't print future invoices
1118 && ( $cust_bill->printed * 2592000 ) <= $since
1121 #my @print_text = $cust_bill->print_text; #( date )
1122 my @invoicing_list = $self->invoicing_list;
1123 if ( grep { $_ ne 'POST' } @invoicing_list ) { #email invoice
1124 $ENV{SMTPHOSTS} = $smtpmachine;
1125 $ENV{MAILADDRESS} = $invoice_from;
1126 my $header = new Mail::Header ( [
1127 "From: $invoice_from",
1128 "To: ". join(', ', grep { $_ ne 'POST' } @invoicing_list ),
1129 "Sender: $invoice_from",
1130 "Reply-To: $invoice_from",
1131 "Date: ". time2str("%a, %d %b %Y %X %z", time),
1134 my $message = new Mail::Internet (
1135 'Header' => $header,
1136 'Body' => [ $cust_bill->print_text ], #( date)
1138 $message->smtpsend or die "Can't send invoice email!"; #die? warn?
1140 } elsif ( ! @invoicing_list || grep { $_ eq 'POST' } @invoicing_list ) {
1141 open(LPR, "|$lpr") or die "Can't open pipe to $lpr: $!";
1142 print LPR $cust_bill->print_text; #( date )
1144 or die $! ? "Error closing $lpr: $!"
1145 : "Exit status $? from $lpr";
1148 my %hash = $cust_bill->hash;
1150 my $new_cust_bill = new FS::cust_bill(\%hash);
1151 my $error = $new_cust_bill->replace($cust_bill);
1152 warn "Error updating $cust_bill->printed: $error" if $error;
1156 } elsif ( $self->payby eq 'COMP' ) {
1157 my $cust_pay = new FS::cust_pay ( {
1158 'invnum' => $cust_bill->invnum,
1162 'payinfo' => $self->payinfo,
1165 my $error = $cust_pay->insert;
1167 $dbh->rollback if $oldAutoCommit;
1168 return 'Error COMPing invnum #'. $cust_bill->invnum. ": $error";
1172 } elsif ( $self->payby eq 'CARD' ) {
1174 if ( $options{'batch_card'} ne 'yes' ) {
1176 unless ( $processor ) {
1177 $dbh->rollback if $oldAutoCommit;
1178 return "Real time card processing not enabled!";
1181 my $address = $self->address1;
1182 $address .= ", ". $self->address2 if $self->address2;
1185 #$self->paydate =~ /^(\d+)\/\d*(\d{2})$/;
1186 $self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
1189 if ( $processor eq 'cybercash3.2' ) {
1191 #fix exp. date for cybercash
1192 #$self->paydate =~ /^(\d+)\/\d*(\d{2})$/;
1193 $self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
1196 my $paybatch = $cust_bill->invnum.
1197 '-' . time2str("%y%m%d%H%M%S", time);
1199 my $payname = $self->payname ||
1200 $self->getfield('first'). ' '. $self->getfield('last');
1203 my $country = $self->country eq 'US' ? 'USA' : $self->country;
1205 my @full_xaction = ( $xaction,
1206 'Order-ID' => $paybatch,
1207 'Amount' => "usd $amount",
1208 'Card-Number' => $self->getfield('payinfo'),
1209 'Card-Name' => $payname,
1210 'Card-Address' => $address,
1211 'Card-City' => $self->getfield('city'),
1212 'Card-State' => $self->getfield('state'),
1213 'Card-Zip' => $self->getfield('zip'),
1214 'Card-Country' => $country,
1219 %result = &CCMckDirectLib3_2::SendCC2_1Server(@full_xaction);
1221 #if ( $result{'MActionCode'} == 7 ) { #cybercash smps v.1.1.3
1222 #if ( $result{'action-code'} == 7 ) { #cybercash smps v.2.1
1223 if ( $result{'MStatus'} eq 'success' ) { #cybercash smps v.2 or 3
1224 my $cust_pay = new FS::cust_pay ( {
1225 'invnum' => $cust_bill->invnum,
1229 'payinfo' => $self->payinfo,
1230 'paybatch' => "$processor:$paybatch",
1232 my $error = $cust_pay->insert;
1234 # gah, even with transactions.
1235 $dbh->commit if $oldAutoCommit; #well.
1236 my $e = 'WARNING: Card debited but database not updated - '.
1237 'error applying payment, invnum #' . $cust_bill->invnum.
1238 " (CyberCash Order-ID $paybatch): $error";
1242 } elsif ( $result{'Mstatus'} ne 'failure-bad-money'
1243 || $options{'report_badcard'} ) {
1244 $dbh->commit if $oldAutoCommit;
1245 return 'Cybercash error, invnum #' .
1246 $cust_bill->invnum. ':'. $result{'MErrMsg'};
1248 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1252 } elsif ( $processor =~ /^Business::OnlinePayment::(.*)$/ ) {
1254 my $bop_processor = $1;
1256 my($payname, $payfirst, $paylast);
1257 if ( $self->payname ) {
1258 $payname = $self->payname;
1259 $payname =~ /^\s*([\w \,\.\-\']*\w)?\s+([\w\,\.\-\']+)$/
1261 $dbh->rollback if $oldAutoCommit;
1262 return "Illegal payname $payname";
1264 ($payfirst, $paylast) = ($1, $2);
1266 $payfirst = $self->getfield('first');
1267 $paylast = $self->getfield('first');
1268 $payname = "$payfirst $paylast";
1271 my @invoicing_list = grep { $_ ne 'POST' } $self->invoicing_list;
1272 if ( $conf->exists('emailinvoiceauto')
1273 || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
1274 push @invoicing_list, $self->default_invoicing_list;
1276 my $email = $invoicing_list[0];
1278 my( $action1, $action2 ) = split(/\s*\,\s*/, $bop_action );
1281 new Business::OnlinePayment( $bop_processor, @bop_options );
1282 $transaction->content(
1284 'login' => $bop_login,
1285 'password' => $bop_password,
1286 'action' => $action1,
1287 'description' => 'Internet Services',
1288 'amount' => $amount,
1289 'invoice_number' => $cust_bill->invnum,
1290 'customer_id' => $self->custnum,
1291 'last_name' => $paylast,
1292 'first_name' => $payfirst,
1294 'address' => $address,
1295 'city' => $self->city,
1296 'state' => $self->state,
1297 'zip' => $self->zip,
1298 'country' => $self->country,
1299 'card_number' => $self->payinfo,
1300 'expiration' => $exp,
1301 'referer' => 'http://cleanwhisker.420.am/',
1304 $transaction->submit();
1306 if ( $transaction->is_success() && $action2 ) {
1307 my $auth = $transaction->authorization;
1308 my $ordernum = $transaction->order_number;
1309 #warn "********* $auth ***********\n";
1310 #warn "********* $ordernum ***********\n";
1312 new Business::OnlinePayment( $bop_processor, @bop_options );
1316 login => $bop_login,
1317 password => $bop_password,
1318 order_number => $ordernum,
1320 authorization => $auth,
1321 description => 'Internet Services',
1326 unless ( $capture->is_success ) {
1327 my $e = "Authorization sucessful but capture failed, invnum #".
1328 $cust_bill->invnum. ': '. $capture->result_code.
1329 ": ". $capture->error_message;
1336 if ( $transaction->is_success() ) {
1338 my $cust_pay = new FS::cust_pay ( {
1339 'invnum' => $cust_bill->invnum,
1343 'payinfo' => $self->payinfo,
1344 'paybatch' => "$processor:". $transaction->authorization,
1346 my $error = $cust_pay->insert;
1348 # gah, even with transactions.
1349 $dbh->commit if $oldAutoCommit; #well.
1350 my $e = 'WARNING: Card debited but database not updated - '.
1351 'error applying payment, invnum #' . $cust_bill->invnum.
1352 " ($processor): $error";
1356 } elsif ( $options{'report_badcard'} ) {
1357 $dbh->commit if $oldAutoCommit;
1358 return "$processor error, invnum #". $cust_bill->invnum. ': '.
1359 $transaction->result_code. ": ". $transaction->error_message;
1361 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1366 $dbh->rollback if $oldAutoCommit;
1367 return "Unknown real-time processor $processor\n";
1370 } else { #batch card
1372 my $cust_pay_batch = new FS::cust_pay_batch ( {
1373 'invnum' => $cust_bill->getfield('invnum'),
1374 'custnum' => $self->getfield('custnum'),
1375 'last' => $self->getfield('last'),
1376 'first' => $self->getfield('first'),
1377 'address1' => $self->getfield('address1'),
1378 'address2' => $self->getfield('address2'),
1379 'city' => $self->getfield('city'),
1380 'state' => $self->getfield('state'),
1381 'zip' => $self->getfield('zip'),
1382 'country' => $self->getfield('country'),
1384 'cardnum' => $self->getfield('payinfo'),
1385 'exp' => $self->getfield('paydate'),
1386 'payname' => $self->getfield('payname'),
1387 'amount' => $amount,
1389 my $error = $cust_pay_batch->insert;
1391 $dbh->rollback if $oldAutoCommit;
1392 return "Error adding to cust_pay_batch: $error";
1398 $dbh->rollback if $oldAutoCommit;
1399 return "Unknown payment type ". $self->payby;
1403 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1410 Returns the total owed for this customer on all invoices
1411 (see L<FS::cust_bill/owed>).
1418 foreach my $cust_bill ( qsearch('cust_bill', {
1419 'custnum' => $self->custnum,
1421 $total_bill += $cust_bill->owed;
1423 sprintf( "%.2f", $total_bill );
1428 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
1429 to outstanding invoice balances in chronological order and returns the value
1430 of any remaining unapplied credits available for refund
1431 (see L<FS::cust_refund>).
1438 return 0 unless $self->total_credited;
1440 my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
1441 qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
1443 my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
1444 qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
1448 foreach my $cust_bill ( @invoices ) {
1451 if ( !defined($credit) || $credit->credited == 0) {
1452 $credit = pop @credits or last;
1455 if ($cust_bill->owed >= $credit->credited) {
1456 $amount=$credit->credited;
1458 $amount=$cust_bill->owed;
1461 my $cust_credit_bill = new FS::cust_credit_bill ( {
1462 'crednum' => $credit->crednum,
1463 'invnum' => $cust_bill->invnum,
1464 'amount' => $amount,
1466 my $error = $cust_credit_bill->insert;
1467 die $error if $error;
1469 redo if ($cust_bill->owed > 0);
1473 return $self->total_credited;
1476 =item apply_payments
1478 Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
1479 to outstanding invoice balances in chronological order.
1481 #and returns the value of any remaining unapplied payments.
1485 sub apply_payments {
1490 my @payments = sort { $b->_date <=> $a->_date } ( grep { $_->unapplied > 0 }
1491 qsearch('cust_pay', { 'custnum' => $self->custnum } ) );
1493 my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
1494 qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
1498 foreach my $cust_bill ( @invoices ) {
1501 if ( !defined($payment) || $payment->unapplied == 0 ) {
1502 $payment = pop @payments or last;
1505 if ( $cust_bill->owed >= $payment->unapplied ) {
1506 $amount = $payment->unapplied;
1508 $amount = $cust_bill->owed;
1511 my $cust_bill_pay = new FS::cust_bill_pay ( {
1512 'paynum' => $payment->paynum,
1513 'invnum' => $cust_bill->invnum,
1514 'amount' => $amount,
1516 my $error = $cust_bill_pay->insert;
1517 die $error if $error;
1519 redo if ( $cust_bill->owed > 0);
1523 return $self->total_unapplied_payments;
1526 =item total_credited
1528 Returns the total outstanding credit (see L<FS::cust_credit>) for this
1529 customer. See L<FS::cust_credit/credited>.
1533 sub total_credited {
1535 my $total_credit = 0;
1536 foreach my $cust_credit ( qsearch('cust_credit', {
1537 'custnum' => $self->custnum,
1539 $total_credit += $cust_credit->credited;
1541 sprintf( "%.2f", $total_credit );
1544 =item total_unapplied_payments
1546 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
1547 See L<FS::cust_pay/unapplied>.
1551 sub total_unapplied_payments {
1553 my $total_unapplied = 0;
1554 foreach my $cust_pay ( qsearch('cust_pay', {
1555 'custnum' => $self->custnum,
1557 $total_unapplied += $cust_pay->unapplied;
1559 sprintf( "%.2f", $total_unapplied );
1564 Returns the balance for this customer (total_owed minus total_credited
1565 minus total_unapplied_payments).
1572 $self->total_owed - $self->total_credited - $self->total_unapplied_payments
1576 =item invoicing_list [ ARRAYREF ]
1578 If an arguement is given, sets these email addresses as invoice recipients
1579 (see L<FS::cust_main_invoice>). Errors are not fatal and are not reported
1580 (except as warnings), so use check_invoicing_list first.
1582 Returns a list of email addresses (with svcnum entries expanded).
1584 Note: You can clear the invoicing list by passing an empty ARRAYREF. You can
1585 check it without disturbing anything by passing nothing.
1587 This interface may change in the future.
1591 sub invoicing_list {
1592 my( $self, $arrayref ) = @_;
1594 my @cust_main_invoice;
1595 if ( $self->custnum ) {
1596 @cust_main_invoice =
1597 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1599 @cust_main_invoice = ();
1601 foreach my $cust_main_invoice ( @cust_main_invoice ) {
1602 #warn $cust_main_invoice->destnum;
1603 unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
1604 #warn $cust_main_invoice->destnum;
1605 my $error = $cust_main_invoice->delete;
1606 warn $error if $error;
1609 if ( $self->custnum ) {
1610 @cust_main_invoice =
1611 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1613 @cust_main_invoice = ();
1615 my %seen = map { $_->address => 1 } @cust_main_invoice;
1616 foreach my $address ( @{$arrayref} ) {
1617 #unless ( grep { $address eq $_->address } @cust_main_invoice ) {
1618 next if exists $seen{$address} && $seen{$address};
1619 $seen{$address} = 1;
1620 my $cust_main_invoice = new FS::cust_main_invoice ( {
1621 'custnum' => $self->custnum,
1624 my $error = $cust_main_invoice->insert;
1625 warn $error if $error;
1628 if ( $self->custnum ) {
1630 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1636 =item check_invoicing_list ARRAYREF
1638 Checks these arguements as valid input for the invoicing_list method. If there
1639 is an error, returns the error, otherwise returns false.
1643 sub check_invoicing_list {
1644 my( $self, $arrayref ) = @_;
1645 foreach my $address ( @{$arrayref} ) {
1646 my $cust_main_invoice = new FS::cust_main_invoice ( {
1647 'custnum' => $self->custnum,
1650 my $error = $self->custnum
1651 ? $cust_main_invoice->check
1652 : $cust_main_invoice->checkdest
1654 return $error if $error;
1659 =item default_invoicing_list
1661 Returns the email addresses of any
1665 sub default_invoicing_list {
1668 foreach my $cust_pkg ( $self->all_pkgs ) {
1669 my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
1671 map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
1672 grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
1674 push @list, map { $_->email } @svc_acct;
1676 $self->invoicing_list(\@list);
1679 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
1681 Returns an array of customers referred by this customer (referral_custnum set
1682 to this custnum). If DEPTH is given, recurses up to the given depth, returning
1683 customers referred by customers referred by this customer and so on, inclusive.
1684 The default behavior is DEPTH 1 (no recursion).
1688 sub referral_cust_main {
1690 my $depth = @_ ? shift : 1;
1691 my $exclude = @_ ? shift : {};
1694 map { $exclude->{$_->custnum}++; $_; }
1695 grep { ! $exclude->{ $_->custnum } }
1696 qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
1700 map { $_->referral_cust_main($depth-1, $exclude) }
1707 =item referral_cust_pkg [ DEPTH ]
1709 Like referral_cust_main, except returns a flat list of all unsuspended packages
1710 for each customer. The number of items in this list may be useful for
1711 comission calculations (perhaps after a grep).
1715 sub referral_cust_pkg {
1717 my $depth = @_ ? shift : 1;
1719 map { $_->unsuspended_pkgs }
1720 grep { $_->unsuspended_pkgs }
1721 $self->referral_cust_main($depth);
1724 =item credit AMOUNT, REASON
1726 Applies a credit to this customer. If there is an error, returns the error,
1727 otherwise returns false.
1732 my( $self, $amount, $reason ) = @_;
1733 my $cust_credit = new FS::cust_credit {
1734 'custnum' => $self->custnum,
1735 'amount' => $amount,
1736 'reason' => $reason,
1738 $cust_credit->insert;
1747 =item check_and_rebuild_fuzzyfiles
1751 sub check_and_rebuild_fuzzyfiles {
1752 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1753 -e "$dir/cust_main.last" && -e "$dir/cust_main.company"
1754 or &rebuild_fuzzyfiles;
1757 =item rebuild_fuzzyfiles
1761 sub rebuild_fuzzyfiles {
1763 use Fcntl qw(:flock);
1765 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1769 open(LASTLOCK,">>$dir/cust_main.last")
1770 or die "can't open $dir/cust_main.last: $!";
1771 flock(LASTLOCK,LOCK_EX)
1772 or die "can't lock $dir/cust_main.last: $!";
1774 my @all_last = map $_->getfield('last'), qsearch('cust_main', {});
1776 grep $_, map $_->getfield('ship_last'), qsearch('cust_main',{})
1777 if defined dbdef->table('cust_main')->column('ship_last');
1779 open (LASTCACHE,">$dir/cust_main.last.tmp")
1780 or die "can't open $dir/cust_main.last.tmp: $!";
1781 print LASTCACHE join("\n", @all_last), "\n";
1782 close LASTCACHE or die "can't close $dir/cust_main.last.tmp: $!";
1784 rename "$dir/cust_main.last.tmp", "$dir/cust_main.last";
1789 open(COMPANYLOCK,">>$dir/cust_main.company")
1790 or die "can't open $dir/cust_main.company: $!";
1791 flock(COMPANYLOCK,LOCK_EX)
1792 or die "can't lock $dir/cust_main.company: $!";
1794 my @all_company = grep $_ ne '', map $_->company, qsearch('cust_main',{});
1796 grep $_ ne '', map $_->ship_company, qsearch('cust_main', {})
1797 if defined dbdef->table('cust_main')->column('ship_last');
1799 open (COMPANYCACHE,">$dir/cust_main.company.tmp")
1800 or die "can't open $dir/cust_main.company.tmp: $!";
1801 print COMPANYCACHE join("\n", @all_company), "\n";
1802 close COMPANYCACHE or die "can't close $dir/cust_main.company.tmp: $!";
1804 rename "$dir/cust_main.company.tmp", "$dir/cust_main.company";
1814 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1815 open(LASTCACHE,"<$dir/cust_main.last")
1816 or die "can't open $dir/cust_main.last: $!";
1817 my @array = map { chomp; $_; } <LASTCACHE>;
1827 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1828 open(COMPANYCACHE,"<$dir/cust_main.company")
1829 or die "can't open $dir/cust_main.last: $!";
1830 my @array = map { chomp; $_; } <COMPANYCACHE>;
1835 =item append_fuzzyfiles LASTNAME COMPANY
1839 sub append_fuzzyfiles {
1840 my( $last, $company ) = @_;
1842 &check_and_rebuild_fuzzyfiles;
1844 use Fcntl qw(:flock);
1846 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1850 open(LAST,">>$dir/cust_main.last")
1851 or die "can't open $dir/cust_main.last: $!";
1853 or die "can't lock $dir/cust_main.last: $!";
1855 print LAST "$last\n";
1858 or die "can't unlock $dir/cust_main.last: $!";
1864 open(COMPANY,">>$dir/cust_main.company")
1865 or die "can't open $dir/cust_main.company: $!";
1866 flock(COMPANY,LOCK_EX)
1867 or die "can't lock $dir/cust_main.company: $!";
1869 print COMPANY "$company\n";
1871 flock(COMPANY,LOCK_UN)
1872 or die "can't unlock $dir/cust_main.company: $!";
1882 $Id: cust_main.pm,v 1.47 2001-11-12 13:19:52 ivan Exp $
1888 The delete method should possibly take an FS::cust_main object reference
1889 instead of a scalar customer number.
1891 Bill and collect options should probably be passed as references instead of a
1894 CyberCash v2 forces us to define some variables in package main.
1896 There should probably be a configuration file with a list of allowed credit
1899 No multiple currency support (probably a larger project than just this module).
1903 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
1904 L<FS::cust_pay_batch>, L<FS::agent>, L<FS::part_referral>,
1905 L<FS::cust_main_county>, L<FS::cust_main_invoice>,
1906 L<FS::UID>, schema.html from the base documentation.