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;
33 @ISA = qw( FS::Record );
40 #ask FS::UID to run this stuff for us later
41 $FS::UID::callback{'FS::cust_main'} = sub {
43 $lpr = $conf->config('lpr');
44 $invoice_from = $conf->config('invoice_from');
45 $smtpmachine = $conf->config('smtpmachine');
47 if ( $conf->exists('cybercash3.2') ) {
49 #qw($MCKversion %Config InitConfig CCError CCDebug CCDebug2);
50 require CCMckDirectLib3_2;
52 require CCMckErrno3_2;
53 #qw(MCKGetErrorMessage $E_NoErr);
54 import CCMckErrno3_2 qw($E_NoErr);
57 ($merchant_conf,$xaction)= $conf->config('cybercash3.2');
58 my $status = &CCMckLib3_2::InitConfig($merchant_conf);
59 if ( $status != $E_NoErr ) {
60 warn "CCMckLib3_2::InitConfig error:\n";
61 foreach my $key (keys %CCMckLib3_2::Config) {
62 warn " $key => $CCMckLib3_2::Config{$key}\n"
64 my($errmsg) = &CCMckErrno3_2::MCKGetErrorMessage($status);
65 die "CCMckLib3_2::InitConfig fatal error: $errmsg\n";
67 $processor='cybercash3.2';
68 } elsif ( $conf->exists('business-onlinepayment') ) {
74 ) = $conf->config('business-onlinepayment');
75 $bop_action ||= 'normal authorization';
76 eval "use Business::OnlinePayment";
77 $processor="Business::OnlinePayment::$bop_processor";
83 my ( $hashref, $cache ) = @_;
84 if ( exists $hashref->{'pkgnum'} ) {
85 # #@{ $self->{'_pkgnum'} } = ();
86 my $subcache = $cache->subcache( 'pkgnum', 'cust_pkg', $hashref->{custnum});
87 $self->{'_pkgnum'} = $subcache;
88 #push @{ $self->{'_pkgnum'} },
89 FS::cust_pkg->new_or_cached($hashref, $subcache) if $hashref->{pkgnum};
95 FS::cust_main - Object methods for cust_main records
101 $record = new FS::cust_main \%hash;
102 $record = new FS::cust_main { 'column' => 'value' };
104 $error = $record->insert;
106 $error = $new_record->replace($old_record);
108 $error = $record->delete;
110 $error = $record->check;
112 @cust_pkg = $record->all_pkgs;
114 @cust_pkg = $record->ncancelled_pkgs;
116 @cust_pkg = $record->suspended_pkgs;
118 $error = $record->bill;
119 $error = $record->bill %options;
120 $error = $record->bill 'time' => $time;
122 $error = $record->collect;
123 $error = $record->collect %options;
124 $error = $record->collect 'invoice_time' => $time,
125 'batch_card' => 'yes',
126 'report_badcard' => 'yes',
131 An FS::cust_main object represents a customer. FS::cust_main inherits from
132 FS::Record. The following fields are currently supported:
136 =item custnum - primary key (assigned automatically for new customers)
138 =item agentnum - agent (see L<FS::agent>)
140 =item refnum - referral (see L<FS::part_referral>)
146 =item ss - social security number (optional)
148 =item company - (optional)
152 =item address2 - (optional)
156 =item county - (optional, see L<FS::cust_main_county>)
158 =item state - (see L<FS::cust_main_county>)
162 =item country - (see L<FS::cust_main_county>)
164 =item daytime - phone (optional)
166 =item night - phone (optional)
168 =item fax - phone (optional)
170 =item ship_first - name
172 =item ship_last - name
174 =item ship_company - (optional)
178 =item ship_address2 - (optional)
182 =item ship_county - (optional, see L<FS::cust_main_county>)
184 =item ship_state - (see L<FS::cust_main_county>)
188 =item ship_country - (see L<FS::cust_main_county>)
190 =item ship_daytime - phone (optional)
192 =item ship_night - phone (optional)
194 =item ship_fax - phone (optional)
196 =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)
198 =item payinfo - card number, P.O., comp issuer (4-8 lowercase alphanumerics; think username) or prepayment identifier (see L<FS::prepay_credit>)
200 =item paydate - expiration date, mm/yyyy, m/yyyy, mm/yy or m/yy
202 =item payname - name on card or billing name
204 =item tax - tax exempt, empty or `Y'
206 =item otaker - order taker (assigned automatically, see L<FS::UID>)
208 =item comments - comments (optional)
218 Creates a new customer. To add the customer to the database, see L<"insert">.
220 Note that this stores the hash reference, not a distinct copy of the hash it
221 points to. You can ask the object for a copy with the I<hash> method.
225 sub table { 'cust_main'; }
227 =item insert [ CUST_PKG_HASHREF [ , INVOICING_LIST_ARYREF ] ]
229 Adds this customer to the database. If there is an error, returns the error,
230 otherwise returns false.
232 CUST_PKG_HASHREF: If you pass a Tie::RefHash data structure to the insert
233 method containing FS::cust_pkg and FS::svc_I<tablename> objects, all records
234 are inserted atomicly, or the transaction is rolled back. Passing an empty
235 hash reference is equivalent to not supplying this parameter. There should be
236 a better explanation of this, but until then, here's an example:
239 tie %hash, 'Tie::RefHash'; #this part is important
241 $cust_pkg => [ $svc_acct ],
244 $cust_main->insert( \%hash );
246 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
247 be set as the invoicing list (see L<"invoicing_list">). Errors return as
248 expected and rollback the entire transaction; it is not necessary to call
249 check_invoicing_list first. The invoicing_list is set after the records in the
250 CUST_PKG_HASHREF above are inserted, so it is now possible to set an
251 invoicing_list destination to the newly-created svc_acct. Here's an example:
253 $cust_main->insert( {}, [ $email, 'POST' ] );
261 local $SIG{HUP} = 'IGNORE';
262 local $SIG{INT} = 'IGNORE';
263 local $SIG{QUIT} = 'IGNORE';
264 local $SIG{TERM} = 'IGNORE';
265 local $SIG{TSTP} = 'IGNORE';
266 local $SIG{PIPE} = 'IGNORE';
268 my $oldAutoCommit = $FS::UID::AutoCommit;
269 local $FS::UID::AutoCommit = 0;
274 if ( $self->payby eq 'PREPAY' ) {
275 $self->payby('BILL');
276 my $prepay_credit = qsearchs(
278 { 'identifier' => $self->payinfo },
282 warn "WARNING: can't find pre-found prepay_credit: ". $self->payinfo
283 unless $prepay_credit;
284 $amount = $prepay_credit->amount;
285 $seconds = $prepay_credit->seconds;
286 my $error = $prepay_credit->delete;
288 $dbh->rollback if $oldAutoCommit;
289 return "removing prepay_credit (transaction rolled back): $error";
293 my $error = $self->SUPER::insert;
295 $dbh->rollback if $oldAutoCommit;
296 return "inserting cust_main record (transaction rolled back): $error";
299 if ( @param ) { # CUST_PKG_HASHREF
300 my $cust_pkgs = shift @param;
301 foreach my $cust_pkg ( keys %$cust_pkgs ) {
302 $cust_pkg->custnum( $self->custnum );
303 $error = $cust_pkg->insert;
305 $dbh->rollback if $oldAutoCommit;
306 return "inserting cust_pkg (transaction rolled back): $error";
308 foreach my $svc_something ( @{$cust_pkgs->{$cust_pkg}} ) {
309 $svc_something->pkgnum( $cust_pkg->pkgnum );
310 if ( $seconds && $svc_something->isa('FS::svc_acct') ) {
311 $svc_something->seconds( $svc_something->seconds + $seconds );
314 $error = $svc_something->insert;
316 $dbh->rollback if $oldAutoCommit;
317 return "inserting svc_ (transaction rolled back): $error";
324 $dbh->rollback if $oldAutoCommit;
325 return "No svc_acct record to apply pre-paid time";
328 if ( @param ) { # INVOICING_LIST_ARYREF
329 my $invoicing_list = shift @param;
330 $error = $self->check_invoicing_list( $invoicing_list );
332 $dbh->rollback if $oldAutoCommit;
333 return "checking invoicing_list (transaction rolled back): $error";
335 $self->invoicing_list( $invoicing_list );
339 my $cust_credit = new FS::cust_credit {
340 'custnum' => $self->custnum,
343 $error = $cust_credit->insert;
345 $dbh->rollback if $oldAutoCommit;
346 return "inserting credit (transaction rolled back): $error";
350 #false laziness with sub replace
351 my $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
352 $error = $queue->insert($self->getfield('last'), $self->company);
354 $dbh->rollback if $oldAutoCommit;
355 return "queueing job (transaction rolled back): $error";
358 if ( defined $self->dbdef_table->column('ship_last') && $self->ship_last ) {
359 $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
360 $error = $queue->insert($self->getfield('last'), $self->company);
362 $dbh->rollback if $oldAutoCommit;
363 return "queueing job (transaction rolled back): $error";
368 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
373 =item delete NEW_CUSTNUM
375 This deletes the customer. If there is an error, returns the error, otherwise
378 This will completely remove all traces of the customer record. This is not
379 what you want when a customer cancels service; for that, cancel all of the
380 customer's packages (see L<FS::cust_pkg/cancel>).
382 If the customer has any uncancelled packages, you need to pass a new (valid)
383 customer number for those packages to be transferred to. Cancelled packages
384 will be deleted. Did I mention that this is NOT what you want when a customer
385 cancels service and that you really should be looking see L<FS::cust_pkg/cancel>?
387 You can't delete a customer with invoices (see L<FS::cust_bill>),
388 or credits (see L<FS::cust_credit>) or payments (see L<FS::cust_pay>).
395 local $SIG{HUP} = 'IGNORE';
396 local $SIG{INT} = 'IGNORE';
397 local $SIG{QUIT} = 'IGNORE';
398 local $SIG{TERM} = 'IGNORE';
399 local $SIG{TSTP} = 'IGNORE';
400 local $SIG{PIPE} = 'IGNORE';
402 my $oldAutoCommit = $FS::UID::AutoCommit;
403 local $FS::UID::AutoCommit = 0;
406 if ( qsearch( 'cust_bill', { 'custnum' => $self->custnum } ) ) {
407 $dbh->rollback if $oldAutoCommit;
408 return "Can't delete a customer with invoices";
410 if ( qsearch( 'cust_credit', { 'custnum' => $self->custnum } ) ) {
411 $dbh->rollback if $oldAutoCommit;
412 return "Can't delete a customer with credits";
414 if ( qsearch( 'cust_pay', { 'custnum' => $self->custnum } ) ) {
415 $dbh->rollback if $oldAutoCommit;
416 return "Can't delete a customer with payments";
419 my @cust_pkg = $self->ncancelled_pkgs;
421 my $new_custnum = shift;
422 unless ( qsearchs( 'cust_main', { 'custnum' => $new_custnum } ) ) {
423 $dbh->rollback if $oldAutoCommit;
424 return "Invalid new customer number: $new_custnum";
426 foreach my $cust_pkg ( @cust_pkg ) {
427 my %hash = $cust_pkg->hash;
428 $hash{'custnum'} = $new_custnum;
429 my $new_cust_pkg = new FS::cust_pkg ( \%hash );
430 my $error = $new_cust_pkg->replace($cust_pkg);
432 $dbh->rollback if $oldAutoCommit;
437 my @cancelled_cust_pkg = $self->all_pkgs;
438 foreach my $cust_pkg ( @cancelled_cust_pkg ) {
439 my $error = $cust_pkg->delete;
441 $dbh->rollback if $oldAutoCommit;
446 foreach my $cust_main_invoice (
447 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } )
449 my $error = $cust_main_invoice->delete;
451 $dbh->rollback if $oldAutoCommit;
456 my $error = $self->SUPER::delete;
458 $dbh->rollback if $oldAutoCommit;
462 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
467 =item replace OLD_RECORD [ INVOICING_LIST_ARYREF ]
469 Replaces the OLD_RECORD with this one in the database. If there is an error,
470 returns the error, otherwise returns false.
472 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
473 be set as the invoicing list (see L<"invoicing_list">). Errors return as
474 expected and rollback the entire transaction; it is not necessary to call
475 check_invoicing_list first. Here's an example:
477 $new_cust_main->replace( $old_cust_main, [ $email, 'POST' ] );
486 local $SIG{HUP} = 'IGNORE';
487 local $SIG{INT} = 'IGNORE';
488 local $SIG{QUIT} = 'IGNORE';
489 local $SIG{TERM} = 'IGNORE';
490 local $SIG{TSTP} = 'IGNORE';
491 local $SIG{PIPE} = 'IGNORE';
493 my $oldAutoCommit = $FS::UID::AutoCommit;
494 local $FS::UID::AutoCommit = 0;
497 my $error = $self->SUPER::replace($old);
500 $dbh->rollback if $oldAutoCommit;
504 if ( @param ) { # INVOICING_LIST_ARYREF
505 my $invoicing_list = shift @param;
506 $error = $self->check_invoicing_list( $invoicing_list );
508 $dbh->rollback if $oldAutoCommit;
511 $self->invoicing_list( $invoicing_list );
514 #false laziness with sub insert
515 my $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
516 $error = $queue->insert($self->getfield('last'), $self->company);
518 $dbh->rollback if $oldAutoCommit;
519 return "queueing job (transaction rolled back): $error";
522 if ( defined $self->dbdef_table->column('ship_last') && $self->ship_last ) {
523 $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
524 $error = $queue->insert($self->getfield('last'), $self->company);
526 $dbh->rollback if $oldAutoCommit;
527 return "queueing job (transaction rolled back): $error";
532 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
539 Checks all fields to make sure this is a valid customer record. If there is
540 an error, returns the error, otherwise returns false. Called by the insert
549 $self->ut_numbern('custnum')
550 || $self->ut_number('agentnum')
551 || $self->ut_number('refnum')
552 || $self->ut_name('last')
553 || $self->ut_name('first')
554 || $self->ut_textn('company')
555 || $self->ut_text('address1')
556 || $self->ut_textn('address2')
557 || $self->ut_text('city')
558 || $self->ut_textn('county')
559 || $self->ut_textn('state')
560 || $self->ut_country('country')
561 || $self->ut_anything('comments')
562 || $self->ut_numbern('referral_custnum')
564 #barf. need message catalogs. i18n. etc.
565 $error .= "Please select a referral."
566 if $error =~ /^Illegal or empty \(numeric\) refnum: /;
567 return $error if $error;
569 return "Unknown agent"
570 unless qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
572 return "Unknown referral"
573 unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } );
575 return "Unknown referring custnum ". $self->referral_custnum
576 unless ! $self->referral_custnum
577 || qsearchs( 'cust_main', { 'custnum' => $self->referral_custnum } );
579 if ( $self->ss eq '' ) {
584 $ss =~ /^(\d{3})(\d{2})(\d{4})$/
585 or return "Illegal social security number: ". $self->ss;
586 $self->ss("$1-$2-$3");
590 unless ( qsearchs('cust_main_county', {
591 'country' => $self->country,
594 return "Unknown state/county/country: ".
595 $self->state. "/". $self->county. "/". $self->country
596 unless qsearchs('cust_main_county',{
597 'state' => $self->state,
598 'county' => $self->county,
599 'country' => $self->country,
605 $self->ut_phonen('daytime', $self->country)
606 || $self->ut_phonen('night', $self->country)
607 || $self->ut_phonen('fax', $self->country)
608 || $self->ut_zip('zip', $self->country)
610 return $error if $error;
613 last first company address1 address2 city county state zip
614 country daytime night fax
617 if ( defined $self->dbdef_table->column('ship_last') ) {
618 if ( grep { $self->getfield($_) ne $self->getfield("ship_$_") } @addfields
619 && grep $self->getfield("ship_$_"), grep $_ ne 'state', @addfields
623 $self->ut_name('ship_last')
624 || $self->ut_name('ship_first')
625 || $self->ut_textn('ship_company')
626 || $self->ut_text('ship_address1')
627 || $self->ut_textn('ship_address2')
628 || $self->ut_text('ship_city')
629 || $self->ut_textn('ship_county')
630 || $self->ut_textn('ship_state')
631 || $self->ut_country('ship_country')
633 return $error if $error;
635 #false laziness with above
636 unless ( qsearchs('cust_main_county', {
637 'country' => $self->ship_country,
640 return "Unknown ship_state/ship_county/ship_country: ".
641 $self->ship_state. "/". $self->ship_county. "/". $self->ship_country
642 unless qsearchs('cust_main_county',{
643 'state' => $self->ship_state,
644 'county' => $self->ship_county,
645 'country' => $self->ship_country,
651 $self->ut_phonen('ship_daytime', $self->ship_country)
652 || $self->ut_phonen('ship_night', $self->ship_country)
653 || $self->ut_phonen('ship_fax', $self->ship_country)
654 || $self->ut_zip('ship_zip', $self->ship_country)
656 return $error if $error;
658 } else { # ship_ info eq billing info, so don't store dup info in database
659 $self->setfield("ship_$_", '')
660 foreach qw( last first company address1 address2 city county state zip
661 country daytime night fax );
665 $self->payby =~ /^(CARD|BILL|COMP|PREPAY)$/
666 or return "Illegal payby: ". $self->payby;
669 if ( $self->payby eq 'CARD' ) {
671 my $payinfo = $self->payinfo;
673 $payinfo =~ /^(\d{13,16})$/
674 or return "Illegal credit card number: ". $self->payinfo;
676 $self->payinfo($payinfo);
678 or return "Illegal credit card number: ". $self->payinfo;
679 return "Unknown card type" if cardtype($self->payinfo) eq "Unknown";
681 } elsif ( $self->payby eq 'BILL' ) {
683 $error = $self->ut_textn('payinfo');
684 return "Illegal P.O. number: ". $self->payinfo if $error;
686 } elsif ( $self->payby eq 'COMP' ) {
688 $error = $self->ut_textn('payinfo');
689 return "Illegal comp account issuer: ". $self->payinfo if $error;
691 } elsif ( $self->payby eq 'PREPAY' ) {
693 my $payinfo = $self->payinfo;
694 $payinfo =~ s/\W//g; #anything else would just confuse things
695 $self->payinfo($payinfo);
696 $error = $self->ut_alpha('payinfo');
697 return "Illegal prepayment identifier: ". $self->payinfo if $error;
698 return "Unknown prepayment identifier"
699 unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } );
703 if ( $self->paydate eq '' || $self->paydate eq '-' ) {
704 return "Expriation date required"
705 unless $self->payby eq 'BILL' || $self->payby eq 'PREPAY';
708 $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/
709 or return "Illegal expiration date: ". $self->paydate;
710 if ( length($2) == 4 ) {
711 $self->paydate("$2-$1-01");
713 $self->paydate("20$2-$1-01");
717 if ( $self->payname eq '' ) {
718 $self->payname( $self->first. " ". $self->getfield('last') );
720 $self->payname =~ /^([\w \,\.\-\']+)$/
721 or return "Illegal billing name: ". $self->payname;
725 $self->tax =~ /^(Y?)$/ or return "Illegal tax: ". $self->tax;
728 $self->otaker(getotaker);
735 Returns all packages (see L<FS::cust_pkg>) for this customer.
741 if ( $self->{'_pkgnum'} ) {
742 values %{ $self->{'_pkgnum'}->cache };
744 qsearch( 'cust_pkg', { 'custnum' => $self->custnum });
748 =item ncancelled_pkgs
750 Returns all non-cancelled packages (see L<FS::cust_pkg>) for this customer.
754 sub ncancelled_pkgs {
756 if ( $self->{'_pkgnum'} ) {
757 grep { ! $_->getfield('cancel') } values %{ $self->{'_pkgnum'}->cache };
759 @{ [ # force list context
760 qsearch( 'cust_pkg', {
761 'custnum' => $self->custnum,
764 qsearch( 'cust_pkg', {
765 'custnum' => $self->custnum,
774 Returns all suspended packages (see L<FS::cust_pkg>) for this customer.
780 grep { $_->susp } $self->ncancelled_pkgs;
783 =item unflagged_suspended_pkgs
785 Returns all unflagged suspended packages (see L<FS::cust_pkg>) for this
786 customer (thouse packages without the `manual_flag' set).
790 sub unflagged_suspended_pkgs {
792 return $self->suspended_pkgs
793 unless dbdef->table('cust_pkg')->column('manual_flag');
794 grep { ! $_->manual_flag } $self->suspended_pkgs;
797 =item unsuspended_pkgs
799 Returns all unsuspended (and uncancelled) packages (see L<FS::cust_pkg>) for
804 sub unsuspended_pkgs {
806 grep { ! $_->susp } $self->ncancelled_pkgs;
811 Unsuspends all unflagged suspended packages (see L</unflagged_suspended_pkgs>
812 and L<FS::cust_pkg>) for this customer. Always returns a list: an empty list
813 on success or a list of errors.
819 grep { $_->unsuspend } $self->suspended_pkgs;
824 Suspends all unsuspended packages (see L<FS::cust_pkg>) for this customer.
825 Always returns a list: an empty list on success or a list of errors.
831 grep { $_->suspend } $self->unsuspended_pkgs;
836 Generates invoices (see L<FS::cust_bill>) for this customer. Usually used in
837 conjunction with the collect method.
839 Options are passed as name-value pairs.
841 The only currently available option is `time', which bills the customer as if
842 it were that time. It is specified as a UNIX timestamp; see
843 L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion
844 functions. For example:
848 $cust_main->bill( 'time' => str2time('April 20th, 2001') );
850 If there is an error, returns the error, otherwise returns false.
855 my( $self, %options ) = @_;
856 my $time = $options{'time'} || time;
861 local $SIG{HUP} = 'IGNORE';
862 local $SIG{INT} = 'IGNORE';
863 local $SIG{QUIT} = 'IGNORE';
864 local $SIG{TERM} = 'IGNORE';
865 local $SIG{TSTP} = 'IGNORE';
866 local $SIG{PIPE} = 'IGNORE';
868 my $oldAutoCommit = $FS::UID::AutoCommit;
869 local $FS::UID::AutoCommit = 0;
872 # find the packages which are due for billing, find out how much they are
873 # & generate invoice database.
875 my( $total_setup, $total_recur ) = ( 0, 0 );
876 my( $taxable_setup, $taxable_recur ) = ( 0, 0 );
877 my @cust_bill_pkg = ();
879 foreach my $cust_pkg (
880 qsearch('cust_pkg', { 'custnum' => $self->custnum } )
883 #NO!! next if $cust_pkg->cancel;
884 next if $cust_pkg->getfield('cancel');
886 #? to avoid use of uninitialized value errors... ?
887 $cust_pkg->setfield('bill', '')
888 unless defined($cust_pkg->bill);
890 my $part_pkg = qsearchs( 'part_pkg', { 'pkgpart' => $cust_pkg->pkgpart } );
892 #so we don't modify cust_pkg record unnecessarily
893 my $cust_pkg_mod_flag = 0;
894 my %hash = $cust_pkg->hash;
895 my $old_cust_pkg = new FS::cust_pkg \%hash;
899 unless ( $cust_pkg->setup ) {
900 my $setup_prog = $part_pkg->getfield('setup');
901 $setup_prog =~ /^(.*)$/ or do {
902 $dbh->rollback if $oldAutoCommit;
903 return "Illegal setup for pkgpart ". $part_pkg->pkgpart.
909 ##$cpt->permit(); #what is necessary?
910 #$cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
911 #$setup = $cpt->reval($setup_prog);
912 $setup = eval $setup_prog;
913 unless ( defined($setup) ) {
914 $dbh->rollback if $oldAutoCommit;
915 return "Error eval-ing part_pkg->setup pkgpart ". $part_pkg->pkgpart.
916 "(expression $setup_prog): $@";
918 $cust_pkg->setfield('setup',$time);
919 $cust_pkg_mod_flag=1;
925 if ( $part_pkg->getfield('freq') > 0 &&
926 ! $cust_pkg->getfield('susp') &&
927 ( $cust_pkg->getfield('bill') || 0 ) < $time
929 my $recur_prog = $part_pkg->getfield('recur');
930 $recur_prog =~ /^(.*)$/ or do {
931 $dbh->rollback if $oldAutoCommit;
932 return "Illegal recur for pkgpart ". $part_pkg->pkgpart.
938 ##$cpt->permit(); #what is necessary?
939 #$cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
940 #$recur = $cpt->reval($recur_prog);
941 $recur = eval $recur_prog;
942 unless ( defined($recur) ) {
943 $dbh->rollback if $oldAutoCommit;
944 return "Error eval-ing part_pkg->recur pkgpart ". $part_pkg->pkgpart.
945 "(expression $recur_prog): $@";
947 #change this bit to use Date::Manip? CAREFUL with timezones (see
948 # mailing list archive)
949 #$sdate=$cust_pkg->bill || time;
950 #$sdate=$cust_pkg->bill || $time;
951 $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
952 my ($sec,$min,$hour,$mday,$mon,$year) =
953 (localtime($sdate) )[0,1,2,3,4,5];
954 $mon += $part_pkg->getfield('freq');
955 until ( $mon < 12 ) { $mon -= 12; $year++; }
956 $cust_pkg->setfield('bill',
957 timelocal($sec,$min,$hour,$mday,$mon,$year));
958 $cust_pkg_mod_flag = 1;
961 warn "\$setup is undefined" unless defined($setup);
962 warn "\$recur is undefined" unless defined($recur);
963 warn "\$cust_pkg->bill is undefined" unless defined($cust_pkg->bill);
965 if ( $cust_pkg_mod_flag ) {
966 $error=$cust_pkg->replace($old_cust_pkg);
967 if ( $error ) { #just in case
968 $dbh->rollback if $oldAutoCommit;
969 return "Error modifying pkgnum ". $cust_pkg->pkgnum. ": $error";
971 $setup = sprintf( "%.2f", $setup );
972 $recur = sprintf( "%.2f", $recur );
974 $dbh->rollback if $oldAutoCommit;
975 return "negative setup $setup for pkgnum ". $cust_pkg->pkgnum;
978 $dbh->rollback if $oldAutoCommit;
979 return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum;
981 if ( $setup > 0 || $recur > 0 ) {
982 my $cust_bill_pkg = new FS::cust_bill_pkg ({
983 'pkgnum' => $cust_pkg->pkgnum,
987 'edate' => $cust_pkg->bill,
989 push @cust_bill_pkg, $cust_bill_pkg;
990 $total_setup += $setup;
991 $total_recur += $recur;
992 $taxable_setup += $setup
993 unless $part_pkg->dbdef_table->column('setuptax')
994 || $part_pkg->setuptax =~ /^Y$/i;
995 $taxable_recur += $recur
996 unless $part_pkg->dbdef_table->column('recurtax')
997 || $part_pkg->recurtax =~ /^Y$/i;
1003 my $charged = sprintf( "%.2f", $total_setup + $total_recur );
1004 my $taxable_charged = sprintf( "%.2f", $taxable_setup + $taxable_recur );
1006 unless ( @cust_bill_pkg ) {
1007 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1011 unless ( $self->tax =~ /Y/i
1012 || $self->payby eq 'COMP'
1013 || $taxable_charged == 0 ) {
1014 my $cust_main_county = qsearchs('cust_main_county',{
1015 'state' => $self->state,
1016 'county' => $self->county,
1017 'country' => $self->country,
1019 my $tax = sprintf( "%.2f",
1020 $taxable_charged * ( $cust_main_county->getfield('tax') / 100 )
1024 $charged = sprintf( "%.2f", $charged+$tax );
1026 my $cust_bill_pkg = new FS::cust_bill_pkg ({
1033 push @cust_bill_pkg, $cust_bill_pkg;
1037 my $cust_bill = new FS::cust_bill ( {
1038 'custnum' => $self->custnum,
1040 'charged' => $charged,
1042 $error = $cust_bill->insert;
1044 $dbh->rollback if $oldAutoCommit;
1045 return "can't create invoice for customer #". $self->custnum. ": $error";
1048 my $invnum = $cust_bill->invnum;
1050 foreach $cust_bill_pkg ( @cust_bill_pkg ) {
1052 $cust_bill_pkg->invnum($invnum);
1053 $error = $cust_bill_pkg->insert;
1055 $dbh->rollback if $oldAutoCommit;
1056 return "can't create invoice line item for customer #". $self->custnum.
1061 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1065 =item collect OPTIONS
1067 (Attempt to) collect money for this customer's outstanding invoices (see
1068 L<FS::cust_bill>). Usually used after the bill method.
1070 Depending on the value of `payby', this may print an invoice (`BILL'), charge
1071 a credit card (`CARD'), or just add any necessary (pseudo-)payment (`COMP').
1073 If there is an error, returns the error, otherwise returns false.
1075 Options are passed as name-value pairs.
1077 Currently available options are:
1079 invoice_time - Use this time when deciding when to print invoices and
1080 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>
1081 for conversion functions.
1083 batch_card - Set this true to batch cards (see L<FS::cust_pay_batch>). By
1084 default, cards are processed immediately, which will generate an error if
1085 CyberCash is not installed.
1087 report_badcard - Set this true if you want bad card transactions to
1088 return an error. By default, they don't.
1090 force_print - force printing even if invoice has been printed more than once
1091 every 30 days, and don't increment the `printed' field.
1096 my( $self, %options ) = @_;
1097 my $invoice_time = $options{'invoice_time'} || time;
1100 local $SIG{HUP} = 'IGNORE';
1101 local $SIG{INT} = 'IGNORE';
1102 local $SIG{QUIT} = 'IGNORE';
1103 local $SIG{TERM} = 'IGNORE';
1104 local $SIG{TSTP} = 'IGNORE';
1105 local $SIG{PIPE} = 'IGNORE';
1107 my $oldAutoCommit = $FS::UID::AutoCommit;
1108 local $FS::UID::AutoCommit = 0;
1111 my $balance = $self->balance;
1112 warn "collect: balance $balance" if $Debug;
1113 unless ( $balance > 0 ) { #redundant?????
1114 $dbh->rollback if $oldAutoCommit; #hmm
1118 foreach my $cust_bill (
1119 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
1122 #this has to be before next's
1123 my $amount = sprintf( "%.2f", $balance < $cust_bill->owed
1127 $balance = sprintf( "%.2f", $balance - $amount );
1129 next unless $cust_bill->owed > 0;
1131 # don't try to charge for the same invoice if it's already in a batch
1132 next if qsearchs( 'cust_pay_batch', { 'invnum' => $cust_bill->invnum } );
1134 warn "invnum ". $cust_bill->invnum. " (owed ". $cust_bill->owed. ", amount $amount, balance $balance)" if $Debug;
1136 next unless $amount > 0;
1138 if ( $self->payby eq 'BILL' ) {
1141 my $since = $invoice_time - ( $cust_bill->_date || 0 );
1142 #warn "$invoice_time ", $cust_bill->_date, " $since";
1143 if ( $since >= 0 #don't print future invoices
1144 && ( ( $cust_bill->printed * 2592000 ) <= $since
1145 || $options{'force_print'} )
1148 #my @print_text = $cust_bill->print_text; #( date )
1149 my @invoicing_list = $self->invoicing_list;
1150 if ( grep { $_ ne 'POST' } @invoicing_list ) { #email invoice
1151 $ENV{SMTPHOSTS} = $smtpmachine;
1152 $ENV{MAILADDRESS} = $invoice_from;
1153 my $header = new Mail::Header ( [
1154 "From: $invoice_from",
1155 "To: ". join(', ', grep { $_ ne 'POST' } @invoicing_list ),
1156 "Sender: $invoice_from",
1157 "Reply-To: $invoice_from",
1158 "Date: ". time2str("%a, %d %b %Y %X %z", time),
1161 my $message = new Mail::Internet (
1162 'Header' => $header,
1163 'Body' => [ $cust_bill->print_text ], #( date)
1165 $message->smtpsend or die "Can't send invoice email!"; #die? warn?
1167 } elsif ( ! @invoicing_list || grep { $_ eq 'POST' } @invoicing_list ) {
1168 open(LPR, "|$lpr") or die "Can't open pipe to $lpr: $!";
1169 print LPR $cust_bill->print_text; #( date )
1171 or die $! ? "Error closing $lpr: $!"
1172 : "Exit status $? from $lpr";
1175 unless ( $options{'force_print'} ) {
1176 my %hash = $cust_bill->hash;
1178 my $new_cust_bill = new FS::cust_bill(\%hash);
1179 my $error = $new_cust_bill->replace($cust_bill);
1180 warn "Error updating $cust_bill->printed: $error" if $error;
1185 } elsif ( $self->payby eq 'COMP' ) {
1186 my $cust_pay = new FS::cust_pay ( {
1187 'invnum' => $cust_bill->invnum,
1191 'payinfo' => $self->payinfo,
1194 my $error = $cust_pay->insert;
1196 $dbh->rollback if $oldAutoCommit;
1197 return 'Error COMPing invnum #'. $cust_bill->invnum. ": $error";
1201 } elsif ( $self->payby eq 'CARD' ) {
1203 if ( $options{'batch_card'} ne 'yes' ) {
1205 unless ( $processor ) {
1206 $dbh->rollback if $oldAutoCommit;
1207 return "Real time card processing not enabled!";
1210 my $address = $self->address1;
1211 $address .= ", ". $self->address2 if $self->address2;
1214 #$self->paydate =~ /^(\d+)\/\d*(\d{2})$/;
1215 $self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
1218 if ( $processor eq 'cybercash3.2' ) {
1220 #fix exp. date for cybercash
1221 #$self->paydate =~ /^(\d+)\/\d*(\d{2})$/;
1222 $self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
1225 my $paybatch = $cust_bill->invnum.
1226 '-' . time2str("%y%m%d%H%M%S", time);
1228 my $payname = $self->payname ||
1229 $self->getfield('first'). ' '. $self->getfield('last');
1232 my $country = $self->country eq 'US' ? 'USA' : $self->country;
1234 my @full_xaction = ( $xaction,
1235 'Order-ID' => $paybatch,
1236 'Amount' => "usd $amount",
1237 'Card-Number' => $self->getfield('payinfo'),
1238 'Card-Name' => $payname,
1239 'Card-Address' => $address,
1240 'Card-City' => $self->getfield('city'),
1241 'Card-State' => $self->getfield('state'),
1242 'Card-Zip' => $self->getfield('zip'),
1243 'Card-Country' => $country,
1248 %result = &CCMckDirectLib3_2::SendCC2_1Server(@full_xaction);
1250 #if ( $result{'MActionCode'} == 7 ) { #cybercash smps v.1.1.3
1251 #if ( $result{'action-code'} == 7 ) { #cybercash smps v.2.1
1252 if ( $result{'MStatus'} eq 'success' ) { #cybercash smps v.2 or 3
1253 my $cust_pay = new FS::cust_pay ( {
1254 'invnum' => $cust_bill->invnum,
1258 'payinfo' => $self->payinfo,
1259 'paybatch' => "$processor:$paybatch",
1261 my $error = $cust_pay->insert;
1263 # gah, even with transactions.
1264 $dbh->commit if $oldAutoCommit; #well.
1265 my $e = 'WARNING: Card debited but database not updated - '.
1266 'error applying payment, invnum #' . $cust_bill->invnum.
1267 " (CyberCash Order-ID $paybatch): $error";
1271 } elsif ( $result{'Mstatus'} ne 'failure-bad-money'
1272 || $options{'report_badcard'} ) {
1273 $dbh->commit if $oldAutoCommit;
1274 return 'Cybercash error, invnum #' .
1275 $cust_bill->invnum. ':'. $result{'MErrMsg'};
1277 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1281 } elsif ( $processor =~ /^Business::OnlinePayment::(.*)$/ ) {
1283 my $bop_processor = $1;
1285 my($payname, $payfirst, $paylast);
1286 if ( $self->payname ) {
1287 $payname = $self->payname;
1288 $payname =~ /^\s*([\w \,\.\-\']*\w)?\s+([\w\,\.\-\']+)$/
1290 $dbh->rollback if $oldAutoCommit;
1291 return "Illegal payname $payname";
1293 ($payfirst, $paylast) = ($1, $2);
1295 $payfirst = $self->getfield('first');
1296 $paylast = $self->getfield('first');
1297 $payname = "$payfirst $paylast";
1300 my @invoicing_list = grep { $_ ne 'POST' } $self->invoicing_list;
1301 if ( $conf->exists('emailinvoiceauto')
1302 || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
1303 push @invoicing_list, $self->default_invoicing_list;
1305 my $email = $invoicing_list[0];
1307 my( $action1, $action2 ) = split(/\s*\,\s*/, $bop_action );
1310 new Business::OnlinePayment( $bop_processor, @bop_options );
1311 $transaction->content(
1313 'login' => $bop_login,
1314 'password' => $bop_password,
1315 'action' => $action1,
1316 'description' => 'Internet Services',
1317 'amount' => $amount,
1318 'invoice_number' => $cust_bill->invnum,
1319 'customer_id' => $self->custnum,
1320 'last_name' => $paylast,
1321 'first_name' => $payfirst,
1323 'address' => $address,
1324 'city' => $self->city,
1325 'state' => $self->state,
1326 'zip' => $self->zip,
1327 'country' => $self->country,
1328 'card_number' => $self->payinfo,
1329 'expiration' => $exp,
1330 'referer' => 'http://cleanwhisker.420.am/',
1333 $transaction->submit();
1335 if ( $transaction->is_success() && $action2 ) {
1336 my $auth = $transaction->authorization;
1337 my $ordernum = $transaction->order_number;
1338 #warn "********* $auth ***********\n";
1339 #warn "********* $ordernum ***********\n";
1341 new Business::OnlinePayment( $bop_processor, @bop_options );
1345 login => $bop_login,
1346 password => $bop_password,
1347 order_number => $ordernum,
1349 authorization => $auth,
1350 description => 'Internet Services',
1355 unless ( $capture->is_success ) {
1356 my $e = "Authorization sucessful but capture failed, invnum #".
1357 $cust_bill->invnum. ': '. $capture->result_code.
1358 ": ". $capture->error_message;
1365 if ( $transaction->is_success() ) {
1367 my $cust_pay = new FS::cust_pay ( {
1368 'invnum' => $cust_bill->invnum,
1372 'payinfo' => $self->payinfo,
1373 'paybatch' => "$processor:". $transaction->authorization,
1375 my $error = $cust_pay->insert;
1377 # gah, even with transactions.
1378 $dbh->commit if $oldAutoCommit; #well.
1379 my $e = 'WARNING: Card debited but database not updated - '.
1380 'error applying payment, invnum #' . $cust_bill->invnum.
1381 " ($processor): $error";
1385 } elsif ( $options{'report_badcard'} ) {
1386 $dbh->commit if $oldAutoCommit;
1387 return "$processor error, invnum #". $cust_bill->invnum. ': '.
1388 $transaction->result_code. ": ". $transaction->error_message;
1390 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1395 $dbh->rollback if $oldAutoCommit;
1396 return "Unknown real-time processor $processor\n";
1399 } else { #batch card
1401 my $cust_pay_batch = new FS::cust_pay_batch ( {
1402 'invnum' => $cust_bill->getfield('invnum'),
1403 'custnum' => $self->getfield('custnum'),
1404 'last' => $self->getfield('last'),
1405 'first' => $self->getfield('first'),
1406 'address1' => $self->getfield('address1'),
1407 'address2' => $self->getfield('address2'),
1408 'city' => $self->getfield('city'),
1409 'state' => $self->getfield('state'),
1410 'zip' => $self->getfield('zip'),
1411 'country' => $self->getfield('country'),
1413 'cardnum' => $self->getfield('payinfo'),
1414 'exp' => $self->getfield('paydate'),
1415 'payname' => $self->getfield('payname'),
1416 'amount' => $amount,
1418 my $error = $cust_pay_batch->insert;
1420 $dbh->rollback if $oldAutoCommit;
1421 return "Error adding to cust_pay_batch: $error";
1427 $dbh->rollback if $oldAutoCommit;
1428 return "Unknown payment type ". $self->payby;
1432 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1439 Returns the total owed for this customer on all invoices
1440 (see L<FS::cust_bill/owed>).
1446 $self->total_owed_date(2145859200); #12/31/2037
1449 =item total_owed_date TIME
1451 Returns the total owed for this customer on all invoices with date earlier than
1452 TIME. TIME is specified as a UNIX timestamp; see L<perlfunc/"time">). Also
1453 see L<Time::Local> and L<Date::Parse> for conversion functions.
1457 sub total_owed_date {
1461 foreach my $cust_bill (
1462 grep { $_->_date <= $time }
1463 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
1465 $total_bill += $cust_bill->owed;
1467 sprintf( "%.2f", $total_bill );
1472 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
1473 to outstanding invoice balances in chronological order and returns the value
1474 of any remaining unapplied credits available for refund
1475 (see L<FS::cust_refund>).
1482 return 0 unless $self->total_credited;
1484 my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
1485 qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
1487 my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
1488 qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
1492 foreach my $cust_bill ( @invoices ) {
1495 if ( !defined($credit) || $credit->credited == 0) {
1496 $credit = pop @credits or last;
1499 if ($cust_bill->owed >= $credit->credited) {
1500 $amount=$credit->credited;
1502 $amount=$cust_bill->owed;
1505 my $cust_credit_bill = new FS::cust_credit_bill ( {
1506 'crednum' => $credit->crednum,
1507 'invnum' => $cust_bill->invnum,
1508 'amount' => $amount,
1510 my $error = $cust_credit_bill->insert;
1511 die $error if $error;
1513 redo if ($cust_bill->owed > 0);
1517 return $self->total_credited;
1520 =item apply_payments
1522 Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
1523 to outstanding invoice balances in chronological order.
1525 #and returns the value of any remaining unapplied payments.
1529 sub apply_payments {
1534 my @payments = sort { $b->_date <=> $a->_date } ( grep { $_->unapplied > 0 }
1535 qsearch('cust_pay', { 'custnum' => $self->custnum } ) );
1537 my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
1538 qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
1542 foreach my $cust_bill ( @invoices ) {
1545 if ( !defined($payment) || $payment->unapplied == 0 ) {
1546 $payment = pop @payments or last;
1549 if ( $cust_bill->owed >= $payment->unapplied ) {
1550 $amount = $payment->unapplied;
1552 $amount = $cust_bill->owed;
1555 my $cust_bill_pay = new FS::cust_bill_pay ( {
1556 'paynum' => $payment->paynum,
1557 'invnum' => $cust_bill->invnum,
1558 'amount' => $amount,
1560 my $error = $cust_bill_pay->insert;
1561 die $error if $error;
1563 redo if ( $cust_bill->owed > 0);
1567 return $self->total_unapplied_payments;
1570 =item total_credited
1572 Returns the total outstanding credit (see L<FS::cust_credit>) for this
1573 customer. See L<FS::cust_credit/credited>.
1577 sub total_credited {
1579 my $total_credit = 0;
1580 foreach my $cust_credit ( qsearch('cust_credit', {
1581 'custnum' => $self->custnum,
1583 $total_credit += $cust_credit->credited;
1585 sprintf( "%.2f", $total_credit );
1588 =item total_unapplied_payments
1590 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
1591 See L<FS::cust_pay/unapplied>.
1595 sub total_unapplied_payments {
1597 my $total_unapplied = 0;
1598 foreach my $cust_pay ( qsearch('cust_pay', {
1599 'custnum' => $self->custnum,
1601 $total_unapplied += $cust_pay->unapplied;
1603 sprintf( "%.2f", $total_unapplied );
1608 Returns the balance for this customer (total_owed minus total_credited
1609 minus total_unapplied_payments).
1616 $self->total_owed - $self->total_credited - $self->total_unapplied_payments
1620 =item balance_date TIME
1622 Returns the balance for this customer, only considering invoices with date
1623 earlier than TIME (total_owed_date minus total_credited minus
1624 total_unapplied_payments). TIME is specified as a UNIX timestamp; see
1625 L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion
1634 $self->total_owed_date($time)
1635 - $self->total_credited
1636 - $self->total_unapplied_payments
1640 =item invoicing_list [ ARRAYREF ]
1642 If an arguement is given, sets these email addresses as invoice recipients
1643 (see L<FS::cust_main_invoice>). Errors are not fatal and are not reported
1644 (except as warnings), so use check_invoicing_list first.
1646 Returns a list of email addresses (with svcnum entries expanded).
1648 Note: You can clear the invoicing list by passing an empty ARRAYREF. You can
1649 check it without disturbing anything by passing nothing.
1651 This interface may change in the future.
1655 sub invoicing_list {
1656 my( $self, $arrayref ) = @_;
1658 my @cust_main_invoice;
1659 if ( $self->custnum ) {
1660 @cust_main_invoice =
1661 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1663 @cust_main_invoice = ();
1665 foreach my $cust_main_invoice ( @cust_main_invoice ) {
1666 #warn $cust_main_invoice->destnum;
1667 unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
1668 #warn $cust_main_invoice->destnum;
1669 my $error = $cust_main_invoice->delete;
1670 warn $error if $error;
1673 if ( $self->custnum ) {
1674 @cust_main_invoice =
1675 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1677 @cust_main_invoice = ();
1679 my %seen = map { $_->address => 1 } @cust_main_invoice;
1680 foreach my $address ( @{$arrayref} ) {
1681 #unless ( grep { $address eq $_->address } @cust_main_invoice ) {
1682 next if exists $seen{$address} && $seen{$address};
1683 $seen{$address} = 1;
1684 my $cust_main_invoice = new FS::cust_main_invoice ( {
1685 'custnum' => $self->custnum,
1688 my $error = $cust_main_invoice->insert;
1689 warn $error if $error;
1692 if ( $self->custnum ) {
1694 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1700 =item check_invoicing_list ARRAYREF
1702 Checks these arguements as valid input for the invoicing_list method. If there
1703 is an error, returns the error, otherwise returns false.
1707 sub check_invoicing_list {
1708 my( $self, $arrayref ) = @_;
1709 foreach my $address ( @{$arrayref} ) {
1710 my $cust_main_invoice = new FS::cust_main_invoice ( {
1711 'custnum' => $self->custnum,
1714 my $error = $self->custnum
1715 ? $cust_main_invoice->check
1716 : $cust_main_invoice->checkdest
1718 return $error if $error;
1723 =item default_invoicing_list
1725 Returns the email addresses of any
1729 sub default_invoicing_list {
1732 foreach my $cust_pkg ( $self->all_pkgs ) {
1733 my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
1735 map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
1736 grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
1738 push @list, map { $_->email } @svc_acct;
1740 $self->invoicing_list(\@list);
1743 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
1745 Returns an array of customers referred by this customer (referral_custnum set
1746 to this custnum). If DEPTH is given, recurses up to the given depth, returning
1747 customers referred by customers referred by this customer and so on, inclusive.
1748 The default behavior is DEPTH 1 (no recursion).
1752 sub referral_cust_main {
1754 my $depth = @_ ? shift : 1;
1755 my $exclude = @_ ? shift : {};
1758 map { $exclude->{$_->custnum}++; $_; }
1759 grep { ! $exclude->{ $_->custnum } }
1760 qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
1764 map { $_->referral_cust_main($depth-1, $exclude) }
1771 =item referral_cust_pkg [ DEPTH ]
1773 Like referral_cust_main, except returns a flat list of all unsuspended packages
1774 for each customer. The number of items in this list may be useful for
1775 comission calculations (perhaps after a grep).
1779 sub referral_cust_pkg {
1781 my $depth = @_ ? shift : 1;
1783 map { $_->unsuspended_pkgs }
1784 grep { $_->unsuspended_pkgs }
1785 $self->referral_cust_main($depth);
1788 =item credit AMOUNT, REASON
1790 Applies a credit to this customer. If there is an error, returns the error,
1791 otherwise returns false.
1796 my( $self, $amount, $reason ) = @_;
1797 my $cust_credit = new FS::cust_credit {
1798 'custnum' => $self->custnum,
1799 'amount' => $amount,
1800 'reason' => $reason,
1802 $cust_credit->insert;
1805 =item charge AMOUNT PKG COMMENT
1807 Creates a one-time charge for this customer. If there is an error, returns
1808 the error, otherwise returns false.
1813 my ( $self, $amount, $pkg, $comment ) = @_;
1815 my $part_pkg = new FS::part_pkg ( {
1816 'pkg' => $pkg || 'One-time charge',
1817 'comment' => $comment,
1834 =item check_and_rebuild_fuzzyfiles
1838 sub check_and_rebuild_fuzzyfiles {
1839 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1840 -e "$dir/cust_main.last" && -e "$dir/cust_main.company"
1841 or &rebuild_fuzzyfiles;
1844 =item rebuild_fuzzyfiles
1848 sub rebuild_fuzzyfiles {
1850 use Fcntl qw(:flock);
1852 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1856 open(LASTLOCK,">>$dir/cust_main.last")
1857 or die "can't open $dir/cust_main.last: $!";
1858 flock(LASTLOCK,LOCK_EX)
1859 or die "can't lock $dir/cust_main.last: $!";
1861 my @all_last = map $_->getfield('last'), qsearch('cust_main', {});
1863 grep $_, map $_->getfield('ship_last'), qsearch('cust_main',{})
1864 if defined dbdef->table('cust_main')->column('ship_last');
1866 open (LASTCACHE,">$dir/cust_main.last.tmp")
1867 or die "can't open $dir/cust_main.last.tmp: $!";
1868 print LASTCACHE join("\n", @all_last), "\n";
1869 close LASTCACHE or die "can't close $dir/cust_main.last.tmp: $!";
1871 rename "$dir/cust_main.last.tmp", "$dir/cust_main.last";
1876 open(COMPANYLOCK,">>$dir/cust_main.company")
1877 or die "can't open $dir/cust_main.company: $!";
1878 flock(COMPANYLOCK,LOCK_EX)
1879 or die "can't lock $dir/cust_main.company: $!";
1881 my @all_company = grep $_ ne '', map $_->company, qsearch('cust_main',{});
1883 grep $_ ne '', map $_->ship_company, qsearch('cust_main', {})
1884 if defined dbdef->table('cust_main')->column('ship_last');
1886 open (COMPANYCACHE,">$dir/cust_main.company.tmp")
1887 or die "can't open $dir/cust_main.company.tmp: $!";
1888 print COMPANYCACHE join("\n", @all_company), "\n";
1889 close COMPANYCACHE or die "can't close $dir/cust_main.company.tmp: $!";
1891 rename "$dir/cust_main.company.tmp", "$dir/cust_main.company";
1901 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1902 open(LASTCACHE,"<$dir/cust_main.last")
1903 or die "can't open $dir/cust_main.last: $!";
1904 my @array = map { chomp; $_; } <LASTCACHE>;
1914 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1915 open(COMPANYCACHE,"<$dir/cust_main.company")
1916 or die "can't open $dir/cust_main.last: $!";
1917 my @array = map { chomp; $_; } <COMPANYCACHE>;
1922 =item append_fuzzyfiles LASTNAME COMPANY
1926 sub append_fuzzyfiles {
1927 my( $last, $company ) = @_;
1929 &check_and_rebuild_fuzzyfiles;
1931 use Fcntl qw(:flock);
1933 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1937 open(LAST,">>$dir/cust_main.last")
1938 or die "can't open $dir/cust_main.last: $!";
1940 or die "can't lock $dir/cust_main.last: $!";
1942 print LAST "$last\n";
1945 or die "can't unlock $dir/cust_main.last: $!";
1951 open(COMPANY,">>$dir/cust_main.company")
1952 or die "can't open $dir/cust_main.company: $!";
1953 flock(COMPANY,LOCK_EX)
1954 or die "can't lock $dir/cust_main.company: $!";
1956 print COMPANY "$company\n";
1958 flock(COMPANY,LOCK_UN)
1959 or die "can't unlock $dir/cust_main.company: $!";
1969 $Id: cust_main.pm,v 1.54 2002-01-09 13:29:33 ivan Exp $
1975 The delete method should possibly take an FS::cust_main object reference
1976 instead of a scalar customer number.
1978 Bill and collect options should probably be passed as references instead of a
1981 CyberCash v2 forces us to define some variables in package main.
1983 There should probably be a configuration file with a list of allowed credit
1986 No multiple currency support (probably a larger project than just this module).
1990 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
1991 L<FS::cust_pay_batch>, L<FS::agent>, L<FS::part_referral>,
1992 L<FS::cust_main_county>, L<FS::cust_main_invoice>,
1993 L<FS::UID>, schema.html from the base documentation.