5 use vars qw( @ISA @EXPORT_OK $DEBUG $me $conf @encrypted_fields
6 $import $skip_fuzzyfiles $ignore_expired_card @paytypes);
7 use vars qw( $realtime_bop_decline_quiet ); #ugh
11 use Time::Local qw(timelocal_nocheck);
14 use Digest::MD5 qw(md5_base64);
18 use String::Approx qw(amatch);
19 use Business::CreditCard 0.28;
22 use FS::UID qw( getotaker dbh driver_name );
23 use FS::Record qw( qsearchs qsearch dbdef );
24 use FS::Misc qw( send_email generate_ps do_print );
25 use FS::Msgcat qw(gettext);
29 use FS::cust_bill_pkg;
31 use FS::cust_pay_pending;
32 use FS::cust_pay_void;
33 use FS::cust_pay_batch;
36 use FS::part_referral;
37 use FS::cust_main_county;
39 use FS::cust_main_invoice;
40 use FS::cust_credit_bill;
41 use FS::cust_bill_pay;
42 use FS::prepay_credit;
46 use FS::part_event_condition;
48 use FS::cust_tax_exempt;
49 use FS::cust_tax_exempt_pkg;
51 use FS::payment_gateway;
52 use FS::agent_payment_gateway;
54 use FS::payinfo_Mixin;
57 @ISA = qw( FS::Record FS::payinfo_Mixin );
59 @EXPORT_OK = qw( smart_search );
61 $realtime_bop_decline_quiet = 0;
63 # 1 is mostly method/subroutine entry and options
64 # 2 traces progress of some operations
65 # 3 is even more information including possibly sensitive data
67 $me = '[FS::cust_main]';
71 $ignore_expired_card = 0;
73 @encrypted_fields = ('payinfo', 'paycvv');
74 @paytypes = ('', 'Personal checking', 'Personal savings', 'Business checking', 'Business savings');
76 #ask FS::UID to run this stuff for us later
77 #$FS::UID::callback{'FS::cust_main'} = sub {
78 install_callback FS::UID sub {
80 #yes, need it for stuff below (prolly should be cached)
85 my ( $hashref, $cache ) = @_;
86 if ( exists $hashref->{'pkgnum'} ) {
87 #@{ $self->{'_pkgnum'} } = ();
88 my $subcache = $cache->subcache( 'pkgnum', 'cust_pkg', $hashref->{custnum});
89 $self->{'_pkgnum'} = $subcache;
90 #push @{ $self->{'_pkgnum'} },
91 FS::cust_pkg->new_or_cached($hashref, $subcache) if $hashref->{pkgnum};
97 FS::cust_main - Object methods for cust_main records
103 $record = new FS::cust_main \%hash;
104 $record = new FS::cust_main { 'column' => 'value' };
106 $error = $record->insert;
108 $error = $new_record->replace($old_record);
110 $error = $record->delete;
112 $error = $record->check;
114 @cust_pkg = $record->all_pkgs;
116 @cust_pkg = $record->ncancelled_pkgs;
118 @cust_pkg = $record->suspended_pkgs;
120 $error = $record->bill;
121 $error = $record->bill %options;
122 $error = $record->bill 'time' => $time;
124 $error = $record->collect;
125 $error = $record->collect %options;
126 $error = $record->collect 'invoice_time' => $time,
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 - Advertising source (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 - Payment Type (See L<FS::payinfo_Mixin> for valid payby values)
198 =item payinfo - Payment Information (See L<FS::payinfo_Mixin> for data format)
200 =item paymask - Masked payinfo (See L<FS::payinfo_Mixin> for how this works)
204 Card Verification Value, "CVV2" (also known as CVC2 or CID), the 3 or 4 digit number on the back (or front, for American Express) of the credit card
206 =item paydate - expiration date, mm/yyyy, m/yyyy, mm/yy or m/yy
208 =item paystart_month - start date month (maestro/solo cards only)
210 =item paystart_year - start date year (maestro/solo cards only)
212 =item payissue - issue number (maestro/solo cards only)
214 =item payname - name on card or billing name
216 =item payip - IP address from which payment information was received
218 =item tax - tax exempt, empty or `Y'
220 =item otaker - order taker (assigned automatically, see L<FS::UID>)
222 =item comments - comments (optional)
224 =item referral_custnum - referring customer number
226 =item spool_cdr - Enable individual CDR spooling, empty or `Y'
236 Creates a new customer. To add the customer to the database, see L<"insert">.
238 Note that this stores the hash reference, not a distinct copy of the hash it
239 points to. You can ask the object for a copy with the I<hash> method.
243 sub table { 'cust_main'; }
245 =item insert [ CUST_PKG_HASHREF [ , INVOICING_LIST_ARYREF ] [ , OPTION => VALUE ... ] ]
247 Adds this customer to the database. If there is an error, returns the error,
248 otherwise returns false.
250 CUST_PKG_HASHREF: If you pass a Tie::RefHash data structure to the insert
251 method containing FS::cust_pkg and FS::svc_I<tablename> objects, all records
252 are inserted atomicly, or the transaction is rolled back. Passing an empty
253 hash reference is equivalent to not supplying this parameter. There should be
254 a better explanation of this, but until then, here's an example:
257 tie %hash, 'Tie::RefHash'; #this part is important
259 $cust_pkg => [ $svc_acct ],
262 $cust_main->insert( \%hash );
264 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
265 be set as the invoicing list (see L<"invoicing_list">). Errors return as
266 expected and rollback the entire transaction; it is not necessary to call
267 check_invoicing_list first. The invoicing_list is set after the records in the
268 CUST_PKG_HASHREF above are inserted, so it is now possible to set an
269 invoicing_list destination to the newly-created svc_acct. Here's an example:
271 $cust_main->insert( {}, [ $email, 'POST' ] );
273 Currently available options are: I<depend_jobnum> and I<noexport>.
275 If I<depend_jobnum> is set, all provisioning jobs will have a dependancy
276 on the supplied jobnum (they will not run until the specific job completes).
277 This can be used to defer provisioning until some action completes (such
278 as running the customer's credit card successfully).
280 The I<noexport> option is deprecated. If I<noexport> is set true, no
281 provisioning jobs (exports) are scheduled. (You can schedule them later with
282 the B<reexport> method.)
288 my $cust_pkgs = @_ ? shift : {};
289 my $invoicing_list = @_ ? shift : '';
291 warn "$me insert called with options ".
292 join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
295 local $SIG{HUP} = 'IGNORE';
296 local $SIG{INT} = 'IGNORE';
297 local $SIG{QUIT} = 'IGNORE';
298 local $SIG{TERM} = 'IGNORE';
299 local $SIG{TSTP} = 'IGNORE';
300 local $SIG{PIPE} = 'IGNORE';
302 my $oldAutoCommit = $FS::UID::AutoCommit;
303 local $FS::UID::AutoCommit = 0;
306 my $prepay_identifier = '';
307 my( $amount, $seconds ) = ( 0, 0 );
309 if ( $self->payby eq 'PREPAY' ) {
311 $self->payby('BILL');
312 $prepay_identifier = $self->payinfo;
315 warn " looking up prepaid card $prepay_identifier\n"
318 my $error = $self->get_prepay($prepay_identifier, \$amount, \$seconds);
320 $dbh->rollback if $oldAutoCommit;
321 #return "error applying prepaid card (transaction rolled back): $error";
325 $payby = 'PREP' if $amount;
327 } elsif ( $self->payby =~ /^(CASH|WEST|MCRD)$/ ) {
330 $self->payby('BILL');
331 $amount = $self->paid;
335 warn " inserting $self\n"
338 $self->signupdate(time) unless $self->signupdate;
340 my $error = $self->SUPER::insert;
342 $dbh->rollback if $oldAutoCommit;
343 #return "inserting cust_main record (transaction rolled back): $error";
347 warn " setting invoicing list\n"
350 if ( $invoicing_list ) {
351 $error = $self->check_invoicing_list( $invoicing_list );
353 $dbh->rollback if $oldAutoCommit;
354 #return "checking invoicing_list (transaction rolled back): $error";
357 $self->invoicing_list( $invoicing_list );
360 if ( $conf->config('cust_main-skeleton_tables')
361 && $conf->config('cust_main-skeleton_custnum') ) {
363 warn " inserting skeleton records\n"
366 my $error = $self->start_copy_skel;
368 $dbh->rollback if $oldAutoCommit;
374 warn " ordering packages\n"
377 $error = $self->order_pkgs($cust_pkgs, \$seconds, %options);
379 $dbh->rollback if $oldAutoCommit;
384 $dbh->rollback if $oldAutoCommit;
385 return "No svc_acct record to apply pre-paid time";
389 warn " inserting initial $payby payment of $amount\n"
391 $error = $self->insert_cust_pay($payby, $amount, $prepay_identifier);
393 $dbh->rollback if $oldAutoCommit;
394 return "inserting payment (transaction rolled back): $error";
398 unless ( $import || $skip_fuzzyfiles ) {
399 warn " queueing fuzzyfiles update\n"
401 $error = $self->queue_fuzzyfiles_update;
403 $dbh->rollback if $oldAutoCommit;
404 return "updating fuzzy search cache: $error";
408 warn " insert complete; committing transaction\n"
411 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
416 sub start_copy_skel {
419 #'mg_user_preference' => {},
420 #'mg_user_indicator_profile.user_indicator_profile_id' => { 'mg_profile_indicator.profile_indicator_id' => { 'mg_profile_details.profile_detail_id' }, },
421 #'mg_watchlist_header.watchlist_header_id' => { 'mg_watchlist_details.watchlist_details_id' },
422 #'mg_user_grid_header.grid_header_id' => { 'mg_user_grid_details.user_grid_details_id' },
423 #'mg_portfolio_header.portfolio_header_id' => { 'mg_portfolio_trades.portfolio_trades_id' => { 'mg_portfolio_trades_positions.portfolio_trades_positions_id' } },
424 my @tables = eval(join('\n',$conf->config('cust_main-skeleton_tables')));
427 _copy_skel( 'cust_main', #tablename
428 $conf->config('cust_main-skeleton_custnum'), #sourceid
429 $self->custnum, #destid
430 @tables, #child tables
434 #recursive subroutine, not a method
436 my( $table, $sourceid, $destid, %child_tables ) = @_;
439 if ( $table =~ /^(\w+)\.(\w+)$/ ) {
440 ( $table, $primary_key ) = ( $1, $2 );
442 my $dbdef_table = dbdef->table($table);
443 $primary_key = $dbdef_table->primary_key
444 or return "$table has no primary key".
445 " (or do you need to run dbdef-create?)";
448 warn " _copy_skel: $table.$primary_key $sourceid to $destid for ".
449 join (', ', keys %child_tables). "\n"
452 foreach my $child_table_def ( keys %child_tables ) {
456 if ( $child_table_def =~ /^(\w+)\.(\w+)$/ ) {
457 ( $child_table, $child_pkey ) = ( $1, $2 );
459 $child_table = $child_table_def;
461 $child_pkey = dbdef->table($child_table)->primary_key;
462 # or return "$table has no primary key".
463 # " (or do you need to run dbdef-create?)\n";
467 if ( keys %{ $child_tables{$child_table_def} } ) {
469 return "$child_table has no primary key".
470 " (run dbdef-create or try specifying it?)\n"
473 #false laziness w/Record::insert and only works on Pg
474 #refactor the proper last-inserted-id stuff out of Record::insert if this
475 # ever gets use for anything besides a quick kludge for one customer
476 my $default = dbdef->table($child_table)->column($child_pkey)->default;
477 $default =~ /^nextval\(\(?'"?([\w\.]+)"?'/i
478 or return "can't parse $child_table.$child_pkey default value ".
479 " for sequence name: $default";
484 my @sel_columns = grep { $_ ne $primary_key }
485 dbdef->table($child_table)->columns;
486 my $sel_columns = join(', ', @sel_columns );
488 my @ins_columns = grep { $_ ne $child_pkey } @sel_columns;
489 my $ins_columns = ' ( '. join(', ', $primary_key, @ins_columns ). ' ) ';
490 my $placeholders = ' ( ?, '. join(', ', map '?', @ins_columns ). ' ) ';
492 my $sel_st = "SELECT $sel_columns FROM $child_table".
493 " WHERE $primary_key = $sourceid";
496 my $sel_sth = dbh->prepare( $sel_st )
497 or return dbh->errstr;
499 $sel_sth->execute or return $sel_sth->errstr;
501 while ( my $row = $sel_sth->fetchrow_hashref ) {
503 warn " selected row: ".
504 join(', ', map { "$_=".$row->{$_} } keys %$row ). "\n"
508 "INSERT INTO $child_table $ins_columns VALUES $placeholders";
509 my $ins_sth =dbh->prepare($statement)
510 or return dbh->errstr;
511 my @param = ( $destid, map $row->{$_}, @ins_columns );
512 warn " $statement: [ ". join(', ', @param). " ]\n"
514 $ins_sth->execute( @param )
515 or return $ins_sth->errstr;
517 #next unless keys %{ $child_tables{$child_table} };
518 next unless $sequence;
520 #another section of that laziness
521 my $seq_sql = "SELECT currval('$sequence')";
522 my $seq_sth = dbh->prepare($seq_sql) or return dbh->errstr;
523 $seq_sth->execute or return $seq_sth->errstr;
524 my $insertid = $seq_sth->fetchrow_arrayref->[0];
526 # don't drink soap! recurse! recurse! okay!
528 _copy_skel( $child_table_def,
529 $row->{$child_pkey}, #sourceid
531 %{ $child_tables{$child_table_def} },
533 return $error if $error;
543 =item order_pkgs HASHREF, [ SECONDSREF, [ , OPTION => VALUE ... ] ]
545 Like the insert method on an existing record, this method orders a package
546 and included services atomicaly. Pass a Tie::RefHash data structure to this
547 method containing FS::cust_pkg and FS::svc_I<tablename> objects. There should
548 be a better explanation of this, but until then, here's an example:
551 tie %hash, 'Tie::RefHash'; #this part is important
553 $cust_pkg => [ $svc_acct ],
556 $cust_main->order_pkgs( \%hash, \'0', 'noexport'=>1 );
558 Services can be new, in which case they are inserted, or existing unaudited
559 services, in which case they are linked to the newly-created package.
561 Currently available options are: I<depend_jobnum> and I<noexport>.
563 If I<depend_jobnum> is set, all provisioning jobs will have a dependancy
564 on the supplied jobnum (they will not run until the specific job completes).
565 This can be used to defer provisioning until some action completes (such
566 as running the customer's credit card successfully).
568 The I<noexport> option is deprecated. If I<noexport> is set true, no
569 provisioning jobs (exports) are scheduled. (You can schedule them later with
570 the B<reexport> method for each cust_pkg object. Using the B<reexport> method
571 on the cust_main object is not recommended, as existing services will also be
578 my $cust_pkgs = shift;
581 my %svc_options = ();
582 $svc_options{'depend_jobnum'} = $options{'depend_jobnum'}
583 if exists $options{'depend_jobnum'};
584 warn "$me order_pkgs called with options ".
585 join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
588 local $SIG{HUP} = 'IGNORE';
589 local $SIG{INT} = 'IGNORE';
590 local $SIG{QUIT} = 'IGNORE';
591 local $SIG{TERM} = 'IGNORE';
592 local $SIG{TSTP} = 'IGNORE';
593 local $SIG{PIPE} = 'IGNORE';
595 my $oldAutoCommit = $FS::UID::AutoCommit;
596 local $FS::UID::AutoCommit = 0;
599 local $FS::svc_Common::noexport_hack = 1 if $options{'noexport'};
601 foreach my $cust_pkg ( keys %$cust_pkgs ) {
602 $cust_pkg->custnum( $self->custnum );
603 my $error = $cust_pkg->insert;
605 $dbh->rollback if $oldAutoCommit;
606 return "inserting cust_pkg (transaction rolled back): $error";
608 foreach my $svc_something ( @{$cust_pkgs->{$cust_pkg}} ) {
609 if ( $svc_something->svcnum ) {
610 my $old_cust_svc = $svc_something->cust_svc;
611 my $new_cust_svc = new FS::cust_svc { $old_cust_svc->hash };
612 $new_cust_svc->pkgnum( $cust_pkg->pkgnum);
613 $error = $new_cust_svc->replace($old_cust_svc);
615 $svc_something->pkgnum( $cust_pkg->pkgnum );
616 if ( $seconds && $$seconds && $svc_something->isa('FS::svc_acct') ) {
617 $svc_something->seconds( $svc_something->seconds + $$seconds );
620 $error = $svc_something->insert(%svc_options);
623 $dbh->rollback if $oldAutoCommit;
624 #return "inserting svc_ (transaction rolled back): $error";
630 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
634 =item recharge_prepay IDENTIFIER | PREPAY_CREDIT_OBJ [ , AMOUNTREF, SECONDSREF, UPBYTEREF, DOWNBYTEREF ]
636 Recharges this (existing) customer with the specified prepaid card (see
637 L<FS::prepay_credit>), specified either by I<identifier> or as an
638 FS::prepay_credit object. If there is an error, returns the error, otherwise
641 Optionally, four scalar references can be passed as well. They will have their
642 values filled in with the amount, number of seconds, and number of upload and
643 download bytes applied by this prepaid
648 sub recharge_prepay {
649 my( $self, $prepay_credit, $amountref, $secondsref,
650 $upbytesref, $downbytesref, $totalbytesref ) = @_;
652 local $SIG{HUP} = 'IGNORE';
653 local $SIG{INT} = 'IGNORE';
654 local $SIG{QUIT} = 'IGNORE';
655 local $SIG{TERM} = 'IGNORE';
656 local $SIG{TSTP} = 'IGNORE';
657 local $SIG{PIPE} = 'IGNORE';
659 my $oldAutoCommit = $FS::UID::AutoCommit;
660 local $FS::UID::AutoCommit = 0;
663 my( $amount, $seconds, $upbytes, $downbytes, $totalbytes) = ( 0, 0, 0, 0, 0 );
665 my $error = $self->get_prepay($prepay_credit, \$amount,
666 \$seconds, \$upbytes, \$downbytes, \$totalbytes)
667 || $self->increment_seconds($seconds)
668 || $self->increment_upbytes($upbytes)
669 || $self->increment_downbytes($downbytes)
670 || $self->increment_totalbytes($totalbytes)
671 || $self->insert_cust_pay_prepay( $amount,
673 ? $prepay_credit->identifier
678 $dbh->rollback if $oldAutoCommit;
682 if ( defined($amountref) ) { $$amountref = $amount; }
683 if ( defined($secondsref) ) { $$secondsref = $seconds; }
684 if ( defined($upbytesref) ) { $$upbytesref = $upbytes; }
685 if ( defined($downbytesref) ) { $$downbytesref = $downbytes; }
686 if ( defined($totalbytesref) ) { $$totalbytesref = $totalbytes; }
688 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
693 =item get_prepay IDENTIFIER | PREPAY_CREDIT_OBJ , AMOUNTREF, SECONDSREF
695 Looks up and deletes a prepaid card (see L<FS::prepay_credit>),
696 specified either by I<identifier> or as an FS::prepay_credit object.
698 References to I<amount> and I<seconds> scalars should be passed as arguments
699 and will be incremented by the values of the prepaid card.
701 If the prepaid card specifies an I<agentnum> (see L<FS::agent>), it is used to
702 check or set this customer's I<agentnum>.
704 If there is an error, returns the error, otherwise returns false.
710 my( $self, $prepay_credit, $amountref, $secondsref,
711 $upref, $downref, $totalref) = @_;
713 local $SIG{HUP} = 'IGNORE';
714 local $SIG{INT} = 'IGNORE';
715 local $SIG{QUIT} = 'IGNORE';
716 local $SIG{TERM} = 'IGNORE';
717 local $SIG{TSTP} = 'IGNORE';
718 local $SIG{PIPE} = 'IGNORE';
720 my $oldAutoCommit = $FS::UID::AutoCommit;
721 local $FS::UID::AutoCommit = 0;
724 unless ( ref($prepay_credit) ) {
726 my $identifier = $prepay_credit;
728 $prepay_credit = qsearchs(
730 { 'identifier' => $prepay_credit },
735 unless ( $prepay_credit ) {
736 $dbh->rollback if $oldAutoCommit;
737 return "Invalid prepaid card: ". $identifier;
742 if ( $prepay_credit->agentnum ) {
743 if ( $self->agentnum && $self->agentnum != $prepay_credit->agentnum ) {
744 $dbh->rollback if $oldAutoCommit;
745 return "prepaid card not valid for agent ". $self->agentnum;
747 $self->agentnum($prepay_credit->agentnum);
750 my $error = $prepay_credit->delete;
752 $dbh->rollback if $oldAutoCommit;
753 return "removing prepay_credit (transaction rolled back): $error";
756 $$amountref += $prepay_credit->amount;
757 $$secondsref += $prepay_credit->seconds;
758 $$upref += $prepay_credit->upbytes;
759 $$downref += $prepay_credit->downbytes;
760 $$totalref += $prepay_credit->totalbytes;
762 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
767 =item increment_upbytes SECONDS
769 Updates this customer's single or primary account (see L<FS::svc_acct>) by
770 the specified number of upbytes. If there is an error, returns the error,
771 otherwise returns false.
775 sub increment_upbytes {
776 _increment_column( shift, 'upbytes', @_);
779 =item increment_downbytes SECONDS
781 Updates this customer's single or primary account (see L<FS::svc_acct>) by
782 the specified number of downbytes. If there is an error, returns the error,
783 otherwise returns false.
787 sub increment_downbytes {
788 _increment_column( shift, 'downbytes', @_);
791 =item increment_totalbytes SECONDS
793 Updates this customer's single or primary account (see L<FS::svc_acct>) by
794 the specified number of totalbytes. If there is an error, returns the error,
795 otherwise returns false.
799 sub increment_totalbytes {
800 _increment_column( shift, 'totalbytes', @_);
803 =item increment_seconds SECONDS
805 Updates this customer's single or primary account (see L<FS::svc_acct>) by
806 the specified number of seconds. If there is an error, returns the error,
807 otherwise returns false.
811 sub increment_seconds {
812 _increment_column( shift, 'seconds', @_);
815 =item _increment_column AMOUNT
817 Updates this customer's single or primary account (see L<FS::svc_acct>) by
818 the specified number of seconds or bytes. If there is an error, returns
819 the error, otherwise returns false.
823 sub _increment_column {
824 my( $self, $column, $amount ) = @_;
825 warn "$me increment_column called: $column, $amount\n"
828 return '' unless $amount;
830 my @cust_pkg = grep { $_->part_pkg->svcpart('svc_acct') }
831 $self->ncancelled_pkgs;
834 return 'No packages with primary or single services found'.
835 ' to apply pre-paid time';
836 } elsif ( scalar(@cust_pkg) > 1 ) {
837 #maybe have a way to specify the package/account?
838 return 'Multiple packages found to apply pre-paid time';
841 my $cust_pkg = $cust_pkg[0];
842 warn " found package pkgnum ". $cust_pkg->pkgnum. "\n"
846 $cust_pkg->cust_svc( $cust_pkg->part_pkg->svcpart('svc_acct') );
849 return 'No account found to apply pre-paid time';
850 } elsif ( scalar(@cust_svc) > 1 ) {
851 return 'Multiple accounts found to apply pre-paid time';
854 my $svc_acct = $cust_svc[0]->svc_x;
855 warn " found service svcnum ". $svc_acct->pkgnum.
856 ' ('. $svc_acct->email. ")\n"
859 $column = "increment_$column";
860 $svc_acct->$column($amount);
864 =item insert_cust_pay_prepay AMOUNT [ PAYINFO ]
866 Inserts a prepayment in the specified amount for this customer. An optional
867 second argument can specify the prepayment identifier for tracking purposes.
868 If there is an error, returns the error, otherwise returns false.
872 sub insert_cust_pay_prepay {
873 shift->insert_cust_pay('PREP', @_);
876 =item insert_cust_pay_cash AMOUNT [ PAYINFO ]
878 Inserts a cash payment in the specified amount for this customer. An optional
879 second argument can specify the payment identifier for tracking purposes.
880 If there is an error, returns the error, otherwise returns false.
884 sub insert_cust_pay_cash {
885 shift->insert_cust_pay('CASH', @_);
888 =item insert_cust_pay_west AMOUNT [ PAYINFO ]
890 Inserts a Western Union payment in the specified amount for this customer. An
891 optional second argument can specify the prepayment identifier for tracking
892 purposes. If there is an error, returns the error, otherwise returns false.
896 sub insert_cust_pay_west {
897 shift->insert_cust_pay('WEST', @_);
900 sub insert_cust_pay {
901 my( $self, $payby, $amount ) = splice(@_, 0, 3);
902 my $payinfo = scalar(@_) ? shift : '';
904 my $cust_pay = new FS::cust_pay {
905 'custnum' => $self->custnum,
906 'paid' => sprintf('%.2f', $amount),
907 #'_date' => #date the prepaid card was purchased???
909 'payinfo' => $payinfo,
917 This method is deprecated. See the I<depend_jobnum> option to the insert and
918 order_pkgs methods for a better way to defer provisioning.
920 Re-schedules all exports by calling the B<reexport> method of all associated
921 packages (see L<FS::cust_pkg>). If there is an error, returns the error;
922 otherwise returns false.
929 carp "WARNING: FS::cust_main::reexport is deprectated; ".
930 "use the depend_jobnum option to insert or order_pkgs to delay export";
932 local $SIG{HUP} = 'IGNORE';
933 local $SIG{INT} = 'IGNORE';
934 local $SIG{QUIT} = 'IGNORE';
935 local $SIG{TERM} = 'IGNORE';
936 local $SIG{TSTP} = 'IGNORE';
937 local $SIG{PIPE} = 'IGNORE';
939 my $oldAutoCommit = $FS::UID::AutoCommit;
940 local $FS::UID::AutoCommit = 0;
943 foreach my $cust_pkg ( $self->ncancelled_pkgs ) {
944 my $error = $cust_pkg->reexport;
946 $dbh->rollback if $oldAutoCommit;
951 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
956 =item delete NEW_CUSTNUM
958 This deletes the customer. If there is an error, returns the error, otherwise
961 This will completely remove all traces of the customer record. This is not
962 what you want when a customer cancels service; for that, cancel all of the
963 customer's packages (see L</cancel>).
965 If the customer has any uncancelled packages, you need to pass a new (valid)
966 customer number for those packages to be transferred to. Cancelled packages
967 will be deleted. Did I mention that this is NOT what you want when a customer
968 cancels service and that you really should be looking see L<FS::cust_pkg/cancel>?
970 You can't delete a customer with invoices (see L<FS::cust_bill>),
971 or credits (see L<FS::cust_credit>), payments (see L<FS::cust_pay>) or
972 refunds (see L<FS::cust_refund>).
979 local $SIG{HUP} = 'IGNORE';
980 local $SIG{INT} = 'IGNORE';
981 local $SIG{QUIT} = 'IGNORE';
982 local $SIG{TERM} = 'IGNORE';
983 local $SIG{TSTP} = 'IGNORE';
984 local $SIG{PIPE} = 'IGNORE';
986 my $oldAutoCommit = $FS::UID::AutoCommit;
987 local $FS::UID::AutoCommit = 0;
990 if ( $self->cust_bill ) {
991 $dbh->rollback if $oldAutoCommit;
992 return "Can't delete a customer with invoices";
994 if ( $self->cust_credit ) {
995 $dbh->rollback if $oldAutoCommit;
996 return "Can't delete a customer with credits";
998 if ( $self->cust_pay ) {
999 $dbh->rollback if $oldAutoCommit;
1000 return "Can't delete a customer with payments";
1002 if ( $self->cust_refund ) {
1003 $dbh->rollback if $oldAutoCommit;
1004 return "Can't delete a customer with refunds";
1007 my @cust_pkg = $self->ncancelled_pkgs;
1009 my $new_custnum = shift;
1010 unless ( qsearchs( 'cust_main', { 'custnum' => $new_custnum } ) ) {
1011 $dbh->rollback if $oldAutoCommit;
1012 return "Invalid new customer number: $new_custnum";
1014 foreach my $cust_pkg ( @cust_pkg ) {
1015 my %hash = $cust_pkg->hash;
1016 $hash{'custnum'} = $new_custnum;
1017 my $new_cust_pkg = new FS::cust_pkg ( \%hash );
1018 my $error = $new_cust_pkg->replace($cust_pkg,
1019 options => { $cust_pkg->options },
1022 $dbh->rollback if $oldAutoCommit;
1027 my @cancelled_cust_pkg = $self->all_pkgs;
1028 foreach my $cust_pkg ( @cancelled_cust_pkg ) {
1029 my $error = $cust_pkg->delete;
1031 $dbh->rollback if $oldAutoCommit;
1036 foreach my $cust_main_invoice ( #(email invoice destinations, not invoices)
1037 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } )
1039 my $error = $cust_main_invoice->delete;
1041 $dbh->rollback if $oldAutoCommit;
1046 my $error = $self->SUPER::delete;
1048 $dbh->rollback if $oldAutoCommit;
1052 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1057 =item replace OLD_RECORD [ INVOICING_LIST_ARYREF ]
1059 Replaces the OLD_RECORD with this one in the database. If there is an error,
1060 returns the error, otherwise returns false.
1062 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
1063 be set as the invoicing list (see L<"invoicing_list">). Errors return as
1064 expected and rollback the entire transaction; it is not necessary to call
1065 check_invoicing_list first. Here's an example:
1067 $new_cust_main->replace( $old_cust_main, [ $email, 'POST' ] );
1075 warn "$me replace called\n"
1078 local $SIG{HUP} = 'IGNORE';
1079 local $SIG{INT} = 'IGNORE';
1080 local $SIG{QUIT} = 'IGNORE';
1081 local $SIG{TERM} = 'IGNORE';
1082 local $SIG{TSTP} = 'IGNORE';
1083 local $SIG{PIPE} = 'IGNORE';
1085 # We absolutely have to have an old vs. new record to make this work.
1086 if (!defined($old)) {
1087 $old = qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
1090 my $curuser = $FS::CurrentUser::CurrentUser;
1091 if ( $self->payby eq 'COMP'
1092 && $self->payby ne $old->payby
1093 && ! $curuser->access_right('Complimentary customer')
1096 return "You are not permitted to create complimentary accounts.";
1099 local($ignore_expired_card) = 1
1100 if $old->payby =~ /^(CARD|DCRD)$/
1101 && $self->payby =~ /^(CARD|DCRD)$/
1102 && ( $old->payinfo eq $self->payinfo || $old->paymask eq $self->paymask );
1104 my $oldAutoCommit = $FS::UID::AutoCommit;
1105 local $FS::UID::AutoCommit = 0;
1108 my $error = $self->SUPER::replace($old);
1111 $dbh->rollback if $oldAutoCommit;
1115 if ( @param ) { # INVOICING_LIST_ARYREF
1116 my $invoicing_list = shift @param;
1117 $error = $self->check_invoicing_list( $invoicing_list );
1119 $dbh->rollback if $oldAutoCommit;
1122 $self->invoicing_list( $invoicing_list );
1125 if ( $self->payby =~ /^(CARD|CHEK|LECB)$/ &&
1126 grep { $self->get($_) ne $old->get($_) } qw(payinfo paydate payname) ) {
1127 # card/check/lec info has changed, want to retry realtime_ invoice events
1128 my $error = $self->retry_realtime;
1130 $dbh->rollback if $oldAutoCommit;
1135 unless ( $import || $skip_fuzzyfiles ) {
1136 $error = $self->queue_fuzzyfiles_update;
1138 $dbh->rollback if $oldAutoCommit;
1139 return "updating fuzzy search cache: $error";
1143 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1148 =item queue_fuzzyfiles_update
1150 Used by insert & replace to update the fuzzy search cache
1154 sub queue_fuzzyfiles_update {
1157 local $SIG{HUP} = 'IGNORE';
1158 local $SIG{INT} = 'IGNORE';
1159 local $SIG{QUIT} = 'IGNORE';
1160 local $SIG{TERM} = 'IGNORE';
1161 local $SIG{TSTP} = 'IGNORE';
1162 local $SIG{PIPE} = 'IGNORE';
1164 my $oldAutoCommit = $FS::UID::AutoCommit;
1165 local $FS::UID::AutoCommit = 0;
1168 my $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
1169 my $error = $queue->insert( map $self->getfield($_),
1170 qw(first last company)
1173 $dbh->rollback if $oldAutoCommit;
1174 return "queueing job (transaction rolled back): $error";
1177 if ( $self->ship_last ) {
1178 $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
1179 $error = $queue->insert( map $self->getfield("ship_$_"),
1180 qw(first last company)
1183 $dbh->rollback if $oldAutoCommit;
1184 return "queueing job (transaction rolled back): $error";
1188 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1195 Checks all fields to make sure this is a valid customer record. If there is
1196 an error, returns the error, otherwise returns false. Called by the insert
1197 and replace methods.
1204 warn "$me check BEFORE: \n". $self->_dump
1208 $self->ut_numbern('custnum')
1209 || $self->ut_number('agentnum')
1210 || $self->ut_textn('agent_custid')
1211 || $self->ut_number('refnum')
1212 || $self->ut_name('last')
1213 || $self->ut_name('first')
1214 || $self->ut_snumbern('birthdate')
1215 || $self->ut_snumbern('signupdate')
1216 || $self->ut_textn('company')
1217 || $self->ut_text('address1')
1218 || $self->ut_textn('address2')
1219 || $self->ut_text('city')
1220 || $self->ut_textn('county')
1221 || $self->ut_textn('state')
1222 || $self->ut_country('country')
1223 || $self->ut_anything('comments')
1224 || $self->ut_numbern('referral_custnum')
1225 || $self->ut_textn('stateid')
1226 || $self->ut_textn('stateid_state')
1227 || $self->ut_textn('invoice_terms')
1229 #barf. need message catalogs. i18n. etc.
1230 $error .= "Please select an advertising source."
1231 if $error =~ /^Illegal or empty \(numeric\) refnum: /;
1232 return $error if $error;
1234 return "Unknown agent"
1235 unless qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
1237 return "Unknown refnum"
1238 unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } );
1240 return "Unknown referring custnum: ". $self->referral_custnum
1241 unless ! $self->referral_custnum
1242 || qsearchs( 'cust_main', { 'custnum' => $self->referral_custnum } );
1244 if ( $self->ss eq '' ) {
1249 $ss =~ /^(\d{3})(\d{2})(\d{4})$/
1250 or return "Illegal social security number: ". $self->ss;
1251 $self->ss("$1-$2-$3");
1255 # bad idea to disable, causes billing to fail because of no tax rates later
1256 # unless ( $import ) {
1257 unless ( qsearch('cust_main_county', {
1258 'country' => $self->country,
1261 return "Unknown state/county/country: ".
1262 $self->state. "/". $self->county. "/". $self->country
1263 unless qsearch('cust_main_county',{
1264 'state' => $self->state,
1265 'county' => $self->county,
1266 'country' => $self->country,
1272 $self->ut_phonen('daytime', $self->country)
1273 || $self->ut_phonen('night', $self->country)
1274 || $self->ut_phonen('fax', $self->country)
1275 || $self->ut_zip('zip', $self->country)
1277 return $error if $error;
1279 if ( $conf->exists('cust_main-require_phone')
1280 && ! length($self->daytime) && ! length($self->night)
1283 my $daytime_label = FS::Msgcat::_gettext('daytime') =~ /^(daytime)?$/
1285 : FS::Msgcat::_gettext('daytime');
1286 my $night_label = FS::Msgcat::_gettext('night') =~ /^(night)?$/
1288 : FS::Msgcat::_gettext('night');
1290 return "$daytime_label or $night_label is required"
1295 last first company address1 address2 city county state zip
1296 country daytime night fax
1299 if ( defined $self->dbdef_table->column('ship_last') ) {
1300 if ( scalar ( grep { $self->getfield($_) ne $self->getfield("ship_$_") }
1302 && scalar ( grep { $self->getfield("ship_$_") ne '' } @addfields )
1306 $self->ut_name('ship_last')
1307 || $self->ut_name('ship_first')
1308 || $self->ut_textn('ship_company')
1309 || $self->ut_text('ship_address1')
1310 || $self->ut_textn('ship_address2')
1311 || $self->ut_text('ship_city')
1312 || $self->ut_textn('ship_county')
1313 || $self->ut_textn('ship_state')
1314 || $self->ut_country('ship_country')
1316 return $error if $error;
1318 #false laziness with above
1319 unless ( qsearchs('cust_main_county', {
1320 'country' => $self->ship_country,
1323 return "Unknown ship_state/ship_county/ship_country: ".
1324 $self->ship_state. "/". $self->ship_county. "/". $self->ship_country
1325 unless qsearch('cust_main_county',{
1326 'state' => $self->ship_state,
1327 'county' => $self->ship_county,
1328 'country' => $self->ship_country,
1334 $self->ut_phonen('ship_daytime', $self->ship_country)
1335 || $self->ut_phonen('ship_night', $self->ship_country)
1336 || $self->ut_phonen('ship_fax', $self->ship_country)
1337 || $self->ut_zip('ship_zip', $self->ship_country)
1339 return $error if $error;
1341 } else { # ship_ info eq billing info, so don't store dup info in database
1342 $self->setfield("ship_$_", '')
1343 foreach qw( last first company address1 address2 city county state zip
1344 country daytime night fax );
1348 #$self->payby =~ /^(CARD|DCRD|CHEK|DCHK|LECB|BILL|COMP|PREPAY|CASH|WEST|MCRD)$/
1349 # or return "Illegal payby: ". $self->payby;
1351 FS::payby->can_payby($self->table, $self->payby)
1352 or return "Illegal payby: ". $self->payby;
1354 $error = $self->ut_numbern('paystart_month')
1355 || $self->ut_numbern('paystart_year')
1356 || $self->ut_numbern('payissue')
1357 || $self->ut_textn('paytype')
1359 return $error if $error;
1361 if ( $self->payip eq '' ) {
1364 $error = $self->ut_ip('payip');
1365 return $error if $error;
1368 # If it is encrypted and the private key is not availaible then we can't
1369 # check the credit card.
1371 my $check_payinfo = 1;
1373 if ($self->is_encrypted($self->payinfo)) {
1377 if ( $check_payinfo && $self->payby =~ /^(CARD|DCRD)$/ ) {
1379 my $payinfo = $self->payinfo;
1380 $payinfo =~ s/\D//g;
1381 $payinfo =~ /^(\d{13,16})$/
1382 or return gettext('invalid_card'); # . ": ". $self->payinfo;
1384 $self->payinfo($payinfo);
1386 or return gettext('invalid_card'); # . ": ". $self->payinfo;
1388 return gettext('unknown_card_type')
1389 if cardtype($self->payinfo) eq "Unknown";
1391 my $ban = qsearchs('banned_pay', $self->_banned_pay_hashref);
1393 return 'Banned credit card: banned on '.
1394 time2str('%a %h %o at %r', $ban->_date).
1395 ' by '. $ban->otaker.
1396 ' (ban# '. $ban->bannum. ')';
1399 if (length($self->paycvv) && !$self->is_encrypted($self->paycvv)) {
1400 if ( cardtype($self->payinfo) eq 'American Express card' ) {
1401 $self->paycvv =~ /^(\d{4})$/
1402 or return "CVV2 (CID) for American Express cards is four digits.";
1405 $self->paycvv =~ /^(\d{3})$/
1406 or return "CVV2 (CVC2/CID) is three digits.";
1413 my $cardtype = cardtype($payinfo);
1414 if ( $cardtype =~ /^(Switch|Solo)$/i ) {
1416 return "Start date or issue number is required for $cardtype cards"
1417 unless $self->paystart_month && $self->paystart_year or $self->payissue;
1419 return "Start month must be between 1 and 12"
1420 if $self->paystart_month
1421 and $self->paystart_month < 1 || $self->paystart_month > 12;
1423 return "Start year must be 1990 or later"
1424 if $self->paystart_year
1425 and $self->paystart_year < 1990;
1427 return "Issue number must be beween 1 and 99"
1429 and $self->payissue < 1 || $self->payissue > 99;
1432 $self->paystart_month('');
1433 $self->paystart_year('');
1434 $self->payissue('');
1437 } elsif ( $check_payinfo && $self->payby =~ /^(CHEK|DCHK)$/ ) {
1439 my $payinfo = $self->payinfo;
1440 $payinfo =~ s/[^\d\@]//g;
1441 if ( $conf->exists('echeck-nonus') ) {
1442 $payinfo =~ /^(\d+)\@(\d+)$/ or return 'invalid echeck account@aba';
1443 $payinfo = "$1\@$2";
1445 $payinfo =~ /^(\d+)\@(\d{9})$/ or return 'invalid echeck account@aba';
1446 $payinfo = "$1\@$2";
1448 $self->payinfo($payinfo);
1451 my $ban = qsearchs('banned_pay', $self->_banned_pay_hashref);
1453 return 'Banned ACH account: banned on '.
1454 time2str('%a %h %o at %r', $ban->_date).
1455 ' by '. $ban->otaker.
1456 ' (ban# '. $ban->bannum. ')';
1459 } elsif ( $self->payby eq 'LECB' ) {
1461 my $payinfo = $self->payinfo;
1462 $payinfo =~ s/\D//g;
1463 $payinfo =~ /^1?(\d{10})$/ or return 'invalid btn billing telephone number';
1465 $self->payinfo($payinfo);
1468 } elsif ( $self->payby eq 'BILL' ) {
1470 $error = $self->ut_textn('payinfo');
1471 return "Illegal P.O. number: ". $self->payinfo if $error;
1474 } elsif ( $self->payby eq 'COMP' ) {
1476 my $curuser = $FS::CurrentUser::CurrentUser;
1477 if ( ! $self->custnum
1478 && ! $curuser->access_right('Complimentary customer')
1481 return "You are not permitted to create complimentary accounts."
1484 $error = $self->ut_textn('payinfo');
1485 return "Illegal comp account issuer: ". $self->payinfo if $error;
1488 } elsif ( $self->payby eq 'PREPAY' ) {
1490 my $payinfo = $self->payinfo;
1491 $payinfo =~ s/\W//g; #anything else would just confuse things
1492 $self->payinfo($payinfo);
1493 $error = $self->ut_alpha('payinfo');
1494 return "Illegal prepayment identifier: ". $self->payinfo if $error;
1495 return "Unknown prepayment identifier"
1496 unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } );
1501 if ( $self->paydate eq '' || $self->paydate eq '-' ) {
1502 return "Expiration date required"
1503 unless $self->payby =~ /^(BILL|PREPAY|CHEK|DCHK|LECB|CASH|WEST|MCRD)$/;
1507 if ( $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/ ) {
1508 ( $m, $y ) = ( $1, length($2) == 4 ? $2 : "20$2" );
1509 } elsif ( $self->paydate =~ /^(20)?(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) {
1510 ( $m, $y ) = ( $3, "20$2" );
1512 return "Illegal expiration date: ". $self->paydate;
1514 $self->paydate("$y-$m-01");
1515 my($nowm,$nowy)=(localtime(time))[4,5]; $nowm++; $nowy+=1900;
1516 return gettext('expired_card')
1518 && !$ignore_expired_card
1519 && ( $y<$nowy || ( $y==$nowy && $1<$nowm ) );
1522 if ( $self->payname eq '' && $self->payby !~ /^(CHEK|DCHK)$/ &&
1523 ( ! $conf->exists('require_cardname')
1524 || $self->payby !~ /^(CARD|DCRD)$/ )
1526 $self->payname( $self->first. " ". $self->getfield('last') );
1528 $self->payname =~ /^([\w \,\.\-\'\&]+)$/
1529 or return gettext('illegal_name'). " payname: ". $self->payname;
1533 foreach my $flag (qw( tax spool_cdr )) {
1534 $self->$flag() =~ /^(Y?)$/ or return "Illegal $flag: ". $self->$flag();
1538 $self->otaker(getotaker) unless $self->otaker;
1540 warn "$me check AFTER: \n". $self->_dump
1543 $self->SUPER::check;
1548 Returns all packages (see L<FS::cust_pkg>) for this customer.
1555 return $self->num_pkgs unless wantarray;
1558 if ( $self->{'_pkgnum'} ) {
1559 @cust_pkg = values %{ $self->{'_pkgnum'}->cache };
1561 @cust_pkg = qsearch( 'cust_pkg', { 'custnum' => $self->custnum });
1564 sort sort_packages @cust_pkg;
1569 Synonym for B<all_pkgs>.
1574 shift->all_pkgs(@_);
1577 =item ncancelled_pkgs
1579 Returns all non-cancelled packages (see L<FS::cust_pkg>) for this customer.
1583 sub ncancelled_pkgs {
1586 return $self->num_ncancelled_pkgs unless wantarray;
1589 if ( $self->{'_pkgnum'} ) {
1591 warn "$me ncancelled_pkgs: returning cached objects"
1594 @cust_pkg = grep { ! $_->getfield('cancel') }
1595 values %{ $self->{'_pkgnum'}->cache };
1599 warn "$me ncancelled_pkgs: searching for packages with custnum ".
1600 $self->custnum. "\n"
1604 qsearch( 'cust_pkg', {
1605 'custnum' => $self->custnum,
1609 qsearch( 'cust_pkg', {
1610 'custnum' => $self->custnum,
1615 sort sort_packages @cust_pkg;
1619 # This should be generalized to use config options to determine order.
1621 if ( $a->get('cancel') and $b->get('cancel') ) {
1622 $a->pkgnum <=> $b->pkgnum;
1623 } elsif ( $a->get('cancel') or $b->get('cancel') ) {
1624 return -1 if $b->get('cancel');
1625 return 1 if $a->get('cancel');
1628 $a->pkgnum <=> $b->pkgnum;
1632 =item suspended_pkgs
1634 Returns all suspended packages (see L<FS::cust_pkg>) for this customer.
1638 sub suspended_pkgs {
1640 grep { $_->susp } $self->ncancelled_pkgs;
1643 =item unflagged_suspended_pkgs
1645 Returns all unflagged suspended packages (see L<FS::cust_pkg>) for this
1646 customer (thouse packages without the `manual_flag' set).
1650 sub unflagged_suspended_pkgs {
1652 return $self->suspended_pkgs
1653 unless dbdef->table('cust_pkg')->column('manual_flag');
1654 grep { ! $_->manual_flag } $self->suspended_pkgs;
1657 =item unsuspended_pkgs
1659 Returns all unsuspended (and uncancelled) packages (see L<FS::cust_pkg>) for
1664 sub unsuspended_pkgs {
1666 grep { ! $_->susp } $self->ncancelled_pkgs;
1669 =item num_cancelled_pkgs
1671 Returns the number of cancelled packages (see L<FS::cust_pkg>) for this
1676 sub num_cancelled_pkgs {
1677 shift->num_pkgs("cust_pkg.cancel IS NOT NULL AND cust_pkg.cancel != 0");
1680 sub num_ncancelled_pkgs {
1681 shift->num_pkgs("( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )");
1685 my( $self ) = shift;
1686 my $sql = scalar(@_) ? shift : '';
1687 $sql = "AND $sql" if $sql && $sql !~ /^\s*$/ && $sql !~ /^\s*AND/i;
1688 my $sth = dbh->prepare(
1689 "SELECT COUNT(*) FROM cust_pkg WHERE custnum = ? $sql"
1690 ) or die dbh->errstr;
1691 $sth->execute($self->custnum) or die $sth->errstr;
1692 $sth->fetchrow_arrayref->[0];
1697 Unsuspends all unflagged suspended packages (see L</unflagged_suspended_pkgs>
1698 and L<FS::cust_pkg>) for this customer. Always returns a list: an empty list
1699 on success or a list of errors.
1705 grep { $_->unsuspend } $self->suspended_pkgs;
1710 Suspends all unsuspended packages (see L<FS::cust_pkg>) for this customer.
1712 Returns a list: an empty list on success or a list of errors.
1718 grep { $_->suspend(@_) } $self->unsuspended_pkgs;
1721 =item suspend_if_pkgpart HASHREF | PKGPART [ , PKGPART ... ]
1723 Suspends all unsuspended packages (see L<FS::cust_pkg>) matching the listed
1724 PKGPARTs (see L<FS::part_pkg>). Preferred usage is to pass a hashref instead
1725 of a list of pkgparts; the hashref has the following keys:
1729 =item pkgparts - listref of pkgparts
1731 =item (other options are passed to the suspend method)
1736 Returns a list: an empty list on success or a list of errors.
1740 sub suspend_if_pkgpart {
1742 my (@pkgparts, %opt);
1743 if (ref($_[0]) eq 'HASH'){
1744 @pkgparts = @{$_[0]{pkgparts}};
1749 grep { $_->suspend(%opt) }
1750 grep { my $pkgpart = $_->pkgpart; grep { $pkgpart eq $_ } @pkgparts }
1751 $self->unsuspended_pkgs;
1754 =item suspend_unless_pkgpart HASHREF | PKGPART [ , PKGPART ... ]
1756 Suspends all unsuspended packages (see L<FS::cust_pkg>) unless they match the
1757 given PKGPARTs (see L<FS::part_pkg>). Preferred usage is to pass a hashref
1758 instead of a list of pkgparts; the hashref has the following keys:
1762 =item pkgparts - listref of pkgparts
1764 =item (other options are passed to the suspend method)
1768 Returns a list: an empty list on success or a list of errors.
1772 sub suspend_unless_pkgpart {
1774 my (@pkgparts, %opt);
1775 if (ref($_[0]) eq 'HASH'){
1776 @pkgparts = @{$_[0]{pkgparts}};
1781 grep { $_->suspend(%opt) }
1782 grep { my $pkgpart = $_->pkgpart; ! grep { $pkgpart eq $_ } @pkgparts }
1783 $self->unsuspended_pkgs;
1786 =item cancel [ OPTION => VALUE ... ]
1788 Cancels all uncancelled packages (see L<FS::cust_pkg>) for this customer.
1790 Available options are:
1794 =item quiet - can be set true to supress email cancellation notices.
1796 =item reason - can be set to a cancellation reason (see L<FS:reason>), either a reasonnum of an existing reason, or passing a hashref will create a new reason. The hashref should have the following keys: typenum - Reason type (see L<FS::reason_type>, reason - Text of the new reason.
1798 =item ban - can be set true to ban this customer's credit card or ACH information, if present.
1802 Always returns a list: an empty list on success or a list of errors.
1807 my( $self, %opt ) = @_;
1809 warn "$me cancel called on customer ". $self->custnum. " with options ".
1810 join(', ', map { "$_: $opt{$_}" } keys %opt ). "\n"
1813 return ( 'access denied' )
1814 unless $FS::CurrentUser::CurrentUser->access_right('Cancel customer');
1816 if ( $opt{'ban'} && $self->payby =~ /^(CARD|DCRD|CHEK|DCHK)$/ ) {
1818 #should try decryption (we might have the private key)
1819 # and if not maybe queue a job for the server that does?
1820 return ( "Can't (yet) ban encrypted credit cards" )
1821 if $self->is_encrypted($self->payinfo);
1823 my $ban = new FS::banned_pay $self->_banned_pay_hashref;
1824 my $error = $ban->insert;
1825 return ( $error ) if $error;
1829 my @pkgs = $self->ncancelled_pkgs;
1831 warn "$me cancelling ". scalar($self->ncancelled_pkgs). "/".
1832 scalar(@pkgs). " packages for customer ". $self->custnum. "\n"
1835 grep { $_ } map { $_->cancel(%opt) } $self->ncancelled_pkgs;
1838 sub _banned_pay_hashref {
1849 'payby' => $payby2ban{$self->payby},
1850 'payinfo' => md5_base64($self->payinfo),
1851 #don't ever *search* on reason! #'reason' =>
1857 Returns all notes (see L<FS::cust_main_note>) for this customer.
1864 qsearch( 'cust_main_note',
1865 { 'custnum' => $self->custnum },
1867 'ORDER BY _DATE DESC'
1873 Returns the agent (see L<FS::agent>) for this customer.
1879 qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
1882 =item bill_and_collect
1884 Cancels and suspends any packages due, generates bills, applies payments and
1887 Warns on errors (Does not currently: If there is an error, returns the error, otherwise returns false.)
1889 Options are passed as name-value pairs. Currently available options are:
1895 Bills the customer as if it were that time. Specified as a UNIX timestamp; see L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion functions. For example:
1899 $cust_main->bill( 'time' => str2time('April 20th, 2001') );
1903 Used in conjunction with the I<time> option, this option specifies the date of for the generated invoices. Other calculations, such as whether or not to generate the invoice in the first place, are not affected.
1907 "1d" for the traditional, daily events (the default), or "1m" for the new monthly events (part_event.check_freq)
1911 If set true, re-charges setup fees.
1915 Debugging level. Default is 0 (no debugging), or can be set to 1 (passed-in options), 2 (traces progress), 3 (more information), or 4 (include full search queries)
1921 sub bill_and_collect {
1922 my( $self, %options ) = @_;
1928 #$^T not $options{time} because freeside-daily -d is for pre-printing invoices
1929 foreach my $cust_pkg (
1930 grep { $_->expire && $_->expire <= $^T } $self->ncancelled_pkgs
1932 my $error = $cust_pkg->cancel;
1933 warn "Error cancelling expired pkg ". $cust_pkg->pkgnum.
1934 " for custnum ". $self->custnum. ": $error"
1942 #$^T not $options{time} because freeside-daily -d is for pre-printing invoices
1943 foreach my $cust_pkg (
1944 grep { ( $_->part_pkg->is_prepaid && $_->bill && $_->bill < $^T
1945 || $_->adjourn && $_->adjourn <= $^T
1949 $self->ncancelled_pkgs
1951 my $error = $cust_pkg->suspend;
1952 warn "Error suspending package ". $cust_pkg->pkgnum.
1953 " for custnum ". $self->custnum. ": $error"
1961 my $error = $self->bill( %options );
1962 warn "Error billing, custnum ". $self->custnum. ": $error" if $error;
1964 $self->apply_payments_and_credits;
1966 $error = $self->collect( %options );
1967 warn "Error collecting, custnum". $self->custnum. ": $error" if $error;
1973 Generates invoices (see L<FS::cust_bill>) for this customer. Usually used in
1974 conjunction with the collect method by calling B<bill_and_collect>.
1976 If there is an error, returns the error, otherwise returns false.
1978 Options are passed as name-value pairs. Currently available options are:
1984 If set true, re-charges setup fees.
1988 Bills the customer as if it were that time. Specified as a UNIX timestamp; see L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion functions. For example:
1992 $cust_main->bill( 'time' => str2time('April 20th, 2001') );
1996 An array ref of specific packages (objects) to attempt billing, instead trying all of them.
1998 $cust_main->bill( pkg_list => [$pkg1, $pkg2] );
2002 Used in conjunction with the I<time> option, this option specifies the date of for the generated invoices. Other calculations, such as whether or not to generate the invoice in the first place, are not affected.
2009 my( $self, %options ) = @_;
2010 return '' if $self->payby eq 'COMP';
2011 warn "$me bill customer ". $self->custnum. "\n"
2014 my $time = $options{'time'} || time;
2019 local $SIG{HUP} = 'IGNORE';
2020 local $SIG{INT} = 'IGNORE';
2021 local $SIG{QUIT} = 'IGNORE';
2022 local $SIG{TERM} = 'IGNORE';
2023 local $SIG{TSTP} = 'IGNORE';
2024 local $SIG{PIPE} = 'IGNORE';
2026 my $oldAutoCommit = $FS::UID::AutoCommit;
2027 local $FS::UID::AutoCommit = 0;
2030 $self->select_for_update; #mutex
2032 #create a new invoice
2033 #(we'll remove it later if it doesn't actually need to be generated [contains
2034 # no line items] and we're inside a transaciton so nothing else will see it)
2035 my $cust_bill = new FS::cust_bill ( {
2036 'custnum' => $self->custnum,
2037 '_date' => ( $options{'invoice_time'} || $time ),
2038 #'charged' => $charged,
2041 $error = $cust_bill->insert;
2043 $dbh->rollback if $oldAutoCommit;
2044 return "can't create invoice for customer #". $self->custnum. ": $error";
2046 my $invnum = $cust_bill->invnum;
2049 # find the packages which are due for billing, find out how much they are
2050 # & generate invoice database.
2053 my( $total_setup, $total_recur ) = ( 0, 0 );
2055 my @precommit_hooks = ();
2057 foreach my $cust_pkg (
2058 qsearch('cust_pkg', { 'custnum' => $self->custnum } )
2061 #NO!! next if $cust_pkg->cancel;
2062 next if $cust_pkg->getfield('cancel');
2064 warn " bill package ". $cust_pkg->pkgnum. "\n" if $DEBUG > 1;
2066 #? to avoid use of uninitialized value errors... ?
2067 $cust_pkg->setfield('bill', '')
2068 unless defined($cust_pkg->bill);
2070 my $part_pkg = $cust_pkg->part_pkg;
2072 my %hash = $cust_pkg->hash;
2073 my $old_cust_pkg = new FS::cust_pkg \%hash;
2082 if ( ! $cust_pkg->setup &&
2084 ( $conf->exists('disable_setup_suspended_pkgs') &&
2085 ! $cust_pkg->getfield('susp')
2086 ) || ! $conf->exists('disable_setup_suspended_pkgs')
2088 || $options{'resetup'}
2091 warn " bill setup\n" if $DEBUG > 1;
2093 $setup = eval { $cust_pkg->calc_setup( $time, \@details ) };
2095 $dbh->rollback if $oldAutoCommit;
2096 return "$@ running calc_setup for $cust_pkg\n";
2099 $cust_pkg->setfield('setup', $time) unless $cust_pkg->setup;
2103 # bill recurring fee
2108 if ( $part_pkg->getfield('freq') ne '0' &&
2109 ! $cust_pkg->getfield('susp') &&
2110 ( $cust_pkg->getfield('bill') || 0 ) <= $time
2113 # XXX should this be a package event? probably. events are called
2114 # at collection time at the moment, though...
2115 if ( $part_pkg->can('reset_usage') ) {
2116 warn " resetting usage counters" if $DEBUG > 1;
2117 $part_pkg->reset_usage($cust_pkg);
2120 warn " bill recur\n" if $DEBUG > 1;
2122 # XXX shared with $recur_prog
2123 $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
2125 #over two params! lets at least switch to a hashref for the rest...
2126 my %param = ( 'precommit_hooks' => \@precommit_hooks, );
2128 $recur = eval { $cust_pkg->calc_recur( \$sdate, \@details, \%param ) };
2130 $dbh->rollback if $oldAutoCommit;
2131 return "$@ running calc_recur for $cust_pkg\n";
2134 #change this bit to use Date::Manip? CAREFUL with timezones (see
2135 # mailing list archive)
2136 my ($sec,$min,$hour,$mday,$mon,$year) =
2137 (localtime($sdate) )[0,1,2,3,4,5];
2139 #pro-rating magic - if $recur_prog fiddles $sdate, want to use that
2140 # only for figuring next bill date, nothing else, so, reset $sdate again
2142 $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
2143 $cust_pkg->last_bill($sdate)
2144 if $cust_pkg->dbdef_table->column('last_bill');
2146 if ( $part_pkg->freq =~ /^\d+$/ ) {
2147 $mon += $part_pkg->freq;
2148 until ( $mon < 12 ) { $mon -= 12; $year++; }
2149 } elsif ( $part_pkg->freq =~ /^(\d+)w$/ ) {
2151 $mday += $weeks * 7;
2152 } elsif ( $part_pkg->freq =~ /^(\d+)d$/ ) {
2155 } elsif ( $part_pkg->freq =~ /^(\d+)h$/ ) {
2159 $dbh->rollback if $oldAutoCommit;
2160 return "unparsable frequency: ". $part_pkg->freq;
2162 $cust_pkg->setfield('bill',
2163 timelocal_nocheck($sec,$min,$hour,$mday,$mon,$year));
2166 warn "\$setup is undefined" unless defined($setup);
2167 warn "\$recur is undefined" unless defined($recur);
2168 warn "\$cust_pkg->bill is undefined" unless defined($cust_pkg->bill);
2171 # If $cust_pkg has been modified, update it and create cust_bill_pkg records
2174 if ( $cust_pkg->modified ) { # hmmm.. and if the options are modified?
2176 warn " package ". $cust_pkg->pkgnum. " modified; updating\n"
2179 $error=$cust_pkg->replace($old_cust_pkg,
2180 options => { $cust_pkg->options },
2182 if ( $error ) { #just in case
2183 $dbh->rollback if $oldAutoCommit;
2184 return "Error modifying pkgnum ". $cust_pkg->pkgnum. ": $error";
2187 $setup = sprintf( "%.2f", $setup );
2188 $recur = sprintf( "%.2f", $recur );
2189 if ( $setup < 0 && ! $conf->exists('allow_negative_charges') ) {
2190 $dbh->rollback if $oldAutoCommit;
2191 return "negative setup $setup for pkgnum ". $cust_pkg->pkgnum;
2193 if ( $recur < 0 && ! $conf->exists('allow_negative_charges') ) {
2194 $dbh->rollback if $oldAutoCommit;
2195 return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum;
2198 if ( $setup != 0 || $recur != 0 ) {
2200 warn " charges (setup=$setup, recur=$recur); adding line items\n"
2202 my $cust_bill_pkg = new FS::cust_bill_pkg ({
2203 'invnum' => $invnum,
2204 'pkgnum' => $cust_pkg->pkgnum,
2208 'edate' => $cust_pkg->bill,
2209 'details' => \@details,
2211 $error = $cust_bill_pkg->insert;
2213 $dbh->rollback if $oldAutoCommit;
2214 return "can't create invoice line item for invoice #$invnum: $error";
2216 $total_setup += $setup;
2217 $total_recur += $recur;
2223 unless ( $self->tax =~ /Y/i || $self->payby eq 'COMP' ) {
2226 ( $conf->exists('tax-ship_address') && length($self->ship_last) )
2229 my %taxhash = map { $_ => $self->get("$prefix$_") }
2230 qw( state county country );
2232 $taxhash{'taxclass'} = $part_pkg->taxclass;
2234 my @taxes = qsearch( 'cust_main_county', \%taxhash );
2237 $taxhash{'taxclass'} = '';
2238 @taxes = qsearch( 'cust_main_county', \%taxhash );
2241 #one more try at a whole-country tax rate
2243 $taxhash{$_} = '' foreach qw( state county );
2244 @taxes = qsearch( 'cust_main_county', \%taxhash );
2247 # maybe eliminate this entirely, along with all the 0% records
2249 $dbh->rollback if $oldAutoCommit;
2251 "fatal: can't find tax rate for state/county/country/taxclass ".
2252 join('/', ( map $self->get("$prefix$_"),
2253 qw(state county country)
2255 $part_pkg->taxclass ). "\n";
2258 foreach my $tax ( @taxes ) {
2260 my $taxable_charged = 0;
2261 $taxable_charged += $setup
2262 unless $part_pkg->setuptax =~ /^Y$/i
2263 || $tax->setuptax =~ /^Y$/i;
2264 $taxable_charged += $recur
2265 unless $part_pkg->recurtax =~ /^Y$/i
2266 || $tax->recurtax =~ /^Y$/i;
2267 next unless $taxable_charged;
2269 if ( $tax->exempt_amount && $tax->exempt_amount > 0 ) {
2270 #my ($mon,$year) = (localtime($sdate) )[4,5];
2271 my ($mon,$year) = (localtime( $sdate || $cust_bill->_date ) )[4,5];
2273 my $freq = $part_pkg->freq || 1;
2274 if ( $freq !~ /(\d+)$/ ) {
2275 $dbh->rollback if $oldAutoCommit;
2276 return "daily/weekly package definitions not (yet?)".
2277 " compatible with monthly tax exemptions";
2279 my $taxable_per_month =
2280 sprintf("%.2f", $taxable_charged / $freq );
2282 #call the whole thing off if this customer has any old
2283 #exemption records...
2284 my @cust_tax_exempt =
2285 qsearch( 'cust_tax_exempt' => { custnum=> $self->custnum } );
2286 if ( @cust_tax_exempt ) {
2287 $dbh->rollback if $oldAutoCommit;
2289 'this customer still has old-style tax exemption records; '.
2290 'run bin/fs-migrate-cust_tax_exempt?';
2293 foreach my $which_month ( 1 .. $freq ) {
2295 #maintain the new exemption table now
2298 FROM cust_tax_exempt_pkg
2299 LEFT JOIN cust_bill_pkg USING ( billpkgnum )
2300 LEFT JOIN cust_bill USING ( invnum )
2306 my $sth = dbh->prepare($sql) or do {
2307 $dbh->rollback if $oldAutoCommit;
2308 return "fatal: can't lookup exising exemption: ". dbh->errstr;
2316 $dbh->rollback if $oldAutoCommit;
2317 return "fatal: can't lookup exising exemption: ". dbh->errstr;
2319 my $existing_exemption = $sth->fetchrow_arrayref->[0] || 0;
2321 my $remaining_exemption =
2322 $tax->exempt_amount - $existing_exemption;
2323 if ( $remaining_exemption > 0 ) {
2324 my $addl = $remaining_exemption > $taxable_per_month
2325 ? $taxable_per_month
2326 : $remaining_exemption;
2327 $taxable_charged -= $addl;
2329 my $cust_tax_exempt_pkg = new FS::cust_tax_exempt_pkg ( {
2330 'billpkgnum' => $cust_bill_pkg->billpkgnum,
2331 'taxnum' => $tax->taxnum,
2332 'year' => 1900+$year,
2334 'amount' => sprintf("%.2f", $addl ),
2336 $error = $cust_tax_exempt_pkg->insert;
2338 $dbh->rollback if $oldAutoCommit;
2339 return "fatal: can't insert cust_tax_exempt_pkg: $error";
2341 } # if $remaining_exemption > 0
2345 #until ( $mon < 12 ) { $mon -= 12; $year++; }
2346 until ( $mon < 13 ) { $mon -= 12; $year++; }
2348 } #foreach $which_month
2350 } #if $tax->exempt_amount
2352 $taxable_charged = sprintf( "%.2f", $taxable_charged);
2354 #$tax += $taxable_charged * $cust_main_county->tax / 100
2355 $tax{ $tax->taxname || 'Tax' } +=
2356 $taxable_charged * $tax->tax / 100
2358 } #foreach my $tax ( @taxes )
2360 } #unless $self->tax =~ /Y/i || $self->payby eq 'COMP'
2362 } #if $setup != 0 || $recur != 0
2364 } #if $cust_pkg->modified
2366 } #foreach my $cust_pkg
2368 unless ( $cust_bill->cust_bill_pkg ) {
2369 $cust_bill->delete; #don't create an invoice w/o line items
2371 # XXX this seems to be broken
2372 #( DBD::Pg::st execute failed: ERROR: syntax error at or near "hcb" )
2373 # # get rid of our fake history too, waste of unecessary space
2374 # my $h_cleanup_query = q{
2375 # DELETE FROM h_cust_bill hcb
2376 # WHERE hcb.invnum = ?
2377 # AND NOT EXISTS ( SELECT 1 FROM cust_bill cb where cb.invnum = hcb.invnum )
2379 # my $h_sth = $dbh->prepare($h_cleanup_query);
2380 # $h_sth->execute($invnum);
2382 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2386 my $charged = sprintf( "%.2f", $total_setup + $total_recur );
2388 foreach my $taxname ( grep { $tax{$_} > 0 } keys %tax ) {
2389 my $tax = sprintf("%.2f", $tax{$taxname} );
2390 $charged = sprintf( "%.2f", $charged+$tax );
2392 my $cust_bill_pkg = new FS::cust_bill_pkg ({
2393 'invnum' => $invnum,
2399 'itemdesc' => $taxname,
2401 $error = $cust_bill_pkg->insert;
2403 $dbh->rollback if $oldAutoCommit;
2404 return "can't create invoice line item for invoice #$invnum: $error";
2406 $total_setup += $tax;
2410 $cust_bill->charged( sprintf( "%.2f", $total_setup + $total_recur ) );
2411 $error = $cust_bill->replace;
2413 $dbh->rollback if $oldAutoCommit;
2414 return "can't update charged for invoice #$invnum: $error";
2417 foreach my $hook ( @precommit_hooks ) {
2419 &{$hook}; #($self) ?
2422 $dbh->rollback if $oldAutoCommit;
2423 return "$@ running precommit hook $hook\n";
2427 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2431 =item collect OPTIONS
2433 (Attempt to) collect money for this customer's outstanding invoices (see
2434 L<FS::cust_bill>). Usually used after the bill method.
2436 Actions are now triggered by billing events; see L<FS::part_event> and the
2437 billing events web interface. Old-style invoice events (see
2438 L<FS::part_bill_event>) have been deprecated.
2440 If there is an error, returns the error, otherwise returns false.
2442 Options are passed as name-value pairs.
2444 Currently available options are:
2450 Use this time when deciding when to print invoices and 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> for conversion functions.
2454 Retry card/echeck/LEC transactions even when not scheduled by invoice events.
2458 set true to surpress email card/ACH decline notices.
2462 "1d" for the traditional, daily events (the default), or "1m" for the new monthly events (part_event.check_freq)
2466 allows for one time override of normal customer billing method
2470 Debugging level. Default is 0 (no debugging), or can be set to 1 (passed-in options), 2 (traces progress), 3 (more information), or 4 (include full search queries)
2478 my( $self, %options ) = @_;
2479 my $invoice_time = $options{'invoice_time'} || time;
2482 local $SIG{HUP} = 'IGNORE';
2483 local $SIG{INT} = 'IGNORE';
2484 local $SIG{QUIT} = 'IGNORE';
2485 local $SIG{TERM} = 'IGNORE';
2486 local $SIG{TSTP} = 'IGNORE';
2487 local $SIG{PIPE} = 'IGNORE';
2489 my $oldAutoCommit = $FS::UID::AutoCommit;
2490 local $FS::UID::AutoCommit = 0;
2493 $self->select_for_update; #mutex
2496 my $balance = $self->balance;
2497 warn "$me collect customer ". $self->custnum. ": balance $balance\n"
2500 if ( exists($options{'retry_card'}) ) {
2501 carp 'retry_card option passed to collect is deprecated; use retry';
2502 $options{'retry'} ||= $options{'retry_card'};
2504 if ( exists($options{'retry'}) && $options{'retry'} ) {
2505 my $error = $self->retry_realtime;
2507 $dbh->rollback if $oldAutoCommit;
2512 # false laziness w/pay_batch::import_results
2514 my $due_cust_event = $self->due_cust_event(
2515 'debug' => ( $options{'debug'} || 0 ),
2516 'time' => $invoice_time,
2517 'check_freq' => $options{'check_freq'},
2519 unless( ref($due_cust_event) ) {
2520 $dbh->rollback if $oldAutoCommit;
2521 return $due_cust_event;
2524 foreach my $cust_event ( @$due_cust_event ) {
2528 #re-eval event conditions (a previous event could have changed things)
2529 unless ( $cust_event->test_conditions( 'time' => $invoice_time ) ) {
2530 #don't leave stray "new/locked" records around
2531 my $error = $cust_event->delete;
2533 #gah, even with transactions
2534 $dbh->commit if $oldAutoCommit; #well.
2541 local $realtime_bop_decline_quiet = 1 if $options{'quiet'};
2542 warn " running cust_event ". $cust_event->eventnum. "\n"
2546 #if ( my $error = $cust_event->do_event(%options) ) { #XXX %options?
2547 if ( my $error = $cust_event->do_event() ) {
2548 #XXX wtf is this? figure out a proper dealio with return value
2550 # gah, even with transactions.
2551 $dbh->commit if $oldAutoCommit; #well.
2558 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2563 =item due_cust_event [ HASHREF | OPTION => VALUE ... ]
2565 Inserts database records for and returns an ordered listref of new events due
2566 for this customer, as FS::cust_event objects (see L<FS::cust_event>). If no
2567 events are due, an empty listref is returned. If there is an error, returns a
2568 scalar error message.
2570 To actually run the events, call each event's test_condition method, and if
2571 still true, call the event's do_event method.
2573 Options are passed as a hashref or as a list of name-value pairs. Available
2580 Search only for events of this check frequency (how often events of this type are checked); currently "1d" (daily, the default) and "1m" (monthly) are recognized.
2584 "Current time" for the events.
2588 Debugging level. Default is 0 (no debugging), or can be set to 1 (passed-in options), 2 (traces progress), 3 (more information), or 4 (include full search queries)
2592 Only return events for the specified eventtable (by default, events of all eventtables are returned)
2596 Explicitly pass the objects to be tested (typically used with eventtable).
2602 sub due_cust_event {
2604 my %opt = ref($_[0]) ? %{ $_[0] } : @_;
2607 #my $DEBUG = $opt{'debug'}
2608 local($DEBUG) = $opt{'debug'}
2609 if defined($opt{'debug'}) && $opt{'debug'} > $DEBUG;
2611 warn "$me due_cust_event called with options ".
2612 join(', ', map { "$_: $opt{$_}" } keys %opt). "\n"
2615 $opt{'time'} ||= time;
2617 local $SIG{HUP} = 'IGNORE';
2618 local $SIG{INT} = 'IGNORE';
2619 local $SIG{QUIT} = 'IGNORE';
2620 local $SIG{TERM} = 'IGNORE';
2621 local $SIG{TSTP} = 'IGNORE';
2622 local $SIG{PIPE} = 'IGNORE';
2624 my $oldAutoCommit = $FS::UID::AutoCommit;
2625 local $FS::UID::AutoCommit = 0;
2628 $self->select_for_update; #mutex
2631 # 1: find possible events (initial search)
2634 my @cust_event = ();
2636 my @eventtable = $opt{'eventtable'}
2637 ? ( $opt{'eventtable'} )
2638 : FS::part_event->eventtables_runorder;
2640 foreach my $eventtable ( @eventtable ) {
2643 if ( $opt{'objects'} ) {
2645 @objects = @{ $opt{'objects'} };
2649 #my @objects = $self->eventtable(); # sub cust_main { @{ [ $self ] }; }
2650 @objects = ( $eventtable eq 'cust_main' )
2652 : ( $self->$eventtable() );
2656 my @e_cust_event = ();
2658 my $cross = "CROSS JOIN $eventtable";
2659 $cross .= ' LEFT JOIN cust_main USING ( custnum )'
2660 unless $eventtable eq 'cust_main';
2662 foreach my $object ( @objects ) {
2664 #this first search uses the condition_sql magic for optimization.
2665 #the more possible events we can eliminate in this step the better
2667 my $cross_where = '';
2668 my $pkey = $object->primary_key;
2669 $cross_where = "$eventtable.$pkey = ". $object->$pkey();
2671 my $join = FS::part_event_condition->join_conditions_sql( $eventtable );
2673 FS::part_event_condition->where_conditions_sql( $eventtable,
2674 'time'=>$opt{'time'}
2676 my $order = FS::part_event_condition->order_conditions_sql( $eventtable );
2678 $extra_sql = "AND $extra_sql" if $extra_sql;
2680 #here is the agent virtualization
2681 $extra_sql .= " AND ( part_event.agentnum IS NULL
2682 OR part_event.agentnum = ". $self->agentnum. ' )';
2684 $extra_sql .= " $order";
2686 warn "searching for events for $eventtable ". $object->$pkey. "\n"
2687 if $opt{'debug'} > 2;
2688 my @part_event = qsearch( {
2689 'debug' => ( $opt{'debug'} > 3 ? 1 : 0 ),
2690 'select' => 'part_event.*',
2691 'table' => 'part_event',
2692 'addl_from' => "$cross $join",
2693 'hashref' => { 'check_freq' => ( $opt{'check_freq'} || '1d' ),
2694 'eventtable' => $eventtable,
2697 'extra_sql' => "AND $cross_where $extra_sql",
2701 my $pkey = $object->primary_key;
2702 warn " ". scalar(@part_event).
2703 " possible events found for $eventtable ". $object->$pkey(). "\n";
2706 push @e_cust_event, map { $_->new_cust_event($object) } @part_event;
2710 warn " ". scalar(@e_cust_event).
2711 " subtotal possible cust events found for $eventtable\n"
2714 push @cust_event, @e_cust_event;
2718 warn " ". scalar(@cust_event).
2719 " total possible cust events found in initial search\n"
2723 # 2: test conditions
2728 @cust_event = grep $_->test_conditions( 'time' => $opt{'time'},
2729 'stats_hashref' => \%unsat ),
2732 warn " ". scalar(@cust_event). " cust events left satisfying conditions\n"
2735 warn " invalid conditions not eliminated with condition_sql:\n".
2736 join('', map " $_: ".$unsat{$_}."\n", keys %unsat )
2743 foreach my $cust_event ( @cust_event ) {
2745 my $error = $cust_event->insert();
2747 $dbh->rollback if $oldAutoCommit;
2753 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2759 warn " returning events: ". Dumper(@cust_event). "\n"
2766 =item retry_realtime
2768 Schedules realtime / batch credit card / electronic check / LEC billing
2769 events for for retry. Useful if card information has changed or manual
2770 retry is desired. The 'collect' method must be called to actually retry
2773 Implementation details: For either this customer, or for each of this
2774 customer's open invoices, changes the status of the first "done" (with
2775 statustext error) realtime processing event to "failed".
2779 sub retry_realtime {
2782 local $SIG{HUP} = 'IGNORE';
2783 local $SIG{INT} = 'IGNORE';
2784 local $SIG{QUIT} = 'IGNORE';
2785 local $SIG{TERM} = 'IGNORE';
2786 local $SIG{TSTP} = 'IGNORE';
2787 local $SIG{PIPE} = 'IGNORE';
2789 my $oldAutoCommit = $FS::UID::AutoCommit;
2790 local $FS::UID::AutoCommit = 0;
2793 #a little false laziness w/due_cust_event (not too bad, really)
2795 my $join = FS::part_event_condition->join_conditions_sql;
2796 my $order = FS::part_event_condition->order_conditions_sql;
2799 . join ( ' OR ' , map {
2800 "( part_event.eventtable = " . dbh->quote($_)
2801 . " AND tablenum IN( SELECT " . dbdef->table($_)->primary_key . " from $_ where custnum = " . dbh->quote( $self->custnum ) . "))" ;
2802 } FS::part_event->eventtables)
2805 #here is the agent virtualization
2806 my $agent_virt = " ( part_event.agentnum IS NULL
2807 OR part_event.agentnum = ". $self->agentnum. ' )';
2809 #XXX this shouldn't be hardcoded, actions should declare it...
2810 my @realtime_events = qw(
2811 cust_bill_realtime_card
2812 cust_bill_realtime_check
2813 cust_bill_realtime_lec
2817 my $is_realtime_event = ' ( '. join(' OR ', map "part_event.action = '$_'",
2822 my @cust_event = qsearchs({
2823 'table' => 'cust_event',
2824 'select' => 'cust_event.*',
2825 'addl_from' => "LEFT JOIN part_event USING ( eventpart ) $join",
2826 'hashref' => { 'status' => 'done' },
2827 'extra_sql' => " AND statustext IS NOT NULL AND statustext != '' ".
2828 " AND $mine AND $is_realtime_event AND $agent_virt $order" # LIMIT 1"
2831 my %seen_invnum = ();
2832 foreach my $cust_event (@cust_event) {
2834 #max one for the customer, one for each open invoice
2835 my $cust_X = $cust_event->cust_X;
2836 next if $seen_invnum{ $cust_event->part_event->eventtable eq 'cust_bill'
2840 or $cust_event->part_event->eventtable eq 'cust_bill'
2843 my $error = $cust_event->retry;
2845 $dbh->rollback if $oldAutoCommit;
2846 return "error scheduling event for retry: $error";
2851 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2856 =item realtime_bop METHOD AMOUNT [ OPTION => VALUE ... ]
2858 Runs a realtime credit card, ACH (electronic check) or phone bill transaction
2859 via a Business::OnlinePayment realtime gateway. See
2860 L<http://420.am/business-onlinepayment> for supported gateways.
2862 Available methods are: I<CC>, I<ECHECK> and I<LEC>
2864 Available options are: I<description>, I<invnum>, I<quiet>, I<paynum_ref>, I<payunique>
2866 The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
2867 I<zip>, I<payinfo> and I<paydate> are also available. Any of these options,
2868 if set, will override the value from the customer record.
2870 I<description> is a free-text field passed to the gateway. It defaults to
2871 "Internet services".
2873 If an I<invnum> is specified, this payment (if successful) is applied to the
2874 specified invoice. If you don't specify an I<invnum> you might want to
2875 call the B<apply_payments> method.
2877 I<quiet> can be set true to surpress email decline notices.
2879 I<paynum_ref> can be set to a scalar reference. It will be filled in with the
2880 resulting paynum, if any.
2882 I<payunique> is a unique identifier for this payment.
2884 (moved from cust_bill) (probably should get realtime_{card,ach,lec} here too)
2889 my( $self, $method, $amount, %options ) = @_;
2891 warn "$me realtime_bop: $method $amount\n";
2892 warn " $_ => $options{$_}\n" foreach keys %options;
2895 $options{'description'} ||= 'Internet services';
2897 return $self->fake_bop($method, $amount, %options) if $options{'fake'};
2899 eval "use Business::OnlinePayment";
2902 my $payinfo = exists($options{'payinfo'})
2903 ? $options{'payinfo'}
2906 my %method2payby = (
2913 # check for banned credit card/ACH
2916 my $ban = qsearchs('banned_pay', {
2917 'payby' => $method2payby{$method},
2918 'payinfo' => md5_base64($payinfo),
2920 return "Banned credit card" if $ban;
2927 if ( $options{'invnum'} ) {
2928 my $cust_bill = qsearchs('cust_bill', { 'invnum' => $options{'invnum'} } );
2929 die "invnum ". $options{'invnum'}. " not found" unless $cust_bill;
2931 map { $_->part_pkg->taxclass }
2933 map { $_->cust_pkg }
2934 $cust_bill->cust_bill_pkg;
2935 unless ( grep { $taxclasses[0] ne $_ } @taxclasses ) { #unless there are
2936 #different taxclasses
2937 $taxclass = $taxclasses[0];
2941 #look for an agent gateway override first
2943 if ( $method eq 'CC' ) {
2944 $cardtype = cardtype($payinfo);
2945 } elsif ( $method eq 'ECHECK' ) {
2948 $cardtype = $method;
2952 qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
2953 cardtype => $cardtype,
2954 taxclass => $taxclass, } )
2955 || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
2957 taxclass => $taxclass, } )
2958 || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
2959 cardtype => $cardtype,
2961 || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
2963 taxclass => '', } );
2965 my $payment_gateway = '';
2966 my( $processor, $login, $password, $action, @bop_options );
2967 if ( $override ) { #use a payment gateway override
2969 $payment_gateway = $override->payment_gateway;
2971 $processor = $payment_gateway->gateway_module;
2972 $login = $payment_gateway->gateway_username;
2973 $password = $payment_gateway->gateway_password;
2974 $action = $payment_gateway->gateway_action;
2975 @bop_options = $payment_gateway->options;
2977 } else { #use the standard settings from the config
2979 ( $processor, $login, $password, $action, @bop_options ) =
2980 $self->default_payment_gateway($method);
2988 my $address = exists($options{'address1'})
2989 ? $options{'address1'}
2991 my $address2 = exists($options{'address2'})
2992 ? $options{'address2'}
2994 $address .= ", ". $address2 if length($address2);
2996 my $o_payname = exists($options{'payname'})
2997 ? $options{'payname'}
2999 my($payname, $payfirst, $paylast);
3000 if ( $o_payname && $method ne 'ECHECK' ) {
3001 ($payname = $o_payname) =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
3002 or return "Illegal payname $payname";
3003 ($payfirst, $paylast) = ($1, $2);
3005 $payfirst = $self->getfield('first');
3006 $paylast = $self->getfield('last');
3007 $payname = "$payfirst $paylast";
3010 my @invoicing_list = $self->invoicing_list_emailonly;
3011 if ( $conf->exists('emailinvoiceautoalways')
3012 || $conf->exists('emailinvoiceauto') && ! @invoicing_list
3013 || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
3014 push @invoicing_list, $self->all_emails;
3017 my $email = ($conf->exists('business-onlinepayment-email-override'))
3018 ? $conf->config('business-onlinepayment-email-override')
3019 : $invoicing_list[0];
3023 my $payip = exists($options{'payip'})
3026 $content{customer_ip} = $payip
3029 $content{invoice_number} = $options{'invnum'}
3030 if exists($options{'invnum'}) && length($options{'invnum'});
3032 $content{email_customer} =
3033 ( $conf->exists('business-onlinepayment-email_customer')
3034 || $conf->exists('business-onlinepayment-email-override') );
3037 if ( $method eq 'CC' ) {
3039 $content{card_number} = $payinfo;
3040 $paydate = exists($options{'paydate'})
3041 ? $options{'paydate'}
3043 $paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
3044 $content{expiration} = "$2/$1";
3046 my $paycvv = exists($options{'paycvv'})
3047 ? $options{'paycvv'}
3049 $content{cvv2} = $paycvv
3052 my $paystart_month = exists($options{'paystart_month'})
3053 ? $options{'paystart_month'}
3054 : $self->paystart_month;
3056 my $paystart_year = exists($options{'paystart_year'})
3057 ? $options{'paystart_year'}
3058 : $self->paystart_year;
3060 $content{card_start} = "$paystart_month/$paystart_year"
3061 if $paystart_month && $paystart_year;
3063 my $payissue = exists($options{'payissue'})
3064 ? $options{'payissue'}
3066 $content{issue_number} = $payissue if $payissue;
3068 $content{recurring_billing} = 'YES'
3069 if qsearch('cust_pay', { 'custnum' => $self->custnum,
3071 'payinfo' => $payinfo,
3073 || qsearch('cust_pay', { 'custnum' => $self->custnum,
3075 'paymask' => $self->mask_payinfo('CARD', $payinfo),
3079 } elsif ( $method eq 'ECHECK' ) {
3080 ( $content{account_number}, $content{routing_code} ) =
3081 split('@', $payinfo);
3082 $content{bank_name} = $o_payname;
3083 $content{bank_state} = exists($options{'paystate'})
3084 ? $options{'paystate'}
3085 : $self->getfield('paystate');
3086 $content{account_type} = exists($options{'paytype'})
3087 ? uc($options{'paytype'}) || 'CHECKING'
3088 : uc($self->getfield('paytype')) || 'CHECKING';
3089 $content{account_name} = $payname;
3090 $content{customer_org} = $self->company ? 'B' : 'I';
3091 $content{state_id} = exists($options{'stateid'})
3092 ? $options{'stateid'}
3093 : $self->getfield('stateid');
3094 $content{state_id_state} = exists($options{'stateid_state'})
3095 ? $options{'stateid_state'}
3096 : $self->getfield('stateid_state');
3097 $content{customer_ssn} = exists($options{'ss'})
3100 } elsif ( $method eq 'LEC' ) {
3101 $content{phone} = $payinfo;
3105 # run transaction(s)
3108 my $balance = exists( $options{'balance'} )
3109 ? $options{'balance'}
3112 $self->select_for_update; #mutex ... just until we get our pending record in
3114 #the checks here are intended to catch concurrent payments
3115 #double-form-submission prevention is taken care of in cust_pay_pending::check
3118 return "The customer's balance has changed; $method transaction aborted."
3119 if $self->balance < $balance;
3120 #&& $self->balance < $amount; #might as well anyway?
3122 #also check and make sure there aren't *other* pending payments for this cust
3124 my @pending = qsearch('cust_pay_pending', {
3125 'custnum' => $self->custnum,
3126 'status' => { op=>'!=', value=>'done' }
3128 return "A payment is already being processed for this customer (".
3129 join(', ', map 'paypendingnum '. $_->paypendingnum, @pending ).
3130 "); $method transaction aborted."
3131 if scalar(@pending);
3133 #okay, good to go, if we're a duplicate, cust_pay_pending will kick us out
3135 my $cust_pay_pending = new FS::cust_pay_pending {
3136 'custnum' => $self->custnum,
3137 #'invnum' => $options{'invnum'},
3140 'payby' => $method2payby{$method},
3141 'payinfo' => $payinfo,
3142 'paydate' => $paydate,
3144 'gatewaynum' => ( $payment_gateway ? $payment_gateway->gatewaynum : '' ),
3146 $cust_pay_pending->payunique( $options{payunique} )
3147 if length($options{payunique});
3148 my $cpp_new_err = $cust_pay_pending->insert; #mutex lost when this is inserted
3149 return $cpp_new_err if $cpp_new_err;
3151 my( $action1, $action2 ) = split(/\s*\,\s*/, $action );
3153 my $transaction = new Business::OnlinePayment( $processor, @bop_options );
3154 $transaction->content(
3157 'password' => $password,
3158 'action' => $action1,
3159 'description' => $options{'description'},
3160 'amount' => $amount,
3161 #'invoice_number' => $options{'invnum'},
3162 'customer_id' => $self->custnum,
3163 'last_name' => $paylast,
3164 'first_name' => $payfirst,
3166 'address' => $address,
3167 'city' => ( exists($options{'city'})
3170 'state' => ( exists($options{'state'})
3173 'zip' => ( exists($options{'zip'})
3176 'country' => ( exists($options{'country'})
3177 ? $options{'country'}
3179 'referer' => 'http://cleanwhisker.420.am/',
3181 'phone' => $self->daytime || $self->night,
3185 $cust_pay_pending->status('pending');
3186 my $cpp_pending_err = $cust_pay_pending->replace;
3187 return $cpp_pending_err if $cpp_pending_err;
3189 $transaction->submit();
3191 if ( $transaction->is_success() && $action2 ) {
3193 $cust_pay_pending->status('authorized');
3194 my $cpp_authorized_err = $cust_pay_pending->replace;
3195 return $cpp_authorized_err if $cpp_authorized_err;
3197 my $auth = $transaction->authorization;
3198 my $ordernum = $transaction->can('order_number')
3199 ? $transaction->order_number
3203 new Business::OnlinePayment( $processor, @bop_options );
3210 password => $password,
3211 order_number => $ordernum,
3213 authorization => $auth,
3214 description => $options{'description'},
3217 foreach my $field (qw( authorization_source_code returned_ACI
3218 transaction_identifier validation_code
3219 transaction_sequence_num local_transaction_date
3220 local_transaction_time AVS_result_code )) {
3221 $capture{$field} = $transaction->$field() if $transaction->can($field);
3224 $capture->content( %capture );
3228 unless ( $capture->is_success ) {
3229 my $e = "Authorization successful but capture failed, custnum #".
3230 $self->custnum. ': '. $capture->result_code.
3231 ": ". $capture->error_message;
3238 $cust_pay_pending->status($transaction->is_success() ? 'captured' : 'declined');
3239 my $cpp_captured_err = $cust_pay_pending->replace;
3240 return $cpp_captured_err if $cpp_captured_err;
3243 # remove paycvv after initial transaction
3246 #false laziness w/misc/process/payment.cgi - check both to make sure working
3248 if ( defined $self->dbdef_table->column('paycvv')
3249 && length($self->paycvv)
3250 && ! grep { $_ eq cardtype($payinfo) } $conf->config('cvv-save')
3252 my $error = $self->remove_cvv;
3254 warn "WARNING: error removing cvv: $error\n";
3262 if ( $transaction->is_success() ) {
3264 my %method2payby = (
3271 if ( $payment_gateway ) { # agent override
3272 $paybatch = $payment_gateway->gatewaynum. '-';
3275 $paybatch .= "$processor:". $transaction->authorization;
3277 $paybatch .= ':'. $transaction->order_number
3278 if $transaction->can('order_number')
3279 && length($transaction->order_number);
3281 my $cust_pay = new FS::cust_pay ( {
3282 'custnum' => $self->custnum,
3283 'invnum' => $options{'invnum'},
3286 'payby' => $method2payby{$method},
3287 'payinfo' => $payinfo,
3288 'paybatch' => $paybatch,
3289 'paydate' => $paydate,
3291 #doesn't hurt to know, even though the dup check is in cust_pay_pending now
3292 $cust_pay->payunique( $options{payunique} ) if length($options{payunique});
3294 my $oldAutoCommit = $FS::UID::AutoCommit;
3295 local $FS::UID::AutoCommit = 0;
3298 #start a transaction, insert the cust_pay and set cust_pay_pending.status to done in a single transction
3300 my $error = $cust_pay->insert($options{'manual'} ? ( 'manual' => 1 ) : () );
3303 $cust_pay->invnum(''); #try again with no specific invnum
3304 my $error2 = $cust_pay->insert( $options{'manual'} ?
3305 ( 'manual' => 1 ) : ()
3308 # gah. but at least we have a record of the state we had to abort in
3309 # from cust_pay_pending now.
3310 my $e = "WARNING: $method captured but payment not recorded - ".
3311 "error inserting payment ($processor): $error2".
3312 " (previously tried insert with invnum #$options{'invnum'}" .
3313 ": $error ) - pending payment saved as paypendingnum ".
3314 $cust_pay_pending->paypendingnum. "\n";
3320 if ( $options{'paynum_ref'} ) {
3321 ${ $options{'paynum_ref'} } = $cust_pay->paynum;
3324 $cust_pay_pending->status('done');
3325 $cust_pay_pending->statustext('captured');
3326 my $cpp_done_err = $cust_pay_pending->replace;
3328 if ( $cpp_done_err ) {
3330 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
3331 my $e = "WARNING: $method captured but payment not recorded - ".
3332 "error updating status for paypendingnum ".
3333 $cust_pay_pending->paypendingnum. ": $cpp_done_err \n";
3339 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3340 return ''; #no error
3346 my $perror = "$processor error: ". $transaction->error_message;
3348 unless ( $transaction->error_message ) {
3351 if ( $transaction->can('response_page') ) {
3353 'page' => ( $transaction->can('response_page')
3354 ? $transaction->response_page
3357 'code' => ( $transaction->can('response_code')
3358 ? $transaction->response_code
3361 'headers' => ( $transaction->can('response_headers')
3362 ? $transaction->response_headers
3368 "No additional debugging information available for $processor";
3371 $perror .= "No error_message returned from $processor -- ".
3372 ( ref($t_response) ? Dumper($t_response) : $t_response );
3376 if ( !$options{'quiet'} && !$realtime_bop_decline_quiet
3377 && $conf->exists('emaildecline')
3378 && grep { $_ ne 'POST' } $self->invoicing_list
3379 && ! grep { $transaction->error_message =~ /$_/ }
3380 $conf->config('emaildecline-exclude')
3382 my @templ = $conf->config('declinetemplate');
3383 my $template = new Text::Template (
3385 SOURCE => [ map "$_\n", @templ ],
3386 ) or return "($perror) can't create template: $Text::Template::ERROR";
3387 $template->compile()
3388 or return "($perror) can't compile template: $Text::Template::ERROR";
3390 my $templ_hash = { error => $transaction->error_message };
3392 my $error = send_email(
3393 'from' => $conf->config('invoice_from'),
3394 'to' => [ grep { $_ ne 'POST' } $self->invoicing_list ],
3395 'subject' => 'Your payment could not be processed',
3396 'body' => [ $template->fill_in(HASH => $templ_hash) ],
3399 $perror .= " (also received error sending decline notification: $error)"
3404 $cust_pay_pending->status('done');
3405 $cust_pay_pending->statustext("declined: $perror");
3406 my $cpp_done_err = $cust_pay_pending->replace;
3407 if ( $cpp_done_err ) {
3408 my $e = "WARNING: $method declined but pending payment not resolved - ".
3409 "error updating status for paypendingnum ".
3410 $cust_pay_pending->paypendingnum. ": $cpp_done_err \n";
3412 $perror = "$e ($perror)";
3425 my( $self, $method, $amount, %options ) = @_;
3427 if ( $options{'fake_failure'} ) {
3428 return "Error: No error; test failure requested with fake_failure";
3431 my %method2payby = (
3438 #if ( $payment_gateway ) { # agent override
3439 # $paybatch = $payment_gateway->gatewaynum. '-';
3442 #$paybatch .= "$processor:". $transaction->authorization;
3444 #$paybatch .= ':'. $transaction->order_number
3445 # if $transaction->can('order_number')
3446 # && length($transaction->order_number);
3448 my $paybatch = 'FakeProcessor:54:32';
3450 my $cust_pay = new FS::cust_pay ( {
3451 'custnum' => $self->custnum,
3452 'invnum' => $options{'invnum'},
3455 'payby' => $method2payby{$method},
3456 #'payinfo' => $payinfo,
3457 'payinfo' => '4111111111111111',
3458 'paybatch' => $paybatch,
3459 #'paydate' => $paydate,
3460 'paydate' => '2012-05-01',
3462 $cust_pay->payunique( $options{payunique} ) if length($options{payunique});
3464 my $error = $cust_pay->insert($options{'manual'} ? ( 'manual' => 1 ) : () );
3467 $cust_pay->invnum(''); #try again with no specific invnum
3468 my $error2 = $cust_pay->insert( $options{'manual'} ?
3469 ( 'manual' => 1 ) : ()
3472 # gah, even with transactions.
3473 my $e = 'WARNING: Card/ACH debited but database not updated - '.
3474 "error inserting (fake!) payment: $error2".
3475 " (previously tried insert with invnum #$options{'invnum'}" .
3482 if ( $options{'paynum_ref'} ) {
3483 ${ $options{'paynum_ref'} } = $cust_pay->paynum;
3486 return ''; #no error
3490 =item default_payment_gateway
3494 sub default_payment_gateway {
3495 my( $self, $method ) = @_;
3497 die "Real-time processing not enabled\n"
3498 unless $conf->exists('business-onlinepayment');
3501 my $bop_config = 'business-onlinepayment';
3502 $bop_config .= '-ach'
3503 if $method =~ /^(ECHECK|CHEK)$/ && $conf->exists($bop_config. '-ach');
3504 my ( $processor, $login, $password, $action, @bop_options ) =
3505 $conf->config($bop_config);
3506 $action ||= 'normal authorization';
3507 pop @bop_options if scalar(@bop_options) % 2 && $bop_options[-1] =~ /^\s*$/;
3508 die "No real-time processor is enabled - ".
3509 "did you set the business-onlinepayment configuration value?\n"
3512 ( $processor, $login, $password, $action, @bop_options )
3517 Removes the I<paycvv> field from the database directly.
3519 If there is an error, returns the error, otherwise returns false.
3525 my $sth = dbh->prepare("UPDATE cust_main SET paycvv = '' WHERE custnum = ?")
3526 or return dbh->errstr;
3527 $sth->execute($self->custnum)
3528 or return $sth->errstr;
3533 =item realtime_refund_bop METHOD [ OPTION => VALUE ... ]
3535 Refunds a realtime credit card, ACH (electronic check) or phone bill transaction
3536 via a Business::OnlinePayment realtime gateway. See
3537 L<http://420.am/business-onlinepayment> for supported gateways.
3539 Available methods are: I<CC>, I<ECHECK> and I<LEC>
3541 Available options are: I<amount>, I<reason>, I<paynum>, I<paydate>
3543 Most gateways require a reference to an original payment transaction to refund,
3544 so you probably need to specify a I<paynum>.
3546 I<amount> defaults to the original amount of the payment if not specified.
3548 I<reason> specifies a reason for the refund.
3550 I<paydate> specifies the expiration date for a credit card overriding the
3551 value from the customer record or the payment record. Specified as yyyy-mm-dd
3553 Implementation note: If I<amount> is unspecified or equal to the amount of the
3554 orignal payment, first an attempt is made to "void" the transaction via
3555 the gateway (to cancel a not-yet settled transaction) and then if that fails,
3556 the normal attempt is made to "refund" ("credit") the transaction via the
3557 gateway is attempted.
3559 #The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
3560 #I<zip>, I<payinfo> and I<paydate> are also available. Any of these options,
3561 #if set, will override the value from the customer record.
3563 #If an I<invnum> is specified, this payment (if successful) is applied to the
3564 #specified invoice. If you don't specify an I<invnum> you might want to
3565 #call the B<apply_payments> method.
3569 #some false laziness w/realtime_bop, not enough to make it worth merging
3570 #but some useful small subs should be pulled out
3571 sub realtime_refund_bop {
3572 my( $self, $method, %options ) = @_;
3574 warn "$me realtime_refund_bop: $method refund\n";
3575 warn " $_ => $options{$_}\n" foreach keys %options;
3578 eval "use Business::OnlinePayment";
3582 # look up the original payment and optionally a gateway for that payment
3586 my $amount = $options{'amount'};
3588 my( $processor, $login, $password, @bop_options ) ;
3589 my( $auth, $order_number ) = ( '', '', '' );
3591 if ( $options{'paynum'} ) {
3593 warn " paynum: $options{paynum}\n" if $DEBUG > 1;
3594 $cust_pay = qsearchs('cust_pay', { paynum=>$options{'paynum'} } )
3595 or return "Unknown paynum $options{'paynum'}";
3596 $amount ||= $cust_pay->paid;
3598 $cust_pay->paybatch =~ /^((\d+)\-)?(\w+):\s*([\w\-\/ ]*)(:([\w\-]+))?$/
3599 or return "Can't parse paybatch for paynum $options{'paynum'}: ".
3600 $cust_pay->paybatch;
3601 my $gatewaynum = '';
3602 ( $gatewaynum, $processor, $auth, $order_number ) = ( $2, $3, $4, $6 );
3604 if ( $gatewaynum ) { #gateway for the payment to be refunded
3606 my $payment_gateway =
3607 qsearchs('payment_gateway', { 'gatewaynum' => $gatewaynum } );
3608 die "payment gateway $gatewaynum not found"
3609 unless $payment_gateway;
3611 $processor = $payment_gateway->gateway_module;
3612 $login = $payment_gateway->gateway_username;
3613 $password = $payment_gateway->gateway_password;
3614 @bop_options = $payment_gateway->options;
3616 } else { #try the default gateway
3618 my( $conf_processor, $unused_action );
3619 ( $conf_processor, $login, $password, $unused_action, @bop_options ) =
3620 $self->default_payment_gateway($method);
3622 return "processor of payment $options{'paynum'} $processor does not".
3623 " match default processor $conf_processor"
3624 unless $processor eq $conf_processor;
3629 } else { # didn't specify a paynum, so look for agent gateway overrides
3630 # like a normal transaction
3633 if ( $method eq 'CC' ) {
3634 $cardtype = cardtype($self->payinfo);
3635 } elsif ( $method eq 'ECHECK' ) {
3638 $cardtype = $method;
3641 qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
3642 cardtype => $cardtype,
3644 || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
3646 taxclass => '', } );
3648 if ( $override ) { #use a payment gateway override
3650 my $payment_gateway = $override->payment_gateway;
3652 $processor = $payment_gateway->gateway_module;
3653 $login = $payment_gateway->gateway_username;
3654 $password = $payment_gateway->gateway_password;
3655 #$action = $payment_gateway->gateway_action;
3656 @bop_options = $payment_gateway->options;
3658 } else { #use the standard settings from the config
3661 ( $processor, $login, $password, $unused_action, @bop_options ) =
3662 $self->default_payment_gateway($method);
3667 return "neither amount nor paynum specified" unless $amount;
3672 'password' => $password,
3673 'order_number' => $order_number,
3674 'amount' => $amount,
3675 'referer' => 'http://cleanwhisker.420.am/',
3677 $content{authorization} = $auth
3678 if length($auth); #echeck/ACH transactions have an order # but no auth
3679 #(at least with authorize.net)
3681 my $disable_void_after;
3682 if ($conf->exists('disable_void_after')
3683 && $conf->config('disable_void_after') =~ /^(\d+)$/) {
3684 $disable_void_after = $1;
3687 #first try void if applicable
3688 if ( $cust_pay && $cust_pay->paid == $amount
3690 ( not defined($disable_void_after) )
3691 || ( time < ($cust_pay->_date + $disable_void_after ) )
3694 warn " attempting void\n" if $DEBUG > 1;
3695 my $void = new Business::OnlinePayment( $processor, @bop_options );
3696 $void->content( 'action' => 'void', %content );
3698 if ( $void->is_success ) {
3699 my $error = $cust_pay->void($options{'reason'});
3701 # gah, even with transactions.
3702 my $e = 'WARNING: Card/ACH voided but database not updated - '.
3703 "error voiding payment: $error";
3707 warn " void successful\n" if $DEBUG > 1;
3712 warn " void unsuccessful, trying refund\n"
3716 my $address = $self->address1;
3717 $address .= ", ". $self->address2 if $self->address2;
3719 my($payname, $payfirst, $paylast);
3720 if ( $self->payname && $method ne 'ECHECK' ) {
3721 $payname = $self->payname;
3722 $payname =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
3723 or return "Illegal payname $payname";
3724 ($payfirst, $paylast) = ($1, $2);
3726 $payfirst = $self->getfield('first');
3727 $paylast = $self->getfield('last');
3728 $payname = "$payfirst $paylast";
3731 my @invoicing_list = $self->invoicing_list_emailonly;
3732 if ( $conf->exists('emailinvoiceautoalways')
3733 || $conf->exists('emailinvoiceauto') && ! @invoicing_list
3734 || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
3735 push @invoicing_list, $self->all_emails;
3738 my $email = ($conf->exists('business-onlinepayment-email-override'))
3739 ? $conf->config('business-onlinepayment-email-override')
3740 : $invoicing_list[0];
3742 my $payip = exists($options{'payip'})
3745 $content{customer_ip} = $payip
3749 if ( $method eq 'CC' ) {
3752 $content{card_number} = $payinfo = $cust_pay->payinfo;
3753 (exists($options{'paydate'}) ? $options{'paydate'} : $cust_pay->paydate)
3754 =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/ &&
3755 ($content{expiration} = "$2/$1"); # where available
3757 $content{card_number} = $payinfo = $self->payinfo;
3758 (exists($options{'paydate'}) ? $options{'paydate'} : $self->paydate)
3759 =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
3760 $content{expiration} = "$2/$1";
3763 } elsif ( $method eq 'ECHECK' ) {
3766 $payinfo = $cust_pay->payinfo;
3768 $payinfo = $self->payinfo;
3770 ( $content{account_number}, $content{routing_code} )= split('@', $payinfo );
3771 $content{bank_name} = $self->payname;
3772 $content{account_type} = 'CHECKING';
3773 $content{account_name} = $payname;
3774 $content{customer_org} = $self->company ? 'B' : 'I';
3775 $content{customer_ssn} = $self->ss;
3776 } elsif ( $method eq 'LEC' ) {
3777 $content{phone} = $payinfo = $self->payinfo;
3781 my $refund = new Business::OnlinePayment( $processor, @bop_options );
3782 my %sub_content = $refund->content(
3783 'action' => 'credit',
3784 'customer_id' => $self->custnum,
3785 'last_name' => $paylast,
3786 'first_name' => $payfirst,
3788 'address' => $address,
3789 'city' => $self->city,
3790 'state' => $self->state,
3791 'zip' => $self->zip,
3792 'country' => $self->country,
3794 'phone' => $self->daytime || $self->night,
3797 warn join('', map { " $_ => $sub_content{$_}\n" } keys %sub_content )
3801 return "$processor error: ". $refund->error_message
3802 unless $refund->is_success();
3804 my %method2payby = (
3810 my $paybatch = "$processor:". $refund->authorization;
3811 $paybatch .= ':'. $refund->order_number
3812 if $refund->can('order_number') && $refund->order_number;
3814 while ( $cust_pay && $cust_pay->unapplied < $amount ) {
3815 my @cust_bill_pay = $cust_pay->cust_bill_pay;
3816 last unless @cust_bill_pay;
3817 my $cust_bill_pay = pop @cust_bill_pay;
3818 my $error = $cust_bill_pay->delete;
3822 my $cust_refund = new FS::cust_refund ( {
3823 'custnum' => $self->custnum,
3824 'paynum' => $options{'paynum'},
3825 'refund' => $amount,
3827 'payby' => $method2payby{$method},
3828 'payinfo' => $payinfo,
3829 'paybatch' => $paybatch,
3830 'reason' => $options{'reason'} || 'card or ACH refund',
3832 my $error = $cust_refund->insert;
3834 $cust_refund->paynum(''); #try again with no specific paynum
3835 my $error2 = $cust_refund->insert;
3837 # gah, even with transactions.
3838 my $e = 'WARNING: Card/ACH refunded but database not updated - '.
3839 "error inserting refund ($processor): $error2".
3840 " (previously tried insert with paynum #$options{'paynum'}" .
3851 =item batch_card OPTION => VALUE...
3853 Adds a payment for this invoice to the pending credit card batch (see
3854 L<FS::cust_pay_batch>), or, if the B<realtime> option is set to a true value,
3855 runs the payment using a realtime gateway.
3860 my ($self, %options) = @_;
3863 if (exists($options{amount})) {
3864 $amount = $options{amount};
3866 $amount = sprintf("%.2f", $self->balance - $self->in_transit_payments);
3868 return '' unless $amount > 0;
3870 my $invnum = delete $options{invnum};
3871 my $payby = $options{invnum} || $self->payby; #dubious
3873 if ($options{'realtime'}) {
3874 return $self->realtime_bop( FS::payby->payby2bop($self->payby),
3880 my $oldAutoCommit = $FS::UID::AutoCommit;
3881 local $FS::UID::AutoCommit = 0;
3884 #this needs to handle mysql as well as Pg, like svc_acct.pm
3885 #(make it into a common function if folks need to do batching with mysql)
3886 $dbh->do("LOCK TABLE pay_batch IN SHARE ROW EXCLUSIVE MODE")
3887 or return "Cannot lock pay_batch: " . $dbh->errstr;
3891 'payby' => FS::payby->payby2payment($payby),
3894 my $pay_batch = qsearchs( 'pay_batch', \%pay_batch );
3896 unless ( $pay_batch ) {
3897 $pay_batch = new FS::pay_batch \%pay_batch;
3898 my $error = $pay_batch->insert;
3900 $dbh->rollback if $oldAutoCommit;
3901 die "error creating new batch: $error\n";
3905 my $old_cust_pay_batch = qsearchs('cust_pay_batch', {
3906 'batchnum' => $pay_batch->batchnum,
3907 'custnum' => $self->custnum,
3910 foreach (qw( address1 address2 city state zip country payby payinfo paydate
3912 $options{$_} = '' unless exists($options{$_});
3915 my $cust_pay_batch = new FS::cust_pay_batch ( {
3916 'batchnum' => $pay_batch->batchnum,
3917 'invnum' => $invnum || 0, # is there a better value?
3918 # this field should be
3920 # cust_bill_pay_batch now
3921 'custnum' => $self->custnum,
3922 'last' => $self->getfield('last'),
3923 'first' => $self->getfield('first'),
3924 'address1' => $options{address1} || $self->address1,
3925 'address2' => $options{address2} || $self->address2,
3926 'city' => $options{city} || $self->city,
3927 'state' => $options{state} || $self->state,
3928 'zip' => $options{zip} || $self->zip,
3929 'country' => $options{country} || $self->country,
3930 'payby' => $options{payby} || $self->payby,
3931 'payinfo' => $options{payinfo} || $self->payinfo,
3932 'exp' => $options{paydate} || $self->paydate,
3933 'payname' => $options{payname} || $self->payname,
3934 'amount' => $amount, # consolidating
3937 $cust_pay_batch->paybatchnum($old_cust_pay_batch->paybatchnum)
3938 if $old_cust_pay_batch;
3941 if ($old_cust_pay_batch) {
3942 $error = $cust_pay_batch->replace($old_cust_pay_batch)
3944 $error = $cust_pay_batch->insert;
3948 $dbh->rollback if $oldAutoCommit;
3952 my $unapplied = $self->total_credited + $self->total_unapplied_payments + $self->in_transit_payments;
3953 foreach my $cust_bill ($self->open_cust_bill) {
3954 #$dbh->commit or die $dbh->errstr if $oldAutoCommit;
3955 my $cust_bill_pay_batch = new FS::cust_bill_pay_batch {
3956 'invnum' => $cust_bill->invnum,
3957 'paybatchnum' => $cust_pay_batch->paybatchnum,
3958 'amount' => $cust_bill->owed,
3961 if ($unapplied >= $cust_bill_pay_batch->amount){
3962 $unapplied -= $cust_bill_pay_batch->amount;
3965 $cust_bill_pay_batch->amount(sprintf ( "%.2f",
3966 $cust_bill_pay_batch->amount - $unapplied )); $unapplied = 0;
3968 $error = $cust_bill_pay_batch->insert;
3970 $dbh->rollback if $oldAutoCommit;
3975 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3981 Returns the total owed for this customer on all invoices
3982 (see L<FS::cust_bill/owed>).
3988 $self->total_owed_date(2145859200); #12/31/2037
3991 =item total_owed_date TIME
3993 Returns the total owed for this customer on all invoices with date earlier than
3994 TIME. TIME is specified as a UNIX timestamp; see L<perlfunc/"time">). Also
3995 see L<Time::Local> and L<Date::Parse> for conversion functions.
3999 sub total_owed_date {
4003 foreach my $cust_bill (
4004 grep { $_->_date <= $time }
4005 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
4007 $total_bill += $cust_bill->owed;
4009 sprintf( "%.2f", $total_bill );
4012 =item apply_payments_and_credits
4014 Applies unapplied payments and credits.
4016 In most cases, this new method should be used in place of sequential
4017 apply_payments and apply_credits methods.
4019 If there is an error, returns the error, otherwise returns false.
4023 sub apply_payments_and_credits {
4026 local $SIG{HUP} = 'IGNORE';
4027 local $SIG{INT} = 'IGNORE';
4028 local $SIG{QUIT} = 'IGNORE';
4029 local $SIG{TERM} = 'IGNORE';
4030 local $SIG{TSTP} = 'IGNORE';
4031 local $SIG{PIPE} = 'IGNORE';
4033 my $oldAutoCommit = $FS::UID::AutoCommit;
4034 local $FS::UID::AutoCommit = 0;
4037 $self->select_for_update; #mutex
4039 foreach my $cust_bill ( $self->open_cust_bill ) {
4040 my $error = $cust_bill->apply_payments_and_credits;
4042 $dbh->rollback if $oldAutoCommit;
4043 return "Error applying: $error";
4047 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4052 =item apply_credits OPTION => VALUE ...
4054 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
4055 to outstanding invoice balances in chronological order (or reverse
4056 chronological order if the I<order> option is set to B<newest>) and returns the
4057 value of any remaining unapplied credits available for refund (see
4058 L<FS::cust_refund>).
4060 Dies if there is an error.
4068 local $SIG{HUP} = 'IGNORE';
4069 local $SIG{INT} = 'IGNORE';
4070 local $SIG{QUIT} = 'IGNORE';
4071 local $SIG{TERM} = 'IGNORE';
4072 local $SIG{TSTP} = 'IGNORE';
4073 local $SIG{PIPE} = 'IGNORE';
4075 my $oldAutoCommit = $FS::UID::AutoCommit;
4076 local $FS::UID::AutoCommit = 0;
4079 $self->select_for_update; #mutex
4081 unless ( $self->total_credited ) {
4082 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4086 my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
4087 qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
4089 my @invoices = $self->open_cust_bill;
4090 @invoices = sort { $b->_date <=> $a->_date } @invoices
4091 if defined($opt{'order'}) && $opt{'order'} eq 'newest';
4094 foreach my $cust_bill ( @invoices ) {
4097 if ( !defined($credit) || $credit->credited == 0) {
4098 $credit = pop @credits or last;
4101 if ($cust_bill->owed >= $credit->credited) {
4102 $amount=$credit->credited;
4104 $amount=$cust_bill->owed;
4107 my $cust_credit_bill = new FS::cust_credit_bill ( {
4108 'crednum' => $credit->crednum,
4109 'invnum' => $cust_bill->invnum,
4110 'amount' => $amount,
4112 my $error = $cust_credit_bill->insert;
4114 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
4118 redo if ($cust_bill->owed > 0);
4122 my $total_credited = $self->total_credited;
4124 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4126 return $total_credited;
4129 =item apply_payments
4131 Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
4132 to outstanding invoice balances in chronological order.
4134 #and returns the value of any remaining unapplied payments.
4136 Dies if there is an error.
4140 sub apply_payments {
4143 local $SIG{HUP} = 'IGNORE';
4144 local $SIG{INT} = 'IGNORE';
4145 local $SIG{QUIT} = 'IGNORE';
4146 local $SIG{TERM} = 'IGNORE';
4147 local $SIG{TSTP} = 'IGNORE';
4148 local $SIG{PIPE} = 'IGNORE';
4150 my $oldAutoCommit = $FS::UID::AutoCommit;
4151 local $FS::UID::AutoCommit = 0;
4154 $self->select_for_update; #mutex
4158 my @payments = sort { $b->_date <=> $a->_date } ( grep { $_->unapplied > 0 }
4159 qsearch('cust_pay', { 'custnum' => $self->custnum } ) );
4161 my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
4162 qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
4166 foreach my $cust_bill ( @invoices ) {
4169 if ( !defined($payment) || $payment->unapplied == 0 ) {
4170 $payment = pop @payments or last;
4173 if ( $cust_bill->owed >= $payment->unapplied ) {
4174 $amount = $payment->unapplied;
4176 $amount = $cust_bill->owed;
4179 my $cust_bill_pay = new FS::cust_bill_pay ( {
4180 'paynum' => $payment->paynum,
4181 'invnum' => $cust_bill->invnum,
4182 'amount' => $amount,
4184 my $error = $cust_bill_pay->insert;
4186 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
4190 redo if ( $cust_bill->owed > 0);
4194 my $total_unapplied_payments = $self->total_unapplied_payments;
4196 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4198 return $total_unapplied_payments;
4201 =item total_credited
4203 Returns the total outstanding credit (see L<FS::cust_credit>) for this
4204 customer. See L<FS::cust_credit/credited>.
4208 sub total_credited {
4210 my $total_credit = 0;
4211 foreach my $cust_credit ( qsearch('cust_credit', {
4212 'custnum' => $self->custnum,
4214 $total_credit += $cust_credit->credited;
4216 sprintf( "%.2f", $total_credit );
4219 =item total_unapplied_payments
4221 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
4222 See L<FS::cust_pay/unapplied>.
4226 sub total_unapplied_payments {
4228 my $total_unapplied = 0;
4229 foreach my $cust_pay ( qsearch('cust_pay', {
4230 'custnum' => $self->custnum,
4232 $total_unapplied += $cust_pay->unapplied;
4234 sprintf( "%.2f", $total_unapplied );
4237 =item total_unapplied_refunds
4239 Returns the total unrefunded refunds (see L<FS::cust_refund>) for this
4240 customer. See L<FS::cust_refund/unapplied>.
4244 sub total_unapplied_refunds {
4246 my $total_unapplied = 0;
4247 foreach my $cust_refund ( qsearch('cust_refund', {
4248 'custnum' => $self->custnum,
4250 $total_unapplied += $cust_refund->unapplied;
4252 sprintf( "%.2f", $total_unapplied );
4257 Returns the balance for this customer (total_owed plus total_unrefunded, minus
4258 total_credited minus total_unapplied_payments).
4266 + $self->total_unapplied_refunds
4267 - $self->total_credited
4268 - $self->total_unapplied_payments
4272 =item balance_date TIME
4274 Returns the balance for this customer, only considering invoices with date
4275 earlier than TIME (total_owed_date minus total_credited minus
4276 total_unapplied_payments). TIME is specified as a UNIX timestamp; see
4277 L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion
4286 $self->total_owed_date($time)
4287 + $self->total_unapplied_refunds
4288 - $self->total_credited
4289 - $self->total_unapplied_payments
4293 =item in_transit_payments
4295 Returns the total of requests for payments for this customer pending in
4296 batches in transit to the bank. See L<FS::pay_batch> and L<FS::cust_pay_batch>
4300 sub in_transit_payments {
4302 my $in_transit_payments = 0;
4303 foreach my $pay_batch ( qsearch('pay_batch', {
4306 foreach my $cust_pay_batch ( qsearch('cust_pay_batch', {
4307 'batchnum' => $pay_batch->batchnum,
4308 'custnum' => $self->custnum,
4310 $in_transit_payments += $cust_pay_batch->amount;
4313 sprintf( "%.2f", $in_transit_payments );
4316 =item paydate_monthyear
4318 Returns a two-element list consisting of the month and year of this customer's
4319 paydate (credit card expiration date for CARD customers)
4323 sub paydate_monthyear {
4325 if ( $self->paydate =~ /^(\d{4})-(\d{1,2})-\d{1,2}$/ ) { #Pg date format
4327 } elsif ( $self->paydate =~ /^(\d{1,2})-(\d{1,2}-)?(\d{4}$)/ ) {
4334 =item invoicing_list [ ARRAYREF ]
4336 If an arguement is given, sets these email addresses as invoice recipients
4337 (see L<FS::cust_main_invoice>). Errors are not fatal and are not reported
4338 (except as warnings), so use check_invoicing_list first.
4340 Returns a list of email addresses (with svcnum entries expanded).
4342 Note: You can clear the invoicing list by passing an empty ARRAYREF. You can
4343 check it without disturbing anything by passing nothing.
4345 This interface may change in the future.
4349 sub invoicing_list {
4350 my( $self, $arrayref ) = @_;
4353 my @cust_main_invoice;
4354 if ( $self->custnum ) {
4355 @cust_main_invoice =
4356 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
4358 @cust_main_invoice = ();
4360 foreach my $cust_main_invoice ( @cust_main_invoice ) {
4361 #warn $cust_main_invoice->destnum;
4362 unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
4363 #warn $cust_main_invoice->destnum;
4364 my $error = $cust_main_invoice->delete;
4365 warn $error if $error;
4368 if ( $self->custnum ) {
4369 @cust_main_invoice =
4370 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
4372 @cust_main_invoice = ();
4374 my %seen = map { $_->address => 1 } @cust_main_invoice;
4375 foreach my $address ( @{$arrayref} ) {
4376 next if exists $seen{$address} && $seen{$address};
4377 $seen{$address} = 1;
4378 my $cust_main_invoice = new FS::cust_main_invoice ( {
4379 'custnum' => $self->custnum,
4382 my $error = $cust_main_invoice->insert;
4383 warn $error if $error;
4387 if ( $self->custnum ) {
4389 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
4396 =item check_invoicing_list ARRAYREF
4398 Checks these arguements as valid input for the invoicing_list method. If there
4399 is an error, returns the error, otherwise returns false.
4403 sub check_invoicing_list {
4404 my( $self, $arrayref ) = @_;
4406 foreach my $address ( @$arrayref ) {
4408 if ($address eq 'FAX' and $self->getfield('fax') eq '') {
4409 return 'Can\'t add FAX invoice destination with a blank FAX number.';
4412 my $cust_main_invoice = new FS::cust_main_invoice ( {
4413 'custnum' => $self->custnum,
4416 my $error = $self->custnum
4417 ? $cust_main_invoice->check
4418 : $cust_main_invoice->checkdest
4420 return $error if $error;
4424 return "Email address required"
4425 if $conf->exists('cust_main-require_invoicing_list_email')
4426 && ! grep { $_ !~ /^([A-Z]+)$/ } @$arrayref;
4431 =item set_default_invoicing_list
4433 Sets the invoicing list to all accounts associated with this customer,
4434 overwriting any previous invoicing list.
4438 sub set_default_invoicing_list {
4440 $self->invoicing_list($self->all_emails);
4445 Returns the email addresses of all accounts provisioned for this customer.
4452 foreach my $cust_pkg ( $self->all_pkgs ) {
4453 my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
4455 map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
4456 grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
4458 $list{$_}=1 foreach map { $_->email } @svc_acct;
4463 =item invoicing_list_addpost
4465 Adds postal invoicing to this customer. If this customer is already configured
4466 to receive postal invoices, does nothing.
4470 sub invoicing_list_addpost {
4472 return if grep { $_ eq 'POST' } $self->invoicing_list;
4473 my @invoicing_list = $self->invoicing_list;
4474 push @invoicing_list, 'POST';
4475 $self->invoicing_list(\@invoicing_list);
4478 =item invoicing_list_emailonly
4480 Returns the list of email invoice recipients (invoicing_list without non-email
4481 destinations such as POST and FAX).
4485 sub invoicing_list_emailonly {
4487 warn "$me invoicing_list_emailonly called"
4489 grep { $_ !~ /^([A-Z]+)$/ } $self->invoicing_list;
4492 =item invoicing_list_emailonly_scalar
4494 Returns the list of email invoice recipients (invoicing_list without non-email
4495 destinations such as POST and FAX) as a comma-separated scalar.
4499 sub invoicing_list_emailonly_scalar {
4501 warn "$me invoicing_list_emailonly_scalar called"
4503 join(', ', $self->invoicing_list_emailonly);
4506 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
4508 Returns an array of customers referred by this customer (referral_custnum set
4509 to this custnum). If DEPTH is given, recurses up to the given depth, returning
4510 customers referred by customers referred by this customer and so on, inclusive.
4511 The default behavior is DEPTH 1 (no recursion).
4515 sub referral_cust_main {
4517 my $depth = @_ ? shift : 1;
4518 my $exclude = @_ ? shift : {};
4521 map { $exclude->{$_->custnum}++; $_; }
4522 grep { ! $exclude->{ $_->custnum } }
4523 qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
4527 map { $_->referral_cust_main($depth-1, $exclude) }
4534 =item referral_cust_main_ncancelled
4536 Same as referral_cust_main, except only returns customers with uncancelled
4541 sub referral_cust_main_ncancelled {
4543 grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
4546 =item referral_cust_pkg [ DEPTH ]
4548 Like referral_cust_main, except returns a flat list of all unsuspended (and
4549 uncancelled) packages for each customer. The number of items in this list may
4550 be useful for comission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
4554 sub referral_cust_pkg {
4556 my $depth = @_ ? shift : 1;
4558 map { $_->unsuspended_pkgs }
4559 grep { $_->unsuspended_pkgs }
4560 $self->referral_cust_main($depth);
4563 =item referring_cust_main
4565 Returns the single cust_main record for the customer who referred this customer
4566 (referral_custnum), or false.
4570 sub referring_cust_main {
4572 return '' unless $self->referral_custnum;
4573 qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
4576 =item credit AMOUNT, REASON
4578 Applies a credit to this customer. If there is an error, returns the error,
4579 otherwise returns false.
4584 my( $self, $amount, $reason ) = @_;
4585 my $cust_credit = new FS::cust_credit {
4586 'custnum' => $self->custnum,
4587 'amount' => $amount,
4588 'reason' => $reason,
4590 $cust_credit->insert;
4593 =item charge AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
4595 Creates a one-time charge for this customer. If there is an error, returns
4596 the error, otherwise returns false.
4602 my ( $amount, $pkg, $comment, $taxclass, $additional );
4603 if ( ref( $_[0] ) ) {
4604 $amount = $_[0]->{amount};
4605 $pkg = exists($_[0]->{pkg}) ? $_[0]->{pkg} : 'One-time charge';
4606 $comment = exists($_[0]->{comment}) ? $_[0]->{comment}
4607 : '$'. sprintf("%.2f",$amount);
4608 $taxclass = exists($_[0]->{taxclass}) ? $_[0]->{taxclass} : '';
4609 $additional = $_[0]->{additional};
4612 $pkg = @_ ? shift : 'One-time charge';
4613 $comment = @_ ? shift : '$'. sprintf("%.2f",$amount);
4614 $taxclass = @_ ? shift : '';
4618 local $SIG{HUP} = 'IGNORE';
4619 local $SIG{INT} = 'IGNORE';
4620 local $SIG{QUIT} = 'IGNORE';
4621 local $SIG{TERM} = 'IGNORE';
4622 local $SIG{TSTP} = 'IGNORE';
4623 local $SIG{PIPE} = 'IGNORE';
4625 my $oldAutoCommit = $FS::UID::AutoCommit;
4626 local $FS::UID::AutoCommit = 0;
4629 my $part_pkg = new FS::part_pkg ( {
4631 'comment' => $comment,
4635 'taxclass' => $taxclass,
4638 my %options = ( ( map { ("additional_info$_" => $additional->[$_] ) }
4639 ( 0 .. @$additional - 1 )
4641 'additional_count' => scalar(@$additional),
4642 'setup_fee' => $amount,
4645 my $error = $part_pkg->insert( options => \%options );
4647 $dbh->rollback if $oldAutoCommit;
4651 my $pkgpart = $part_pkg->pkgpart;
4652 my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
4653 unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
4654 my $type_pkgs = new FS::type_pkgs \%type_pkgs;
4655 $error = $type_pkgs->insert;
4657 $dbh->rollback if $oldAutoCommit;
4662 my $cust_pkg = new FS::cust_pkg ( {
4663 'custnum' => $self->custnum,
4664 'pkgpart' => $pkgpart,
4667 $error = $cust_pkg->insert;
4669 $dbh->rollback if $oldAutoCommit;
4673 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4680 Returns all the invoices (see L<FS::cust_bill>) for this customer.
4686 sort { $a->_date <=> $b->_date }
4687 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
4690 =item open_cust_bill
4692 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
4697 sub open_cust_bill {
4699 grep { $_->owed > 0 } $self->cust_bill;
4704 Returns all the credits (see L<FS::cust_credit>) for this customer.
4710 sort { $a->_date <=> $b->_date }
4711 qsearch( 'cust_credit', { 'custnum' => $self->custnum } )
4716 Returns all the payments (see L<FS::cust_pay>) for this customer.
4722 sort { $a->_date <=> $b->_date }
4723 qsearch( 'cust_pay', { 'custnum' => $self->custnum } )
4728 Returns all voided payments (see L<FS::cust_pay_void>) for this customer.
4734 sort { $a->_date <=> $b->_date }
4735 qsearch( 'cust_pay_void', { 'custnum' => $self->custnum } )
4738 =item cust_pay_batch
4740 Returns all batched payments (see L<FS::cust_pay_void>) for this customer.
4744 sub cust_pay_batch {
4746 sort { $a->_date <=> $b->_date }
4747 qsearch( 'cust_pay_batch', { 'custnum' => $self->custnum } )
4752 Returns all the refunds (see L<FS::cust_refund>) for this customer.
4758 sort { $a->_date <=> $b->_date }
4759 qsearch( 'cust_refund', { 'custnum' => $self->custnum } )
4764 Returns a name string for this customer, either "Company (Last, First)" or
4771 my $name = $self->contact;
4772 $name = $self->company. " ($name)" if $self->company;
4778 Returns a name string for this (service/shipping) contact, either
4779 "Company (Last, First)" or "Last, First".
4785 if ( $self->get('ship_last') ) {
4786 my $name = $self->ship_contact;
4787 $name = $self->ship_company. " ($name)" if $self->ship_company;
4796 Returns this customer's full (billing) contact name only, "Last, First"
4802 $self->get('last'). ', '. $self->first;
4807 Returns this customer's full (shipping) contact name only, "Last, First"
4813 $self->get('ship_last')
4814 ? $self->get('ship_last'). ', '. $self->ship_first
4820 Returns this customer's full country name
4826 code2country($self->country);
4833 Returns a status string for this customer, currently:
4837 =item prospect - No packages have ever been ordered
4839 =item active - One or more recurring packages is active
4841 =item inactive - No active recurring packages, but otherwise unsuspended/uncancelled (the inactive status is new - previously inactive customers were mis-identified as cancelled)
4843 =item suspended - All non-cancelled recurring packages are suspended
4845 =item cancelled - All recurring packages are cancelled
4851 sub status { shift->cust_status(@_); }
4855 for my $status (qw( prospect active inactive suspended cancelled )) {
4856 my $method = $status.'_sql';
4857 my $numnum = ( my $sql = $self->$method() ) =~ s/cust_main\.custnum/?/g;
4858 my $sth = dbh->prepare("SELECT $sql") or die dbh->errstr;
4859 $sth->execute( ($self->custnum) x $numnum )
4860 or die "Error executing 'SELECT $sql': ". $sth->errstr;
4861 return $status if $sth->fetchrow_arrayref->[0];
4865 =item ucfirst_cust_status
4867 =item ucfirst_status
4869 Returns the status with the first character capitalized.
4873 sub ucfirst_status { shift->ucfirst_cust_status(@_); }
4875 sub ucfirst_cust_status {
4877 ucfirst($self->cust_status);
4882 Returns a hex triplet color string for this customer's status.
4886 use vars qw(%statuscolor);
4887 tie my %statuscolor, 'Tie::IxHash',
4888 'prospect' => '7e0079', #'000000', #black? naw, purple
4889 'active' => '00CC00', #green
4890 'inactive' => '0000CC', #blue
4891 'suspended' => 'FF9900', #yellow
4892 'cancelled' => 'FF0000', #red
4895 sub statuscolor { shift->cust_statuscolor(@_); }
4897 sub cust_statuscolor {
4899 $statuscolor{$self->cust_status};
4904 Returns an array of hashes representing the customer's RT tickets.
4911 my $num = $conf->config('cust_main-max_tickets') || 10;
4914 unless ( $conf->config('ticket_system-custom_priority_field') ) {
4916 @tickets = @{ FS::TicketSystem->customer_tickets($self->custnum, $num) };
4920 foreach my $priority (
4921 $conf->config('ticket_system-custom_priority_field-values'), ''
4923 last if scalar(@tickets) >= $num;
4925 @{ FS::TicketSystem->customer_tickets( $self->custnum,
4926 $num - scalar(@tickets),
4935 # Return services representing svc_accts in customer support packages
4936 sub support_services {
4938 my %packages = map { $_ => 1 } $conf->config('support_packages');
4940 grep { $_->pkg_svc && $_->pkg_svc->primary_svc eq 'Y' }
4941 grep { $_->part_svc->svcdb eq 'svc_acct' }
4942 map { $_->cust_svc }
4943 grep { exists $packages{ $_->pkgpart } }
4944 $self->ncancelled_pkgs;
4950 =head1 CLASS METHODS
4956 Class method that returns the list of possible status strings for customers
4957 (see L<the status method|/status>). For example:
4959 @statuses = FS::cust_main->statuses();
4964 #my $self = shift; #could be class...
4970 Returns an SQL expression identifying prospective cust_main records (customers
4971 with no packages ever ordered)
4975 use vars qw($select_count_pkgs);
4976 $select_count_pkgs =
4977 "SELECT COUNT(*) FROM cust_pkg
4978 WHERE cust_pkg.custnum = cust_main.custnum";
4980 sub select_count_pkgs_sql {
4984 sub prospect_sql { "
4985 0 = ( $select_count_pkgs )
4990 Returns an SQL expression identifying active cust_main records (customers with
4991 no active recurring packages, but otherwise unsuspended/uncancelled).
4996 0 < ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. "
5002 Returns an SQL expression identifying inactive cust_main records (customers with
5003 active recurring packages).
5007 sub inactive_sql { "
5008 0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " )
5010 0 < ( $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " )
5016 Returns an SQL expression identifying suspended cust_main records.
5021 sub suspended_sql { susp_sql(@_); }
5023 0 < ( $select_count_pkgs AND ". FS::cust_pkg->suspended_sql. " )
5025 0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " )
5031 Returns an SQL expression identifying cancelled cust_main records.
5035 sub cancelled_sql { cancel_sql(@_); }
5038 my $recurring_sql = FS::cust_pkg->recurring_sql;
5039 #my $recurring_sql = "
5040 # '0' != ( select freq from part_pkg
5041 # where cust_pkg.pkgpart = part_pkg.pkgpart )
5045 0 < ( $select_count_pkgs )
5046 AND 0 = ( $select_count_pkgs AND $recurring_sql
5047 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
5053 =item uncancelled_sql
5055 Returns an SQL expression identifying un-cancelled cust_main records.
5059 sub uncancelled_sql { uncancel_sql(@_); }
5060 sub uncancel_sql { "
5061 ( 0 < ( $select_count_pkgs
5062 AND ( cust_pkg.cancel IS NULL
5063 OR cust_pkg.cancel = 0
5066 OR 0 = ( $select_count_pkgs )
5072 Returns an SQL fragment to retreive the balance.
5077 COALESCE( ( SELECT SUM(charged) FROM cust_bill
5078 WHERE cust_bill.custnum = cust_main.custnum ), 0)
5079 - COALESCE( ( SELECT SUM(paid) FROM cust_pay
5080 WHERE cust_pay.custnum = cust_main.custnum ), 0)
5081 - COALESCE( ( SELECT SUM(amount) FROM cust_credit
5082 WHERE cust_credit.custnum = cust_main.custnum ), 0)
5083 + COALESCE( ( SELECT SUM(refund) FROM cust_refund
5084 WHERE cust_refund.custnum = cust_main.custnum ), 0)
5087 =item balance_date_sql TIME
5089 Returns an SQL fragment to retreive the balance for this customer, only
5090 considering invoices with date earlier than TIME. (total_owed_date minus total_credited minus
5091 total_unapplied_payments). TIME is specified as an SQL fragment or a numeric
5092 UNIX timestamp; see L<perlfunc/"time">). Also see L<Time::Local> and
5093 L<Date::Parse> for conversion functions.
5097 sub balance_date_sql {
5098 my( $class, $time ) = @_;
5100 my $owed_sql = FS::cust_bill->owed_sql;
5101 my $unapp_refund_sql = FS::cust_refund->unapplied_sql;
5102 #my $unapp_credit_sql = FS::cust_credit->unapplied_sql;
5103 my $unapp_credit_sql = FS::cust_credit->credited_sql;
5104 my $unapp_pay_sql = FS::cust_pay->unapplied_sql;
5107 COALESCE( ( SELECT SUM($owed_sql) FROM cust_bill
5108 WHERE cust_bill.custnum = cust_main.custnum
5109 AND cust_bill._date <= $time )
5112 + COALESCE( ( SELECT SUM($unapp_refund_sql) FROM cust_refund
5113 WHERE cust_refund.custnum = cust_main.custnum )
5116 - COALESCE( ( SELECT SUM($unapp_credit_sql) FROM cust_credit
5117 WHERE cust_credit.custnum = cust_main.custnum )
5120 - COALESCE( ( SELECT SUM($unapp_pay_sql) FROM cust_pay
5121 WHERE cust_pay.custnum = cust_main.custnum )
5129 =item fuzzy_search FUZZY_HASHREF [ HASHREF, SELECT, EXTRA_SQL, CACHE_OBJ ]
5131 Performs a fuzzy (approximate) search and returns the matching FS::cust_main
5132 records. Currently, I<first>, I<last> and/or I<company> may be specified (the
5133 appropriate ship_ field is also searched).
5135 Additional options are the same as FS::Record::qsearch
5140 my( $self, $fuzzy, $hash, @opt) = @_;
5145 check_and_rebuild_fuzzyfiles();
5146 foreach my $field ( keys %$fuzzy ) {
5148 my $all = $self->all_X($field);
5149 next unless scalar(@$all);
5152 $match{$_}=1 foreach ( amatch( $fuzzy->{$field}, ['i'], @$all ) );
5155 foreach ( keys %match ) {
5156 push @fcust, qsearch('cust_main', { %$hash, $field=>$_}, @opt);
5157 push @fcust, qsearch('cust_main', { %$hash, "ship_$field"=>$_}, @opt);
5160 push @cust_main, grep { ! $fsaw{$_->custnum}++ } @fcust;
5163 # we want the components of $fuzzy ANDed, not ORed, but still don't want dupes
5165 @cust_main = grep { ++$saw{$_->custnum} == scalar(keys %$fuzzy) } @cust_main;
5173 Returns a masked version of the named field
5178 my ($self,$field) = @_;
5182 'x'x(length($self->getfield($field))-4).
5183 substr($self->getfield($field), (length($self->getfield($field))-4));
5193 =item smart_search OPTION => VALUE ...
5195 Accepts the following options: I<search>, the string to search for. The string
5196 will be searched for as a customer number, phone number, name or company name,
5197 as an exact, or, in some cases, a substring or fuzzy match (see the source code
5198 for the exact heuristics used); I<no_fuzzy_on_exact>, causes smart_search to
5199 skip fuzzy matching when an exact match is found.
5201 Any additional options are treated as an additional qualifier on the search
5204 Returns a (possibly empty) array of FS::cust_main objects.
5211 #here is the agent virtualization
5212 my $agentnums_sql = $FS::CurrentUser::CurrentUser->agentnums_sql;
5216 my $skip_fuzzy = delete $options{'no_fuzzy_on_exact'};
5217 my $search = delete $options{'search'};
5218 ( my $alphanum_search = $search ) =~ s/\W//g;
5220 if ( $alphanum_search =~ /^1?(\d{3})(\d{3})(\d{4})(\d*)$/ ) { #phone# search
5222 #false laziness w/Record::ut_phone
5223 my $phonen = "$1-$2-$3";
5224 $phonen .= " x$4" if $4;
5226 push @cust_main, qsearch( {
5227 'table' => 'cust_main',
5228 'hashref' => { %options },
5229 'extra_sql' => ( scalar(keys %options) ? ' AND ' : ' WHERE ' ).
5231 join(' OR ', map "$_ = '$phonen'",
5232 qw( daytime night fax
5233 ship_daytime ship_night ship_fax )
5236 " AND $agentnums_sql", #agent virtualization
5239 unless ( @cust_main || $phonen =~ /x\d+$/ ) { #no exact match
5240 #try looking for matches with extensions unless one was specified
5242 push @cust_main, qsearch( {
5243 'table' => 'cust_main',
5244 'hashref' => { %options },
5245 'extra_sql' => ( scalar(keys %options) ? ' AND ' : ' WHERE ' ).
5247 join(' OR ', map "$_ LIKE '$phonen\%'",
5249 ship_daytime ship_night )
5252 " AND $agentnums_sql", #agent virtualization
5257 } elsif ( $search =~ /^\s*(\d+)\s*$/ ) { # customer # search
5259 push @cust_main, qsearch( {
5260 'table' => 'cust_main',
5261 'hashref' => { 'custnum' => $1, %options },
5262 'extra_sql' => " AND $agentnums_sql", #agent virtualization
5265 } elsif ( $search =~ /^\s*(\S.*\S)\s+\((.+), ([^,]+)\)\s*$/ ) {
5267 my($company, $last, $first) = ( $1, $2, $3 );
5269 # "Company (Last, First)"
5270 #this is probably something a browser remembered,
5271 #so just do an exact search
5273 foreach my $prefix ( '', 'ship_' ) {
5274 push @cust_main, qsearch( {
5275 'table' => 'cust_main',
5276 'hashref' => { $prefix.'first' => $first,
5277 $prefix.'last' => $last,
5278 $prefix.'company' => $company,
5281 'extra_sql' => " AND $agentnums_sql",
5285 } elsif ( $search =~ /^\s*(\S.*\S)\s*$/ ) { # value search
5286 # try (ship_){last,company}
5290 # # remove "(Last, First)" in "Company (Last, First)", otherwise the
5291 # # full strings the browser remembers won't work
5292 # $value =~ s/\([\w \,\.\-\']*\)$//; #false laziness w/Record::ut_name
5294 use Lingua::EN::NameParse;
5295 my $NameParse = new Lingua::EN::NameParse(
5297 allow_reversed => 1,
5300 my($last, $first) = ( '', '' );
5301 #maybe disable this too and just rely on NameParse?
5302 if ( $value =~ /^(.+),\s*([^,]+)$/ ) { # Last, First
5304 ($last, $first) = ( $1, $2 );
5306 #} elsif ( $value =~ /^(.+)\s+(.+)$/ ) {
5307 } elsif ( ! $NameParse->parse($value) ) {
5309 my %name = $NameParse->components;
5310 $first = $name{'given_name_1'};
5311 $last = $name{'surname_1'};
5315 if ( $first && $last ) {
5317 my($q_last, $q_first) = ( dbh->quote($last), dbh->quote($first) );
5320 my $sql = scalar(keys %options) ? ' AND ' : ' WHERE ';
5322 ( ( LOWER(last) = $q_last AND LOWER(first) = $q_first )
5323 OR ( LOWER(ship_last) = $q_last AND LOWER(ship_first) = $q_first )
5326 push @cust_main, qsearch( {
5327 'table' => 'cust_main',
5328 'hashref' => \%options,
5329 'extra_sql' => "$sql AND $agentnums_sql", #agent virtualization
5332 # or it just be something that was typed in... (try that in a sec)
5336 my $q_value = dbh->quote($value);
5339 my $sql = scalar(keys %options) ? ' AND ' : ' WHERE ';
5340 $sql .= " ( LOWER(last) = $q_value
5341 OR LOWER(company) = $q_value
5342 OR LOWER(ship_last) = $q_value
5343 OR LOWER(ship_company) = $q_value
5346 push @cust_main, qsearch( {
5347 'table' => 'cust_main',
5348 'hashref' => \%options,
5349 'extra_sql' => "$sql AND $agentnums_sql", #agent virtualization
5352 #no exact match, trying substring/fuzzy
5353 #always do substring & fuzzy (unless they're explicity config'ed off)
5354 #getting complaints searches are not returning enough
5355 unless ( @cust_main && $skip_fuzzy || $conf->exists('disable-fuzzy') ) {
5357 #still some false laziness w/ search/cust_main.cgi
5362 { 'company' => { op=>'ILIKE', value=>"%$value%" }, },
5363 { 'ship_company' => { op=>'ILIKE', value=>"%$value%" }, },
5366 if ( $first && $last ) {
5369 { 'first' => { op=>'ILIKE', value=>"%$first%" },
5370 'last' => { op=>'ILIKE', value=>"%$last%" },
5372 { 'ship_first' => { op=>'ILIKE', value=>"%$first%" },
5373 'ship_last' => { op=>'ILIKE', value=>"%$last%" },
5380 { 'last' => { op=>'ILIKE', value=>"%$value%" }, },
5381 { 'ship_last' => { op=>'ILIKE', value=>"%$value%" }, },
5385 foreach my $hashref ( @hashrefs ) {
5387 push @cust_main, qsearch( {
5388 'table' => 'cust_main',
5389 'hashref' => { %$hashref,
5392 'extra_sql' => " AND $agentnums_sql", #agent virtualizaiton
5401 " AND $agentnums_sql", #extra_sql #agent virtualization
5404 if ( $first && $last ) {
5405 push @cust_main, FS::cust_main->fuzzy_search(
5406 { 'last' => $last, #fuzzy hashref
5407 'first' => $first }, #
5411 foreach my $field ( 'last', 'company' ) {
5413 FS::cust_main->fuzzy_search( { $field => $value }, @fuzopts );
5418 #eliminate duplicates
5420 @cust_main = grep { !$saw{$_->custnum}++ } @cust_main;
5428 =item check_and_rebuild_fuzzyfiles
5432 use vars qw(@fuzzyfields);
5433 @fuzzyfields = ( 'last', 'first', 'company' );
5435 sub check_and_rebuild_fuzzyfiles {
5436 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
5437 rebuild_fuzzyfiles() if grep { ! -e "$dir/cust_main.$_" } @fuzzyfields
5440 =item rebuild_fuzzyfiles
5444 sub rebuild_fuzzyfiles {
5446 use Fcntl qw(:flock);
5448 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
5449 mkdir $dir, 0700 unless -d $dir;
5451 foreach my $fuzzy ( @fuzzyfields ) {
5453 open(LOCK,">>$dir/cust_main.$fuzzy")
5454 or die "can't open $dir/cust_main.$fuzzy: $!";
5456 or die "can't lock $dir/cust_main.$fuzzy: $!";
5458 open (CACHE,">$dir/cust_main.$fuzzy.tmp")
5459 or die "can't open $dir/cust_main.$fuzzy.tmp: $!";
5461 foreach my $field ( $fuzzy, "ship_$fuzzy" ) {
5462 my $sth = dbh->prepare("SELECT $field FROM cust_main".
5463 " WHERE $field != '' AND $field IS NOT NULL");
5464 $sth->execute or die $sth->errstr;
5466 while ( my $row = $sth->fetchrow_arrayref ) {
5467 print CACHE $row->[0]. "\n";
5472 close CACHE or die "can't close $dir/cust_main.$fuzzy.tmp: $!";
5474 rename "$dir/cust_main.$fuzzy.tmp", "$dir/cust_main.$fuzzy";
5485 my( $self, $field ) = @_;
5486 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
5487 open(CACHE,"<$dir/cust_main.$field")
5488 or die "can't open $dir/cust_main.$field: $!";
5489 my @array = map { chomp; $_; } <CACHE>;
5494 =item append_fuzzyfiles LASTNAME COMPANY
5498 sub append_fuzzyfiles {
5499 #my( $first, $last, $company ) = @_;
5501 &check_and_rebuild_fuzzyfiles;
5503 use Fcntl qw(:flock);
5505 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
5507 foreach my $field (qw( first last company )) {
5512 open(CACHE,">>$dir/cust_main.$field")
5513 or die "can't open $dir/cust_main.$field: $!";
5514 flock(CACHE,LOCK_EX)
5515 or die "can't lock $dir/cust_main.$field: $!";
5517 print CACHE "$value\n";
5519 flock(CACHE,LOCK_UN)
5520 or die "can't unlock $dir/cust_main.$field: $!";
5535 #warn join('-',keys %$param);
5536 my $fh = $param->{filehandle};
5537 my $agentnum = $param->{agentnum};
5539 my $refnum = $param->{refnum};
5540 my $pkgpart = $param->{pkgpart};
5542 #my @fields = @{$param->{fields}};
5543 my $format = $param->{'format'};
5546 if ( $format eq 'simple' ) {
5547 @fields = qw( cust_pkg.setup dayphone first last
5548 address1 address2 city state zip comments );
5550 } elsif ( $format eq 'extended' ) {
5551 @fields = qw( agent_custid refnum
5552 last first address1 address2 city state zip country
5554 ship_last ship_first ship_address1 ship_address2
5555 ship_city ship_state ship_zip ship_country
5556 payinfo paycvv paydate
5559 svc_acct.username svc_acct._password
5563 die "unknown format $format";
5566 eval "use Text::CSV_XS;";
5569 my $csv = new Text::CSV_XS;
5576 local $SIG{HUP} = 'IGNORE';
5577 local $SIG{INT} = 'IGNORE';
5578 local $SIG{QUIT} = 'IGNORE';
5579 local $SIG{TERM} = 'IGNORE';
5580 local $SIG{TSTP} = 'IGNORE';
5581 local $SIG{PIPE} = 'IGNORE';
5583 my $oldAutoCommit = $FS::UID::AutoCommit;
5584 local $FS::UID::AutoCommit = 0;
5587 #while ( $columns = $csv->getline($fh) ) {
5589 while ( defined($line=<$fh>) ) {
5591 $csv->parse($line) or do {
5592 $dbh->rollback if $oldAutoCommit;
5593 return "can't parse: ". $csv->error_input();
5596 my @columns = $csv->fields();
5597 #warn join('-',@columns);
5600 agentnum => $agentnum,
5602 country => $conf->config('countrydefault') || 'US',
5603 payby => $payby, #default
5604 paydate => '12/2037', #default
5606 my $billtime = time;
5607 my %cust_pkg = ( pkgpart => $pkgpart );
5609 foreach my $field ( @fields ) {
5611 if ( $field =~ /^cust_pkg\.(pkgpart|setup|bill|susp|adjourn|expire|cancel)$/ ) {
5613 #$cust_pkg{$1} = str2time( shift @$columns );
5614 if ( $1 eq 'pkgpart' ) {
5615 $cust_pkg{$1} = shift @columns;
5616 } elsif ( $1 eq 'setup' ) {
5617 $billtime = str2time(shift @columns);
5619 $cust_pkg{$1} = str2time( shift @columns );
5622 } elsif ( $field =~ /^svc_acct\.(username|_password)$/ ) {
5624 $svc_acct{$1} = shift @columns;
5628 #refnum interception
5629 if ( $field eq 'refnum' && $columns[0] !~ /^\s*(\d+)\s*$/ ) {
5631 my $referral = $columns[0];
5632 my %hash = ( 'referral' => $referral,
5633 'agentnum' => $agentnum,
5637 my $part_referral = qsearchs('part_referral', \%hash )
5638 || new FS::part_referral \%hash;
5640 unless ( $part_referral->refnum ) {
5641 my $error = $part_referral->insert;
5643 $dbh->rollback if $oldAutoCommit;
5644 return "can't auto-insert advertising source: $referral: $error";
5648 $columns[0] = $part_referral->refnum;
5651 #$cust_main{$field} = shift @$columns;
5652 $cust_main{$field} = shift @columns;
5656 $cust_main{'payby'} = 'CARD' if length($cust_main{'payinfo'});
5658 my $invoicing_list = $cust_main{'invoicing_list'}
5659 ? [ delete $cust_main{'invoicing_list'} ]
5662 my $cust_main = new FS::cust_main ( \%cust_main );
5665 tie my %hash, 'Tie::RefHash'; #this part is important
5667 if ( $cust_pkg{'pkgpart'} ) {
5668 my $cust_pkg = new FS::cust_pkg ( \%cust_pkg );
5671 if ( $svc_acct{'username'} ) {
5672 my $part_pkg = $cust_pkg->part_pkg;
5673 unless ( $part_pkg ) {
5674 $dbh->rollback if $oldAutoCommit;
5675 return "unknown pkgpart: ". $cust_pkg{'pkgpart'};
5677 $svc_acct{svcpart} = $part_pkg->svcpart( 'svc_acct' );
5678 push @svc_acct, new FS::svc_acct ( \%svc_acct )
5681 $hash{$cust_pkg} = \@svc_acct;
5684 my $error = $cust_main->insert( \%hash, $invoicing_list );
5687 $dbh->rollback if $oldAutoCommit;
5688 return "can't insert customer for $line: $error";
5691 if ( $format eq 'simple' ) {
5693 #false laziness w/bill.cgi
5694 $error = $cust_main->bill( 'time' => $billtime );
5696 $dbh->rollback if $oldAutoCommit;
5697 return "can't bill customer for $line: $error";
5700 $error = $cust_main->apply_payments_and_credits;
5702 $dbh->rollback if $oldAutoCommit;
5703 return "can't bill customer for $line: $error";
5706 $error = $cust_main->collect();
5708 $dbh->rollback if $oldAutoCommit;
5709 return "can't collect customer for $line: $error";
5717 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
5719 return "Empty file!" unless $imported;
5731 #warn join('-',keys %$param);
5732 my $fh = $param->{filehandle};
5733 my @fields = @{$param->{fields}};
5735 eval "use Text::CSV_XS;";
5738 my $csv = new Text::CSV_XS;
5745 local $SIG{HUP} = 'IGNORE';
5746 local $SIG{INT} = 'IGNORE';
5747 local $SIG{QUIT} = 'IGNORE';
5748 local $SIG{TERM} = 'IGNORE';
5749 local $SIG{TSTP} = 'IGNORE';
5750 local $SIG{PIPE} = 'IGNORE';
5752 my $oldAutoCommit = $FS::UID::AutoCommit;
5753 local $FS::UID::AutoCommit = 0;
5756 #while ( $columns = $csv->getline($fh) ) {
5758 while ( defined($line=<$fh>) ) {
5760 $csv->parse($line) or do {
5761 $dbh->rollback if $oldAutoCommit;
5762 return "can't parse: ". $csv->error_input();
5765 my @columns = $csv->fields();
5766 #warn join('-',@columns);
5769 foreach my $field ( @fields ) {
5770 $row{$field} = shift @columns;
5773 my $cust_main = qsearchs('cust_main', { 'custnum' => $row{'custnum'} } );
5774 unless ( $cust_main ) {
5775 $dbh->rollback if $oldAutoCommit;
5776 return "unknown custnum $row{'custnum'}";
5779 if ( $row{'amount'} > 0 ) {
5780 my $error = $cust_main->charge($row{'amount'}, $row{'pkg'});
5782 $dbh->rollback if $oldAutoCommit;
5786 } elsif ( $row{'amount'} < 0 ) {
5787 my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ),
5790 $dbh->rollback if $oldAutoCommit;
5800 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
5802 return "Empty file!" unless $imported;
5808 =item notify CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
5810 Sends a templated email notification to the customer (see L<Text::Template>).
5812 OPTIONS is a hash and may include
5814 I<from> - the email sender (default is invoice_from)
5816 I<to> - comma-separated scalar or arrayref of recipients
5817 (default is invoicing_list)
5819 I<subject> - The subject line of the sent email notification
5820 (default is "Notice from company_name")
5822 I<extra_fields> - a hashref of name/value pairs which will be substituted
5825 The following variables are vavailable in the template.
5827 I<$first> - the customer first name
5828 I<$last> - the customer last name
5829 I<$company> - the customer company
5830 I<$payby> - a description of the method of payment for the customer
5831 # would be nice to use FS::payby::shortname
5832 I<$payinfo> - the account information used to collect for this customer
5833 I<$expdate> - the expiration of the customer payment in seconds from epoch
5838 my ($customer, $template, %options) = @_;
5840 return unless $conf->exists($template);
5842 my $from = $conf->config('invoice_from') if $conf->exists('invoice_from');
5843 $from = $options{from} if exists($options{from});
5845 my $to = join(',', $customer->invoicing_list_emailonly);
5846 $to = $options{to} if exists($options{to});
5848 my $subject = "Notice from " . $conf->config('company_name')
5849 if $conf->exists('company_name');
5850 $subject = $options{subject} if exists($options{subject});
5852 my $notify_template = new Text::Template (TYPE => 'ARRAY',
5853 SOURCE => [ map "$_\n",
5854 $conf->config($template)]
5856 or die "can't create new Text::Template object: Text::Template::ERROR";
5857 $notify_template->compile()
5858 or die "can't compile template: Text::Template::ERROR";
5860 $FS::notify_template::_template::company_name = $conf->config('company_name');
5861 $FS::notify_template::_template::company_address =
5862 join("\n", $conf->config('company_address') ). "\n";
5864 my $paydate = $customer->paydate;
5865 $FS::notify_template::_template::first = $customer->first;
5866 $FS::notify_template::_template::last = $customer->last;
5867 $FS::notify_template::_template::company = $customer->company;
5868 $FS::notify_template::_template::payinfo = $customer->mask_payinfo;
5869 my $payby = $customer->payby;
5870 my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
5871 my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
5873 #credit cards expire at the end of the month/year of their exp date
5874 if ($payby eq 'CARD' || $payby eq 'DCRD') {
5875 $FS::notify_template::_template::payby = 'credit card';
5876 ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
5877 $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
5879 }elsif ($payby eq 'COMP') {
5880 $FS::notify_template::_template::payby = 'complimentary account';
5882 $FS::notify_template::_template::payby = 'current method';
5884 $FS::notify_template::_template::expdate = $expire_time;
5886 for (keys %{$options{extra_fields}}){
5888 ${"FS::notify_template::_template::$_"} = $options{extra_fields}->{$_};
5891 send_email(from => $from,
5893 subject => $subject,
5894 body => $notify_template->fill_in( PACKAGE =>
5895 'FS::notify_template::_template' ),
5900 =item generate_letter CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
5902 Generates a templated notification to the customer (see L<Text::Template>).
5904 OPTIONS is a hash and may include
5906 I<extra_fields> - a hashref of name/value pairs which will be substituted
5907 into the template. These values may override values mentioned below
5908 and those from the customer record.
5910 The following variables are available in the template instead of or in addition
5911 to the fields of the customer record.
5913 I<$payby> - a description of the method of payment for the customer
5914 # would be nice to use FS::payby::shortname
5915 I<$payinfo> - the masked account information used to collect for this customer
5916 I<$expdate> - the expiration of the customer payment method in seconds from epoch
5917 I<$returnaddress> - the return address defaults to invoice_latexreturnaddress or company_address
5921 sub generate_letter {
5922 my ($self, $template, %options) = @_;
5924 return unless $conf->exists($template);
5926 my $letter_template = new Text::Template
5928 SOURCE => [ map "$_\n", $conf->config($template)],
5929 DELIMITERS => [ '[@--', '--@]' ],
5931 or die "can't create new Text::Template object: Text::Template::ERROR";
5933 $letter_template->compile()
5934 or die "can't compile template: Text::Template::ERROR";
5936 my %letter_data = map { $_ => $self->$_ } $self->fields;
5937 $letter_data{payinfo} = $self->mask_payinfo;
5939 #my $paydate = $self->paydate || '2037-12';
5940 my $paydate = $self->paydate =~ /^\S+$/ ? $self->paydate : '2037-12';
5942 my $payby = $self->payby;
5943 my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
5944 my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
5946 #credit cards expire at the end of the month/year of their exp date
5947 if ($payby eq 'CARD' || $payby eq 'DCRD') {
5948 $letter_data{payby} = 'credit card';
5949 ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
5950 $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
5952 }elsif ($payby eq 'COMP') {
5953 $letter_data{payby} = 'complimentary account';
5955 $letter_data{payby} = 'current method';
5957 $letter_data{expdate} = $expire_time;
5959 for (keys %{$options{extra_fields}}){
5960 $letter_data{$_} = $options{extra_fields}->{$_};
5963 unless(exists($letter_data{returnaddress})){
5964 my $retadd = join("\n", $conf->config_orbase( 'invoice_latexreturnaddress',
5965 $self->agent_template)
5967 if ( length($retadd) ) {
5968 $letter_data{returnaddress} = $retadd;
5969 } elsif ( grep /\S/, $conf->config('company_address') ) {
5970 $letter_data{returnaddress} =
5971 join( '\\*'."\n", map s/( {2,})/'~' x length($1)/eg,
5972 $conf->config('company_address')
5975 $letter_data{returnaddress} = '~';
5979 $letter_data{conf_dir} = "$FS::UID::conf_dir/conf.$FS::UID::datasrc";
5981 $letter_data{company_name} = $conf->config('company_name');
5983 my $dir = $FS::UID::conf_dir."cache.". $FS::UID::datasrc;
5984 my $fh = new File::Temp( TEMPLATE => 'letter.'. $self->custnum. '.XXXXXXXX',
5988 ) or die "can't open temp file: $!\n";
5990 $letter_template->fill_in( OUTPUT => $fh, HASH => \%letter_data );
5992 $fh->filename =~ /^(.*).tex$/ or die "unparsable filename: ". $fh->filename;
5996 =item print_ps TEMPLATE
5998 Returns an postscript letter filled in from TEMPLATE, as a scalar.
6004 my $file = $self->generate_letter(@_);
6005 FS::Misc::generate_ps($file);
6008 =item print TEMPLATE
6010 Prints the filled in template.
6012 TEMPLATE is the name of a L<Text::Template> to fill in and print.
6016 sub queueable_print {
6019 my $self = qsearchs('cust_main', { 'custnum' => $opt{custnum} } )
6020 or die "invalid customer number: " . $opt{custvnum};
6022 my $error = $self->print( $opt{template} );
6023 die $error if $error;
6027 my ($self, $template) = (shift, shift);
6028 do_print [ $self->print_ps($template) ];
6031 sub agent_template {
6033 $self->_agent_plandata('agent_templatename');
6036 sub agent_invoice_from {
6038 $self->_agent_plandata('agent_invoice_from');
6041 sub _agent_plandata {
6042 my( $self, $option ) = @_;
6044 #yuck. this whole thing needs to be reconciled better with 1.9's idea of
6045 #agent-specific Conf
6047 use FS::part_event::Condition;
6049 my $agentnum = $self->agentnum;
6052 if ( driver_name =~ /^Pg/i ) {
6054 } elsif ( driver_name =~ /^mysql/i ) {
6057 die "don't know how to use regular expressions in ". driver_name. " databases";
6060 my $part_event_option =
6062 'select' => 'part_event_option.*',
6063 'table' => 'part_event_option',
6065 LEFT JOIN part_event USING ( eventpart )
6066 LEFT JOIN part_event_option AS peo_agentnum
6067 ON ( part_event.eventpart = peo_agentnum.eventpart
6068 AND peo_agentnum.optionname = 'agentnum'
6069 AND peo_agentnum.optionvalue }. $regexp. q{ '(^|,)}. $agentnum. q{(,|$)'
6071 LEFT JOIN part_event_option AS peo_cust_bill_age
6072 ON ( part_event.eventpart = peo_cust_bill_age.eventpart
6073 AND peo_cust_bill_age.optionname = 'cust_bill_age'
6076 #'hashref' => { 'optionname' => $option },
6077 #'hashref' => { 'part_event_option.optionname' => $option },
6079 " WHERE part_event_option.optionname = ". dbh->quote($option).
6080 " AND action = 'cust_bill_send_agent' ".
6081 " AND ( disabled IS NULL OR disabled != 'Y' ) ".
6082 " AND peo_agentnum.optionname = 'agentnum' ".
6083 " AND agentnum IS NULL OR agentnum = $agentnum ".
6085 CASE WHEN peo_cust_bill_age.optionname != 'cust_bill_age'
6087 ELSE ". FS::part_event::Condition->age2seconds_sql('peo_cust_bill_age.optionvalue').
6089 , part_event.weight".
6093 unless ( $part_event_option ) {
6094 return $self->agent->invoice_template || ''
6095 if $option eq 'agent_templatename';
6099 $part_event_option->optionvalue;
6104 ## actual sub, not a method, designed to be called from the queue.
6105 ## sets up the customer, and calls the bill_and_collect
6106 my (%args) = @_; #, ($time, $invoice_time, $check_freq, $resetup) = @_;
6107 my $cust_main = qsearchs( 'cust_main', { custnum => $args{'custnum'} } );
6108 $cust_main->bill_and_collect(
6119 The delete method should possibly take an FS::cust_main object reference
6120 instead of a scalar customer number.
6122 Bill and collect options should probably be passed as references instead of a
6125 There should probably be a configuration file with a list of allowed credit
6128 No multiple currency support (probably a larger project than just this module).
6130 payinfo_masked false laziness with cust_pay.pm and cust_refund.pm
6132 Birthdates rely on negative epoch values.
6134 The payby for card/check batches is broken. With mixed batching, bad
6137 B<collect> I<invoice_time> should be renamed I<time>, like B<bill>.
6141 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
6142 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
6143 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.