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 Cancels all uncancelled packages (see L<FS::cust_pkg>) for this customer.
837 Always returns a list: an empty list on success or a list of errors.
843 grep { $_->cancel } $self->ncancelled_pkgs;
848 Generates invoices (see L<FS::cust_bill>) for this customer. Usually used in
849 conjunction with the collect method.
851 Options are passed as name-value pairs.
853 The only currently available option is `time', which bills the customer as if
854 it were that time. It is specified as a UNIX timestamp; see
855 L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion
856 functions. For example:
860 $cust_main->bill( 'time' => str2time('April 20th, 2001') );
862 If there is an error, returns the error, otherwise returns false.
867 my( $self, %options ) = @_;
868 my $time = $options{'time'} || time;
873 local $SIG{HUP} = 'IGNORE';
874 local $SIG{INT} = 'IGNORE';
875 local $SIG{QUIT} = 'IGNORE';
876 local $SIG{TERM} = 'IGNORE';
877 local $SIG{TSTP} = 'IGNORE';
878 local $SIG{PIPE} = 'IGNORE';
880 my $oldAutoCommit = $FS::UID::AutoCommit;
881 local $FS::UID::AutoCommit = 0;
884 # find the packages which are due for billing, find out how much they are
885 # & generate invoice database.
887 my( $total_setup, $total_recur ) = ( 0, 0 );
888 my( $taxable_setup, $taxable_recur ) = ( 0, 0 );
889 my @cust_bill_pkg = ();
891 foreach my $cust_pkg (
892 qsearch('cust_pkg', { 'custnum' => $self->custnum } )
895 #NO!! next if $cust_pkg->cancel;
896 next if $cust_pkg->getfield('cancel');
898 #? to avoid use of uninitialized value errors... ?
899 $cust_pkg->setfield('bill', '')
900 unless defined($cust_pkg->bill);
902 my $part_pkg = qsearchs( 'part_pkg', { 'pkgpart' => $cust_pkg->pkgpart } );
904 #so we don't modify cust_pkg record unnecessarily
905 my $cust_pkg_mod_flag = 0;
906 my %hash = $cust_pkg->hash;
907 my $old_cust_pkg = new FS::cust_pkg \%hash;
911 unless ( $cust_pkg->setup ) {
912 my $setup_prog = $part_pkg->getfield('setup');
913 $setup_prog =~ /^(.*)$/ or do {
914 $dbh->rollback if $oldAutoCommit;
915 return "Illegal setup for pkgpart ". $part_pkg->pkgpart.
921 ##$cpt->permit(); #what is necessary?
922 #$cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
923 #$setup = $cpt->reval($setup_prog);
924 $setup = eval $setup_prog;
925 unless ( defined($setup) ) {
926 $dbh->rollback if $oldAutoCommit;
927 return "Error eval-ing part_pkg->setup pkgpart ". $part_pkg->pkgpart.
928 "(expression $setup_prog): $@";
930 $cust_pkg->setfield('setup',$time);
931 $cust_pkg_mod_flag=1;
937 if ( $part_pkg->getfield('freq') > 0 &&
938 ! $cust_pkg->getfield('susp') &&
939 ( $cust_pkg->getfield('bill') || 0 ) < $time
941 my $recur_prog = $part_pkg->getfield('recur');
942 $recur_prog =~ /^(.*)$/ or do {
943 $dbh->rollback if $oldAutoCommit;
944 return "Illegal recur for pkgpart ". $part_pkg->pkgpart.
950 ##$cpt->permit(); #what is necessary?
951 #$cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
952 #$recur = $cpt->reval($recur_prog);
953 $recur = eval $recur_prog;
954 unless ( defined($recur) ) {
955 $dbh->rollback if $oldAutoCommit;
956 return "Error eval-ing part_pkg->recur pkgpart ". $part_pkg->pkgpart.
957 "(expression $recur_prog): $@";
959 #change this bit to use Date::Manip? CAREFUL with timezones (see
960 # mailing list archive)
961 #$sdate=$cust_pkg->bill || time;
962 #$sdate=$cust_pkg->bill || $time;
963 $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
964 my ($sec,$min,$hour,$mday,$mon,$year) =
965 (localtime($sdate) )[0,1,2,3,4,5];
966 $mon += $part_pkg->getfield('freq');
967 until ( $mon < 12 ) { $mon -= 12; $year++; }
968 $cust_pkg->setfield('bill',
969 timelocal($sec,$min,$hour,$mday,$mon,$year));
970 $cust_pkg_mod_flag = 1;
973 warn "\$setup is undefined" unless defined($setup);
974 warn "\$recur is undefined" unless defined($recur);
975 warn "\$cust_pkg->bill is undefined" unless defined($cust_pkg->bill);
977 if ( $cust_pkg_mod_flag ) {
978 $error=$cust_pkg->replace($old_cust_pkg);
979 if ( $error ) { #just in case
980 $dbh->rollback if $oldAutoCommit;
981 return "Error modifying pkgnum ". $cust_pkg->pkgnum. ": $error";
983 $setup = sprintf( "%.2f", $setup );
984 $recur = sprintf( "%.2f", $recur );
986 $dbh->rollback if $oldAutoCommit;
987 return "negative setup $setup for pkgnum ". $cust_pkg->pkgnum;
990 $dbh->rollback if $oldAutoCommit;
991 return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum;
993 if ( $setup > 0 || $recur > 0 ) {
994 my $cust_bill_pkg = new FS::cust_bill_pkg ({
995 'pkgnum' => $cust_pkg->pkgnum,
999 'edate' => $cust_pkg->bill,
1001 push @cust_bill_pkg, $cust_bill_pkg;
1002 $total_setup += $setup;
1003 $total_recur += $recur;
1004 $taxable_setup += $setup
1005 unless $part_pkg->dbdef_table->column('setuptax')
1006 || $part_pkg->setuptax =~ /^Y$/i;
1007 $taxable_recur += $recur
1008 unless $part_pkg->dbdef_table->column('recurtax')
1009 || $part_pkg->recurtax =~ /^Y$/i;
1015 my $charged = sprintf( "%.2f", $total_setup + $total_recur );
1016 my $taxable_charged = sprintf( "%.2f", $taxable_setup + $taxable_recur );
1018 unless ( @cust_bill_pkg ) {
1019 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1023 unless ( $self->tax =~ /Y/i
1024 || $self->payby eq 'COMP'
1025 || $taxable_charged == 0 ) {
1026 my $cust_main_county = qsearchs('cust_main_county',{
1027 'state' => $self->state,
1028 'county' => $self->county,
1029 'country' => $self->country,
1031 my $tax = sprintf( "%.2f",
1032 $taxable_charged * ( $cust_main_county->getfield('tax') / 100 )
1036 $charged = sprintf( "%.2f", $charged+$tax );
1038 my $cust_bill_pkg = new FS::cust_bill_pkg ({
1045 push @cust_bill_pkg, $cust_bill_pkg;
1049 my $cust_bill = new FS::cust_bill ( {
1050 'custnum' => $self->custnum,
1052 'charged' => $charged,
1054 $error = $cust_bill->insert;
1056 $dbh->rollback if $oldAutoCommit;
1057 return "can't create invoice for customer #". $self->custnum. ": $error";
1060 my $invnum = $cust_bill->invnum;
1062 foreach $cust_bill_pkg ( @cust_bill_pkg ) {
1064 $cust_bill_pkg->invnum($invnum);
1065 $error = $cust_bill_pkg->insert;
1067 $dbh->rollback if $oldAutoCommit;
1068 return "can't create invoice line item for customer #". $self->custnum.
1073 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1077 =item collect OPTIONS
1079 (Attempt to) collect money for this customer's outstanding invoices (see
1080 L<FS::cust_bill>). Usually used after the bill method.
1082 Depending on the value of `payby', this may print an invoice (`BILL'), charge
1083 a credit card (`CARD'), or just add any necessary (pseudo-)payment (`COMP').
1085 If there is an error, returns the error, otherwise returns false.
1087 Options are passed as name-value pairs.
1089 Currently available options are:
1091 invoice_time - Use this time when deciding when to print invoices and
1092 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>
1093 for conversion functions.
1095 batch_card - Set this true to batch cards (see L<FS::cust_pay_batch>). By
1096 default, cards are processed immediately, which will generate an error if
1097 CyberCash is not installed.
1099 report_badcard - Set this true if you want bad card transactions to
1100 return an error. By default, they don't.
1102 force_print - force printing even if invoice has been printed more than once
1103 every 30 days, and don't increment the `printed' field.
1108 my( $self, %options ) = @_;
1109 my $invoice_time = $options{'invoice_time'} || time;
1112 local $SIG{HUP} = 'IGNORE';
1113 local $SIG{INT} = 'IGNORE';
1114 local $SIG{QUIT} = 'IGNORE';
1115 local $SIG{TERM} = 'IGNORE';
1116 local $SIG{TSTP} = 'IGNORE';
1117 local $SIG{PIPE} = 'IGNORE';
1119 my $oldAutoCommit = $FS::UID::AutoCommit;
1120 local $FS::UID::AutoCommit = 0;
1123 my $balance = $self->balance;
1124 warn "collect: balance $balance" if $Debug;
1125 unless ( $balance > 0 ) { #redundant?????
1126 $dbh->rollback if $oldAutoCommit; #hmm
1130 foreach my $cust_bill (
1131 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
1134 #this has to be before next's
1135 my $amount = sprintf( "%.2f", $balance < $cust_bill->owed
1139 $balance = sprintf( "%.2f", $balance - $amount );
1141 next unless $cust_bill->owed > 0;
1143 # don't try to charge for the same invoice if it's already in a batch
1144 next if qsearchs( 'cust_pay_batch', { 'invnum' => $cust_bill->invnum } );
1146 warn "invnum ". $cust_bill->invnum. " (owed ". $cust_bill->owed. ", amount $amount, balance $balance)" if $Debug;
1148 next unless $amount > 0;
1150 if ( $self->payby eq 'BILL' ) {
1153 my $since = $invoice_time - ( $cust_bill->_date || 0 );
1154 #warn "$invoice_time ", $cust_bill->_date, " $since";
1155 if ( $since >= 0 #don't print future invoices
1156 && ( ( $cust_bill->printed * 2592000 ) <= $since
1157 || $options{'force_print'} )
1160 #my @print_text = $cust_bill->print_text; #( date )
1161 my @invoicing_list = $self->invoicing_list;
1162 if ( grep { $_ ne 'POST' } @invoicing_list ) { #email invoice
1163 $ENV{SMTPHOSTS} = $smtpmachine;
1164 $ENV{MAILADDRESS} = $invoice_from;
1165 my $header = new Mail::Header ( [
1166 "From: $invoice_from",
1167 "To: ". join(', ', grep { $_ ne 'POST' } @invoicing_list ),
1168 "Sender: $invoice_from",
1169 "Reply-To: $invoice_from",
1170 "Date: ". time2str("%a, %d %b %Y %X %z", time),
1173 my $message = new Mail::Internet (
1174 'Header' => $header,
1175 'Body' => [ $cust_bill->print_text ], #( date)
1177 $message->smtpsend or die "Can't send invoice email!"; #die? warn?
1179 } elsif ( ! @invoicing_list || grep { $_ eq 'POST' } @invoicing_list ) {
1180 open(LPR, "|$lpr") or die "Can't open pipe to $lpr: $!";
1181 print LPR $cust_bill->print_text; #( date )
1183 or die $! ? "Error closing $lpr: $!"
1184 : "Exit status $? from $lpr";
1187 unless ( $options{'force_print'} ) {
1188 my %hash = $cust_bill->hash;
1190 my $new_cust_bill = new FS::cust_bill(\%hash);
1191 my $error = $new_cust_bill->replace($cust_bill);
1192 warn "Error updating $cust_bill->printed: $error" if $error;
1197 } elsif ( $self->payby eq 'COMP' ) {
1198 my $cust_pay = new FS::cust_pay ( {
1199 'invnum' => $cust_bill->invnum,
1203 'payinfo' => $self->payinfo,
1206 my $error = $cust_pay->insert;
1208 $dbh->rollback if $oldAutoCommit;
1209 return 'Error COMPing invnum #'. $cust_bill->invnum. ": $error";
1213 } elsif ( $self->payby eq 'CARD' ) {
1215 if ( $options{'batch_card'} ne 'yes' ) {
1217 unless ( $processor ) {
1218 $dbh->rollback if $oldAutoCommit;
1219 return "Real time card processing not enabled!";
1222 my $address = $self->address1;
1223 $address .= ", ". $self->address2 if $self->address2;
1226 #$self->paydate =~ /^(\d+)\/\d*(\d{2})$/;
1227 $self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
1230 if ( $processor eq 'cybercash3.2' ) {
1232 #fix exp. date for cybercash
1233 #$self->paydate =~ /^(\d+)\/\d*(\d{2})$/;
1234 $self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
1237 my $paybatch = $cust_bill->invnum.
1238 '-' . time2str("%y%m%d%H%M%S", time);
1240 my $payname = $self->payname ||
1241 $self->getfield('first'). ' '. $self->getfield('last');
1244 my $country = $self->country eq 'US' ? 'USA' : $self->country;
1246 my @full_xaction = ( $xaction,
1247 'Order-ID' => $paybatch,
1248 'Amount' => "usd $amount",
1249 'Card-Number' => $self->getfield('payinfo'),
1250 'Card-Name' => $payname,
1251 'Card-Address' => $address,
1252 'Card-City' => $self->getfield('city'),
1253 'Card-State' => $self->getfield('state'),
1254 'Card-Zip' => $self->getfield('zip'),
1255 'Card-Country' => $country,
1260 %result = &CCMckDirectLib3_2::SendCC2_1Server(@full_xaction);
1262 #if ( $result{'MActionCode'} == 7 ) { #cybercash smps v.1.1.3
1263 #if ( $result{'action-code'} == 7 ) { #cybercash smps v.2.1
1264 if ( $result{'MStatus'} eq 'success' ) { #cybercash smps v.2 or 3
1265 my $cust_pay = new FS::cust_pay ( {
1266 'invnum' => $cust_bill->invnum,
1270 'payinfo' => $self->payinfo,
1271 'paybatch' => "$processor:$paybatch",
1273 my $error = $cust_pay->insert;
1275 # gah, even with transactions.
1276 $dbh->commit if $oldAutoCommit; #well.
1277 my $e = 'WARNING: Card debited but database not updated - '.
1278 'error applying payment, invnum #' . $cust_bill->invnum.
1279 " (CyberCash Order-ID $paybatch): $error";
1283 } elsif ( $result{'Mstatus'} ne 'failure-bad-money'
1284 || $options{'report_badcard'} ) {
1285 $dbh->commit if $oldAutoCommit;
1286 return 'Cybercash error, invnum #' .
1287 $cust_bill->invnum. ':'. $result{'MErrMsg'};
1289 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1293 } elsif ( $processor =~ /^Business::OnlinePayment::(.*)$/ ) {
1295 my $bop_processor = $1;
1297 my($payname, $payfirst, $paylast);
1298 if ( $self->payname ) {
1299 $payname = $self->payname;
1300 $payname =~ /^\s*([\w \,\.\-\']*\w)?\s+([\w\,\.\-\']+)$/
1302 $dbh->rollback if $oldAutoCommit;
1303 return "Illegal payname $payname";
1305 ($payfirst, $paylast) = ($1, $2);
1307 $payfirst = $self->getfield('first');
1308 $paylast = $self->getfield('first');
1309 $payname = "$payfirst $paylast";
1312 my @invoicing_list = grep { $_ ne 'POST' } $self->invoicing_list;
1313 if ( $conf->exists('emailinvoiceauto')
1314 || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
1315 push @invoicing_list, $self->default_invoicing_list;
1317 my $email = $invoicing_list[0];
1319 my( $action1, $action2 ) = split(/\s*\,\s*/, $bop_action );
1322 new Business::OnlinePayment( $bop_processor, @bop_options );
1323 $transaction->content(
1325 'login' => $bop_login,
1326 'password' => $bop_password,
1327 'action' => $action1,
1328 'description' => 'Internet Services',
1329 'amount' => $amount,
1330 'invoice_number' => $cust_bill->invnum,
1331 'customer_id' => $self->custnum,
1332 'last_name' => $paylast,
1333 'first_name' => $payfirst,
1335 'address' => $address,
1336 'city' => $self->city,
1337 'state' => $self->state,
1338 'zip' => $self->zip,
1339 'country' => $self->country,
1340 'card_number' => $self->payinfo,
1341 'expiration' => $exp,
1342 'referer' => 'http://cleanwhisker.420.am/',
1345 $transaction->submit();
1347 if ( $transaction->is_success() && $action2 ) {
1348 my $auth = $transaction->authorization;
1349 my $ordernum = $transaction->order_number;
1350 #warn "********* $auth ***********\n";
1351 #warn "********* $ordernum ***********\n";
1353 new Business::OnlinePayment( $bop_processor, @bop_options );
1357 login => $bop_login,
1358 password => $bop_password,
1359 order_number => $ordernum,
1361 authorization => $auth,
1362 description => 'Internet Services',
1367 unless ( $capture->is_success ) {
1368 my $e = "Authorization sucessful but capture failed, invnum #".
1369 $cust_bill->invnum. ': '. $capture->result_code.
1370 ": ". $capture->error_message;
1377 if ( $transaction->is_success() ) {
1379 my $cust_pay = new FS::cust_pay ( {
1380 'invnum' => $cust_bill->invnum,
1384 'payinfo' => $self->payinfo,
1385 'paybatch' => "$processor:". $transaction->authorization,
1387 my $error = $cust_pay->insert;
1389 # gah, even with transactions.
1390 $dbh->commit if $oldAutoCommit; #well.
1391 my $e = 'WARNING: Card debited but database not updated - '.
1392 'error applying payment, invnum #' . $cust_bill->invnum.
1393 " ($processor): $error";
1397 } elsif ( $options{'report_badcard'} ) {
1398 $dbh->commit if $oldAutoCommit;
1399 return "$processor error, invnum #". $cust_bill->invnum. ': '.
1400 $transaction->result_code. ": ". $transaction->error_message;
1402 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1407 $dbh->rollback if $oldAutoCommit;
1408 return "Unknown real-time processor $processor\n";
1411 } else { #batch card
1413 my $cust_pay_batch = new FS::cust_pay_batch ( {
1414 'invnum' => $cust_bill->getfield('invnum'),
1415 'custnum' => $self->getfield('custnum'),
1416 'last' => $self->getfield('last'),
1417 'first' => $self->getfield('first'),
1418 'address1' => $self->getfield('address1'),
1419 'address2' => $self->getfield('address2'),
1420 'city' => $self->getfield('city'),
1421 'state' => $self->getfield('state'),
1422 'zip' => $self->getfield('zip'),
1423 'country' => $self->getfield('country'),
1425 'cardnum' => $self->getfield('payinfo'),
1426 'exp' => $self->getfield('paydate'),
1427 'payname' => $self->getfield('payname'),
1428 'amount' => $amount,
1430 my $error = $cust_pay_batch->insert;
1432 $dbh->rollback if $oldAutoCommit;
1433 return "Error adding to cust_pay_batch: $error";
1439 $dbh->rollback if $oldAutoCommit;
1440 return "Unknown payment type ". $self->payby;
1444 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1451 Returns the total owed for this customer on all invoices
1452 (see L<FS::cust_bill/owed>).
1458 $self->total_owed_date(2145859200); #12/31/2037
1461 =item total_owed_date TIME
1463 Returns the total owed for this customer on all invoices with date earlier than
1464 TIME. TIME is specified as a UNIX timestamp; see L<perlfunc/"time">). Also
1465 see L<Time::Local> and L<Date::Parse> for conversion functions.
1469 sub total_owed_date {
1473 foreach my $cust_bill (
1474 grep { $_->_date <= $time }
1475 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
1477 $total_bill += $cust_bill->owed;
1479 sprintf( "%.2f", $total_bill );
1484 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
1485 to outstanding invoice balances in chronological order and returns the value
1486 of any remaining unapplied credits available for refund
1487 (see L<FS::cust_refund>).
1494 return 0 unless $self->total_credited;
1496 my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
1497 qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
1499 my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
1500 qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
1504 foreach my $cust_bill ( @invoices ) {
1507 if ( !defined($credit) || $credit->credited == 0) {
1508 $credit = pop @credits or last;
1511 if ($cust_bill->owed >= $credit->credited) {
1512 $amount=$credit->credited;
1514 $amount=$cust_bill->owed;
1517 my $cust_credit_bill = new FS::cust_credit_bill ( {
1518 'crednum' => $credit->crednum,
1519 'invnum' => $cust_bill->invnum,
1520 'amount' => $amount,
1522 my $error = $cust_credit_bill->insert;
1523 die $error if $error;
1525 redo if ($cust_bill->owed > 0);
1529 return $self->total_credited;
1532 =item apply_payments
1534 Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
1535 to outstanding invoice balances in chronological order.
1537 #and returns the value of any remaining unapplied payments.
1541 sub apply_payments {
1546 my @payments = sort { $b->_date <=> $a->_date } ( grep { $_->unapplied > 0 }
1547 qsearch('cust_pay', { 'custnum' => $self->custnum } ) );
1549 my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
1550 qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
1554 foreach my $cust_bill ( @invoices ) {
1557 if ( !defined($payment) || $payment->unapplied == 0 ) {
1558 $payment = pop @payments or last;
1561 if ( $cust_bill->owed >= $payment->unapplied ) {
1562 $amount = $payment->unapplied;
1564 $amount = $cust_bill->owed;
1567 my $cust_bill_pay = new FS::cust_bill_pay ( {
1568 'paynum' => $payment->paynum,
1569 'invnum' => $cust_bill->invnum,
1570 'amount' => $amount,
1572 my $error = $cust_bill_pay->insert;
1573 die $error if $error;
1575 redo if ( $cust_bill->owed > 0);
1579 return $self->total_unapplied_payments;
1582 =item total_credited
1584 Returns the total outstanding credit (see L<FS::cust_credit>) for this
1585 customer. See L<FS::cust_credit/credited>.
1589 sub total_credited {
1591 my $total_credit = 0;
1592 foreach my $cust_credit ( qsearch('cust_credit', {
1593 'custnum' => $self->custnum,
1595 $total_credit += $cust_credit->credited;
1597 sprintf( "%.2f", $total_credit );
1600 =item total_unapplied_payments
1602 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
1603 See L<FS::cust_pay/unapplied>.
1607 sub total_unapplied_payments {
1609 my $total_unapplied = 0;
1610 foreach my $cust_pay ( qsearch('cust_pay', {
1611 'custnum' => $self->custnum,
1613 $total_unapplied += $cust_pay->unapplied;
1615 sprintf( "%.2f", $total_unapplied );
1620 Returns the balance for this customer (total_owed minus total_credited
1621 minus total_unapplied_payments).
1628 $self->total_owed - $self->total_credited - $self->total_unapplied_payments
1632 =item balance_date TIME
1634 Returns the balance for this customer, only considering invoices with date
1635 earlier than TIME (total_owed_date minus total_credited minus
1636 total_unapplied_payments). TIME is specified as a UNIX timestamp; see
1637 L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion
1646 $self->total_owed_date($time)
1647 - $self->total_credited
1648 - $self->total_unapplied_payments
1652 =item invoicing_list [ ARRAYREF ]
1654 If an arguement is given, sets these email addresses as invoice recipients
1655 (see L<FS::cust_main_invoice>). Errors are not fatal and are not reported
1656 (except as warnings), so use check_invoicing_list first.
1658 Returns a list of email addresses (with svcnum entries expanded).
1660 Note: You can clear the invoicing list by passing an empty ARRAYREF. You can
1661 check it without disturbing anything by passing nothing.
1663 This interface may change in the future.
1667 sub invoicing_list {
1668 my( $self, $arrayref ) = @_;
1670 my @cust_main_invoice;
1671 if ( $self->custnum ) {
1672 @cust_main_invoice =
1673 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1675 @cust_main_invoice = ();
1677 foreach my $cust_main_invoice ( @cust_main_invoice ) {
1678 #warn $cust_main_invoice->destnum;
1679 unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
1680 #warn $cust_main_invoice->destnum;
1681 my $error = $cust_main_invoice->delete;
1682 warn $error if $error;
1685 if ( $self->custnum ) {
1686 @cust_main_invoice =
1687 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1689 @cust_main_invoice = ();
1691 my %seen = map { $_->address => 1 } @cust_main_invoice;
1692 foreach my $address ( @{$arrayref} ) {
1693 #unless ( grep { $address eq $_->address } @cust_main_invoice ) {
1694 next if exists $seen{$address} && $seen{$address};
1695 $seen{$address} = 1;
1696 my $cust_main_invoice = new FS::cust_main_invoice ( {
1697 'custnum' => $self->custnum,
1700 my $error = $cust_main_invoice->insert;
1701 warn $error if $error;
1704 if ( $self->custnum ) {
1706 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1712 =item check_invoicing_list ARRAYREF
1714 Checks these arguements as valid input for the invoicing_list method. If there
1715 is an error, returns the error, otherwise returns false.
1719 sub check_invoicing_list {
1720 my( $self, $arrayref ) = @_;
1721 foreach my $address ( @{$arrayref} ) {
1722 my $cust_main_invoice = new FS::cust_main_invoice ( {
1723 'custnum' => $self->custnum,
1726 my $error = $self->custnum
1727 ? $cust_main_invoice->check
1728 : $cust_main_invoice->checkdest
1730 return $error if $error;
1735 =item default_invoicing_list
1737 Sets the invoicing list to all accounts associated with this customer.
1741 sub default_invoicing_list {
1744 foreach my $cust_pkg ( $self->all_pkgs ) {
1745 my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
1747 map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
1748 grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
1750 push @list, map { $_->email } @svc_acct;
1752 $self->invoicing_list(\@list);
1755 =item invoicing_list_addpost
1757 Adds postal invoicing to this customer. If this customer is already configured
1758 to receive postal invoices, does nothing.
1762 sub invoicing_list_addpost {
1764 return if grep { $_ eq 'POST' } $self->invoicing_list;
1765 my @invoicing_list = $self->invoicing_list;
1766 push @invoicing_list, 'POST';
1767 $self->invoicing_list(\@invoicing_list);
1770 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
1772 Returns an array of customers referred by this customer (referral_custnum set
1773 to this custnum). If DEPTH is given, recurses up to the given depth, returning
1774 customers referred by customers referred by this customer and so on, inclusive.
1775 The default behavior is DEPTH 1 (no recursion).
1779 sub referral_cust_main {
1781 my $depth = @_ ? shift : 1;
1782 my $exclude = @_ ? shift : {};
1785 map { $exclude->{$_->custnum}++; $_; }
1786 grep { ! $exclude->{ $_->custnum } }
1787 qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
1791 map { $_->referral_cust_main($depth-1, $exclude) }
1798 =item referral_cust_pkg [ DEPTH ]
1800 Like referral_cust_main, except returns a flat list of all unsuspended packages
1801 for each customer. The number of items in this list may be useful for
1802 comission calculations (perhaps after a grep).
1806 sub referral_cust_pkg {
1808 my $depth = @_ ? shift : 1;
1810 map { $_->unsuspended_pkgs }
1811 grep { $_->unsuspended_pkgs }
1812 $self->referral_cust_main($depth);
1815 =item credit AMOUNT, REASON
1817 Applies a credit to this customer. If there is an error, returns the error,
1818 otherwise returns false.
1823 my( $self, $amount, $reason ) = @_;
1824 my $cust_credit = new FS::cust_credit {
1825 'custnum' => $self->custnum,
1826 'amount' => $amount,
1827 'reason' => $reason,
1829 $cust_credit->insert;
1832 =item charge AMOUNT PKG COMMENT
1834 Creates a one-time charge for this customer. If there is an error, returns
1835 the error, otherwise returns false.
1840 my ( $self, $amount, $pkg, $comment ) = @_;
1842 my $part_pkg = new FS::part_pkg ( {
1843 'pkg' => $pkg || 'One-time charge',
1844 'comment' => $comment,
1861 =item check_and_rebuild_fuzzyfiles
1865 sub check_and_rebuild_fuzzyfiles {
1866 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1867 -e "$dir/cust_main.last" && -e "$dir/cust_main.company"
1868 or &rebuild_fuzzyfiles;
1871 =item rebuild_fuzzyfiles
1875 sub rebuild_fuzzyfiles {
1877 use Fcntl qw(:flock);
1879 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1883 open(LASTLOCK,">>$dir/cust_main.last")
1884 or die "can't open $dir/cust_main.last: $!";
1885 flock(LASTLOCK,LOCK_EX)
1886 or die "can't lock $dir/cust_main.last: $!";
1888 my @all_last = map $_->getfield('last'), qsearch('cust_main', {});
1890 grep $_, map $_->getfield('ship_last'), qsearch('cust_main',{})
1891 if defined dbdef->table('cust_main')->column('ship_last');
1893 open (LASTCACHE,">$dir/cust_main.last.tmp")
1894 or die "can't open $dir/cust_main.last.tmp: $!";
1895 print LASTCACHE join("\n", @all_last), "\n";
1896 close LASTCACHE or die "can't close $dir/cust_main.last.tmp: $!";
1898 rename "$dir/cust_main.last.tmp", "$dir/cust_main.last";
1903 open(COMPANYLOCK,">>$dir/cust_main.company")
1904 or die "can't open $dir/cust_main.company: $!";
1905 flock(COMPANYLOCK,LOCK_EX)
1906 or die "can't lock $dir/cust_main.company: $!";
1908 my @all_company = grep $_ ne '', map $_->company, qsearch('cust_main',{});
1910 grep $_ ne '', map $_->ship_company, qsearch('cust_main', {})
1911 if defined dbdef->table('cust_main')->column('ship_last');
1913 open (COMPANYCACHE,">$dir/cust_main.company.tmp")
1914 or die "can't open $dir/cust_main.company.tmp: $!";
1915 print COMPANYCACHE join("\n", @all_company), "\n";
1916 close COMPANYCACHE or die "can't close $dir/cust_main.company.tmp: $!";
1918 rename "$dir/cust_main.company.tmp", "$dir/cust_main.company";
1928 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1929 open(LASTCACHE,"<$dir/cust_main.last")
1930 or die "can't open $dir/cust_main.last: $!";
1931 my @array = map { chomp; $_; } <LASTCACHE>;
1941 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1942 open(COMPANYCACHE,"<$dir/cust_main.company")
1943 or die "can't open $dir/cust_main.last: $!";
1944 my @array = map { chomp; $_; } <COMPANYCACHE>;
1949 =item append_fuzzyfiles LASTNAME COMPANY
1953 sub append_fuzzyfiles {
1954 my( $last, $company ) = @_;
1956 &check_and_rebuild_fuzzyfiles;
1958 use Fcntl qw(:flock);
1960 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1964 open(LAST,">>$dir/cust_main.last")
1965 or die "can't open $dir/cust_main.last: $!";
1967 or die "can't lock $dir/cust_main.last: $!";
1969 print LAST "$last\n";
1972 or die "can't unlock $dir/cust_main.last: $!";
1978 open(COMPANY,">>$dir/cust_main.company")
1979 or die "can't open $dir/cust_main.company: $!";
1980 flock(COMPANY,LOCK_EX)
1981 or die "can't lock $dir/cust_main.company: $!";
1983 print COMPANY "$company\n";
1985 flock(COMPANY,LOCK_UN)
1986 or die "can't unlock $dir/cust_main.company: $!";
1996 $Id: cust_main.pm,v 1.55 2002-01-29 16:33:15 ivan Exp $
2002 The delete method should possibly take an FS::cust_main object reference
2003 instead of a scalar customer number.
2005 Bill and collect options should probably be passed as references instead of a
2008 CyberCash v2 forces us to define some variables in package main.
2010 There should probably be a configuration file with a list of allowed credit
2013 No multiple currency support (probably a larger project than just this module).
2017 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
2018 L<FS::cust_pay_batch>, L<FS::agent>, L<FS::part_referral>,
2019 L<FS::cust_main_county>, L<FS::cust_main_invoice>,
2020 L<FS::UID>, schema.html from the base documentation.