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 Scalar::Util qw( blessed );
12 use Time::Local qw(timelocal_nocheck);
15 use Digest::MD5 qw(md5_base64);
19 use File::Slurp qw( slurp );
20 use File::Temp qw( tempfile );
21 use String::Approx qw(amatch);
22 use Business::CreditCard 0.28;
24 use FS::UID qw( getotaker dbh driver_name );
25 use FS::Record qw( qsearchs qsearch dbdef );
26 use FS::Misc qw( generate_email send_email generate_ps do_print );
27 use FS::Msgcat qw(gettext);
31 use FS::cust_bill_pkg;
32 use FS::cust_bill_pkg_display;
34 use FS::cust_pay_pending;
35 use FS::cust_pay_void;
36 use FS::cust_pay_batch;
39 use FS::part_referral;
40 use FS::cust_main_county;
41 use FS::cust_tax_location;
43 use FS::cust_main_invoice;
44 use FS::cust_credit_bill;
45 use FS::cust_bill_pay;
46 use FS::prepay_credit;
50 use FS::part_event_condition;
53 use FS::payment_gateway;
54 use FS::agent_payment_gateway;
56 use FS::payinfo_Mixin;
59 @ISA = qw( FS::payinfo_Mixin FS::Record );
61 @EXPORT_OK = qw( smart_search );
63 $realtime_bop_decline_quiet = 0;
65 # 1 is mostly method/subroutine entry and options
66 # 2 traces progress of some operations
67 # 3 is even more information including possibly sensitive data
69 $me = '[FS::cust_main]';
73 $ignore_expired_card = 0;
75 @encrypted_fields = ('payinfo', 'paycvv');
76 @paytypes = ('', 'Personal checking', 'Personal savings', 'Business checking', 'Business savings');
78 #ask FS::UID to run this stuff for us later
79 #$FS::UID::callback{'FS::cust_main'} = sub {
80 install_callback FS::UID sub {
82 #yes, need it for stuff below (prolly should be cached)
87 my ( $hashref, $cache ) = @_;
88 if ( exists $hashref->{'pkgnum'} ) {
89 #@{ $self->{'_pkgnum'} } = ();
90 my $subcache = $cache->subcache( 'pkgnum', 'cust_pkg', $hashref->{custnum});
91 $self->{'_pkgnum'} = $subcache;
92 #push @{ $self->{'_pkgnum'} },
93 FS::cust_pkg->new_or_cached($hashref, $subcache) if $hashref->{pkgnum};
99 FS::cust_main - Object methods for cust_main records
105 $record = new FS::cust_main \%hash;
106 $record = new FS::cust_main { 'column' => 'value' };
108 $error = $record->insert;
110 $error = $new_record->replace($old_record);
112 $error = $record->delete;
114 $error = $record->check;
116 @cust_pkg = $record->all_pkgs;
118 @cust_pkg = $record->ncancelled_pkgs;
120 @cust_pkg = $record->suspended_pkgs;
122 $error = $record->bill;
123 $error = $record->bill %options;
124 $error = $record->bill 'time' => $time;
126 $error = $record->collect;
127 $error = $record->collect %options;
128 $error = $record->collect 'invoice_time' => $time,
133 An FS::cust_main object represents a customer. FS::cust_main inherits from
134 FS::Record. The following fields are currently supported:
138 =item custnum - primary key (assigned automatically for new customers)
140 =item agentnum - agent (see L<FS::agent>)
142 =item refnum - Advertising source (see L<FS::part_referral>)
148 =item ss - social security number (optional)
150 =item company - (optional)
154 =item address2 - (optional)
158 =item county - (optional, see L<FS::cust_main_county>)
160 =item state - (see L<FS::cust_main_county>)
164 =item country - (see L<FS::cust_main_county>)
166 =item daytime - phone (optional)
168 =item night - phone (optional)
170 =item fax - phone (optional)
172 =item ship_first - name
174 =item ship_last - name
176 =item ship_company - (optional)
180 =item ship_address2 - (optional)
184 =item ship_county - (optional, see L<FS::cust_main_county>)
186 =item ship_state - (see L<FS::cust_main_county>)
190 =item ship_country - (see L<FS::cust_main_county>)
192 =item ship_daytime - phone (optional)
194 =item ship_night - phone (optional)
196 =item ship_fax - phone (optional)
198 =item payby - Payment Type (See L<FS::payinfo_Mixin> for valid payby values)
200 =item payinfo - Payment Information (See L<FS::payinfo_Mixin> for data format)
202 =item paymask - Masked payinfo (See L<FS::payinfo_Mixin> for how this works)
206 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
208 =item paydate - expiration date, mm/yyyy, m/yyyy, mm/yy or m/yy
210 =item paystart_month - start date month (maestro/solo cards only)
212 =item paystart_year - start date year (maestro/solo cards only)
214 =item payissue - issue number (maestro/solo cards only)
216 =item payname - name on card or billing name
218 =item payip - IP address from which payment information was received
220 =item tax - tax exempt, empty or `Y'
222 =item otaker - order taker (assigned automatically, see L<FS::UID>)
224 =item comments - comments (optional)
226 =item referral_custnum - referring customer number
228 =item spool_cdr - Enable individual CDR spooling, empty or `Y'
230 =item dundate - a suggestion to events (see L<FS::part_bill_event">) to delay until this unix timestamp
232 =item squelch_cdr - Discourage individual CDR printing, empty or `Y'
242 Creates a new customer. To add the customer to the database, see L<"insert">.
244 Note that this stores the hash reference, not a distinct copy of the hash it
245 points to. You can ask the object for a copy with the I<hash> method.
249 sub table { 'cust_main'; }
251 =item insert [ CUST_PKG_HASHREF [ , INVOICING_LIST_ARYREF ] [ , OPTION => VALUE ... ] ]
253 Adds this customer to the database. If there is an error, returns the error,
254 otherwise returns false.
256 CUST_PKG_HASHREF: If you pass a Tie::RefHash data structure to the insert
257 method containing FS::cust_pkg and FS::svc_I<tablename> objects, all records
258 are inserted atomicly, or the transaction is rolled back. Passing an empty
259 hash reference is equivalent to not supplying this parameter. There should be
260 a better explanation of this, but until then, here's an example:
263 tie %hash, 'Tie::RefHash'; #this part is important
265 $cust_pkg => [ $svc_acct ],
268 $cust_main->insert( \%hash );
270 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
271 be set as the invoicing list (see L<"invoicing_list">). Errors return as
272 expected and rollback the entire transaction; it is not necessary to call
273 check_invoicing_list first. The invoicing_list is set after the records in the
274 CUST_PKG_HASHREF above are inserted, so it is now possible to set an
275 invoicing_list destination to the newly-created svc_acct. Here's an example:
277 $cust_main->insert( {}, [ $email, 'POST' ] );
279 Currently available options are: I<depend_jobnum> and I<noexport>.
281 If I<depend_jobnum> is set, all provisioning jobs will have a dependancy
282 on the supplied jobnum (they will not run until the specific job completes).
283 This can be used to defer provisioning until some action completes (such
284 as running the customer's credit card successfully).
286 The I<noexport> option is deprecated. If I<noexport> is set true, no
287 provisioning jobs (exports) are scheduled. (You can schedule them later with
288 the B<reexport> method.)
294 my $cust_pkgs = @_ ? shift : {};
295 my $invoicing_list = @_ ? shift : '';
297 warn "$me insert called with options ".
298 join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
301 local $SIG{HUP} = 'IGNORE';
302 local $SIG{INT} = 'IGNORE';
303 local $SIG{QUIT} = 'IGNORE';
304 local $SIG{TERM} = 'IGNORE';
305 local $SIG{TSTP} = 'IGNORE';
306 local $SIG{PIPE} = 'IGNORE';
308 my $oldAutoCommit = $FS::UID::AutoCommit;
309 local $FS::UID::AutoCommit = 0;
312 my $prepay_identifier = '';
313 my( $amount, $seconds ) = ( 0, 0 );
315 if ( $self->payby eq 'PREPAY' ) {
317 $self->payby('BILL');
318 $prepay_identifier = $self->payinfo;
321 warn " looking up prepaid card $prepay_identifier\n"
324 my $error = $self->get_prepay($prepay_identifier, \$amount, \$seconds);
326 $dbh->rollback if $oldAutoCommit;
327 #return "error applying prepaid card (transaction rolled back): $error";
331 $payby = 'PREP' if $amount;
333 } elsif ( $self->payby =~ /^(CASH|WEST|MCRD)$/ ) {
336 $self->payby('BILL');
337 $amount = $self->paid;
341 warn " inserting $self\n"
344 $self->signupdate(time) unless $self->signupdate;
346 my $error = $self->SUPER::insert;
348 $dbh->rollback if $oldAutoCommit;
349 #return "inserting cust_main record (transaction rolled back): $error";
353 warn " setting invoicing list\n"
356 if ( $invoicing_list ) {
357 $error = $self->check_invoicing_list( $invoicing_list );
359 $dbh->rollback if $oldAutoCommit;
360 #return "checking invoicing_list (transaction rolled back): $error";
363 $self->invoicing_list( $invoicing_list );
366 if ( $conf->config('cust_main-skeleton_tables')
367 && $conf->config('cust_main-skeleton_custnum') ) {
369 warn " inserting skeleton records\n"
372 my $error = $self->start_copy_skel;
374 $dbh->rollback if $oldAutoCommit;
380 warn " ordering packages\n"
383 $error = $self->order_pkgs($cust_pkgs, \$seconds, %options);
385 $dbh->rollback if $oldAutoCommit;
390 $dbh->rollback if $oldAutoCommit;
391 return "No svc_acct record to apply pre-paid time";
395 warn " inserting initial $payby payment of $amount\n"
397 $error = $self->insert_cust_pay($payby, $amount, $prepay_identifier);
399 $dbh->rollback if $oldAutoCommit;
400 return "inserting payment (transaction rolled back): $error";
404 unless ( $import || $skip_fuzzyfiles ) {
405 warn " queueing fuzzyfiles update\n"
407 $error = $self->queue_fuzzyfiles_update;
409 $dbh->rollback if $oldAutoCommit;
410 return "updating fuzzy search cache: $error";
414 warn " insert complete; committing transaction\n"
417 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
422 sub start_copy_skel {
425 #'mg_user_preference' => {},
426 #'mg_user_indicator_profile.user_indicator_profile_id' => { 'mg_profile_indicator.profile_indicator_id' => { 'mg_profile_details.profile_detail_id' }, },
427 #'mg_watchlist_header.watchlist_header_id' => { 'mg_watchlist_details.watchlist_details_id' },
428 #'mg_user_grid_header.grid_header_id' => { 'mg_user_grid_details.user_grid_details_id' },
429 #'mg_portfolio_header.portfolio_header_id' => { 'mg_portfolio_trades.portfolio_trades_id' => { 'mg_portfolio_trades_positions.portfolio_trades_positions_id' } },
430 my @tables = eval(join('\n',$conf->config('cust_main-skeleton_tables')));
433 _copy_skel( 'cust_main', #tablename
434 $conf->config('cust_main-skeleton_custnum'), #sourceid
435 $self->custnum, #destid
436 @tables, #child tables
440 #recursive subroutine, not a method
442 my( $table, $sourceid, $destid, %child_tables ) = @_;
445 if ( $table =~ /^(\w+)\.(\w+)$/ ) {
446 ( $table, $primary_key ) = ( $1, $2 );
448 my $dbdef_table = dbdef->table($table);
449 $primary_key = $dbdef_table->primary_key
450 or return "$table has no primary key".
451 " (or do you need to run dbdef-create?)";
454 warn " _copy_skel: $table.$primary_key $sourceid to $destid for ".
455 join (', ', keys %child_tables). "\n"
458 foreach my $child_table_def ( keys %child_tables ) {
462 if ( $child_table_def =~ /^(\w+)\.(\w+)$/ ) {
463 ( $child_table, $child_pkey ) = ( $1, $2 );
465 $child_table = $child_table_def;
467 $child_pkey = dbdef->table($child_table)->primary_key;
468 # or return "$table has no primary key".
469 # " (or do you need to run dbdef-create?)\n";
473 if ( keys %{ $child_tables{$child_table_def} } ) {
475 return "$child_table has no primary key".
476 " (run dbdef-create or try specifying it?)\n"
479 #false laziness w/Record::insert and only works on Pg
480 #refactor the proper last-inserted-id stuff out of Record::insert if this
481 # ever gets use for anything besides a quick kludge for one customer
482 my $default = dbdef->table($child_table)->column($child_pkey)->default;
483 $default =~ /^nextval\(\(?'"?([\w\.]+)"?'/i
484 or return "can't parse $child_table.$child_pkey default value ".
485 " for sequence name: $default";
490 my @sel_columns = grep { $_ ne $primary_key }
491 dbdef->table($child_table)->columns;
492 my $sel_columns = join(', ', @sel_columns );
494 my @ins_columns = grep { $_ ne $child_pkey } @sel_columns;
495 my $ins_columns = ' ( '. join(', ', $primary_key, @ins_columns ). ' ) ';
496 my $placeholders = ' ( ?, '. join(', ', map '?', @ins_columns ). ' ) ';
498 my $sel_st = "SELECT $sel_columns FROM $child_table".
499 " WHERE $primary_key = $sourceid";
502 my $sel_sth = dbh->prepare( $sel_st )
503 or return dbh->errstr;
505 $sel_sth->execute or return $sel_sth->errstr;
507 while ( my $row = $sel_sth->fetchrow_hashref ) {
509 warn " selected row: ".
510 join(', ', map { "$_=".$row->{$_} } keys %$row ). "\n"
514 "INSERT INTO $child_table $ins_columns VALUES $placeholders";
515 my $ins_sth =dbh->prepare($statement)
516 or return dbh->errstr;
517 my @param = ( $destid, map $row->{$_}, @ins_columns );
518 warn " $statement: [ ". join(', ', @param). " ]\n"
520 $ins_sth->execute( @param )
521 or return $ins_sth->errstr;
523 #next unless keys %{ $child_tables{$child_table} };
524 next unless $sequence;
526 #another section of that laziness
527 my $seq_sql = "SELECT currval('$sequence')";
528 my $seq_sth = dbh->prepare($seq_sql) or return dbh->errstr;
529 $seq_sth->execute or return $seq_sth->errstr;
530 my $insertid = $seq_sth->fetchrow_arrayref->[0];
532 # don't drink soap! recurse! recurse! okay!
534 _copy_skel( $child_table_def,
535 $row->{$child_pkey}, #sourceid
537 %{ $child_tables{$child_table_def} },
539 return $error if $error;
549 =item order_pkgs HASHREF, [ SECONDSREF, [ , OPTION => VALUE ... ] ]
551 Like the insert method on an existing record, this method orders a package
552 and included services atomicaly. Pass a Tie::RefHash data structure to this
553 method containing FS::cust_pkg and FS::svc_I<tablename> objects. There should
554 be a better explanation of this, but until then, here's an example:
557 tie %hash, 'Tie::RefHash'; #this part is important
559 $cust_pkg => [ $svc_acct ],
562 $cust_main->order_pkgs( \%hash, \'0', 'noexport'=>1 );
564 Services can be new, in which case they are inserted, or existing unaudited
565 services, in which case they are linked to the newly-created package.
567 Currently available options are: I<depend_jobnum> and I<noexport>.
569 If I<depend_jobnum> is set, all provisioning jobs will have a dependancy
570 on the supplied jobnum (they will not run until the specific job completes).
571 This can be used to defer provisioning until some action completes (such
572 as running the customer's credit card successfully).
574 The I<noexport> option is deprecated. If I<noexport> is set true, no
575 provisioning jobs (exports) are scheduled. (You can schedule them later with
576 the B<reexport> method for each cust_pkg object. Using the B<reexport> method
577 on the cust_main object is not recommended, as existing services will also be
584 my $cust_pkgs = shift;
587 my %svc_options = ();
588 $svc_options{'depend_jobnum'} = $options{'depend_jobnum'}
589 if exists $options{'depend_jobnum'};
590 warn "$me order_pkgs called with options ".
591 join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
594 local $SIG{HUP} = 'IGNORE';
595 local $SIG{INT} = 'IGNORE';
596 local $SIG{QUIT} = 'IGNORE';
597 local $SIG{TERM} = 'IGNORE';
598 local $SIG{TSTP} = 'IGNORE';
599 local $SIG{PIPE} = 'IGNORE';
601 my $oldAutoCommit = $FS::UID::AutoCommit;
602 local $FS::UID::AutoCommit = 0;
605 local $FS::svc_Common::noexport_hack = 1 if $options{'noexport'};
607 foreach my $cust_pkg ( keys %$cust_pkgs ) {
608 $cust_pkg->custnum( $self->custnum );
609 my $error = $cust_pkg->insert;
611 $dbh->rollback if $oldAutoCommit;
612 return "inserting cust_pkg (transaction rolled back): $error";
614 foreach my $svc_something ( @{$cust_pkgs->{$cust_pkg}} ) {
615 if ( $svc_something->svcnum ) {
616 my $old_cust_svc = $svc_something->cust_svc;
617 my $new_cust_svc = new FS::cust_svc { $old_cust_svc->hash };
618 $new_cust_svc->pkgnum( $cust_pkg->pkgnum);
619 $error = $new_cust_svc->replace($old_cust_svc);
621 $svc_something->pkgnum( $cust_pkg->pkgnum );
622 if ( $seconds && $$seconds && $svc_something->isa('FS::svc_acct') ) {
623 $svc_something->seconds( $svc_something->seconds + $$seconds );
626 $error = $svc_something->insert(%svc_options);
629 $dbh->rollback if $oldAutoCommit;
630 #return "inserting svc_ (transaction rolled back): $error";
636 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
640 =item recharge_prepay IDENTIFIER | PREPAY_CREDIT_OBJ [ , AMOUNTREF, SECONDSREF, UPBYTEREF, DOWNBYTEREF ]
642 Recharges this (existing) customer with the specified prepaid card (see
643 L<FS::prepay_credit>), specified either by I<identifier> or as an
644 FS::prepay_credit object. If there is an error, returns the error, otherwise
647 Optionally, four scalar references can be passed as well. They will have their
648 values filled in with the amount, number of seconds, and number of upload and
649 download bytes applied by this prepaid
654 sub recharge_prepay {
655 my( $self, $prepay_credit, $amountref, $secondsref,
656 $upbytesref, $downbytesref, $totalbytesref ) = @_;
658 local $SIG{HUP} = 'IGNORE';
659 local $SIG{INT} = 'IGNORE';
660 local $SIG{QUIT} = 'IGNORE';
661 local $SIG{TERM} = 'IGNORE';
662 local $SIG{TSTP} = 'IGNORE';
663 local $SIG{PIPE} = 'IGNORE';
665 my $oldAutoCommit = $FS::UID::AutoCommit;
666 local $FS::UID::AutoCommit = 0;
669 my( $amount, $seconds, $upbytes, $downbytes, $totalbytes) = ( 0, 0, 0, 0, 0 );
671 my $error = $self->get_prepay($prepay_credit, \$amount,
672 \$seconds, \$upbytes, \$downbytes, \$totalbytes)
673 || $self->increment_seconds($seconds)
674 || $self->increment_upbytes($upbytes)
675 || $self->increment_downbytes($downbytes)
676 || $self->increment_totalbytes($totalbytes)
677 || $self->insert_cust_pay_prepay( $amount,
679 ? $prepay_credit->identifier
684 $dbh->rollback if $oldAutoCommit;
688 if ( defined($amountref) ) { $$amountref = $amount; }
689 if ( defined($secondsref) ) { $$secondsref = $seconds; }
690 if ( defined($upbytesref) ) { $$upbytesref = $upbytes; }
691 if ( defined($downbytesref) ) { $$downbytesref = $downbytes; }
692 if ( defined($totalbytesref) ) { $$totalbytesref = $totalbytes; }
694 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
699 =item get_prepay IDENTIFIER | PREPAY_CREDIT_OBJ , AMOUNTREF, SECONDSREF
701 Looks up and deletes a prepaid card (see L<FS::prepay_credit>),
702 specified either by I<identifier> or as an FS::prepay_credit object.
704 References to I<amount> and I<seconds> scalars should be passed as arguments
705 and will be incremented by the values of the prepaid card.
707 If the prepaid card specifies an I<agentnum> (see L<FS::agent>), it is used to
708 check or set this customer's I<agentnum>.
710 If there is an error, returns the error, otherwise returns false.
716 my( $self, $prepay_credit, $amountref, $secondsref,
717 $upref, $downref, $totalref) = @_;
719 local $SIG{HUP} = 'IGNORE';
720 local $SIG{INT} = 'IGNORE';
721 local $SIG{QUIT} = 'IGNORE';
722 local $SIG{TERM} = 'IGNORE';
723 local $SIG{TSTP} = 'IGNORE';
724 local $SIG{PIPE} = 'IGNORE';
726 my $oldAutoCommit = $FS::UID::AutoCommit;
727 local $FS::UID::AutoCommit = 0;
730 unless ( ref($prepay_credit) ) {
732 my $identifier = $prepay_credit;
734 $prepay_credit = qsearchs(
736 { 'identifier' => $prepay_credit },
741 unless ( $prepay_credit ) {
742 $dbh->rollback if $oldAutoCommit;
743 return "Invalid prepaid card: ". $identifier;
748 if ( $prepay_credit->agentnum ) {
749 if ( $self->agentnum && $self->agentnum != $prepay_credit->agentnum ) {
750 $dbh->rollback if $oldAutoCommit;
751 return "prepaid card not valid for agent ". $self->agentnum;
753 $self->agentnum($prepay_credit->agentnum);
756 my $error = $prepay_credit->delete;
758 $dbh->rollback if $oldAutoCommit;
759 return "removing prepay_credit (transaction rolled back): $error";
762 $$amountref += $prepay_credit->amount;
763 $$secondsref += $prepay_credit->seconds;
764 $$upref += $prepay_credit->upbytes;
765 $$downref += $prepay_credit->downbytes;
766 $$totalref += $prepay_credit->totalbytes;
768 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
773 =item increment_upbytes SECONDS
775 Updates this customer's single or primary account (see L<FS::svc_acct>) by
776 the specified number of upbytes. If there is an error, returns the error,
777 otherwise returns false.
781 sub increment_upbytes {
782 _increment_column( shift, 'upbytes', @_);
785 =item increment_downbytes SECONDS
787 Updates this customer's single or primary account (see L<FS::svc_acct>) by
788 the specified number of downbytes. If there is an error, returns the error,
789 otherwise returns false.
793 sub increment_downbytes {
794 _increment_column( shift, 'downbytes', @_);
797 =item increment_totalbytes SECONDS
799 Updates this customer's single or primary account (see L<FS::svc_acct>) by
800 the specified number of totalbytes. If there is an error, returns the error,
801 otherwise returns false.
805 sub increment_totalbytes {
806 _increment_column( shift, 'totalbytes', @_);
809 =item increment_seconds SECONDS
811 Updates this customer's single or primary account (see L<FS::svc_acct>) by
812 the specified number of seconds. If there is an error, returns the error,
813 otherwise returns false.
817 sub increment_seconds {
818 _increment_column( shift, 'seconds', @_);
821 =item _increment_column AMOUNT
823 Updates this customer's single or primary account (see L<FS::svc_acct>) by
824 the specified number of seconds or bytes. If there is an error, returns
825 the error, otherwise returns false.
829 sub _increment_column {
830 my( $self, $column, $amount ) = @_;
831 warn "$me increment_column called: $column, $amount\n"
834 return '' unless $amount;
836 my @cust_pkg = grep { $_->part_pkg->svcpart('svc_acct') }
837 $self->ncancelled_pkgs;
840 return 'No packages with primary or single services found'.
841 ' to apply pre-paid time';
842 } elsif ( scalar(@cust_pkg) > 1 ) {
843 #maybe have a way to specify the package/account?
844 return 'Multiple packages found to apply pre-paid time';
847 my $cust_pkg = $cust_pkg[0];
848 warn " found package pkgnum ". $cust_pkg->pkgnum. "\n"
852 $cust_pkg->cust_svc( $cust_pkg->part_pkg->svcpart('svc_acct') );
855 return 'No account found to apply pre-paid time';
856 } elsif ( scalar(@cust_svc) > 1 ) {
857 return 'Multiple accounts found to apply pre-paid time';
860 my $svc_acct = $cust_svc[0]->svc_x;
861 warn " found service svcnum ". $svc_acct->pkgnum.
862 ' ('. $svc_acct->email. ")\n"
865 $column = "increment_$column";
866 $svc_acct->$column($amount);
870 =item insert_cust_pay_prepay AMOUNT [ PAYINFO ]
872 Inserts a prepayment in the specified amount for this customer. An optional
873 second argument can specify the prepayment identifier for tracking purposes.
874 If there is an error, returns the error, otherwise returns false.
878 sub insert_cust_pay_prepay {
879 shift->insert_cust_pay('PREP', @_);
882 =item insert_cust_pay_cash AMOUNT [ PAYINFO ]
884 Inserts a cash payment in the specified amount for this customer. An optional
885 second argument can specify the payment identifier for tracking purposes.
886 If there is an error, returns the error, otherwise returns false.
890 sub insert_cust_pay_cash {
891 shift->insert_cust_pay('CASH', @_);
894 =item insert_cust_pay_west AMOUNT [ PAYINFO ]
896 Inserts a Western Union payment in the specified amount for this customer. An
897 optional second argument can specify the prepayment identifier for tracking
898 purposes. If there is an error, returns the error, otherwise returns false.
902 sub insert_cust_pay_west {
903 shift->insert_cust_pay('WEST', @_);
906 sub insert_cust_pay {
907 my( $self, $payby, $amount ) = splice(@_, 0, 3);
908 my $payinfo = scalar(@_) ? shift : '';
910 my $cust_pay = new FS::cust_pay {
911 'custnum' => $self->custnum,
912 'paid' => sprintf('%.2f', $amount),
913 #'_date' => #date the prepaid card was purchased???
915 'payinfo' => $payinfo,
923 This method is deprecated. See the I<depend_jobnum> option to the insert and
924 order_pkgs methods for a better way to defer provisioning.
926 Re-schedules all exports by calling the B<reexport> method of all associated
927 packages (see L<FS::cust_pkg>). If there is an error, returns the error;
928 otherwise returns false.
935 carp "WARNING: FS::cust_main::reexport is deprectated; ".
936 "use the depend_jobnum option to insert or order_pkgs to delay export";
938 local $SIG{HUP} = 'IGNORE';
939 local $SIG{INT} = 'IGNORE';
940 local $SIG{QUIT} = 'IGNORE';
941 local $SIG{TERM} = 'IGNORE';
942 local $SIG{TSTP} = 'IGNORE';
943 local $SIG{PIPE} = 'IGNORE';
945 my $oldAutoCommit = $FS::UID::AutoCommit;
946 local $FS::UID::AutoCommit = 0;
949 foreach my $cust_pkg ( $self->ncancelled_pkgs ) {
950 my $error = $cust_pkg->reexport;
952 $dbh->rollback if $oldAutoCommit;
957 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
962 =item delete NEW_CUSTNUM
964 This deletes the customer. If there is an error, returns the error, otherwise
967 This will completely remove all traces of the customer record. This is not
968 what you want when a customer cancels service; for that, cancel all of the
969 customer's packages (see L</cancel>).
971 If the customer has any uncancelled packages, you need to pass a new (valid)
972 customer number for those packages to be transferred to. Cancelled packages
973 will be deleted. Did I mention that this is NOT what you want when a customer
974 cancels service and that you really should be looking see L<FS::cust_pkg/cancel>?
976 You can't delete a customer with invoices (see L<FS::cust_bill>),
977 or credits (see L<FS::cust_credit>), payments (see L<FS::cust_pay>) or
978 refunds (see L<FS::cust_refund>).
985 local $SIG{HUP} = 'IGNORE';
986 local $SIG{INT} = 'IGNORE';
987 local $SIG{QUIT} = 'IGNORE';
988 local $SIG{TERM} = 'IGNORE';
989 local $SIG{TSTP} = 'IGNORE';
990 local $SIG{PIPE} = 'IGNORE';
992 my $oldAutoCommit = $FS::UID::AutoCommit;
993 local $FS::UID::AutoCommit = 0;
996 if ( $self->cust_bill ) {
997 $dbh->rollback if $oldAutoCommit;
998 return "Can't delete a customer with invoices";
1000 if ( $self->cust_credit ) {
1001 $dbh->rollback if $oldAutoCommit;
1002 return "Can't delete a customer with credits";
1004 if ( $self->cust_pay ) {
1005 $dbh->rollback if $oldAutoCommit;
1006 return "Can't delete a customer with payments";
1008 if ( $self->cust_refund ) {
1009 $dbh->rollback if $oldAutoCommit;
1010 return "Can't delete a customer with refunds";
1013 my @cust_pkg = $self->ncancelled_pkgs;
1015 my $new_custnum = shift;
1016 unless ( qsearchs( 'cust_main', { 'custnum' => $new_custnum } ) ) {
1017 $dbh->rollback if $oldAutoCommit;
1018 return "Invalid new customer number: $new_custnum";
1020 foreach my $cust_pkg ( @cust_pkg ) {
1021 my %hash = $cust_pkg->hash;
1022 $hash{'custnum'} = $new_custnum;
1023 my $new_cust_pkg = new FS::cust_pkg ( \%hash );
1024 my $error = $new_cust_pkg->replace($cust_pkg,
1025 options => { $cust_pkg->options },
1028 $dbh->rollback if $oldAutoCommit;
1033 my @cancelled_cust_pkg = $self->all_pkgs;
1034 foreach my $cust_pkg ( @cancelled_cust_pkg ) {
1035 my $error = $cust_pkg->delete;
1037 $dbh->rollback if $oldAutoCommit;
1042 foreach my $cust_main_invoice ( #(email invoice destinations, not invoices)
1043 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } )
1045 my $error = $cust_main_invoice->delete;
1047 $dbh->rollback if $oldAutoCommit;
1052 my $error = $self->SUPER::delete;
1054 $dbh->rollback if $oldAutoCommit;
1058 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1063 =item replace [ OLD_RECORD ] [ INVOICING_LIST_ARYREF ]
1065 Replaces the OLD_RECORD with this one in the database. If there is an error,
1066 returns the error, otherwise returns false.
1068 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
1069 be set as the invoicing list (see L<"invoicing_list">). Errors return as
1070 expected and rollback the entire transaction; it is not necessary to call
1071 check_invoicing_list first. Here's an example:
1073 $new_cust_main->replace( $old_cust_main, [ $email, 'POST' ] );
1080 my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
1082 : $self->replace_old;
1086 warn "$me replace called\n"
1089 my $curuser = $FS::CurrentUser::CurrentUser;
1090 if ( $self->payby eq 'COMP'
1091 && $self->payby ne $old->payby
1092 && ! $curuser->access_right('Complimentary customer')
1095 return "You are not permitted to create complimentary accounts.";
1098 local($ignore_expired_card) = 1
1099 if $old->payby =~ /^(CARD|DCRD)$/
1100 && $self->payby =~ /^(CARD|DCRD)$/
1101 && ( $old->payinfo eq $self->payinfo || $old->paymask eq $self->paymask );
1103 local $SIG{HUP} = 'IGNORE';
1104 local $SIG{INT} = 'IGNORE';
1105 local $SIG{QUIT} = 'IGNORE';
1106 local $SIG{TERM} = 'IGNORE';
1107 local $SIG{TSTP} = 'IGNORE';
1108 local $SIG{PIPE} = 'IGNORE';
1110 my $oldAutoCommit = $FS::UID::AutoCommit;
1111 local $FS::UID::AutoCommit = 0;
1114 my $error = $self->SUPER::replace($old);
1117 $dbh->rollback if $oldAutoCommit;
1121 if ( @param ) { # INVOICING_LIST_ARYREF
1122 my $invoicing_list = shift @param;
1123 $error = $self->check_invoicing_list( $invoicing_list );
1125 $dbh->rollback if $oldAutoCommit;
1128 $self->invoicing_list( $invoicing_list );
1131 if ( $self->payby =~ /^(CARD|CHEK|LECB)$/ &&
1132 grep { $self->get($_) ne $old->get($_) } qw(payinfo paydate payname) ) {
1133 # card/check/lec info has changed, want to retry realtime_ invoice events
1134 my $error = $self->retry_realtime;
1136 $dbh->rollback if $oldAutoCommit;
1141 unless ( $import || $skip_fuzzyfiles ) {
1142 $error = $self->queue_fuzzyfiles_update;
1144 $dbh->rollback if $oldAutoCommit;
1145 return "updating fuzzy search cache: $error";
1149 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1154 =item queue_fuzzyfiles_update
1156 Used by insert & replace to update the fuzzy search cache
1160 sub queue_fuzzyfiles_update {
1163 local $SIG{HUP} = 'IGNORE';
1164 local $SIG{INT} = 'IGNORE';
1165 local $SIG{QUIT} = 'IGNORE';
1166 local $SIG{TERM} = 'IGNORE';
1167 local $SIG{TSTP} = 'IGNORE';
1168 local $SIG{PIPE} = 'IGNORE';
1170 my $oldAutoCommit = $FS::UID::AutoCommit;
1171 local $FS::UID::AutoCommit = 0;
1174 my $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
1175 my $error = $queue->insert( map $self->getfield($_),
1176 qw(first last company)
1179 $dbh->rollback if $oldAutoCommit;
1180 return "queueing job (transaction rolled back): $error";
1183 if ( $self->ship_last ) {
1184 $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
1185 $error = $queue->insert( map $self->getfield("ship_$_"),
1186 qw(first last company)
1189 $dbh->rollback if $oldAutoCommit;
1190 return "queueing job (transaction rolled back): $error";
1194 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1201 Checks all fields to make sure this is a valid customer record. If there is
1202 an error, returns the error, otherwise returns false. Called by the insert
1203 and replace methods.
1210 warn "$me check BEFORE: \n". $self->_dump
1214 $self->ut_numbern('custnum')
1215 || $self->ut_number('agentnum')
1216 || $self->ut_textn('agent_custid')
1217 || $self->ut_number('refnum')
1218 || $self->ut_textn('custbatch')
1219 || $self->ut_name('last')
1220 || $self->ut_name('first')
1221 || $self->ut_snumbern('birthdate')
1222 || $self->ut_snumbern('signupdate')
1223 || $self->ut_textn('company')
1224 || $self->ut_text('address1')
1225 || $self->ut_textn('address2')
1226 || $self->ut_text('city')
1227 || $self->ut_textn('county')
1228 || $self->ut_textn('state')
1229 || $self->ut_country('country')
1230 || $self->ut_anything('comments')
1231 || $self->ut_numbern('referral_custnum')
1232 || $self->ut_textn('stateid')
1233 || $self->ut_textn('stateid_state')
1234 || $self->ut_textn('invoice_terms')
1236 #barf. need message catalogs. i18n. etc.
1237 $error .= "Please select an advertising source."
1238 if $error =~ /^Illegal or empty \(numeric\) refnum: /;
1239 return $error if $error;
1241 return "Unknown agent"
1242 unless qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
1244 return "Unknown refnum"
1245 unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } );
1247 return "Unknown referring custnum: ". $self->referral_custnum
1248 unless ! $self->referral_custnum
1249 || qsearchs( 'cust_main', { 'custnum' => $self->referral_custnum } );
1251 if ( $self->ss eq '' ) {
1256 $ss =~ /^(\d{3})(\d{2})(\d{4})$/
1257 or return "Illegal social security number: ". $self->ss;
1258 $self->ss("$1-$2-$3");
1262 # bad idea to disable, causes billing to fail because of no tax rates later
1263 # unless ( $import ) {
1264 unless ( qsearch('cust_main_county', {
1265 'country' => $self->country,
1268 return "Unknown state/county/country: ".
1269 $self->state. "/". $self->county. "/". $self->country
1270 unless qsearch('cust_main_county',{
1271 'state' => $self->state,
1272 'county' => $self->county,
1273 'country' => $self->country,
1279 $self->ut_phonen('daytime', $self->country)
1280 || $self->ut_phonen('night', $self->country)
1281 || $self->ut_phonen('fax', $self->country)
1282 || $self->ut_zip('zip', $self->country)
1284 return $error if $error;
1286 if ( $conf->exists('cust_main-require_phone')
1287 && ! length($self->daytime) && ! length($self->night)
1290 my $daytime_label = FS::Msgcat::_gettext('daytime') =~ /^(daytime)?$/
1292 : FS::Msgcat::_gettext('daytime');
1293 my $night_label = FS::Msgcat::_gettext('night') =~ /^(night)?$/
1295 : FS::Msgcat::_gettext('night');
1297 return "$daytime_label or $night_label is required"
1301 if ( $self->has_ship_address
1302 && scalar ( grep { $self->getfield($_) ne $self->getfield("ship_$_") }
1303 $self->addr_fields )
1307 $self->ut_name('ship_last')
1308 || $self->ut_name('ship_first')
1309 || $self->ut_textn('ship_company')
1310 || $self->ut_text('ship_address1')
1311 || $self->ut_textn('ship_address2')
1312 || $self->ut_text('ship_city')
1313 || $self->ut_textn('ship_county')
1314 || $self->ut_textn('ship_state')
1315 || $self->ut_country('ship_country')
1317 return $error if $error;
1319 #false laziness with above
1320 unless ( qsearchs('cust_main_county', {
1321 'country' => $self->ship_country,
1324 return "Unknown ship_state/ship_county/ship_country: ".
1325 $self->ship_state. "/". $self->ship_county. "/". $self->ship_country
1326 unless qsearch('cust_main_county',{
1327 'state' => $self->ship_state,
1328 'county' => $self->ship_county,
1329 'country' => $self->ship_country,
1335 $self->ut_phonen('ship_daytime', $self->ship_country)
1336 || $self->ut_phonen('ship_night', $self->ship_country)
1337 || $self->ut_phonen('ship_fax', $self->ship_country)
1338 || $self->ut_zip('ship_zip', $self->ship_country)
1340 return $error if $error;
1342 return "Unit # is required."
1343 if $self->ship_address2 =~ /^\s*$/
1344 && $conf->exists('cust_main-require_address2');
1346 } else { # ship_ info eq billing info, so don't store dup info in database
1348 $self->setfield("ship_$_", '')
1349 foreach $self->addr_fields;
1351 return "Unit # is required."
1352 if $self->address2 =~ /^\s*$/
1353 && $conf->exists('cust_main-require_address2');
1357 #$self->payby =~ /^(CARD|DCRD|CHEK|DCHK|LECB|BILL|COMP|PREPAY|CASH|WEST|MCRD)$/
1358 # or return "Illegal payby: ". $self->payby;
1360 FS::payby->can_payby($self->table, $self->payby)
1361 or return "Illegal payby: ". $self->payby;
1363 $error = $self->ut_numbern('paystart_month')
1364 || $self->ut_numbern('paystart_year')
1365 || $self->ut_numbern('payissue')
1366 || $self->ut_textn('paytype')
1368 return $error if $error;
1370 if ( $self->payip eq '' ) {
1373 $error = $self->ut_ip('payip');
1374 return $error if $error;
1377 # If it is encrypted and the private key is not availaible then we can't
1378 # check the credit card.
1380 my $check_payinfo = 1;
1382 if ($self->is_encrypted($self->payinfo)) {
1386 if ( $check_payinfo && $self->payby =~ /^(CARD|DCRD)$/ ) {
1388 my $payinfo = $self->payinfo;
1389 $payinfo =~ s/\D//g;
1390 $payinfo =~ /^(\d{13,16})$/
1391 or return gettext('invalid_card'); # . ": ". $self->payinfo;
1393 $self->payinfo($payinfo);
1395 or return gettext('invalid_card'); # . ": ". $self->payinfo;
1397 return gettext('unknown_card_type')
1398 if cardtype($self->payinfo) eq "Unknown";
1400 my $ban = qsearchs('banned_pay', $self->_banned_pay_hashref);
1402 return 'Banned credit card: banned on '.
1403 time2str('%a %h %o at %r', $ban->_date).
1404 ' by '. $ban->otaker.
1405 ' (ban# '. $ban->bannum. ')';
1408 if (length($self->paycvv) && !$self->is_encrypted($self->paycvv)) {
1409 if ( cardtype($self->payinfo) eq 'American Express card' ) {
1410 $self->paycvv =~ /^(\d{4})$/
1411 or return "CVV2 (CID) for American Express cards is four digits.";
1414 $self->paycvv =~ /^(\d{3})$/
1415 or return "CVV2 (CVC2/CID) is three digits.";
1422 my $cardtype = cardtype($payinfo);
1423 if ( $cardtype =~ /^(Switch|Solo)$/i ) {
1425 return "Start date or issue number is required for $cardtype cards"
1426 unless $self->paystart_month && $self->paystart_year or $self->payissue;
1428 return "Start month must be between 1 and 12"
1429 if $self->paystart_month
1430 and $self->paystart_month < 1 || $self->paystart_month > 12;
1432 return "Start year must be 1990 or later"
1433 if $self->paystart_year
1434 and $self->paystart_year < 1990;
1436 return "Issue number must be beween 1 and 99"
1438 and $self->payissue < 1 || $self->payissue > 99;
1441 $self->paystart_month('');
1442 $self->paystart_year('');
1443 $self->payissue('');
1446 } elsif ( $check_payinfo && $self->payby =~ /^(CHEK|DCHK)$/ ) {
1448 my $payinfo = $self->payinfo;
1449 $payinfo =~ s/[^\d\@]//g;
1450 if ( $conf->exists('echeck-nonus') ) {
1451 $payinfo =~ /^(\d+)\@(\d+)$/ or return 'invalid echeck account@aba';
1452 $payinfo = "$1\@$2";
1454 $payinfo =~ /^(\d+)\@(\d{9})$/ or return 'invalid echeck account@aba';
1455 $payinfo = "$1\@$2";
1457 $self->payinfo($payinfo);
1460 my $ban = qsearchs('banned_pay', $self->_banned_pay_hashref);
1462 return 'Banned ACH account: banned on '.
1463 time2str('%a %h %o at %r', $ban->_date).
1464 ' by '. $ban->otaker.
1465 ' (ban# '. $ban->bannum. ')';
1468 } elsif ( $self->payby eq 'LECB' ) {
1470 my $payinfo = $self->payinfo;
1471 $payinfo =~ s/\D//g;
1472 $payinfo =~ /^1?(\d{10})$/ or return 'invalid btn billing telephone number';
1474 $self->payinfo($payinfo);
1477 } elsif ( $self->payby eq 'BILL' ) {
1479 $error = $self->ut_textn('payinfo');
1480 return "Illegal P.O. number: ". $self->payinfo if $error;
1483 } elsif ( $self->payby eq 'COMP' ) {
1485 my $curuser = $FS::CurrentUser::CurrentUser;
1486 if ( ! $self->custnum
1487 && ! $curuser->access_right('Complimentary customer')
1490 return "You are not permitted to create complimentary accounts."
1493 $error = $self->ut_textn('payinfo');
1494 return "Illegal comp account issuer: ". $self->payinfo if $error;
1497 } elsif ( $self->payby eq 'PREPAY' ) {
1499 my $payinfo = $self->payinfo;
1500 $payinfo =~ s/\W//g; #anything else would just confuse things
1501 $self->payinfo($payinfo);
1502 $error = $self->ut_alpha('payinfo');
1503 return "Illegal prepayment identifier: ". $self->payinfo if $error;
1504 return "Unknown prepayment identifier"
1505 unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } );
1510 if ( $self->paydate eq '' || $self->paydate eq '-' ) {
1511 return "Expiration date required"
1512 unless $self->payby =~ /^(BILL|PREPAY|CHEK|DCHK|LECB|CASH|WEST|MCRD)$/;
1516 if ( $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/ ) {
1517 ( $m, $y ) = ( $1, length($2) == 4 ? $2 : "20$2" );
1518 } elsif ( $self->paydate =~ /^(20)?(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) {
1519 ( $m, $y ) = ( $3, "20$2" );
1521 return "Illegal expiration date: ". $self->paydate;
1523 $self->paydate("$y-$m-01");
1524 my($nowm,$nowy)=(localtime(time))[4,5]; $nowm++; $nowy+=1900;
1525 return gettext('expired_card')
1527 && !$ignore_expired_card
1528 && ( $y<$nowy || ( $y==$nowy && $1<$nowm ) );
1531 if ( $self->payname eq '' && $self->payby !~ /^(CHEK|DCHK)$/ &&
1532 ( ! $conf->exists('require_cardname')
1533 || $self->payby !~ /^(CARD|DCRD)$/ )
1535 $self->payname( $self->first. " ". $self->getfield('last') );
1537 $self->payname =~ /^([\w \,\.\-\'\&]+)$/
1538 or return gettext('illegal_name'). " payname: ". $self->payname;
1542 foreach my $flag (qw( tax spool_cdr squelch_cdr )) {
1543 $self->$flag() =~ /^(Y?)$/ or return "Illegal $flag: ". $self->$flag();
1547 $self->otaker(getotaker) unless $self->otaker;
1549 warn "$me check AFTER: \n". $self->_dump
1552 $self->SUPER::check;
1557 Returns a list of fields which have ship_ duplicates.
1562 qw( last first company
1563 address1 address2 city county state zip country
1568 =item has_ship_address
1570 Returns true if this customer record has a separate shipping address.
1574 sub has_ship_address {
1576 scalar( grep { $self->getfield("ship_$_") ne '' } $self->addr_fields );
1581 Returns all packages (see L<FS::cust_pkg>) for this customer.
1588 return $self->num_pkgs unless wantarray;
1591 if ( $self->{'_pkgnum'} ) {
1592 @cust_pkg = values %{ $self->{'_pkgnum'}->cache };
1594 @cust_pkg = qsearch( 'cust_pkg', { 'custnum' => $self->custnum });
1597 sort sort_packages @cust_pkg;
1602 Synonym for B<all_pkgs>.
1607 shift->all_pkgs(@_);
1610 =item ncancelled_pkgs
1612 Returns all non-cancelled packages (see L<FS::cust_pkg>) for this customer.
1616 sub ncancelled_pkgs {
1619 return $self->num_ncancelled_pkgs unless wantarray;
1622 if ( $self->{'_pkgnum'} ) {
1624 warn "$me ncancelled_pkgs: returning cached objects"
1627 @cust_pkg = grep { ! $_->getfield('cancel') }
1628 values %{ $self->{'_pkgnum'}->cache };
1632 warn "$me ncancelled_pkgs: searching for packages with custnum ".
1633 $self->custnum. "\n"
1637 qsearch( 'cust_pkg', {
1638 'custnum' => $self->custnum,
1642 qsearch( 'cust_pkg', {
1643 'custnum' => $self->custnum,
1648 sort sort_packages @cust_pkg;
1652 # This should be generalized to use config options to determine order.
1654 if ( $a->get('cancel') and $b->get('cancel') ) {
1655 $a->pkgnum <=> $b->pkgnum;
1656 } elsif ( $a->get('cancel') or $b->get('cancel') ) {
1657 return -1 if $b->get('cancel');
1658 return 1 if $a->get('cancel');
1661 $a->pkgnum <=> $b->pkgnum;
1665 =item suspended_pkgs
1667 Returns all suspended packages (see L<FS::cust_pkg>) for this customer.
1671 sub suspended_pkgs {
1673 grep { $_->susp } $self->ncancelled_pkgs;
1676 =item unflagged_suspended_pkgs
1678 Returns all unflagged suspended packages (see L<FS::cust_pkg>) for this
1679 customer (thouse packages without the `manual_flag' set).
1683 sub unflagged_suspended_pkgs {
1685 return $self->suspended_pkgs
1686 unless dbdef->table('cust_pkg')->column('manual_flag');
1687 grep { ! $_->manual_flag } $self->suspended_pkgs;
1690 =item unsuspended_pkgs
1692 Returns all unsuspended (and uncancelled) packages (see L<FS::cust_pkg>) for
1697 sub unsuspended_pkgs {
1699 grep { ! $_->susp } $self->ncancelled_pkgs;
1702 =item num_cancelled_pkgs
1704 Returns the number of cancelled packages (see L<FS::cust_pkg>) for this
1709 sub num_cancelled_pkgs {
1710 shift->num_pkgs("cust_pkg.cancel IS NOT NULL AND cust_pkg.cancel != 0");
1713 sub num_ncancelled_pkgs {
1714 shift->num_pkgs("( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )");
1718 my( $self ) = shift;
1719 my $sql = scalar(@_) ? shift : '';
1720 $sql = "AND $sql" if $sql && $sql !~ /^\s*$/ && $sql !~ /^\s*AND/i;
1721 my $sth = dbh->prepare(
1722 "SELECT COUNT(*) FROM cust_pkg WHERE custnum = ? $sql"
1723 ) or die dbh->errstr;
1724 $sth->execute($self->custnum) or die $sth->errstr;
1725 $sth->fetchrow_arrayref->[0];
1730 Unsuspends all unflagged suspended packages (see L</unflagged_suspended_pkgs>
1731 and L<FS::cust_pkg>) for this customer. Always returns a list: an empty list
1732 on success or a list of errors.
1738 grep { $_->unsuspend } $self->suspended_pkgs;
1743 Suspends all unsuspended packages (see L<FS::cust_pkg>) for this customer.
1745 Returns a list: an empty list on success or a list of errors.
1751 grep { $_->suspend(@_) } $self->unsuspended_pkgs;
1754 =item suspend_if_pkgpart HASHREF | PKGPART [ , PKGPART ... ]
1756 Suspends all unsuspended packages (see L<FS::cust_pkg>) matching the listed
1757 PKGPARTs (see L<FS::part_pkg>). Preferred usage is to pass a hashref instead
1758 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)
1769 Returns a list: an empty list on success or a list of errors.
1773 sub suspend_if_pkgpart {
1775 my (@pkgparts, %opt);
1776 if (ref($_[0]) eq 'HASH'){
1777 @pkgparts = @{$_[0]{pkgparts}};
1782 grep { $_->suspend(%opt) }
1783 grep { my $pkgpart = $_->pkgpart; grep { $pkgpart eq $_ } @pkgparts }
1784 $self->unsuspended_pkgs;
1787 =item suspend_unless_pkgpart HASHREF | PKGPART [ , PKGPART ... ]
1789 Suspends all unsuspended packages (see L<FS::cust_pkg>) unless they match the
1790 given PKGPARTs (see L<FS::part_pkg>). Preferred usage is to pass a hashref
1791 instead of a list of pkgparts; the hashref has the following keys:
1795 =item pkgparts - listref of pkgparts
1797 =item (other options are passed to the suspend method)
1801 Returns a list: an empty list on success or a list of errors.
1805 sub suspend_unless_pkgpart {
1807 my (@pkgparts, %opt);
1808 if (ref($_[0]) eq 'HASH'){
1809 @pkgparts = @{$_[0]{pkgparts}};
1814 grep { $_->suspend(%opt) }
1815 grep { my $pkgpart = $_->pkgpart; ! grep { $pkgpart eq $_ } @pkgparts }
1816 $self->unsuspended_pkgs;
1819 =item cancel [ OPTION => VALUE ... ]
1821 Cancels all uncancelled packages (see L<FS::cust_pkg>) for this customer.
1823 Available options are:
1827 =item quiet - can be set true to supress email cancellation notices.
1829 =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.
1831 =item ban - can be set true to ban this customer's credit card or ACH information, if present.
1835 Always returns a list: an empty list on success or a list of errors.
1840 my( $self, %opt ) = @_;
1842 warn "$me cancel called on customer ". $self->custnum. " with options ".
1843 join(', ', map { "$_: $opt{$_}" } keys %opt ). "\n"
1846 return ( 'access denied' )
1847 unless $FS::CurrentUser::CurrentUser->access_right('Cancel customer');
1849 if ( $opt{'ban'} && $self->payby =~ /^(CARD|DCRD|CHEK|DCHK)$/ ) {
1851 #should try decryption (we might have the private key)
1852 # and if not maybe queue a job for the server that does?
1853 return ( "Can't (yet) ban encrypted credit cards" )
1854 if $self->is_encrypted($self->payinfo);
1856 my $ban = new FS::banned_pay $self->_banned_pay_hashref;
1857 my $error = $ban->insert;
1858 return ( $error ) if $error;
1862 my @pkgs = $self->ncancelled_pkgs;
1864 warn "$me cancelling ". scalar($self->ncancelled_pkgs). "/".
1865 scalar(@pkgs). " packages for customer ". $self->custnum. "\n"
1868 grep { $_ } map { $_->cancel(%opt) } $self->ncancelled_pkgs;
1871 sub _banned_pay_hashref {
1882 'payby' => $payby2ban{$self->payby},
1883 'payinfo' => md5_base64($self->payinfo),
1884 #don't ever *search* on reason! #'reason' =>
1890 Returns all notes (see L<FS::cust_main_note>) for this customer.
1897 qsearch( 'cust_main_note',
1898 { 'custnum' => $self->custnum },
1900 'ORDER BY _DATE DESC'
1906 Returns the agent (see L<FS::agent>) for this customer.
1912 qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
1915 =item bill_and_collect
1917 Cancels and suspends any packages due, generates bills, applies payments and
1920 Warns on errors (Does not currently: If there is an error, returns the error, otherwise returns false.)
1922 Options are passed as name-value pairs. Currently available options are:
1928 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:
1932 $cust_main->bill( 'time' => str2time('April 20th, 2001') );
1936 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.
1940 "1d" for the traditional, daily events (the default), or "1m" for the new monthly events (part_event.check_freq)
1944 If set true, re-charges setup fees.
1948 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)
1954 sub bill_and_collect {
1955 my( $self, %options ) = @_;
1961 #$options{actual_time} not $options{time} because freeside-daily -d is for
1962 #pre-printing invoices
1963 my @cancel_pkgs = grep { $_->expire && $_->expire <= $options{actual_time} }
1964 $self->ncancelled_pkgs;
1966 foreach my $cust_pkg ( @cancel_pkgs ) {
1967 my $cpr = $cust_pkg->last_cust_pkg_reason('expire');
1968 my $error = $cust_pkg->cancel($cpr ? ( 'reason' => $cpr->reasonnum,
1969 'reason_otaker' => $cpr->otaker
1973 warn "Error cancelling expired pkg ". $cust_pkg->pkgnum.
1974 " for custnum ". $self->custnum. ": $error"
1982 #$options{actual_time} not $options{time} because freeside-daily -d is for
1983 #pre-printing invoices
1986 && ( ( $_->part_pkg->is_prepaid
1988 && $_->bill < $options{actual_time}
1991 && $_->adjourn <= $options{actual_time}
1995 $self->ncancelled_pkgs;
1997 foreach my $cust_pkg ( @susp_pkgs ) {
1998 my $cpr = $cust_pkg->last_cust_pkg_reason('adjourn')
1999 if ($cust_pkg->adjourn && $cust_pkg->adjourn < $^T);
2000 my $error = $cust_pkg->suspend($cpr ? ( 'reason' => $cpr->reasonnum,
2001 'reason_otaker' => $cpr->otaker
2006 warn "Error suspending package ". $cust_pkg->pkgnum.
2007 " for custnum ". $self->custnum. ": $error"
2015 my $error = $self->bill( %options );
2016 warn "Error billing, custnum ". $self->custnum. ": $error" if $error;
2018 $self->apply_payments_and_credits;
2020 $error = $self->collect( %options );
2021 warn "Error collecting, custnum". $self->custnum. ": $error" if $error;
2027 Generates invoices (see L<FS::cust_bill>) for this customer. Usually used in
2028 conjunction with the collect method by calling B<bill_and_collect>.
2030 If there is an error, returns the error, otherwise returns false.
2032 Options are passed as name-value pairs. Currently available options are:
2038 If set true, re-charges setup fees.
2042 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:
2046 $cust_main->bill( 'time' => str2time('April 20th, 2001') );
2050 An array ref of specific packages (objects) to attempt billing, instead trying all of them.
2052 $cust_main->bill( pkg_list => [$pkg1, $pkg2] );
2056 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.
2063 my( $self, %options ) = @_;
2064 return '' if $self->payby eq 'COMP';
2065 warn "$me bill customer ". $self->custnum. "\n"
2068 my $time = $options{'time'} || time;
2071 local $SIG{HUP} = 'IGNORE';
2072 local $SIG{INT} = 'IGNORE';
2073 local $SIG{QUIT} = 'IGNORE';
2074 local $SIG{TERM} = 'IGNORE';
2075 local $SIG{TSTP} = 'IGNORE';
2076 local $SIG{PIPE} = 'IGNORE';
2078 my $oldAutoCommit = $FS::UID::AutoCommit;
2079 local $FS::UID::AutoCommit = 0;
2082 $self->select_for_update; #mutex
2084 my @cust_bill_pkg = ();
2087 # find the packages which are due for billing, find out how much they are
2088 # & generate invoice database.
2091 my( $total_setup, $total_recur, $postal_charge ) = ( 0, 0, 0 );
2095 my @precommit_hooks = ();
2097 my @cust_pkgs = qsearch('cust_pkg', { 'custnum' => $self->custnum } );
2098 foreach my $cust_pkg (@cust_pkgs) {
2100 #NO!! next if $cust_pkg->cancel;
2101 next if $cust_pkg->getfield('cancel');
2103 warn " bill package ". $cust_pkg->pkgnum. "\n" if $DEBUG > 1;
2105 #? to avoid use of uninitialized value errors... ?
2106 $cust_pkg->setfield('bill', '')
2107 unless defined($cust_pkg->bill);
2109 #my $part_pkg = $cust_pkg->part_pkg;
2111 my $real_pkgpart = $cust_pkg->pkgpart;
2112 my %hash = $cust_pkg->hash;
2114 foreach my $part_pkg ( $cust_pkg->part_pkg->self_and_bill_linked ) {
2116 $cust_pkg->set($_, $hash{$_}) foreach qw ( setup last_bill bill );
2119 $self->_make_lines( 'part_pkg' => $part_pkg,
2120 'cust_pkg' => $cust_pkg,
2121 'precommit_hooks' => \@precommit_hooks,
2122 'line_items' => \@cust_bill_pkg,
2123 'setup' => \$total_setup,
2124 'recur' => \$total_recur,
2125 'tax_matrix' => \%taxlisthash,
2127 'options' => \%options,
2130 $dbh->rollback if $oldAutoCommit;
2134 } #foreach my $part_pkg
2136 } #foreach my $cust_pkg
2138 unless ( @cust_bill_pkg ) { #don't create an invoice w/o line items
2139 #but do commit any package date cycling that happened
2140 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2144 my $postal_pkg = $self->charge_postal_fee();
2145 if ( $postal_pkg && !ref( $postal_pkg ) ) {
2146 $dbh->rollback if $oldAutoCommit;
2147 return "can't charge postal invoice fee for customer ".
2148 $self->custnum. ": $postal_pkg";
2151 ( scalar( grep { $_->recur && $_->recur > 0 } @cust_bill_pkg) ||
2152 !$conf->exists('postal_invoice-recurring_only')
2156 foreach my $part_pkg ( $postal_pkg->part_pkg->self_and_bill_linked ) {
2158 $self->_make_lines( 'part_pkg' => $part_pkg,
2159 'cust_pkg' => $postal_pkg,
2160 'precommit_hooks' => \@precommit_hooks,
2161 'line_items' => \@cust_bill_pkg,
2162 'setup' => \$total_setup,
2163 'recur' => \$total_recur,
2164 'tax_matrix' => \%taxlisthash,
2166 'options' => \%options,
2169 $dbh->rollback if $oldAutoCommit;
2175 warn "having a look at the taxes we found...\n" if $DEBUG > 2;
2176 foreach my $tax ( keys %taxlisthash ) {
2177 my $tax_object = shift @{ $taxlisthash{$tax} };
2178 warn "found ". $tax_object->taxname. " as $tax\n" if $DEBUG > 2;
2179 my $listref_or_error = $tax_object->taxline( @{ $taxlisthash{$tax} } );
2180 unless (ref($listref_or_error)) {
2181 $dbh->rollback if $oldAutoCommit;
2182 return $listref_or_error;
2184 unshift @{ $taxlisthash{$tax} }, $tax_object;
2186 warn "adding ". $listref_or_error->[1].
2187 " as ". $listref_or_error->[0]. "\n"
2189 $tax{ $tax_object->taxname } += $listref_or_error->[1];
2190 if ( $taxname{ $listref_or_error->[0] } ) {
2191 push @{ $taxname{ $listref_or_error->[0] } }, $tax_object->taxname;
2193 $taxname{ $listref_or_error->[0] } = [ $tax_object->taxname ];
2198 #some taxes are taxed
2201 warn "finding taxed taxes...\n" if $DEBUG > 2;
2202 foreach my $tax ( keys %taxlisthash ) {
2203 my $tax_object = shift @{ $taxlisthash{$tax} };
2204 warn "found possible taxed tax ". $tax_object->taxname. " we call $tax\n"
2206 next unless $tax_object->can('tax_on_tax');
2208 foreach my $tot ( $tax_object->tax_on_tax( $self ) ) {
2209 my $totname = ref( $tot ). ' '. $tot->taxnum;
2211 warn "checking $totname which we call ". $tot->taxname. " as applicable\n"
2213 next unless exists( $taxlisthash{ $totname } ); # only increase
2215 warn "adding $totname to taxed taxes\n" if $DEBUG > 2;
2216 if ( exists( $totlisthash{ $totname } ) ) {
2217 push @{ $totlisthash{ $totname } }, $tax{ $tax_object->taxname };
2219 $totlisthash{ $totname } = [ $tot, $tax{ $tax_object->taxname } ];
2224 warn "having a look at taxed taxes...\n" if $DEBUG > 2;
2225 foreach my $tax ( keys %totlisthash ) {
2226 my $tax_object = shift @{ $totlisthash{$tax} };
2227 warn "found previously found taxed tax ". $tax_object->taxname. "\n"
2229 my $listref_or_error = $tax_object->taxline( @{ $totlisthash{$tax} } );
2230 unless (ref($listref_or_error)) {
2231 $dbh->rollback if $oldAutoCommit;
2232 return $listref_or_error;
2235 warn "adding taxed tax amount ". $listref_or_error->[1].
2236 " as ". $tax_object->taxname. "\n"
2238 $tax{ $tax_object->taxname } += $listref_or_error->[1];
2241 #consolidate and create tax line items
2242 warn "consolidating and generating...\n" if $DEBUG > 2;
2243 foreach my $taxname ( keys %taxname ) {
2246 warn "adding $taxname\n" if $DEBUG > 1;
2247 foreach my $taxitem ( @{ $taxname{$taxname} } ) {
2248 $tax += $tax{$taxitem} unless $seen{$taxitem};
2249 warn "adding $tax{$taxitem}\n" if $DEBUG > 1;
2253 $tax = sprintf('%.2f', $tax );
2254 $total_setup = sprintf('%.2f', $total_setup+$tax );
2256 push @cust_bill_pkg, new FS::cust_bill_pkg {
2262 'itemdesc' => $taxname,
2267 my $charged = sprintf('%.2f', $total_setup + $total_recur );
2269 #create the new invoice
2270 my $cust_bill = new FS::cust_bill ( {
2271 'custnum' => $self->custnum,
2272 '_date' => ( $options{'invoice_time'} || $time ),
2273 'charged' => $charged,
2275 my $error = $cust_bill->insert;
2277 $dbh->rollback if $oldAutoCommit;
2278 return "can't create invoice for customer #". $self->custnum. ": $error";
2281 foreach my $cust_bill_pkg ( @cust_bill_pkg ) {
2282 $cust_bill_pkg->invnum($cust_bill->invnum);
2283 my $error = $cust_bill_pkg->insert;
2285 $dbh->rollback if $oldAutoCommit;
2286 return "can't create invoice line item: $error";
2291 foreach my $hook ( @precommit_hooks ) {
2293 &{$hook}; #($self) ?
2296 $dbh->rollback if $oldAutoCommit;
2297 return "$@ running precommit hook $hook\n";
2301 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2307 my ($self, %params) = @_;
2309 my $part_pkg = $params{part_pkg} or die "no part_pkg specified";
2310 my $cust_pkg = $params{cust_pkg} or die "no cust_pkg specified";
2311 my $precommit_hooks = $params{precommit_hooks} or die "no package specified";
2312 my $cust_bill_pkgs = $params{line_items} or die "no line buffer specified";
2313 my $total_setup = $params{setup} or die "no setup accumulator specified";
2314 my $total_recur = $params{recur} or die "no recur accumulator specified";
2315 my $taxlisthash = $params{tax_matrix} or die "no tax accumulator specified";
2316 my $time = $params{'time'} or die "no time specified";
2317 my (%options) = %{$params{options}}; #hmmm only for 'resetup'
2320 my $real_pkgpart = $cust_pkg->pkgpart;
2321 my %hash = $cust_pkg->hash;
2322 my $old_cust_pkg = new FS::cust_pkg \%hash;
2328 $cust_pkg->pkgpart($part_pkg->pkgpart);
2336 if ( ! $cust_pkg->setup &&
2338 ( $conf->exists('disable_setup_suspended_pkgs') &&
2339 ! $cust_pkg->getfield('susp')
2340 ) || ! $conf->exists('disable_setup_suspended_pkgs')
2342 || $options{'resetup'}
2345 warn " bill setup\n" if $DEBUG > 1;
2348 $setup = eval { $cust_pkg->calc_setup( $time, \@details ) };
2349 return "$@ running calc_setup for $cust_pkg\n"
2352 $unitsetup = $cust_pkg->part_pkg->unit_setup || $setup; #XXX uuh
2354 $cust_pkg->setfield('setup', $time)
2355 unless $cust_pkg->setup;
2356 #do need it, but it won't get written to the db
2357 #|| $cust_pkg->pkgpart != $real_pkgpart;
2362 # bill recurring fee
2365 #XXX unit stuff here too
2369 if ( $part_pkg->getfield('freq') ne '0' &&
2370 ! $cust_pkg->getfield('susp') &&
2371 ( $cust_pkg->getfield('bill') || 0 ) <= $time
2374 # XXX should this be a package event? probably. events are called
2375 # at collection time at the moment, though...
2376 $part_pkg->reset_usage($cust_pkg, 'debug'=>$DEBUG)
2377 if $part_pkg->can('reset_usage');
2378 #don't want to reset usage just cause we want a line item??
2379 #&& $part_pkg->pkgpart == $real_pkgpart;
2381 warn " bill recur\n" if $DEBUG > 1;
2384 # XXX shared with $recur_prog
2385 $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
2387 #over two params! lets at least switch to a hashref for the rest...
2388 my %param = ( 'precommit_hooks' => $precommit_hooks, );
2390 $recur = eval { $cust_pkg->calc_recur( \$sdate, \@details, \%param ) };
2391 return "$@ running calc_recur for $cust_pkg\n"
2395 #change this bit to use Date::Manip? CAREFUL with timezones (see
2396 # mailing list archive)
2397 my ($sec,$min,$hour,$mday,$mon,$year) =
2398 (localtime($sdate) )[0,1,2,3,4,5];
2400 #pro-rating magic - if $recur_prog fiddles $sdate, want to use that
2401 # only for figuring next bill date, nothing else, so, reset $sdate again
2403 $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
2404 #no need, its in $hash{last_bill}# my $last_bill = $cust_pkg->last_bill;
2405 $cust_pkg->last_bill($sdate);
2407 if ( $part_pkg->freq =~ /^\d+$/ ) {
2408 $mon += $part_pkg->freq;
2409 until ( $mon < 12 ) { $mon -= 12; $year++; }
2410 } elsif ( $part_pkg->freq =~ /^(\d+)w$/ ) {
2412 $mday += $weeks * 7;
2413 } elsif ( $part_pkg->freq =~ /^(\d+)d$/ ) {
2416 } elsif ( $part_pkg->freq =~ /^(\d+)h$/ ) {
2420 return "unparsable frequency: ". $part_pkg->freq;
2422 $cust_pkg->setfield('bill',
2423 timelocal_nocheck($sec,$min,$hour,$mday,$mon,$year));
2427 warn "\$setup is undefined" unless defined($setup);
2428 warn "\$recur is undefined" unless defined($recur);
2429 warn "\$cust_pkg->bill is undefined" unless defined($cust_pkg->bill);
2432 # If there's line items, create em cust_bill_pkg records
2433 # If $cust_pkg has been modified, update it (if we're a real pkgpart)
2438 if ( $cust_pkg->modified && $cust_pkg->pkgpart == $real_pkgpart ) {
2439 # hmm.. and if just the options are modified in some weird price plan?
2441 warn " package ". $cust_pkg->pkgnum. " modified; updating\n"
2444 my $error = $cust_pkg->replace( $old_cust_pkg,
2445 'options' => { $cust_pkg->options },
2447 return "Error modifying pkgnum ". $cust_pkg->pkgnum. ": $error"
2448 if $error; #just in case
2451 $setup = sprintf( "%.2f", $setup );
2452 $recur = sprintf( "%.2f", $recur );
2453 if ( $setup < 0 && ! $conf->exists('allow_negative_charges') ) {
2454 return "negative setup $setup for pkgnum ". $cust_pkg->pkgnum;
2456 if ( $recur < 0 && ! $conf->exists('allow_negative_charges') ) {
2457 return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum;
2460 if ( $setup != 0 || $recur != 0 ) {
2462 warn " charges (setup=$setup, recur=$recur); adding line items\n"
2465 my @cust_pkg_detail = map { $_->detail } $cust_pkg->cust_pkg_detail('I');
2467 warn " adding customer package invoice detail: $_\n"
2468 foreach @cust_pkg_detail;
2470 push @details, @cust_pkg_detail;
2472 my $cust_bill_pkg = new FS::cust_bill_pkg {
2473 'pkgnum' => $cust_pkg->pkgnum,
2475 'unitsetup' => $unitsetup,
2477 'unitrecur' => $unitrecur,
2478 'quantity' => $cust_pkg->quantity,
2479 'details' => \@details,
2482 if ( $part_pkg->option('recur_temporality', 1) eq 'preceding' ) {
2483 $cust_bill_pkg->sdate( $hash{last_bill} );
2484 $cust_bill_pkg->edate( $sdate - 86399 ); #60s*60m*24h-1
2485 } else { #if ( $part_pkg->option('recur_temporality', 1) eq 'upcoming' ) {
2486 $cust_bill_pkg->sdate( $sdate );
2487 $cust_bill_pkg->edate( $cust_pkg->bill );
2490 $cust_bill_pkg->pkgpart_override($part_pkg->pkgpart)
2491 unless $part_pkg->pkgpart == $real_pkgpart;
2493 $$total_setup += $setup;
2494 $$total_recur += $recur;
2501 $self->_handle_taxes($part_pkg, $taxlisthash, $cust_bill_pkg, $cust_pkg);
2502 return $error if $error;
2504 push @$cust_bill_pkgs, $cust_bill_pkg;
2506 } #if $setup != 0 || $recur != 0
2516 my $part_pkg = shift;
2517 my $taxlisthash = shift;
2518 my $cust_bill_pkg = shift;
2519 my $cust_pkg = shift;
2521 my %cust_bill_pkg = ();
2525 ( $conf->exists('tax-ship_address') && length($self->ship_last) )
2530 #push @classes, $cust_bill_pkg->usage_classes if $cust_bill_pkg->type eq 'U';
2531 push @classes, $cust_bill_pkg->usage_classes if $cust_bill_pkg->usage;
2532 push @classes, 'setup' if $cust_bill_pkg->setup;
2533 push @classes, 'recur' if $cust_bill_pkg->recur;
2535 if ( $conf->exists('enable_taxproducts')
2536 && (scalar($part_pkg->part_pkg_taxoverride) || $part_pkg->has_taxproduct)
2537 && ( $self->tax !~ /Y/i && $self->payby ne 'COMP' )
2541 foreach my $class (@classes) {
2542 my $err_or_ref = $self->_gather_taxes( $part_pkg, $class, $prefix );
2543 return $err_or_ref unless ref($err_or_ref);
2544 $taxes{$class} = $err_or_ref;
2547 unless (exists $taxes{''}) {
2548 my $err_or_ref = $self->_gather_taxes( $part_pkg, '', $prefix );
2549 return $err_or_ref unless ref($err_or_ref);
2550 $taxes{''} = $err_or_ref;
2553 } elsif ( $self->tax !~ /Y/i && $self->payby ne 'COMP' ) {
2555 my %taxhash = map { $_ => $self->get("$prefix$_") }
2556 qw( state county country );
2558 $taxhash{'taxclass'} = $part_pkg->taxclass;
2560 my @taxes = qsearch( 'cust_main_county', \%taxhash );
2563 $taxhash{'taxclass'} = '';
2564 @taxes = qsearch( 'cust_main_county', \%taxhash );
2567 #one more try at a whole-country tax rate
2569 $taxhash{$_} = '' foreach qw( state county );
2570 @taxes = qsearch( 'cust_main_county', \%taxhash );
2573 $taxes{''} = [ @taxes ];
2574 $taxes{'setup'} = [ @taxes ];
2575 $taxes{'recur'} = [ @taxes ];
2576 $taxes{$_} = [ @taxes ] foreach (@classes);
2578 # maybe eliminate this entirely, along with all the 0% records
2581 "fatal: can't find tax rate for state/county/country/taxclass ".
2582 join('/', ( map $self->get("$prefix$_"),
2583 qw(state county country)
2585 $part_pkg->taxclass ). "\n";
2588 } #if $conf->exists('enable_taxproducts') ...
2591 if ( $conf->exists('separate_usage') ) {
2592 my $section = $cust_pkg->part_pkg->option('usage_section', 'Hush!');
2593 my $summary = $cust_pkg->part_pkg->option('summarize_usage', 'Hush!');
2594 push @display, new FS::cust_bill_pkg_display { type => 'S' };
2595 push @display, new FS::cust_bill_pkg_display { type => 'R' };
2596 push @display, new FS::cust_bill_pkg_display { type => 'U',
2599 if ($section && $summary) {
2600 $display[2]->post_total('Y');
2601 push @display, new FS::cust_bill_pkg_display { type => 'U',
2606 $cust_bill_pkg->set('display', \@display);
2608 my %tax_cust_bill_pkg = $cust_bill_pkg->disintegrate;
2609 foreach my $key (keys %tax_cust_bill_pkg) {
2610 my @taxes = @{ $taxes{$key} };
2611 my $tax_cust_bill_pkg = $tax_cust_bill_pkg{$key};
2613 foreach my $tax ( @taxes ) {
2614 my $taxname = ref( $tax ). ' '. $tax->taxnum;
2615 if ( exists( $taxlisthash->{ $taxname } ) ) {
2616 push @{ $taxlisthash->{ $taxname } }, $tax_cust_bill_pkg;
2618 $taxlisthash->{ $taxname } = [ $tax, $tax_cust_bill_pkg ];
2628 my $part_pkg = shift;
2633 my $geocode = $self->geocode('cch');
2635 my @taxclassnums = map { $_->taxclassnum }
2636 $part_pkg->part_pkg_taxoverride($class);
2638 unless (@taxclassnums) {
2639 @taxclassnums = map { $_->taxclassnum }
2640 $part_pkg->part_pkg_taxrate('cch', $geocode, $class);
2642 warn "Found taxclassnum values of ". join(',', @taxclassnums)
2647 join(' OR ', map { "taxclassnum = $_" } @taxclassnums ). ")";
2649 @taxes = qsearch({ 'table' => 'tax_rate',
2650 'hashref' => { 'geocode' => $geocode, },
2651 'extra_sql' => $extra_sql,
2653 if scalar(@taxclassnums);
2655 # maybe eliminate this entirely, along with all the 0% records
2658 "fatal: can't find tax rate for zip/taxproduct/pkgpart ".
2659 join('/', ( map $self->get("$prefix$_"),
2662 $part_pkg->taxproduct_description,
2663 $part_pkg->pkgpart ). "\n";
2666 warn "Found taxes ".
2667 join(',', map{ ref($_). " ". $_->get($_->primary_key) } @taxes). "\n"
2674 =item collect OPTIONS
2676 (Attempt to) collect money for this customer's outstanding invoices (see
2677 L<FS::cust_bill>). Usually used after the bill method.
2679 Actions are now triggered by billing events; see L<FS::part_event> and the
2680 billing events web interface. Old-style invoice events (see
2681 L<FS::part_bill_event>) have been deprecated.
2683 If there is an error, returns the error, otherwise returns false.
2685 Options are passed as name-value pairs.
2687 Currently available options are:
2693 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.
2697 Retry card/echeck/LEC transactions even when not scheduled by invoice events.
2701 set true to surpress email card/ACH decline notices.
2705 "1d" for the traditional, daily events (the default), or "1m" for the new monthly events (part_event.check_freq)
2709 allows for one time override of normal customer billing method
2713 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)
2721 my( $self, %options ) = @_;
2722 my $invoice_time = $options{'invoice_time'} || time;
2725 local $SIG{HUP} = 'IGNORE';
2726 local $SIG{INT} = 'IGNORE';
2727 local $SIG{QUIT} = 'IGNORE';
2728 local $SIG{TERM} = 'IGNORE';
2729 local $SIG{TSTP} = 'IGNORE';
2730 local $SIG{PIPE} = 'IGNORE';
2732 my $oldAutoCommit = $FS::UID::AutoCommit;
2733 local $FS::UID::AutoCommit = 0;
2736 $self->select_for_update; #mutex
2739 my $balance = $self->balance;
2740 warn "$me collect customer ". $self->custnum. ": balance $balance\n"
2743 if ( exists($options{'retry_card'}) ) {
2744 carp 'retry_card option passed to collect is deprecated; use retry';
2745 $options{'retry'} ||= $options{'retry_card'};
2747 if ( exists($options{'retry'}) && $options{'retry'} ) {
2748 my $error = $self->retry_realtime;
2750 $dbh->rollback if $oldAutoCommit;
2755 # false laziness w/pay_batch::import_results
2757 my $due_cust_event = $self->due_cust_event(
2758 'debug' => ( $options{'debug'} || 0 ),
2759 'time' => $invoice_time,
2760 'check_freq' => $options{'check_freq'},
2762 unless( ref($due_cust_event) ) {
2763 $dbh->rollback if $oldAutoCommit;
2764 return $due_cust_event;
2767 foreach my $cust_event ( @$due_cust_event ) {
2771 #re-eval event conditions (a previous event could have changed things)
2772 unless ( $cust_event->test_conditions( 'time' => $invoice_time ) ) {
2773 #don't leave stray "new/locked" records around
2774 my $error = $cust_event->delete;
2776 #gah, even with transactions
2777 $dbh->commit if $oldAutoCommit; #well.
2784 local $realtime_bop_decline_quiet = 1 if $options{'quiet'};
2785 warn " running cust_event ". $cust_event->eventnum. "\n"
2789 #if ( my $error = $cust_event->do_event(%options) ) { #XXX %options?
2790 if ( my $error = $cust_event->do_event() ) {
2791 #XXX wtf is this? figure out a proper dealio with return value
2793 # gah, even with transactions.
2794 $dbh->commit if $oldAutoCommit; #well.
2801 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2806 =item due_cust_event [ HASHREF | OPTION => VALUE ... ]
2808 Inserts database records for and returns an ordered listref of new events due
2809 for this customer, as FS::cust_event objects (see L<FS::cust_event>). If no
2810 events are due, an empty listref is returned. If there is an error, returns a
2811 scalar error message.
2813 To actually run the events, call each event's test_condition method, and if
2814 still true, call the event's do_event method.
2816 Options are passed as a hashref or as a list of name-value pairs. Available
2823 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.
2827 "Current time" for the events.
2831 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)
2835 Only return events for the specified eventtable (by default, events of all eventtables are returned)
2839 Explicitly pass the objects to be tested (typically used with eventtable).
2845 sub due_cust_event {
2847 my %opt = ref($_[0]) ? %{ $_[0] } : @_;
2850 #my $DEBUG = $opt{'debug'}
2851 local($DEBUG) = $opt{'debug'}
2852 if defined($opt{'debug'}) && $opt{'debug'} > $DEBUG;
2854 warn "$me due_cust_event called with options ".
2855 join(', ', map { "$_: $opt{$_}" } keys %opt). "\n"
2858 $opt{'time'} ||= time;
2860 local $SIG{HUP} = 'IGNORE';
2861 local $SIG{INT} = 'IGNORE';
2862 local $SIG{QUIT} = 'IGNORE';
2863 local $SIG{TERM} = 'IGNORE';
2864 local $SIG{TSTP} = 'IGNORE';
2865 local $SIG{PIPE} = 'IGNORE';
2867 my $oldAutoCommit = $FS::UID::AutoCommit;
2868 local $FS::UID::AutoCommit = 0;
2871 $self->select_for_update; #mutex
2874 # 1: find possible events (initial search)
2877 my @cust_event = ();
2879 my @eventtable = $opt{'eventtable'}
2880 ? ( $opt{'eventtable'} )
2881 : FS::part_event->eventtables_runorder;
2883 foreach my $eventtable ( @eventtable ) {
2886 if ( $opt{'objects'} ) {
2888 @objects = @{ $opt{'objects'} };
2892 #my @objects = $self->eventtable(); # sub cust_main { @{ [ $self ] }; }
2893 @objects = ( $eventtable eq 'cust_main' )
2895 : ( $self->$eventtable() );
2899 my @e_cust_event = ();
2901 my $cross = "CROSS JOIN $eventtable";
2902 $cross .= ' LEFT JOIN cust_main USING ( custnum )'
2903 unless $eventtable eq 'cust_main';
2905 foreach my $object ( @objects ) {
2907 #this first search uses the condition_sql magic for optimization.
2908 #the more possible events we can eliminate in this step the better
2910 my $cross_where = '';
2911 my $pkey = $object->primary_key;
2912 $cross_where = "$eventtable.$pkey = ". $object->$pkey();
2914 my $join = FS::part_event_condition->join_conditions_sql( $eventtable );
2916 FS::part_event_condition->where_conditions_sql( $eventtable,
2917 'time'=>$opt{'time'}
2919 my $order = FS::part_event_condition->order_conditions_sql( $eventtable );
2921 $extra_sql = "AND $extra_sql" if $extra_sql;
2923 #here is the agent virtualization
2924 $extra_sql .= " AND ( part_event.agentnum IS NULL
2925 OR part_event.agentnum = ". $self->agentnum. ' )';
2927 $extra_sql .= " $order";
2929 warn "searching for events for $eventtable ". $object->$pkey. "\n"
2930 if $opt{'debug'} > 2;
2931 my @part_event = qsearch( {
2932 'debug' => ( $opt{'debug'} > 3 ? 1 : 0 ),
2933 'select' => 'part_event.*',
2934 'table' => 'part_event',
2935 'addl_from' => "$cross $join",
2936 'hashref' => { 'check_freq' => ( $opt{'check_freq'} || '1d' ),
2937 'eventtable' => $eventtable,
2940 'extra_sql' => "AND $cross_where $extra_sql",
2944 my $pkey = $object->primary_key;
2945 warn " ". scalar(@part_event).
2946 " possible events found for $eventtable ". $object->$pkey(). "\n";
2949 push @e_cust_event, map { $_->new_cust_event($object) } @part_event;
2953 warn " ". scalar(@e_cust_event).
2954 " subtotal possible cust events found for $eventtable\n"
2957 push @cust_event, @e_cust_event;
2961 warn " ". scalar(@cust_event).
2962 " total possible cust events found in initial search\n"
2966 # 2: test conditions
2971 @cust_event = grep $_->test_conditions( 'time' => $opt{'time'},
2972 'stats_hashref' => \%unsat ),
2975 warn " ". scalar(@cust_event). " cust events left satisfying conditions\n"
2978 warn " invalid conditions not eliminated with condition_sql:\n".
2979 join('', map " $_: ".$unsat{$_}."\n", keys %unsat )
2986 unless( $opt{testonly} ) {
2987 foreach my $cust_event ( @cust_event ) {
2989 my $error = $cust_event->insert();
2991 $dbh->rollback if $oldAutoCommit;
2998 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3004 warn " returning events: ". Dumper(@cust_event). "\n"
3011 =item retry_realtime
3013 Schedules realtime / batch credit card / electronic check / LEC billing
3014 events for for retry. Useful if card information has changed or manual
3015 retry is desired. The 'collect' method must be called to actually retry
3018 Implementation details: For either this customer, or for each of this
3019 customer's open invoices, changes the status of the first "done" (with
3020 statustext error) realtime processing event to "failed".
3024 sub retry_realtime {
3027 local $SIG{HUP} = 'IGNORE';
3028 local $SIG{INT} = 'IGNORE';
3029 local $SIG{QUIT} = 'IGNORE';
3030 local $SIG{TERM} = 'IGNORE';
3031 local $SIG{TSTP} = 'IGNORE';
3032 local $SIG{PIPE} = 'IGNORE';
3034 my $oldAutoCommit = $FS::UID::AutoCommit;
3035 local $FS::UID::AutoCommit = 0;
3038 #a little false laziness w/due_cust_event (not too bad, really)
3040 my $join = FS::part_event_condition->join_conditions_sql;
3041 my $order = FS::part_event_condition->order_conditions_sql;
3044 . join ( ' OR ' , map {
3045 "( part_event.eventtable = " . dbh->quote($_)
3046 . " AND tablenum IN( SELECT " . dbdef->table($_)->primary_key . " from $_ where custnum = " . dbh->quote( $self->custnum ) . "))" ;
3047 } FS::part_event->eventtables)
3050 #here is the agent virtualization
3051 my $agent_virt = " ( part_event.agentnum IS NULL
3052 OR part_event.agentnum = ". $self->agentnum. ' )';
3054 #XXX this shouldn't be hardcoded, actions should declare it...
3055 my @realtime_events = qw(
3056 cust_bill_realtime_card
3057 cust_bill_realtime_check
3058 cust_bill_realtime_lec
3062 my $is_realtime_event = ' ( '. join(' OR ', map "part_event.action = '$_'",
3067 my @cust_event = qsearchs({
3068 'table' => 'cust_event',
3069 'select' => 'cust_event.*',
3070 'addl_from' => "LEFT JOIN part_event USING ( eventpart ) $join",
3071 'hashref' => { 'status' => 'done' },
3072 'extra_sql' => " AND statustext IS NOT NULL AND statustext != '' ".
3073 " AND $mine AND $is_realtime_event AND $agent_virt $order" # LIMIT 1"
3076 my %seen_invnum = ();
3077 foreach my $cust_event (@cust_event) {
3079 #max one for the customer, one for each open invoice
3080 my $cust_X = $cust_event->cust_X;
3081 next if $seen_invnum{ $cust_event->part_event->eventtable eq 'cust_bill'
3085 or $cust_event->part_event->eventtable eq 'cust_bill'
3088 my $error = $cust_event->retry;
3090 $dbh->rollback if $oldAutoCommit;
3091 return "error scheduling event for retry: $error";
3096 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3101 =item realtime_bop METHOD AMOUNT [ OPTION => VALUE ... ]
3103 Runs a realtime credit card, ACH (electronic check) or phone bill transaction
3104 via a Business::OnlinePayment realtime gateway. See
3105 L<http://420.am/business-onlinepayment> for supported gateways.
3107 Available methods are: I<CC>, I<ECHECK> and I<LEC>
3109 Available options are: I<description>, I<invnum>, I<quiet>, I<paynum_ref>, I<payunique>
3111 The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
3112 I<zip>, I<payinfo> and I<paydate> are also available. Any of these options,
3113 if set, will override the value from the customer record.
3115 I<description> is a free-text field passed to the gateway. It defaults to
3116 "Internet services".
3118 If an I<invnum> is specified, this payment (if successful) is applied to the
3119 specified invoice. If you don't specify an I<invnum> you might want to
3120 call the B<apply_payments> method.
3122 I<quiet> can be set true to surpress email decline notices.
3124 I<paynum_ref> can be set to a scalar reference. It will be filled in with the
3125 resulting paynum, if any.
3127 I<payunique> is a unique identifier for this payment.
3129 (moved from cust_bill) (probably should get realtime_{card,ach,lec} here too)
3134 my( $self, $method, $amount, %options ) = @_;
3136 warn "$me realtime_bop: $method $amount\n";
3137 warn " $_ => $options{$_}\n" foreach keys %options;
3140 $options{'description'} ||= 'Internet services';
3142 return $self->fake_bop($method, $amount, %options) if $options{'fake'};
3144 eval "use Business::OnlinePayment";
3147 my $payinfo = exists($options{'payinfo'})
3148 ? $options{'payinfo'}
3151 my %method2payby = (
3158 # check for banned credit card/ACH
3161 my $ban = qsearchs('banned_pay', {
3162 'payby' => $method2payby{$method},
3163 'payinfo' => md5_base64($payinfo),
3165 return "Banned credit card" if $ban;
3172 if ( $options{'invnum'} ) {
3173 my $cust_bill = qsearchs('cust_bill', { 'invnum' => $options{'invnum'} } );
3174 die "invnum ". $options{'invnum'}. " not found" unless $cust_bill;
3176 map { $_->part_pkg->taxclass }
3178 map { $_->cust_pkg }
3179 $cust_bill->cust_bill_pkg;
3180 unless ( grep { $taxclasses[0] ne $_ } @taxclasses ) { #unless there are
3181 #different taxclasses
3182 $taxclass = $taxclasses[0];
3186 #look for an agent gateway override first
3188 if ( $method eq 'CC' ) {
3189 $cardtype = cardtype($payinfo);
3190 } elsif ( $method eq 'ECHECK' ) {
3193 $cardtype = $method;
3197 qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
3198 cardtype => $cardtype,
3199 taxclass => $taxclass, } )
3200 || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
3202 taxclass => $taxclass, } )
3203 || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
3204 cardtype => $cardtype,
3206 || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
3208 taxclass => '', } );
3210 my $payment_gateway = '';
3211 my( $processor, $login, $password, $action, @bop_options );
3212 if ( $override ) { #use a payment gateway override
3214 $payment_gateway = $override->payment_gateway;
3216 $processor = $payment_gateway->gateway_module;
3217 $login = $payment_gateway->gateway_username;
3218 $password = $payment_gateway->gateway_password;
3219 $action = $payment_gateway->gateway_action;
3220 @bop_options = $payment_gateway->options;
3222 } else { #use the standard settings from the config
3224 ( $processor, $login, $password, $action, @bop_options ) =
3225 $self->default_payment_gateway($method);
3233 my $address = exists($options{'address1'})
3234 ? $options{'address1'}
3236 my $address2 = exists($options{'address2'})
3237 ? $options{'address2'}
3239 $address .= ", ". $address2 if length($address2);
3241 my $o_payname = exists($options{'payname'})
3242 ? $options{'payname'}
3244 my($payname, $payfirst, $paylast);
3245 if ( $o_payname && $method ne 'ECHECK' ) {
3246 ($payname = $o_payname) =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
3247 or return "Illegal payname $payname";
3248 ($payfirst, $paylast) = ($1, $2);
3250 $payfirst = $self->getfield('first');
3251 $paylast = $self->getfield('last');
3252 $payname = "$payfirst $paylast";
3255 my @invoicing_list = $self->invoicing_list_emailonly;
3256 if ( $conf->exists('emailinvoiceautoalways')
3257 || $conf->exists('emailinvoiceauto') && ! @invoicing_list
3258 || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
3259 push @invoicing_list, $self->all_emails;
3262 my $email = ($conf->exists('business-onlinepayment-email-override'))
3263 ? $conf->config('business-onlinepayment-email-override')
3264 : $invoicing_list[0];
3268 my $payip = exists($options{'payip'})
3271 $content{customer_ip} = $payip
3274 $content{invoice_number} = $options{'invnum'}
3275 if exists($options{'invnum'}) && length($options{'invnum'});
3277 $content{email_customer} =
3278 ( $conf->exists('business-onlinepayment-email_customer')
3279 || $conf->exists('business-onlinepayment-email-override') );
3282 if ( $method eq 'CC' ) {
3284 $content{card_number} = $payinfo;
3285 $paydate = exists($options{'paydate'})
3286 ? $options{'paydate'}
3288 $paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
3289 $content{expiration} = "$2/$1";
3291 my $paycvv = exists($options{'paycvv'})
3292 ? $options{'paycvv'}
3294 $content{cvv2} = $paycvv
3297 my $paystart_month = exists($options{'paystart_month'})
3298 ? $options{'paystart_month'}
3299 : $self->paystart_month;
3301 my $paystart_year = exists($options{'paystart_year'})
3302 ? $options{'paystart_year'}
3303 : $self->paystart_year;
3305 $content{card_start} = "$paystart_month/$paystart_year"
3306 if $paystart_month && $paystart_year;
3308 my $payissue = exists($options{'payissue'})
3309 ? $options{'payissue'}
3311 $content{issue_number} = $payissue if $payissue;
3313 $content{recurring_billing} = 'YES'
3314 if qsearch('cust_pay', { 'custnum' => $self->custnum,
3316 'payinfo' => $payinfo,
3318 || qsearch('cust_pay', { 'custnum' => $self->custnum,
3320 'paymask' => $self->mask_payinfo('CARD', $payinfo),
3324 } elsif ( $method eq 'ECHECK' ) {
3325 ( $content{account_number}, $content{routing_code} ) =
3326 split('@', $payinfo);
3327 $content{bank_name} = $o_payname;
3328 $content{bank_state} = exists($options{'paystate'})
3329 ? $options{'paystate'}
3330 : $self->getfield('paystate');
3331 $content{account_type} = exists($options{'paytype'})
3332 ? uc($options{'paytype'}) || 'CHECKING'
3333 : uc($self->getfield('paytype')) || 'CHECKING';
3334 $content{account_name} = $payname;
3335 $content{customer_org} = $self->company ? 'B' : 'I';
3336 $content{state_id} = exists($options{'stateid'})
3337 ? $options{'stateid'}
3338 : $self->getfield('stateid');
3339 $content{state_id_state} = exists($options{'stateid_state'})
3340 ? $options{'stateid_state'}
3341 : $self->getfield('stateid_state');
3342 $content{customer_ssn} = exists($options{'ss'})
3345 } elsif ( $method eq 'LEC' ) {
3346 $content{phone} = $payinfo;
3350 # run transaction(s)
3353 my $balance = exists( $options{'balance'} )
3354 ? $options{'balance'}
3357 $self->select_for_update; #mutex ... just until we get our pending record in
3359 #the checks here are intended to catch concurrent payments
3360 #double-form-submission prevention is taken care of in cust_pay_pending::check
3363 return "The customer's balance has changed; $method transaction aborted."
3364 if $self->balance < $balance;
3365 #&& $self->balance < $amount; #might as well anyway?
3367 #also check and make sure there aren't *other* pending payments for this cust
3369 my @pending = qsearch('cust_pay_pending', {
3370 'custnum' => $self->custnum,
3371 'status' => { op=>'!=', value=>'done' }
3373 return "A payment is already being processed for this customer (".
3374 join(', ', map 'paypendingnum '. $_->paypendingnum, @pending ).
3375 "); $method transaction aborted."
3376 if scalar(@pending);
3378 #okay, good to go, if we're a duplicate, cust_pay_pending will kick us out
3380 my $cust_pay_pending = new FS::cust_pay_pending {
3381 'custnum' => $self->custnum,
3382 #'invnum' => $options{'invnum'},
3385 'payby' => $method2payby{$method},
3386 'payinfo' => $payinfo,
3387 'paydate' => $paydate,
3389 'gatewaynum' => ( $payment_gateway ? $payment_gateway->gatewaynum : '' ),
3391 $cust_pay_pending->payunique( $options{payunique} )
3392 if defined($options{payunique}) && length($options{payunique});
3393 my $cpp_new_err = $cust_pay_pending->insert; #mutex lost when this is inserted
3394 return $cpp_new_err if $cpp_new_err;
3396 my( $action1, $action2 ) = split(/\s*\,\s*/, $action );
3398 my $transaction = new Business::OnlinePayment( $processor, @bop_options );
3399 $transaction->content(
3402 'password' => $password,
3403 'action' => $action1,
3404 'description' => $options{'description'},
3405 'amount' => $amount,
3406 #'invoice_number' => $options{'invnum'},
3407 'customer_id' => $self->custnum,
3408 'last_name' => $paylast,
3409 'first_name' => $payfirst,
3411 'address' => $address,
3412 'city' => ( exists($options{'city'})
3415 'state' => ( exists($options{'state'})
3418 'zip' => ( exists($options{'zip'})
3421 'country' => ( exists($options{'country'})
3422 ? $options{'country'}
3424 'referer' => 'http://cleanwhisker.420.am/',
3426 'phone' => $self->daytime || $self->night,
3430 $cust_pay_pending->status('pending');
3431 my $cpp_pending_err = $cust_pay_pending->replace;
3432 return $cpp_pending_err if $cpp_pending_err;
3435 my $BOP_TESTING = 0;
3436 my $BOP_TESTING_SUCCESS = 1;
3438 unless ( $BOP_TESTING ) {
3439 $transaction->submit();
3441 if ( $BOP_TESTING_SUCCESS ) {
3442 $transaction->is_success(1);
3443 $transaction->authorization('fake auth');
3445 $transaction->is_success(0);
3446 $transaction->error_message('fake failure');
3450 if ( $transaction->is_success() && $action2 ) {
3452 $cust_pay_pending->status('authorized');
3453 my $cpp_authorized_err = $cust_pay_pending->replace;
3454 return $cpp_authorized_err if $cpp_authorized_err;
3456 my $auth = $transaction->authorization;
3457 my $ordernum = $transaction->can('order_number')
3458 ? $transaction->order_number
3462 new Business::OnlinePayment( $processor, @bop_options );
3469 password => $password,
3470 order_number => $ordernum,
3472 authorization => $auth,
3473 description => $options{'description'},
3476 foreach my $field (qw( authorization_source_code returned_ACI
3477 transaction_identifier validation_code
3478 transaction_sequence_num local_transaction_date
3479 local_transaction_time AVS_result_code )) {
3480 $capture{$field} = $transaction->$field() if $transaction->can($field);
3483 $capture->content( %capture );
3487 unless ( $capture->is_success ) {
3488 my $e = "Authorization successful but capture failed, custnum #".
3489 $self->custnum. ': '. $capture->result_code.
3490 ": ". $capture->error_message;
3497 $cust_pay_pending->status($transaction->is_success() ? 'captured' : 'declined');
3498 my $cpp_captured_err = $cust_pay_pending->replace;
3499 return $cpp_captured_err if $cpp_captured_err;
3502 # remove paycvv after initial transaction
3505 #false laziness w/misc/process/payment.cgi - check both to make sure working
3507 if ( defined $self->dbdef_table->column('paycvv')
3508 && length($self->paycvv)
3509 && ! grep { $_ eq cardtype($payinfo) } $conf->config('cvv-save')
3511 my $error = $self->remove_cvv;
3513 warn "WARNING: error removing cvv: $error\n";
3521 if ( $transaction->is_success() ) {
3524 if ( $payment_gateway ) { # agent override
3525 $paybatch = $payment_gateway->gatewaynum. '-';
3528 $paybatch .= "$processor:". $transaction->authorization;
3530 $paybatch .= ':'. $transaction->order_number
3531 if $transaction->can('order_number')
3532 && length($transaction->order_number);
3534 my $cust_pay = new FS::cust_pay ( {
3535 'custnum' => $self->custnum,
3536 'invnum' => $options{'invnum'},
3539 'payby' => $method2payby{$method},
3540 'payinfo' => $payinfo,
3541 'paybatch' => $paybatch,
3542 'paydate' => $paydate,
3544 #doesn't hurt to know, even though the dup check is in cust_pay_pending now
3545 $cust_pay->payunique( $options{payunique} )
3546 if defined($options{payunique}) && length($options{payunique});
3548 my $oldAutoCommit = $FS::UID::AutoCommit;
3549 local $FS::UID::AutoCommit = 0;
3552 #start a transaction, insert the cust_pay and set cust_pay_pending.status to done in a single transction
3554 my $error = $cust_pay->insert($options{'manual'} ? ( 'manual' => 1 ) : () );
3557 $cust_pay->invnum(''); #try again with no specific invnum
3558 my $error2 = $cust_pay->insert( $options{'manual'} ?
3559 ( 'manual' => 1 ) : ()
3562 # gah. but at least we have a record of the state we had to abort in
3563 # from cust_pay_pending now.
3564 my $e = "WARNING: $method captured but payment not recorded - ".
3565 "error inserting payment ($processor): $error2".
3566 " (previously tried insert with invnum #$options{'invnum'}" .
3567 ": $error ) - pending payment saved as paypendingnum ".
3568 $cust_pay_pending->paypendingnum. "\n";
3574 if ( $options{'paynum_ref'} ) {
3575 ${ $options{'paynum_ref'} } = $cust_pay->paynum;
3578 $cust_pay_pending->status('done');
3579 $cust_pay_pending->statustext('captured');
3580 my $cpp_done_err = $cust_pay_pending->replace;
3582 if ( $cpp_done_err ) {
3584 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
3585 my $e = "WARNING: $method captured but payment not recorded - ".
3586 "error updating status for paypendingnum ".
3587 $cust_pay_pending->paypendingnum. ": $cpp_done_err \n";
3593 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3594 return ''; #no error
3600 my $perror = "$processor error: ". $transaction->error_message;
3602 unless ( $transaction->error_message ) {
3605 if ( $transaction->can('response_page') ) {
3607 'page' => ( $transaction->can('response_page')
3608 ? $transaction->response_page
3611 'code' => ( $transaction->can('response_code')
3612 ? $transaction->response_code
3615 'headers' => ( $transaction->can('response_headers')
3616 ? $transaction->response_headers
3622 "No additional debugging information available for $processor";
3625 $perror .= "No error_message returned from $processor -- ".
3626 ( ref($t_response) ? Dumper($t_response) : $t_response );
3630 if ( !$options{'quiet'} && !$realtime_bop_decline_quiet
3631 && $conf->exists('emaildecline')
3632 && grep { $_ ne 'POST' } $self->invoicing_list
3633 && ! grep { $transaction->error_message =~ /$_/ }
3634 $conf->config('emaildecline-exclude')
3636 my @templ = $conf->config('declinetemplate');
3637 my $template = new Text::Template (
3639 SOURCE => [ map "$_\n", @templ ],
3640 ) or return "($perror) can't create template: $Text::Template::ERROR";
3641 $template->compile()
3642 or return "($perror) can't compile template: $Text::Template::ERROR";
3644 my $templ_hash = { error => $transaction->error_message };
3646 my $error = send_email(
3647 'from' => $conf->config('invoice_from'),
3648 'to' => [ grep { $_ ne 'POST' } $self->invoicing_list ],
3649 'subject' => 'Your payment could not be processed',
3650 'body' => [ $template->fill_in(HASH => $templ_hash) ],
3653 $perror .= " (also received error sending decline notification: $error)"
3658 $cust_pay_pending->status('done');
3659 $cust_pay_pending->statustext("declined: $perror");
3660 my $cpp_done_err = $cust_pay_pending->replace;
3661 if ( $cpp_done_err ) {
3662 my $e = "WARNING: $method declined but pending payment not resolved - ".
3663 "error updating status for paypendingnum ".
3664 $cust_pay_pending->paypendingnum. ": $cpp_done_err \n";
3666 $perror = "$e ($perror)";
3679 my( $self, $method, $amount, %options ) = @_;
3681 if ( $options{'fake_failure'} ) {
3682 return "Error: No error; test failure requested with fake_failure";
3685 my %method2payby = (
3692 #if ( $payment_gateway ) { # agent override
3693 # $paybatch = $payment_gateway->gatewaynum. '-';
3696 #$paybatch .= "$processor:". $transaction->authorization;
3698 #$paybatch .= ':'. $transaction->order_number
3699 # if $transaction->can('order_number')
3700 # && length($transaction->order_number);
3702 my $paybatch = 'FakeProcessor:54:32';
3704 my $cust_pay = new FS::cust_pay ( {
3705 'custnum' => $self->custnum,
3706 'invnum' => $options{'invnum'},
3709 'payby' => $method2payby{$method},
3710 #'payinfo' => $payinfo,
3711 'payinfo' => '4111111111111111',
3712 'paybatch' => $paybatch,
3713 #'paydate' => $paydate,
3714 'paydate' => '2012-05-01',
3716 $cust_pay->payunique( $options{payunique} ) if length($options{payunique});
3718 my $error = $cust_pay->insert($options{'manual'} ? ( 'manual' => 1 ) : () );
3721 $cust_pay->invnum(''); #try again with no specific invnum
3722 my $error2 = $cust_pay->insert( $options{'manual'} ?
3723 ( 'manual' => 1 ) : ()
3726 # gah, even with transactions.
3727 my $e = 'WARNING: Card/ACH debited but database not updated - '.
3728 "error inserting (fake!) payment: $error2".
3729 " (previously tried insert with invnum #$options{'invnum'}" .
3736 if ( $options{'paynum_ref'} ) {
3737 ${ $options{'paynum_ref'} } = $cust_pay->paynum;
3740 return ''; #no error
3744 =item default_payment_gateway
3748 sub default_payment_gateway {
3749 my( $self, $method ) = @_;
3751 die "Real-time processing not enabled\n"
3752 unless $conf->exists('business-onlinepayment');
3755 my $bop_config = 'business-onlinepayment';
3756 $bop_config .= '-ach'
3757 if $method =~ /^(ECHECK|CHEK)$/ && $conf->exists($bop_config. '-ach');
3758 my ( $processor, $login, $password, $action, @bop_options ) =
3759 $conf->config($bop_config);
3760 $action ||= 'normal authorization';
3761 pop @bop_options if scalar(@bop_options) % 2 && $bop_options[-1] =~ /^\s*$/;
3762 die "No real-time processor is enabled - ".
3763 "did you set the business-onlinepayment configuration value?\n"
3766 ( $processor, $login, $password, $action, @bop_options )
3771 Removes the I<paycvv> field from the database directly.
3773 If there is an error, returns the error, otherwise returns false.
3779 my $sth = dbh->prepare("UPDATE cust_main SET paycvv = '' WHERE custnum = ?")
3780 or return dbh->errstr;
3781 $sth->execute($self->custnum)
3782 or return $sth->errstr;
3787 =item realtime_refund_bop METHOD [ OPTION => VALUE ... ]
3789 Refunds a realtime credit card, ACH (electronic check) or phone bill transaction
3790 via a Business::OnlinePayment realtime gateway. See
3791 L<http://420.am/business-onlinepayment> for supported gateways.
3793 Available methods are: I<CC>, I<ECHECK> and I<LEC>
3795 Available options are: I<amount>, I<reason>, I<paynum>, I<paydate>
3797 Most gateways require a reference to an original payment transaction to refund,
3798 so you probably need to specify a I<paynum>.
3800 I<amount> defaults to the original amount of the payment if not specified.
3802 I<reason> specifies a reason for the refund.
3804 I<paydate> specifies the expiration date for a credit card overriding the
3805 value from the customer record or the payment record. Specified as yyyy-mm-dd
3807 Implementation note: If I<amount> is unspecified or equal to the amount of the
3808 orignal payment, first an attempt is made to "void" the transaction via
3809 the gateway (to cancel a not-yet settled transaction) and then if that fails,
3810 the normal attempt is made to "refund" ("credit") the transaction via the
3811 gateway is attempted.
3813 #The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
3814 #I<zip>, I<payinfo> and I<paydate> are also available. Any of these options,
3815 #if set, will override the value from the customer record.
3817 #If an I<invnum> is specified, this payment (if successful) is applied to the
3818 #specified invoice. If you don't specify an I<invnum> you might want to
3819 #call the B<apply_payments> method.
3823 #some false laziness w/realtime_bop, not enough to make it worth merging
3824 #but some useful small subs should be pulled out
3825 sub realtime_refund_bop {
3826 my( $self, $method, %options ) = @_;
3828 warn "$me realtime_refund_bop: $method refund\n";
3829 warn " $_ => $options{$_}\n" foreach keys %options;
3832 eval "use Business::OnlinePayment";
3836 # look up the original payment and optionally a gateway for that payment
3840 my $amount = $options{'amount'};
3842 my( $processor, $login, $password, @bop_options ) ;
3843 my( $auth, $order_number ) = ( '', '', '' );
3845 if ( $options{'paynum'} ) {
3847 warn " paynum: $options{paynum}\n" if $DEBUG > 1;
3848 $cust_pay = qsearchs('cust_pay', { paynum=>$options{'paynum'} } )
3849 or return "Unknown paynum $options{'paynum'}";
3850 $amount ||= $cust_pay->paid;
3852 $cust_pay->paybatch =~ /^((\d+)\-)?(\w+):\s*([\w\-\/ ]*)(:([\w\-]+))?$/
3853 or return "Can't parse paybatch for paynum $options{'paynum'}: ".
3854 $cust_pay->paybatch;
3855 my $gatewaynum = '';
3856 ( $gatewaynum, $processor, $auth, $order_number ) = ( $2, $3, $4, $6 );
3858 if ( $gatewaynum ) { #gateway for the payment to be refunded
3860 my $payment_gateway =
3861 qsearchs('payment_gateway', { 'gatewaynum' => $gatewaynum } );
3862 die "payment gateway $gatewaynum not found"
3863 unless $payment_gateway;
3865 $processor = $payment_gateway->gateway_module;
3866 $login = $payment_gateway->gateway_username;
3867 $password = $payment_gateway->gateway_password;
3868 @bop_options = $payment_gateway->options;
3870 } else { #try the default gateway
3872 my( $conf_processor, $unused_action );
3873 ( $conf_processor, $login, $password, $unused_action, @bop_options ) =
3874 $self->default_payment_gateway($method);
3876 return "processor of payment $options{'paynum'} $processor does not".
3877 " match default processor $conf_processor"
3878 unless $processor eq $conf_processor;
3883 } else { # didn't specify a paynum, so look for agent gateway overrides
3884 # like a normal transaction
3887 if ( $method eq 'CC' ) {
3888 $cardtype = cardtype($self->payinfo);
3889 } elsif ( $method eq 'ECHECK' ) {
3892 $cardtype = $method;
3895 qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
3896 cardtype => $cardtype,
3898 || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
3900 taxclass => '', } );
3902 if ( $override ) { #use a payment gateway override
3904 my $payment_gateway = $override->payment_gateway;
3906 $processor = $payment_gateway->gateway_module;
3907 $login = $payment_gateway->gateway_username;
3908 $password = $payment_gateway->gateway_password;
3909 #$action = $payment_gateway->gateway_action;
3910 @bop_options = $payment_gateway->options;
3912 } else { #use the standard settings from the config
3915 ( $processor, $login, $password, $unused_action, @bop_options ) =
3916 $self->default_payment_gateway($method);
3921 return "neither amount nor paynum specified" unless $amount;
3926 'password' => $password,
3927 'order_number' => $order_number,
3928 'amount' => $amount,
3929 'referer' => 'http://cleanwhisker.420.am/',
3931 $content{authorization} = $auth
3932 if length($auth); #echeck/ACH transactions have an order # but no auth
3933 #(at least with authorize.net)
3935 my $disable_void_after;
3936 if ($conf->exists('disable_void_after')
3937 && $conf->config('disable_void_after') =~ /^(\d+)$/) {
3938 $disable_void_after = $1;
3941 #first try void if applicable
3942 if ( $cust_pay && $cust_pay->paid == $amount
3944 ( not defined($disable_void_after) )
3945 || ( time < ($cust_pay->_date + $disable_void_after ) )
3948 warn " attempting void\n" if $DEBUG > 1;
3949 my $void = new Business::OnlinePayment( $processor, @bop_options );
3950 $void->content( 'action' => 'void', %content );
3952 if ( $void->is_success ) {
3953 my $error = $cust_pay->void($options{'reason'});
3955 # gah, even with transactions.
3956 my $e = 'WARNING: Card/ACH voided but database not updated - '.
3957 "error voiding payment: $error";
3961 warn " void successful\n" if $DEBUG > 1;
3966 warn " void unsuccessful, trying refund\n"
3970 my $address = $self->address1;
3971 $address .= ", ". $self->address2 if $self->address2;
3973 my($payname, $payfirst, $paylast);
3974 if ( $self->payname && $method ne 'ECHECK' ) {
3975 $payname = $self->payname;
3976 $payname =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
3977 or return "Illegal payname $payname";
3978 ($payfirst, $paylast) = ($1, $2);
3980 $payfirst = $self->getfield('first');
3981 $paylast = $self->getfield('last');
3982 $payname = "$payfirst $paylast";
3985 my @invoicing_list = $self->invoicing_list_emailonly;
3986 if ( $conf->exists('emailinvoiceautoalways')
3987 || $conf->exists('emailinvoiceauto') && ! @invoicing_list
3988 || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
3989 push @invoicing_list, $self->all_emails;
3992 my $email = ($conf->exists('business-onlinepayment-email-override'))
3993 ? $conf->config('business-onlinepayment-email-override')
3994 : $invoicing_list[0];
3996 my $payip = exists($options{'payip'})
3999 $content{customer_ip} = $payip
4003 if ( $method eq 'CC' ) {
4006 $content{card_number} = $payinfo = $cust_pay->payinfo;
4007 (exists($options{'paydate'}) ? $options{'paydate'} : $cust_pay->paydate)
4008 =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/ &&
4009 ($content{expiration} = "$2/$1"); # where available
4011 $content{card_number} = $payinfo = $self->payinfo;
4012 (exists($options{'paydate'}) ? $options{'paydate'} : $self->paydate)
4013 =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
4014 $content{expiration} = "$2/$1";
4017 } elsif ( $method eq 'ECHECK' ) {
4020 $payinfo = $cust_pay->payinfo;
4022 $payinfo = $self->payinfo;
4024 ( $content{account_number}, $content{routing_code} )= split('@', $payinfo );
4025 $content{bank_name} = $self->payname;
4026 $content{account_type} = 'CHECKING';
4027 $content{account_name} = $payname;
4028 $content{customer_org} = $self->company ? 'B' : 'I';
4029 $content{customer_ssn} = $self->ss;
4030 } elsif ( $method eq 'LEC' ) {
4031 $content{phone} = $payinfo = $self->payinfo;
4035 my $refund = new Business::OnlinePayment( $processor, @bop_options );
4036 my %sub_content = $refund->content(
4037 'action' => 'credit',
4038 'customer_id' => $self->custnum,
4039 'last_name' => $paylast,
4040 'first_name' => $payfirst,
4042 'address' => $address,
4043 'city' => $self->city,
4044 'state' => $self->state,
4045 'zip' => $self->zip,
4046 'country' => $self->country,
4048 'phone' => $self->daytime || $self->night,
4051 warn join('', map { " $_ => $sub_content{$_}\n" } keys %sub_content )
4055 return "$processor error: ". $refund->error_message
4056 unless $refund->is_success();
4058 my %method2payby = (
4064 my $paybatch = "$processor:". $refund->authorization;
4065 $paybatch .= ':'. $refund->order_number
4066 if $refund->can('order_number') && $refund->order_number;
4068 while ( $cust_pay && $cust_pay->unapplied < $amount ) {
4069 my @cust_bill_pay = $cust_pay->cust_bill_pay;
4070 last unless @cust_bill_pay;
4071 my $cust_bill_pay = pop @cust_bill_pay;
4072 my $error = $cust_bill_pay->delete;
4076 my $cust_refund = new FS::cust_refund ( {
4077 'custnum' => $self->custnum,
4078 'paynum' => $options{'paynum'},
4079 'refund' => $amount,
4081 'payby' => $method2payby{$method},
4082 'payinfo' => $payinfo,
4083 'paybatch' => $paybatch,
4084 'reason' => $options{'reason'} || 'card or ACH refund',
4086 my $error = $cust_refund->insert;
4088 $cust_refund->paynum(''); #try again with no specific paynum
4089 my $error2 = $cust_refund->insert;
4091 # gah, even with transactions.
4092 my $e = 'WARNING: Card/ACH refunded but database not updated - '.
4093 "error inserting refund ($processor): $error2".
4094 " (previously tried insert with paynum #$options{'paynum'}" .
4105 =item batch_card OPTION => VALUE...
4107 Adds a payment for this invoice to the pending credit card batch (see
4108 L<FS::cust_pay_batch>), or, if the B<realtime> option is set to a true value,
4109 runs the payment using a realtime gateway.
4114 my ($self, %options) = @_;
4117 if (exists($options{amount})) {
4118 $amount = $options{amount};
4120 $amount = sprintf("%.2f", $self->balance - $self->in_transit_payments);
4122 return '' unless $amount > 0;
4124 my $invnum = delete $options{invnum};
4125 my $payby = $options{invnum} || $self->payby; #dubious
4127 if ($options{'realtime'}) {
4128 return $self->realtime_bop( FS::payby->payby2bop($self->payby),
4134 my $oldAutoCommit = $FS::UID::AutoCommit;
4135 local $FS::UID::AutoCommit = 0;
4138 #this needs to handle mysql as well as Pg, like svc_acct.pm
4139 #(make it into a common function if folks need to do batching with mysql)
4140 $dbh->do("LOCK TABLE pay_batch IN SHARE ROW EXCLUSIVE MODE")
4141 or return "Cannot lock pay_batch: " . $dbh->errstr;
4145 'payby' => FS::payby->payby2payment($payby),
4148 my $pay_batch = qsearchs( 'pay_batch', \%pay_batch );
4150 unless ( $pay_batch ) {
4151 $pay_batch = new FS::pay_batch \%pay_batch;
4152 my $error = $pay_batch->insert;
4154 $dbh->rollback if $oldAutoCommit;
4155 die "error creating new batch: $error\n";
4159 my $old_cust_pay_batch = qsearchs('cust_pay_batch', {
4160 'batchnum' => $pay_batch->batchnum,
4161 'custnum' => $self->custnum,
4164 foreach (qw( address1 address2 city state zip country payby payinfo paydate
4166 $options{$_} = '' unless exists($options{$_});
4169 my $cust_pay_batch = new FS::cust_pay_batch ( {
4170 'batchnum' => $pay_batch->batchnum,
4171 'invnum' => $invnum || 0, # is there a better value?
4172 # this field should be
4174 # cust_bill_pay_batch now
4175 'custnum' => $self->custnum,
4176 'last' => $self->getfield('last'),
4177 'first' => $self->getfield('first'),
4178 'address1' => $options{address1} || $self->address1,
4179 'address2' => $options{address2} || $self->address2,
4180 'city' => $options{city} || $self->city,
4181 'state' => $options{state} || $self->state,
4182 'zip' => $options{zip} || $self->zip,
4183 'country' => $options{country} || $self->country,
4184 'payby' => $options{payby} || $self->payby,
4185 'payinfo' => $options{payinfo} || $self->payinfo,
4186 'exp' => $options{paydate} || $self->paydate,
4187 'payname' => $options{payname} || $self->payname,
4188 'amount' => $amount, # consolidating
4191 $cust_pay_batch->paybatchnum($old_cust_pay_batch->paybatchnum)
4192 if $old_cust_pay_batch;
4195 if ($old_cust_pay_batch) {
4196 $error = $cust_pay_batch->replace($old_cust_pay_batch)
4198 $error = $cust_pay_batch->insert;
4202 $dbh->rollback if $oldAutoCommit;
4206 my $unapplied = $self->total_credited + $self->total_unapplied_payments + $self->in_transit_payments;
4207 foreach my $cust_bill ($self->open_cust_bill) {
4208 #$dbh->commit or die $dbh->errstr if $oldAutoCommit;
4209 my $cust_bill_pay_batch = new FS::cust_bill_pay_batch {
4210 'invnum' => $cust_bill->invnum,
4211 'paybatchnum' => $cust_pay_batch->paybatchnum,
4212 'amount' => $cust_bill->owed,
4215 if ($unapplied >= $cust_bill_pay_batch->amount){
4216 $unapplied -= $cust_bill_pay_batch->amount;
4219 $cust_bill_pay_batch->amount(sprintf ( "%.2f",
4220 $cust_bill_pay_batch->amount - $unapplied )); $unapplied = 0;
4222 $error = $cust_bill_pay_batch->insert;
4224 $dbh->rollback if $oldAutoCommit;
4229 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4235 Returns the total owed for this customer on all invoices
4236 (see L<FS::cust_bill/owed>).
4242 $self->total_owed_date(2145859200); #12/31/2037
4245 =item total_owed_date TIME
4247 Returns the total owed for this customer on all invoices with date earlier than
4248 TIME. TIME is specified as a UNIX timestamp; see L<perlfunc/"time">). Also
4249 see L<Time::Local> and L<Date::Parse> for conversion functions.
4253 sub total_owed_date {
4257 foreach my $cust_bill (
4258 grep { $_->_date <= $time }
4259 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
4261 $total_bill += $cust_bill->owed;
4263 sprintf( "%.2f", $total_bill );
4266 =item apply_payments_and_credits
4268 Applies unapplied payments and credits.
4270 In most cases, this new method should be used in place of sequential
4271 apply_payments and apply_credits methods.
4273 If there is an error, returns the error, otherwise returns false.
4277 sub apply_payments_and_credits {
4280 local $SIG{HUP} = 'IGNORE';
4281 local $SIG{INT} = 'IGNORE';
4282 local $SIG{QUIT} = 'IGNORE';
4283 local $SIG{TERM} = 'IGNORE';
4284 local $SIG{TSTP} = 'IGNORE';
4285 local $SIG{PIPE} = 'IGNORE';
4287 my $oldAutoCommit = $FS::UID::AutoCommit;
4288 local $FS::UID::AutoCommit = 0;
4291 $self->select_for_update; #mutex
4293 foreach my $cust_bill ( $self->open_cust_bill ) {
4294 my $error = $cust_bill->apply_payments_and_credits;
4296 $dbh->rollback if $oldAutoCommit;
4297 return "Error applying: $error";
4301 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4306 =item apply_credits OPTION => VALUE ...
4308 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
4309 to outstanding invoice balances in chronological order (or reverse
4310 chronological order if the I<order> option is set to B<newest>) and returns the
4311 value of any remaining unapplied credits available for refund (see
4312 L<FS::cust_refund>).
4314 Dies if there is an error.
4322 local $SIG{HUP} = 'IGNORE';
4323 local $SIG{INT} = 'IGNORE';
4324 local $SIG{QUIT} = 'IGNORE';
4325 local $SIG{TERM} = 'IGNORE';
4326 local $SIG{TSTP} = 'IGNORE';
4327 local $SIG{PIPE} = 'IGNORE';
4329 my $oldAutoCommit = $FS::UID::AutoCommit;
4330 local $FS::UID::AutoCommit = 0;
4333 $self->select_for_update; #mutex
4335 unless ( $self->total_credited ) {
4336 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4340 my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
4341 qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
4343 my @invoices = $self->open_cust_bill;
4344 @invoices = sort { $b->_date <=> $a->_date } @invoices
4345 if defined($opt{'order'}) && $opt{'order'} eq 'newest';
4348 foreach my $cust_bill ( @invoices ) {
4351 if ( !defined($credit) || $credit->credited == 0) {
4352 $credit = pop @credits or last;
4355 if ($cust_bill->owed >= $credit->credited) {
4356 $amount=$credit->credited;
4358 $amount=$cust_bill->owed;
4361 my $cust_credit_bill = new FS::cust_credit_bill ( {
4362 'crednum' => $credit->crednum,
4363 'invnum' => $cust_bill->invnum,
4364 'amount' => $amount,
4366 my $error = $cust_credit_bill->insert;
4368 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
4372 redo if ($cust_bill->owed > 0);
4376 my $total_credited = $self->total_credited;
4378 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4380 return $total_credited;
4383 =item apply_payments
4385 Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
4386 to outstanding invoice balances in chronological order.
4388 #and returns the value of any remaining unapplied payments.
4390 Dies if there is an error.
4394 sub apply_payments {
4397 local $SIG{HUP} = 'IGNORE';
4398 local $SIG{INT} = 'IGNORE';
4399 local $SIG{QUIT} = 'IGNORE';
4400 local $SIG{TERM} = 'IGNORE';
4401 local $SIG{TSTP} = 'IGNORE';
4402 local $SIG{PIPE} = 'IGNORE';
4404 my $oldAutoCommit = $FS::UID::AutoCommit;
4405 local $FS::UID::AutoCommit = 0;
4408 $self->select_for_update; #mutex
4412 my @payments = sort { $b->_date <=> $a->_date } ( grep { $_->unapplied > 0 }
4413 qsearch('cust_pay', { 'custnum' => $self->custnum } ) );
4415 my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
4416 qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
4420 foreach my $cust_bill ( @invoices ) {
4423 if ( !defined($payment) || $payment->unapplied == 0 ) {
4424 $payment = pop @payments or last;
4427 if ( $cust_bill->owed >= $payment->unapplied ) {
4428 $amount = $payment->unapplied;
4430 $amount = $cust_bill->owed;
4433 my $cust_bill_pay = new FS::cust_bill_pay ( {
4434 'paynum' => $payment->paynum,
4435 'invnum' => $cust_bill->invnum,
4436 'amount' => $amount,
4438 my $error = $cust_bill_pay->insert;
4440 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
4444 redo if ( $cust_bill->owed > 0);
4448 my $total_unapplied_payments = $self->total_unapplied_payments;
4450 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4452 return $total_unapplied_payments;
4455 =item total_credited
4457 Returns the total outstanding credit (see L<FS::cust_credit>) for this
4458 customer. See L<FS::cust_credit/credited>.
4462 sub total_credited {
4464 my $total_credit = 0;
4465 foreach my $cust_credit ( qsearch('cust_credit', {
4466 'custnum' => $self->custnum,
4468 $total_credit += $cust_credit->credited;
4470 sprintf( "%.2f", $total_credit );
4473 =item total_unapplied_payments
4475 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
4476 See L<FS::cust_pay/unapplied>.
4480 sub total_unapplied_payments {
4482 my $total_unapplied = 0;
4483 foreach my $cust_pay ( qsearch('cust_pay', {
4484 'custnum' => $self->custnum,
4486 $total_unapplied += $cust_pay->unapplied;
4488 sprintf( "%.2f", $total_unapplied );
4491 =item total_unapplied_refunds
4493 Returns the total unrefunded refunds (see L<FS::cust_refund>) for this
4494 customer. See L<FS::cust_refund/unapplied>.
4498 sub total_unapplied_refunds {
4500 my $total_unapplied = 0;
4501 foreach my $cust_refund ( qsearch('cust_refund', {
4502 'custnum' => $self->custnum,
4504 $total_unapplied += $cust_refund->unapplied;
4506 sprintf( "%.2f", $total_unapplied );
4511 Returns the balance for this customer (total_owed plus total_unrefunded, minus
4512 total_credited minus total_unapplied_payments).
4520 + $self->total_unapplied_refunds
4521 - $self->total_credited
4522 - $self->total_unapplied_payments
4526 =item balance_date TIME
4528 Returns the balance for this customer, only considering invoices with date
4529 earlier than TIME (total_owed_date minus total_credited minus
4530 total_unapplied_payments). TIME is specified as a UNIX timestamp; see
4531 L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion
4540 $self->total_owed_date($time)
4541 + $self->total_unapplied_refunds
4542 - $self->total_credited
4543 - $self->total_unapplied_payments
4547 =item in_transit_payments
4549 Returns the total of requests for payments for this customer pending in
4550 batches in transit to the bank. See L<FS::pay_batch> and L<FS::cust_pay_batch>
4554 sub in_transit_payments {
4556 my $in_transit_payments = 0;
4557 foreach my $pay_batch ( qsearch('pay_batch', {
4560 foreach my $cust_pay_batch ( qsearch('cust_pay_batch', {
4561 'batchnum' => $pay_batch->batchnum,
4562 'custnum' => $self->custnum,
4564 $in_transit_payments += $cust_pay_batch->amount;
4567 sprintf( "%.2f", $in_transit_payments );
4570 =item paydate_monthyear
4572 Returns a two-element list consisting of the month and year of this customer's
4573 paydate (credit card expiration date for CARD customers)
4577 sub paydate_monthyear {
4579 if ( $self->paydate =~ /^(\d{4})-(\d{1,2})-\d{1,2}$/ ) { #Pg date format
4581 } elsif ( $self->paydate =~ /^(\d{1,2})-(\d{1,2}-)?(\d{4}$)/ ) {
4588 =item invoicing_list [ ARRAYREF ]
4590 If an arguement is given, sets these email addresses as invoice recipients
4591 (see L<FS::cust_main_invoice>). Errors are not fatal and are not reported
4592 (except as warnings), so use check_invoicing_list first.
4594 Returns a list of email addresses (with svcnum entries expanded).
4596 Note: You can clear the invoicing list by passing an empty ARRAYREF. You can
4597 check it without disturbing anything by passing nothing.
4599 This interface may change in the future.
4603 sub invoicing_list {
4604 my( $self, $arrayref ) = @_;
4607 my @cust_main_invoice;
4608 if ( $self->custnum ) {
4609 @cust_main_invoice =
4610 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
4612 @cust_main_invoice = ();
4614 foreach my $cust_main_invoice ( @cust_main_invoice ) {
4615 #warn $cust_main_invoice->destnum;
4616 unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
4617 #warn $cust_main_invoice->destnum;
4618 my $error = $cust_main_invoice->delete;
4619 warn $error if $error;
4622 if ( $self->custnum ) {
4623 @cust_main_invoice =
4624 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
4626 @cust_main_invoice = ();
4628 my %seen = map { $_->address => 1 } @cust_main_invoice;
4629 foreach my $address ( @{$arrayref} ) {
4630 next if exists $seen{$address} && $seen{$address};
4631 $seen{$address} = 1;
4632 my $cust_main_invoice = new FS::cust_main_invoice ( {
4633 'custnum' => $self->custnum,
4636 my $error = $cust_main_invoice->insert;
4637 warn $error if $error;
4641 if ( $self->custnum ) {
4643 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
4650 =item check_invoicing_list ARRAYREF
4652 Checks these arguements as valid input for the invoicing_list method. If there
4653 is an error, returns the error, otherwise returns false.
4657 sub check_invoicing_list {
4658 my( $self, $arrayref ) = @_;
4660 foreach my $address ( @$arrayref ) {
4662 if ($address eq 'FAX' and $self->getfield('fax') eq '') {
4663 return 'Can\'t add FAX invoice destination with a blank FAX number.';
4666 my $cust_main_invoice = new FS::cust_main_invoice ( {
4667 'custnum' => $self->custnum,
4670 my $error = $self->custnum
4671 ? $cust_main_invoice->check
4672 : $cust_main_invoice->checkdest
4674 return $error if $error;
4678 return "Email address required"
4679 if $conf->exists('cust_main-require_invoicing_list_email')
4680 && ! grep { $_ !~ /^([A-Z]+)$/ } @$arrayref;
4685 =item set_default_invoicing_list
4687 Sets the invoicing list to all accounts associated with this customer,
4688 overwriting any previous invoicing list.
4692 sub set_default_invoicing_list {
4694 $self->invoicing_list($self->all_emails);
4699 Returns the email addresses of all accounts provisioned for this customer.
4706 foreach my $cust_pkg ( $self->all_pkgs ) {
4707 my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
4709 map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
4710 grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
4712 $list{$_}=1 foreach map { $_->email } @svc_acct;
4717 =item invoicing_list_addpost
4719 Adds postal invoicing to this customer. If this customer is already configured
4720 to receive postal invoices, does nothing.
4724 sub invoicing_list_addpost {
4726 return if grep { $_ eq 'POST' } $self->invoicing_list;
4727 my @invoicing_list = $self->invoicing_list;
4728 push @invoicing_list, 'POST';
4729 $self->invoicing_list(\@invoicing_list);
4732 =item invoicing_list_emailonly
4734 Returns the list of email invoice recipients (invoicing_list without non-email
4735 destinations such as POST and FAX).
4739 sub invoicing_list_emailonly {
4741 warn "$me invoicing_list_emailonly called"
4743 grep { $_ !~ /^([A-Z]+)$/ } $self->invoicing_list;
4746 =item invoicing_list_emailonly_scalar
4748 Returns the list of email invoice recipients (invoicing_list without non-email
4749 destinations such as POST and FAX) as a comma-separated scalar.
4753 sub invoicing_list_emailonly_scalar {
4755 warn "$me invoicing_list_emailonly_scalar called"
4757 join(', ', $self->invoicing_list_emailonly);
4760 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
4762 Returns an array of customers referred by this customer (referral_custnum set
4763 to this custnum). If DEPTH is given, recurses up to the given depth, returning
4764 customers referred by customers referred by this customer and so on, inclusive.
4765 The default behavior is DEPTH 1 (no recursion).
4769 sub referral_cust_main {
4771 my $depth = @_ ? shift : 1;
4772 my $exclude = @_ ? shift : {};
4775 map { $exclude->{$_->custnum}++; $_; }
4776 grep { ! $exclude->{ $_->custnum } }
4777 qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
4781 map { $_->referral_cust_main($depth-1, $exclude) }
4788 =item referral_cust_main_ncancelled
4790 Same as referral_cust_main, except only returns customers with uncancelled
4795 sub referral_cust_main_ncancelled {
4797 grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
4800 =item referral_cust_pkg [ DEPTH ]
4802 Like referral_cust_main, except returns a flat list of all unsuspended (and
4803 uncancelled) packages for each customer. The number of items in this list may
4804 be useful for comission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
4808 sub referral_cust_pkg {
4810 my $depth = @_ ? shift : 1;
4812 map { $_->unsuspended_pkgs }
4813 grep { $_->unsuspended_pkgs }
4814 $self->referral_cust_main($depth);
4817 =item referring_cust_main
4819 Returns the single cust_main record for the customer who referred this customer
4820 (referral_custnum), or false.
4824 sub referring_cust_main {
4826 return '' unless $self->referral_custnum;
4827 qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
4830 =item credit AMOUNT, REASON
4832 Applies a credit to this customer. If there is an error, returns the error,
4833 otherwise returns false.
4838 my( $self, $amount, $reason, %options ) = @_;
4839 my $cust_credit = new FS::cust_credit {
4840 'custnum' => $self->custnum,
4841 'amount' => $amount,
4842 'reason' => $reason,
4844 $cust_credit->insert(%options);
4847 =item charge AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
4849 Creates a one-time charge for this customer. If there is an error, returns
4850 the error, otherwise returns false.
4856 my ( $amount, $quantity, $pkg, $comment, $taxclass, $additional, $classnum );
4857 my ( $taxproduct, $override );
4858 if ( ref( $_[0] ) ) {
4859 $amount = $_[0]->{amount};
4860 $quantity = exists($_[0]->{quantity}) ? $_[0]->{quantity} : 1;
4861 $pkg = exists($_[0]->{pkg}) ? $_[0]->{pkg} : 'One-time charge';
4862 $comment = exists($_[0]->{comment}) ? $_[0]->{comment}
4863 : '$'. sprintf("%.2f",$amount);
4864 $taxclass = exists($_[0]->{taxclass}) ? $_[0]->{taxclass} : '';
4865 $classnum = exists($_[0]->{classnum}) ? $_[0]->{classnum} : '';
4866 $additional = $_[0]->{additional};
4867 $taxproduct = $_[0]->{taxproductnum};
4868 $override = { '' => $_[0]->{tax_override} };
4872 $pkg = @_ ? shift : 'One-time charge';
4873 $comment = @_ ? shift : '$'. sprintf("%.2f",$amount);
4874 $taxclass = @_ ? shift : '';
4878 local $SIG{HUP} = 'IGNORE';
4879 local $SIG{INT} = 'IGNORE';
4880 local $SIG{QUIT} = 'IGNORE';
4881 local $SIG{TERM} = 'IGNORE';
4882 local $SIG{TSTP} = 'IGNORE';
4883 local $SIG{PIPE} = 'IGNORE';
4885 my $oldAutoCommit = $FS::UID::AutoCommit;
4886 local $FS::UID::AutoCommit = 0;
4889 my $part_pkg = new FS::part_pkg ( {
4891 'comment' => $comment,
4895 'classnum' => $classnum ? $classnum : '',
4896 'taxclass' => $taxclass,
4897 'taxproductnum' => $taxproduct,
4900 my %options = ( ( map { ("additional_info$_" => $additional->[$_] ) }
4901 ( 0 .. @$additional - 1 )
4903 'additional_count' => scalar(@$additional),
4904 'setup_fee' => $amount,
4907 my $error = $part_pkg->insert( options => \%options,
4908 tax_overrides => $override,
4911 $dbh->rollback if $oldAutoCommit;
4915 my $pkgpart = $part_pkg->pkgpart;
4916 my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
4917 unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
4918 my $type_pkgs = new FS::type_pkgs \%type_pkgs;
4919 $error = $type_pkgs->insert;
4921 $dbh->rollback if $oldAutoCommit;
4926 my $cust_pkg = new FS::cust_pkg ( {
4927 'custnum' => $self->custnum,
4928 'pkgpart' => $pkgpart,
4929 'quantity' => $quantity,
4932 $error = $cust_pkg->insert;
4934 $dbh->rollback if $oldAutoCommit;
4938 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4943 #=item charge_postal_fee
4945 #Applies a one time charge this customer. If there is an error,
4946 #returns the error, returns the cust_pkg charge object or false
4947 #if there was no charge.
4951 # This should be a customer event. For that to work requires that bill
4952 # also be a customer event.
4954 sub charge_postal_fee {
4957 my $pkgpart = $conf->config('postal_invoice-fee_pkgpart');
4958 return '' unless ($pkgpart && grep { $_ eq 'POST' } $self->invoicing_list);
4960 my $cust_pkg = new FS::cust_pkg ( {
4961 'custnum' => $self->custnum,
4962 'pkgpart' => $pkgpart,
4966 my $error = $cust_pkg->insert;
4967 $error ? $error : $cust_pkg;
4972 Returns all the invoices (see L<FS::cust_bill>) for this customer.
4978 sort { $a->_date <=> $b->_date }
4979 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
4982 =item open_cust_bill
4984 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
4989 sub open_cust_bill {
4991 grep { $_->owed > 0 } $self->cust_bill;
4996 Returns all the credits (see L<FS::cust_credit>) for this customer.
5002 sort { $a->_date <=> $b->_date }
5003 qsearch( 'cust_credit', { 'custnum' => $self->custnum } )
5008 Returns all the payments (see L<FS::cust_pay>) for this customer.
5014 sort { $a->_date <=> $b->_date }
5015 qsearch( 'cust_pay', { 'custnum' => $self->custnum } )
5020 Returns all voided payments (see L<FS::cust_pay_void>) for this customer.
5026 sort { $a->_date <=> $b->_date }
5027 qsearch( 'cust_pay_void', { 'custnum' => $self->custnum } )
5030 =item cust_pay_batch
5032 Returns all batched payments (see L<FS::cust_pay_void>) for this customer.
5036 sub cust_pay_batch {
5038 sort { $a->_date <=> $b->_date }
5039 qsearch( 'cust_pay_batch', { 'custnum' => $self->custnum } )
5044 Returns all the refunds (see L<FS::cust_refund>) for this customer.
5050 sort { $a->_date <=> $b->_date }
5051 qsearch( 'cust_refund', { 'custnum' => $self->custnum } )
5056 Returns a name string for this customer, either "Company (Last, First)" or
5063 my $name = $self->contact;
5064 $name = $self->company. " ($name)" if $self->company;
5070 Returns a name string for this (service/shipping) contact, either
5071 "Company (Last, First)" or "Last, First".
5077 if ( $self->get('ship_last') ) {
5078 my $name = $self->ship_contact;
5079 $name = $self->ship_company. " ($name)" if $self->ship_company;
5088 Returns this customer's full (billing) contact name only, "Last, First"
5094 $self->get('last'). ', '. $self->first;
5099 Returns this customer's full (shipping) contact name only, "Last, First"
5105 $self->get('ship_last')
5106 ? $self->get('ship_last'). ', '. $self->ship_first
5112 Returns this customer's full country name
5118 code2country($self->country);
5121 =item geocode DATA_VENDOR
5123 Returns a value for the customer location as encoded by DATA_VENDOR.
5124 Currently this only makes sense for "CCH" as DATA_VENDOR.
5129 my ($self, $data_vendor) = (shift, shift); #always cch for now
5131 my $prefix = ( $conf->exists('tax-ship_address') && length($self->ship_last) )
5135 my ($zip,$plus4) = split /-/, $self->get("${prefix}zip")
5136 if $self->country eq 'US';
5138 #CCH specific location stuff
5139 my $extra_sql = "AND plus4lo <= '$plus4' AND plus4hi >= '$plus4'";
5142 my $cust_tax_location =
5144 'table' => 'cust_tax_location',
5145 'hashref' => { 'zip' => $zip, 'data_vendor' => $data_vendor },
5146 'extra_sql' => $extra_sql,
5149 $geocode = $cust_tax_location->geocode
5150 if $cust_tax_location;
5159 Returns a status string for this customer, currently:
5163 =item prospect - No packages have ever been ordered
5165 =item active - One or more recurring packages is active
5167 =item inactive - No active recurring packages, but otherwise unsuspended/uncancelled (the inactive status is new - previously inactive customers were mis-identified as cancelled)
5169 =item suspended - All non-cancelled recurring packages are suspended
5171 =item cancelled - All recurring packages are cancelled
5177 sub status { shift->cust_status(@_); }
5181 for my $status (qw( prospect active inactive suspended cancelled )) {
5182 my $method = $status.'_sql';
5183 my $numnum = ( my $sql = $self->$method() ) =~ s/cust_main\.custnum/?/g;
5184 my $sth = dbh->prepare("SELECT $sql") or die dbh->errstr;
5185 $sth->execute( ($self->custnum) x $numnum )
5186 or die "Error executing 'SELECT $sql': ". $sth->errstr;
5187 return $status if $sth->fetchrow_arrayref->[0];
5191 =item ucfirst_cust_status
5193 =item ucfirst_status
5195 Returns the status with the first character capitalized.
5199 sub ucfirst_status { shift->ucfirst_cust_status(@_); }
5201 sub ucfirst_cust_status {
5203 ucfirst($self->cust_status);
5208 Returns a hex triplet color string for this customer's status.
5212 use vars qw(%statuscolor);
5213 tie %statuscolor, 'Tie::IxHash',
5214 'prospect' => '7e0079', #'000000', #black? naw, purple
5215 'active' => '00CC00', #green
5216 'inactive' => '0000CC', #blue
5217 'suspended' => 'FF9900', #yellow
5218 'cancelled' => 'FF0000', #red
5221 sub statuscolor { shift->cust_statuscolor(@_); }
5223 sub cust_statuscolor {
5225 $statuscolor{$self->cust_status};
5230 Returns an array of hashes representing the customer's RT tickets.
5237 my $num = $conf->config('cust_main-max_tickets') || 10;
5240 unless ( $conf->config('ticket_system-custom_priority_field') ) {
5242 @tickets = @{ FS::TicketSystem->customer_tickets($self->custnum, $num) };
5246 foreach my $priority (
5247 $conf->config('ticket_system-custom_priority_field-values'), ''
5249 last if scalar(@tickets) >= $num;
5251 @{ FS::TicketSystem->customer_tickets( $self->custnum,
5252 $num - scalar(@tickets),
5261 # Return services representing svc_accts in customer support packages
5262 sub support_services {
5264 my %packages = map { $_ => 1 } $conf->config('support_packages');
5266 grep { $_->pkg_svc && $_->pkg_svc->primary_svc eq 'Y' }
5267 grep { $_->part_svc->svcdb eq 'svc_acct' }
5268 map { $_->cust_svc }
5269 grep { exists $packages{ $_->pkgpart } }
5270 $self->ncancelled_pkgs;
5276 =head1 CLASS METHODS
5282 Class method that returns the list of possible status strings for customers
5283 (see L<the status method|/status>). For example:
5285 @statuses = FS::cust_main->statuses();
5290 #my $self = shift; #could be class...
5296 Returns an SQL expression identifying prospective cust_main records (customers
5297 with no packages ever ordered)
5301 use vars qw($select_count_pkgs);
5302 $select_count_pkgs =
5303 "SELECT COUNT(*) FROM cust_pkg
5304 WHERE cust_pkg.custnum = cust_main.custnum";
5306 sub select_count_pkgs_sql {
5310 sub prospect_sql { "
5311 0 = ( $select_count_pkgs )
5316 Returns an SQL expression identifying active cust_main records (customers with
5317 active recurring packages).
5322 0 < ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. "
5328 Returns an SQL expression identifying inactive cust_main records (customers with
5329 no active recurring packages, but otherwise unsuspended/uncancelled).
5333 sub inactive_sql { "
5334 0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " )
5336 0 < ( $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " )
5342 Returns an SQL expression identifying suspended cust_main records.
5347 sub suspended_sql { susp_sql(@_); }
5349 0 < ( $select_count_pkgs AND ". FS::cust_pkg->suspended_sql. " )
5351 0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " )
5357 Returns an SQL expression identifying cancelled cust_main records.
5361 sub cancelled_sql { cancel_sql(@_); }
5364 my $recurring_sql = FS::cust_pkg->recurring_sql;
5365 my $cancelled_sql = FS::cust_pkg->cancelled_sql;
5368 0 < ( $select_count_pkgs )
5369 AND 0 < ( $select_count_pkgs AND $recurring_sql AND $cancelled_sql )
5370 AND 0 = ( $select_count_pkgs AND $recurring_sql
5371 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
5373 AND 0 = ( $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " )
5379 =item uncancelled_sql
5381 Returns an SQL expression identifying un-cancelled cust_main records.
5385 sub uncancelled_sql { uncancel_sql(@_); }
5386 sub uncancel_sql { "
5387 ( 0 < ( $select_count_pkgs
5388 AND ( cust_pkg.cancel IS NULL
5389 OR cust_pkg.cancel = 0
5392 OR 0 = ( $select_count_pkgs )
5398 Returns an SQL fragment to retreive the balance.
5403 ( SELECT COALESCE( SUM(charged), 0 ) FROM cust_bill
5404 WHERE cust_bill.custnum = cust_main.custnum )
5405 - ( SELECT COALESCE( SUM(paid), 0 ) FROM cust_pay
5406 WHERE cust_pay.custnum = cust_main.custnum )
5407 - ( SELECT COALESCE( SUM(amount), 0 ) FROM cust_credit
5408 WHERE cust_credit.custnum = cust_main.custnum )
5409 + ( SELECT COALESCE( SUM(refund), 0 ) FROM cust_refund
5410 WHERE cust_refund.custnum = cust_main.custnum )
5413 =item balance_date_sql START_TIME [ END_TIME [ OPTION => VALUE ... ] ]
5415 Returns an SQL fragment to retreive the balance for this customer, only
5416 considering invoices with date earlier than START_TIME, and optionally not
5417 later than END_TIME (total_owed_date minus total_credited minus
5418 total_unapplied_payments).
5420 Times are specified as SQL fragments or numeric
5421 UNIX timestamps; see L<perlfunc/"time">). Also see L<Time::Local> and
5422 L<Date::Parse> for conversion functions. The empty string can be passed
5423 to disable that time constraint completely.
5425 Available options are:
5429 =item unapplied_date
5431 set to true to disregard unapplied credits, payments and refunds outside the specified time period - by default the time period restriction only applies to invoices (useful for reporting, probably a bad idea for event triggering)
5436 set to true to remove all customer comparison clauses, for totals
5441 WHERE clause hashref (elements "AND"ed together) (typically used with the total option)
5446 JOIN clause (typically used with the total option)
5452 sub balance_date_sql {
5453 my( $class, $start, $end, %opt ) = @_;
5455 my $owed = FS::cust_bill->owed_sql;
5456 my $unapp_refund = FS::cust_refund->unapplied_sql;
5457 my $unapp_credit = FS::cust_credit->unapplied_sql;
5458 my $unapp_pay = FS::cust_pay->unapplied_sql;
5460 my $j = $opt{'join'} || '';
5462 my $owed_wh = $class->_money_table_where( 'cust_bill', $start,$end,%opt );
5463 my $refund_wh = $class->_money_table_where( 'cust_refund', $start,$end,%opt );
5464 my $credit_wh = $class->_money_table_where( 'cust_credit', $start,$end,%opt );
5465 my $pay_wh = $class->_money_table_where( 'cust_pay', $start,$end,%opt );
5467 " ( SELECT COALESCE(SUM($owed), 0) FROM cust_bill $j $owed_wh )
5468 + ( SELECT COALESCE(SUM($unapp_refund), 0) FROM cust_refund $j $refund_wh )
5469 - ( SELECT COALESCE(SUM($unapp_credit), 0) FROM cust_credit $j $credit_wh )
5470 - ( SELECT COALESCE(SUM($unapp_pay), 0) FROM cust_pay $j $pay_wh )
5475 =item _money_table_where TABLE START_TIME [ END_TIME [ OPTION => VALUE ... ] ]
5477 Helper method for balance_date_sql; name (and usage) subject to change
5478 (suggestions welcome).
5480 Returns a WHERE clause for the specified monetary TABLE (cust_bill,
5481 cust_refund, cust_credit or cust_pay).
5483 If TABLE is "cust_bill" or the unapplied_date option is true, only
5484 considers records with date earlier than START_TIME, and optionally not
5485 later than END_TIME .
5489 sub _money_table_where {
5490 my( $class, $table, $start, $end, %opt ) = @_;
5493 push @where, "cust_main.custnum = $table.custnum" unless $opt{'total'};
5494 if ( $table eq 'cust_bill' || $opt{'unapplied_date'} ) {
5495 push @where, "$table._date <= $start" if defined($start) && length($start);
5496 push @where, "$table._date > $end" if defined($end) && length($end);
5498 push @where, @{$opt{'where'}} if $opt{'where'};
5499 my $where = scalar(@where) ? 'WHERE '. join(' AND ', @where ) : '';
5505 =item search_sql HASHREF
5509 Returns a qsearch hash expression to search for parameters specified in HREF.
5510 Valid parameters are
5518 =item cancelled_pkgs
5524 listref of start date, end date
5530 =item current_balance
5532 listref (list returned by FS::UI::Web::parse_lt_gt($cgi, 'current_balance'))
5536 =item flattened_pkgs
5545 my ($class, $params) = @_;
5556 if ( $params->{'agentnum'} =~ /^(\d+)$/ and $1 ) {
5558 "cust_main.agentnum = $1";
5565 #prospect active inactive suspended cancelled
5566 if ( grep { $params->{'status'} eq $_ } FS::cust_main->statuses() ) {
5567 my $method = $params->{'status'}. '_sql';
5568 #push @where, $class->$method();
5569 push @where, FS::cust_main->$method();
5573 # parse cancelled package checkbox
5578 $pkgwhere .= "AND (cancel = 0 or cancel is null)"
5579 unless $params->{'cancelled_pkgs'};
5585 foreach my $field (qw( signupdate )) {
5587 next unless exists($params->{$field});
5589 my($beginning, $ending) = @{$params->{$field}};
5592 "cust_main.$field IS NOT NULL",
5593 "cust_main.$field >= $beginning",
5594 "cust_main.$field <= $ending";
5596 $orderby ||= "ORDER BY cust_main.$field";
5604 my @payby = grep /^([A-Z]{4})$/, @{ $params->{'payby'} };
5606 push @where, '( '. join(' OR ', map "cust_main.payby = '$_'", @payby). ' )';
5613 #my $balance_sql = $class->balance_sql();
5614 my $balance_sql = FS::cust_main->balance_sql();
5616 push @where, map { s/current_balance/$balance_sql/; $_ }
5617 @{ $params->{'current_balance'} };
5623 if ( $params->{'custbatch'} =~ /^([\w\/\-\:\.]+)$/ and $1 ) {
5625 "cust_main.custbatch = '$1'";
5629 # setup queries, subs, etc. for the search
5632 $orderby ||= 'ORDER BY custnum';
5634 # here is the agent virtualization
5635 push @where, $FS::CurrentUser::CurrentUser->agentnums_sql;
5637 my $extra_sql = scalar(@where) ? ' WHERE '. join(' AND ', @where) : '';
5639 my $addl_from = 'LEFT JOIN cust_pkg USING ( custnum ) ';
5641 my $count_query = "SELECT COUNT(*) FROM cust_main $extra_sql";
5643 my $select = join(', ',
5644 'cust_main.custnum',
5645 FS::UI::Web::cust_sql_fields($params->{'cust_fields'}),
5648 my(@extra_headers) = ();
5649 my(@extra_fields) = ();
5651 if ($params->{'flattened_pkgs'}) {
5653 if ($dbh->{Driver}->{Name} eq 'Pg') {
5655 $select .= ", array_to_string(array(select pkg from cust_pkg left join part_pkg using ( pkgpart ) where cust_main.custnum = cust_pkg.custnum $pkgwhere),'|') as magic";
5657 }elsif ($dbh->{Driver}->{Name} =~ /^mysql/i) {
5658 $select .= ", GROUP_CONCAT(pkg SEPARATOR '|') as magic";
5659 $addl_from .= " LEFT JOIN part_pkg using ( pkgpart )";
5661 warn "warning: unknown database type ". $dbh->{Driver}->{Name}.
5662 "omitting packing information from report.";
5665 my $header_query = "SELECT COUNT(cust_pkg.custnum = cust_main.custnum) AS count FROM cust_main $addl_from $extra_sql $pkgwhere group by cust_main.custnum order by count desc limit 1";
5667 my $sth = dbh->prepare($header_query) or die dbh->errstr;
5668 $sth->execute() or die $sth->errstr;
5669 my $headerrow = $sth->fetchrow_arrayref;
5670 my $headercount = $headerrow ? $headerrow->[0] : 0;
5671 while($headercount) {
5672 unshift @extra_headers, "Package ". $headercount;
5673 unshift @extra_fields, eval q!sub {my $c = shift;
5674 my @a = split '\|', $c->magic;
5675 my $p = $a[!.--$headercount. q!];
5683 'table' => 'cust_main',
5684 'select' => $select,
5686 'extra_sql' => $extra_sql,
5687 'order_by' => $orderby,
5688 'count_query' => $count_query,
5689 'extra_headers' => \@extra_headers,
5690 'extra_fields' => \@extra_fields,
5695 =item email_search_sql HASHREF
5699 Emails a notice to the specified customers.
5701 Valid parameters are those of the L<search_sql> method, plus the following:
5723 Optional job queue job for status updates.
5727 Returns an error message, or false for success.
5729 If an error occurs during any email, stops the enture send and returns that
5730 error. Presumably if you're getting SMTP errors aborting is better than
5731 retrying everything.
5735 sub email_search_sql {
5736 my($class, $params) = @_;
5738 my $from = delete $params->{from};
5739 my $subject = delete $params->{subject};
5740 my $html_body = delete $params->{html_body};
5741 my $text_body = delete $params->{text_body};
5743 my $job = delete $params->{'job'};
5745 my $sql_query = $class->search_sql($params);
5747 my $count_query = delete($sql_query->{'count_query'});
5748 my $count_sth = dbh->prepare($count_query)
5749 or die "Error preparing $count_query: ". dbh->errstr;
5751 or die "Error executing $count_query: ". $count_sth->errstr;
5752 my $count_arrayref = $count_sth->fetchrow_arrayref;
5753 my $num_cust = $count_arrayref->[0];
5755 #my @extra_headers = @{ delete($sql_query->{'extra_headers'}) };
5756 #my @extra_fields = @{ delete($sql_query->{'extra_fields'}) };
5759 my( $num, $last, $min_sec ) = (0, time, 5); #progresbar foo
5761 #eventually order+limit magic to reduce memory use?
5762 foreach my $cust_main ( qsearch($sql_query) ) {
5764 my $to = $cust_main->invoicing_list_emailonly_scalar;
5767 my $error = send_email(
5771 'subject' => $subject,
5772 'html_body' => $html_body,
5773 'text_body' => $text_body,
5776 return $error if $error;
5778 if ( $job ) { #progressbar foo
5780 if ( time - $min_sec > $last ) {
5781 my $error = $job->update_statustext(
5782 int( 100 * $num / $num_cust )
5784 die $error if $error;
5794 use Storable qw(thaw);
5797 sub process_email_search_sql {
5799 #warn "$me process_re_X $method for job $job\n" if $DEBUG;
5801 my $param = thaw(decode_base64(shift));
5802 warn Dumper($param) if $DEBUG;
5804 $param->{'job'} = $job;
5806 my $error = FS::cust_main->email_search_sql( $param );
5807 die $error if $error;
5811 =item fuzzy_search FUZZY_HASHREF [ HASHREF, SELECT, EXTRA_SQL, CACHE_OBJ ]
5813 Performs a fuzzy (approximate) search and returns the matching FS::cust_main
5814 records. Currently, I<first>, I<last> and/or I<company> may be specified (the
5815 appropriate ship_ field is also searched).
5817 Additional options are the same as FS::Record::qsearch
5822 my( $self, $fuzzy, $hash, @opt) = @_;
5827 check_and_rebuild_fuzzyfiles();
5828 foreach my $field ( keys %$fuzzy ) {
5830 my $all = $self->all_X($field);
5831 next unless scalar(@$all);
5834 $match{$_}=1 foreach ( amatch( $fuzzy->{$field}, ['i'], @$all ) );
5837 foreach ( keys %match ) {
5838 push @fcust, qsearch('cust_main', { %$hash, $field=>$_}, @opt);
5839 push @fcust, qsearch('cust_main', { %$hash, "ship_$field"=>$_}, @opt);
5842 push @cust_main, grep { ! $fsaw{$_->custnum}++ } @fcust;
5845 # we want the components of $fuzzy ANDed, not ORed, but still don't want dupes
5847 @cust_main = grep { ++$saw{$_->custnum} == scalar(keys %$fuzzy) } @cust_main;
5855 Returns a masked version of the named field
5860 my ($self,$field) = @_;
5864 'x'x(length($self->getfield($field))-4).
5865 substr($self->getfield($field), (length($self->getfield($field))-4));
5875 =item smart_search OPTION => VALUE ...
5877 Accepts the following options: I<search>, the string to search for. The string
5878 will be searched for as a customer number, phone number, name or company name,
5879 as an exact, or, in some cases, a substring or fuzzy match (see the source code
5880 for the exact heuristics used); I<no_fuzzy_on_exact>, causes smart_search to
5881 skip fuzzy matching when an exact match is found.
5883 Any additional options are treated as an additional qualifier on the search
5886 Returns a (possibly empty) array of FS::cust_main objects.
5893 #here is the agent virtualization
5894 my $agentnums_sql = $FS::CurrentUser::CurrentUser->agentnums_sql;
5898 my $skip_fuzzy = delete $options{'no_fuzzy_on_exact'};
5899 my $search = delete $options{'search'};
5900 ( my $alphanum_search = $search ) =~ s/\W//g;
5902 if ( $alphanum_search =~ /^1?(\d{3})(\d{3})(\d{4})(\d*)$/ ) { #phone# search
5904 #false laziness w/Record::ut_phone
5905 my $phonen = "$1-$2-$3";
5906 $phonen .= " x$4" if $4;
5908 push @cust_main, qsearch( {
5909 'table' => 'cust_main',
5910 'hashref' => { %options },
5911 'extra_sql' => ( scalar(keys %options) ? ' AND ' : ' WHERE ' ).
5913 join(' OR ', map "$_ = '$phonen'",
5914 qw( daytime night fax
5915 ship_daytime ship_night ship_fax )
5918 " AND $agentnums_sql", #agent virtualization
5921 unless ( @cust_main || $phonen =~ /x\d+$/ ) { #no exact match
5922 #try looking for matches with extensions unless one was specified
5924 push @cust_main, qsearch( {
5925 'table' => 'cust_main',
5926 'hashref' => { %options },
5927 'extra_sql' => ( scalar(keys %options) ? ' AND ' : ' WHERE ' ).
5929 join(' OR ', map "$_ LIKE '$phonen\%'",
5931 ship_daytime ship_night )
5934 " AND $agentnums_sql", #agent virtualization
5939 # custnum search (also try agent_custid), with some tweaking options if your
5940 # legacy cust "numbers" have letters
5941 } elsif ( $search =~ /^\s*(\d+)\s*$/
5942 || ( $conf->config('cust_main-agent_custid-format') eq 'ww?d+'
5943 && $search =~ /^\s*(\w\w?\d+)\s*$/
5948 push @cust_main, qsearch( {
5949 'table' => 'cust_main',
5950 'hashref' => { 'custnum' => $1, %options },
5951 'extra_sql' => " AND $agentnums_sql", #agent virtualization
5954 push @cust_main, qsearch( {
5955 'table' => 'cust_main',
5956 'hashref' => { 'agent_custid' => $1, %options },
5957 'extra_sql' => " AND $agentnums_sql", #agent virtualization
5960 } elsif ( $search =~ /^\s*(\S.*\S)\s+\((.+), ([^,]+)\)\s*$/ ) {
5962 my($company, $last, $first) = ( $1, $2, $3 );
5964 # "Company (Last, First)"
5965 #this is probably something a browser remembered,
5966 #so just do an exact search
5968 foreach my $prefix ( '', 'ship_' ) {
5969 push @cust_main, qsearch( {
5970 'table' => 'cust_main',
5971 'hashref' => { $prefix.'first' => $first,
5972 $prefix.'last' => $last,
5973 $prefix.'company' => $company,
5976 'extra_sql' => " AND $agentnums_sql",
5980 } elsif ( $search =~ /^\s*(\S.*\S)\s*$/ ) { # value search
5981 # try (ship_){last,company}
5985 # # remove "(Last, First)" in "Company (Last, First)", otherwise the
5986 # # full strings the browser remembers won't work
5987 # $value =~ s/\([\w \,\.\-\']*\)$//; #false laziness w/Record::ut_name
5989 use Lingua::EN::NameParse;
5990 my $NameParse = new Lingua::EN::NameParse(
5992 allow_reversed => 1,
5995 my($last, $first) = ( '', '' );
5996 #maybe disable this too and just rely on NameParse?
5997 if ( $value =~ /^(.+),\s*([^,]+)$/ ) { # Last, First
5999 ($last, $first) = ( $1, $2 );
6001 #} elsif ( $value =~ /^(.+)\s+(.+)$/ ) {
6002 } elsif ( ! $NameParse->parse($value) ) {
6004 my %name = $NameParse->components;
6005 $first = $name{'given_name_1'};
6006 $last = $name{'surname_1'};
6010 if ( $first && $last ) {
6012 my($q_last, $q_first) = ( dbh->quote($last), dbh->quote($first) );
6015 my $sql = scalar(keys %options) ? ' AND ' : ' WHERE ';
6017 ( ( LOWER(last) = $q_last AND LOWER(first) = $q_first )
6018 OR ( LOWER(ship_last) = $q_last AND LOWER(ship_first) = $q_first )
6021 push @cust_main, qsearch( {
6022 'table' => 'cust_main',
6023 'hashref' => \%options,
6024 'extra_sql' => "$sql AND $agentnums_sql", #agent virtualization
6027 # or it just be something that was typed in... (try that in a sec)
6031 my $q_value = dbh->quote($value);
6034 my $sql = scalar(keys %options) ? ' AND ' : ' WHERE ';
6035 $sql .= " ( LOWER(last) = $q_value
6036 OR LOWER(company) = $q_value
6037 OR LOWER(ship_last) = $q_value
6038 OR LOWER(ship_company) = $q_value
6041 push @cust_main, qsearch( {
6042 'table' => 'cust_main',
6043 'hashref' => \%options,
6044 'extra_sql' => "$sql AND $agentnums_sql", #agent virtualization
6047 #no exact match, trying substring/fuzzy
6048 #always do substring & fuzzy (unless they're explicity config'ed off)
6049 #getting complaints searches are not returning enough
6050 unless ( @cust_main && $skip_fuzzy || $conf->exists('disable-fuzzy') ) {
6052 #still some false laziness w/search_sql (was search/cust_main.cgi)
6057 { 'company' => { op=>'ILIKE', value=>"%$value%" }, },
6058 { 'ship_company' => { op=>'ILIKE', value=>"%$value%" }, },
6061 if ( $first && $last ) {
6064 { 'first' => { op=>'ILIKE', value=>"%$first%" },
6065 'last' => { op=>'ILIKE', value=>"%$last%" },
6067 { 'ship_first' => { op=>'ILIKE', value=>"%$first%" },
6068 'ship_last' => { op=>'ILIKE', value=>"%$last%" },
6075 { 'last' => { op=>'ILIKE', value=>"%$value%" }, },
6076 { 'ship_last' => { op=>'ILIKE', value=>"%$value%" }, },
6080 foreach my $hashref ( @hashrefs ) {
6082 push @cust_main, qsearch( {
6083 'table' => 'cust_main',
6084 'hashref' => { %$hashref,
6087 'extra_sql' => " AND $agentnums_sql", #agent virtualizaiton
6096 " AND $agentnums_sql", #extra_sql #agent virtualization
6099 if ( $first && $last ) {
6100 push @cust_main, FS::cust_main->fuzzy_search(
6101 { 'last' => $last, #fuzzy hashref
6102 'first' => $first }, #
6106 foreach my $field ( 'last', 'company' ) {
6108 FS::cust_main->fuzzy_search( { $field => $value }, @fuzopts );
6113 #eliminate duplicates
6115 @cust_main = grep { !$saw{$_->custnum}++ } @cust_main;
6125 Accepts the following options: I<email>, the email address to search for. The
6126 email address will be searched for as an email invoice destination and as an
6129 #Any additional options are treated as an additional qualifier on the search
6130 #(i.e. I<agentnum>).
6132 Returns a (possibly empty) array of FS::cust_main objects (but usually just
6142 my $email = delete $options{'email'};
6144 #we're only being used by RT at the moment... no agent virtualization yet
6145 #my $agentnums_sql = $FS::CurrentUser::CurrentUser->agentnums_sql;
6149 if ( $email =~ /([^@]+)\@([^@]+)/ ) {
6151 my ( $user, $domain ) = ( $1, $2 );
6153 warn "$me smart_search: searching for $user in domain $domain"
6159 'table' => 'cust_main_invoice',
6160 'hashref' => { 'dest' => $email },
6167 map $_->cust_svc->cust_pkg,
6169 'table' => 'svc_acct',
6170 'hashref' => { 'username' => $user, },
6172 'AND ( SELECT domain FROM svc_domain
6173 WHERE svc_acct.domsvc = svc_domain.svcnum
6174 ) = '. dbh->quote($domain),
6180 @cust_main = grep { !$saw{$_->custnum}++ } @cust_main;
6182 warn "$me smart_search: found ". scalar(@cust_main). " unique customers"
6189 =item check_and_rebuild_fuzzyfiles
6193 use vars qw(@fuzzyfields);
6194 @fuzzyfields = ( 'last', 'first', 'company' );
6196 sub check_and_rebuild_fuzzyfiles {
6197 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
6198 rebuild_fuzzyfiles() if grep { ! -e "$dir/cust_main.$_" } @fuzzyfields
6201 =item rebuild_fuzzyfiles
6205 sub rebuild_fuzzyfiles {
6207 use Fcntl qw(:flock);
6209 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
6210 mkdir $dir, 0700 unless -d $dir;
6212 foreach my $fuzzy ( @fuzzyfields ) {
6214 open(LOCK,">>$dir/cust_main.$fuzzy")
6215 or die "can't open $dir/cust_main.$fuzzy: $!";
6217 or die "can't lock $dir/cust_main.$fuzzy: $!";
6219 open (CACHE,">$dir/cust_main.$fuzzy.tmp")
6220 or die "can't open $dir/cust_main.$fuzzy.tmp: $!";
6222 foreach my $field ( $fuzzy, "ship_$fuzzy" ) {
6223 my $sth = dbh->prepare("SELECT $field FROM cust_main".
6224 " WHERE $field != '' AND $field IS NOT NULL");
6225 $sth->execute or die $sth->errstr;
6227 while ( my $row = $sth->fetchrow_arrayref ) {
6228 print CACHE $row->[0]. "\n";
6233 close CACHE or die "can't close $dir/cust_main.$fuzzy.tmp: $!";
6235 rename "$dir/cust_main.$fuzzy.tmp", "$dir/cust_main.$fuzzy";
6246 my( $self, $field ) = @_;
6247 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
6248 open(CACHE,"<$dir/cust_main.$field")
6249 or die "can't open $dir/cust_main.$field: $!";
6250 my @array = map { chomp; $_; } <CACHE>;
6255 =item append_fuzzyfiles LASTNAME COMPANY
6259 sub append_fuzzyfiles {
6260 #my( $first, $last, $company ) = @_;
6262 &check_and_rebuild_fuzzyfiles;
6264 use Fcntl qw(:flock);
6266 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
6268 foreach my $field (qw( first last company )) {
6273 open(CACHE,">>$dir/cust_main.$field")
6274 or die "can't open $dir/cust_main.$field: $!";
6275 flock(CACHE,LOCK_EX)
6276 or die "can't lock $dir/cust_main.$field: $!";
6278 print CACHE "$value\n";
6280 flock(CACHE,LOCK_UN)
6281 or die "can't unlock $dir/cust_main.$field: $!";
6290 =item process_batch_import
6292 Load a batch import as a queued JSRPC job
6296 use Storable qw(thaw);
6299 sub process_batch_import {
6302 my $param = thaw(decode_base64(shift));
6303 warn Dumper($param) if $DEBUG;
6305 my $files = $param->{'uploaded_files'}
6306 or die "No files provided.\n";
6308 my (%files) = map { /^(\w+):([\.\w]+)$/ ? ($1,$2):() } split /,/, $files;
6310 my $dir = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc. '/';
6311 my $file = $dir. $files{'file'};
6314 if ( $file =~ /\.(\w+)$/i ) {
6318 warn "can't parse file type from filename $file; defaulting to CSV";
6323 FS::cust_main::batch_import( {
6327 custbatch => $param->{custbatch},
6328 agentnum => $param->{'agentnum'},
6329 refnum => $param->{'refnum'},
6330 pkgpart => $param->{'pkgpart'},
6331 #'fields' => [qw( cust_pkg.setup dayphone first last address1 address2
6332 # city state zip comments )],
6333 'format' => $param->{'format'},
6338 die "$error\n" if $error;
6346 #some false laziness w/cdr.pm now
6350 my $job = $param->{job};
6352 my $filename = $param->{file};
6353 my $type = $param->{type} || 'csv';
6355 my $custbatch = $param->{custbatch};
6357 my $agentnum = $param->{agentnum};
6358 my $refnum = $param->{refnum};
6359 my $pkgpart = $param->{pkgpart};
6361 my $format = $param->{'format'};
6365 if ( $format eq 'simple' ) {
6366 @fields = qw( cust_pkg.setup dayphone first last
6367 address1 address2 city state zip comments );
6369 } elsif ( $format eq 'extended' ) {
6370 @fields = qw( agent_custid refnum
6371 last first address1 address2 city state zip country
6373 ship_last ship_first ship_address1 ship_address2
6374 ship_city ship_state ship_zip ship_country
6375 payinfo paycvv paydate
6378 svc_acct.username svc_acct._password
6381 } elsif ( $format eq 'extended-plus_company' ) {
6382 @fields = qw( agent_custid refnum
6383 last first company address1 address2 city state zip country
6385 ship_last ship_first ship_company ship_address1 ship_address2
6386 ship_city ship_state ship_zip ship_country
6387 payinfo paycvv paydate
6390 svc_acct.username svc_acct._password
6394 die "unknown format $format";
6400 if ( $type eq 'csv' ) {
6402 eval "use Text::CSV_XS;";
6405 $parser = new Text::CSV_XS;
6407 @buffer = split(/\r?\n/, slurp($filename) );
6408 $count = scalar(@buffer);
6410 } elsif ( $type eq 'xls' ) {
6412 eval "use Spreadsheet::ParseExcel;";
6415 my $excel = new Spreadsheet::ParseExcel::Workbook->Parse($filename);
6416 $parser = $excel->{Worksheet}[0]; #first sheet
6418 $count = $parser->{MaxRow} || $parser->{MinRow};
6422 die "Unknown file type $type\n";
6427 local $SIG{HUP} = 'IGNORE';
6428 local $SIG{INT} = 'IGNORE';
6429 local $SIG{QUIT} = 'IGNORE';
6430 local $SIG{TERM} = 'IGNORE';
6431 local $SIG{TSTP} = 'IGNORE';
6432 local $SIG{PIPE} = 'IGNORE';
6434 my $oldAutoCommit = $FS::UID::AutoCommit;
6435 local $FS::UID::AutoCommit = 0;
6440 my( $last, $min_sec ) = ( time, 5 ); #progressbar foo
6444 if ( $type eq 'csv' ) {
6446 last unless scalar(@buffer);
6447 $line = shift(@buffer);
6449 $parser->parse($line) or do {
6450 $dbh->rollback if $oldAutoCommit;
6451 return "can't parse: ". $parser->error_input();
6453 @columns = $parser->fields();
6455 } elsif ( $type eq 'xls' ) {
6457 last if $row > ($parser->{MaxRow} || $parser->{MinRow});
6459 my @row = @{ $parser->{Cells}[$row] };
6460 @columns = map $_->{Val}, @row;
6463 #warn $z++. ": $_\n" for @columns;
6466 die "Unknown file type $type\n";
6469 #warn join('-',@columns);
6472 custbatch => $custbatch,
6473 agentnum => $agentnum,
6475 country => $conf->config('countrydefault') || 'US',
6476 payby => $payby, #default
6477 paydate => '12/2037', #default
6479 my $billtime = time;
6480 my %cust_pkg = ( pkgpart => $pkgpart );
6482 foreach my $field ( @fields ) {
6484 if ( $field =~ /^cust_pkg\.(pkgpart|setup|bill|susp|adjourn|expire|cancel)$/ ) {
6486 #$cust_pkg{$1} = str2time( shift @$columns );
6487 if ( $1 eq 'pkgpart' ) {
6488 $cust_pkg{$1} = shift @columns;
6489 } elsif ( $1 eq 'setup' ) {
6490 $billtime = str2time(shift @columns);
6492 $cust_pkg{$1} = str2time( shift @columns );
6495 } elsif ( $field =~ /^svc_acct\.(username|_password)$/ ) {
6497 $svc_acct{$1} = shift @columns;
6501 #refnum interception
6502 if ( $field eq 'refnum' && $columns[0] !~ /^\s*(\d+)\s*$/ ) {
6504 my $referral = $columns[0];
6505 my %hash = ( 'referral' => $referral,
6506 'agentnum' => $agentnum,
6510 my $part_referral = qsearchs('part_referral', \%hash )
6511 || new FS::part_referral \%hash;
6513 unless ( $part_referral->refnum ) {
6514 my $error = $part_referral->insert;
6516 $dbh->rollback if $oldAutoCommit;
6517 return "can't auto-insert advertising source: $referral: $error";
6521 $columns[0] = $part_referral->refnum;
6524 my $value = shift @columns;
6525 $cust_main{$field} = $value if length($value);
6529 $cust_main{'payby'} = 'CARD'
6530 if defined $cust_main{'payinfo'}
6531 && length $cust_main{'payinfo'};
6533 my $invoicing_list = $cust_main{'invoicing_list'}
6534 ? [ delete $cust_main{'invoicing_list'} ]
6537 my $cust_main = new FS::cust_main ( \%cust_main );
6540 tie my %hash, 'Tie::RefHash'; #this part is important
6542 if ( $cust_pkg{'pkgpart'} ) {
6543 my $cust_pkg = new FS::cust_pkg ( \%cust_pkg );
6546 if ( $svc_acct{'username'} ) {
6547 my $part_pkg = $cust_pkg->part_pkg;
6548 unless ( $part_pkg ) {
6549 $dbh->rollback if $oldAutoCommit;
6550 return "unknown pkgpart: ". $cust_pkg{'pkgpart'};
6552 $svc_acct{svcpart} = $part_pkg->svcpart( 'svc_acct' );
6553 push @svc_acct, new FS::svc_acct ( \%svc_acct )
6556 $hash{$cust_pkg} = \@svc_acct;
6559 my $error = $cust_main->insert( \%hash, $invoicing_list );
6562 $dbh->rollback if $oldAutoCommit;
6563 return "can't insert customer". ( $line ? " for $line" : '' ). ": $error";
6566 if ( $format eq 'simple' ) {
6568 #false laziness w/bill.cgi
6569 $error = $cust_main->bill( 'time' => $billtime );
6571 $dbh->rollback if $oldAutoCommit;
6572 return "can't bill customer for $line: $error";
6575 $error = $cust_main->apply_payments_and_credits;
6577 $dbh->rollback if $oldAutoCommit;
6578 return "can't bill customer for $line: $error";
6581 $error = $cust_main->collect();
6583 $dbh->rollback if $oldAutoCommit;
6584 return "can't collect customer for $line: $error";
6591 if ( $job && time - $min_sec > $last ) { #progress bar
6592 $job->update_statustext( int(100 * $row / $count) );
6598 $dbh->commit or die $dbh->errstr if $oldAutoCommit;;
6600 return "Empty file!" unless $row;
6612 #warn join('-',keys %$param);
6613 my $fh = $param->{filehandle};
6614 my @fields = @{$param->{fields}};
6616 eval "use Text::CSV_XS;";
6619 my $csv = new Text::CSV_XS;
6626 local $SIG{HUP} = 'IGNORE';
6627 local $SIG{INT} = 'IGNORE';
6628 local $SIG{QUIT} = 'IGNORE';
6629 local $SIG{TERM} = 'IGNORE';
6630 local $SIG{TSTP} = 'IGNORE';
6631 local $SIG{PIPE} = 'IGNORE';
6633 my $oldAutoCommit = $FS::UID::AutoCommit;
6634 local $FS::UID::AutoCommit = 0;
6637 #while ( $columns = $csv->getline($fh) ) {
6639 while ( defined($line=<$fh>) ) {
6641 $csv->parse($line) or do {
6642 $dbh->rollback if $oldAutoCommit;
6643 return "can't parse: ". $csv->error_input();
6646 my @columns = $csv->fields();
6647 #warn join('-',@columns);
6650 foreach my $field ( @fields ) {
6651 $row{$field} = shift @columns;
6654 my $cust_main = qsearchs('cust_main', { 'custnum' => $row{'custnum'} } );
6655 unless ( $cust_main ) {
6656 $dbh->rollback if $oldAutoCommit;
6657 return "unknown custnum $row{'custnum'}";
6660 if ( $row{'amount'} > 0 ) {
6661 my $error = $cust_main->charge($row{'amount'}, $row{'pkg'});
6663 $dbh->rollback if $oldAutoCommit;
6667 } elsif ( $row{'amount'} < 0 ) {
6668 my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ),
6671 $dbh->rollback if $oldAutoCommit;
6681 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
6683 return "Empty file!" unless $imported;
6689 =item notify CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
6691 Sends a templated email notification to the customer (see L<Text::Template>).
6693 OPTIONS is a hash and may include
6695 I<from> - the email sender (default is invoice_from)
6697 I<to> - comma-separated scalar or arrayref of recipients
6698 (default is invoicing_list)
6700 I<subject> - The subject line of the sent email notification
6701 (default is "Notice from company_name")
6703 I<extra_fields> - a hashref of name/value pairs which will be substituted
6706 The following variables are vavailable in the template.
6708 I<$first> - the customer first name
6709 I<$last> - the customer last name
6710 I<$company> - the customer company
6711 I<$payby> - a description of the method of payment for the customer
6712 # would be nice to use FS::payby::shortname
6713 I<$payinfo> - the account information used to collect for this customer
6714 I<$expdate> - the expiration of the customer payment in seconds from epoch
6719 my ($customer, $template, %options) = @_;
6721 return unless $conf->exists($template);
6723 my $from = $conf->config('invoice_from') if $conf->exists('invoice_from');
6724 $from = $options{from} if exists($options{from});
6726 my $to = join(',', $customer->invoicing_list_emailonly);
6727 $to = $options{to} if exists($options{to});
6729 my $subject = "Notice from " . $conf->config('company_name')
6730 if $conf->exists('company_name');
6731 $subject = $options{subject} if exists($options{subject});
6733 my $notify_template = new Text::Template (TYPE => 'ARRAY',
6734 SOURCE => [ map "$_\n",
6735 $conf->config($template)]
6737 or die "can't create new Text::Template object: Text::Template::ERROR";
6738 $notify_template->compile()
6739 or die "can't compile template: Text::Template::ERROR";
6741 $FS::notify_template::_template::company_name = $conf->config('company_name');
6742 $FS::notify_template::_template::company_address =
6743 join("\n", $conf->config('company_address') ). "\n";
6745 my $paydate = $customer->paydate || '2037-12-31';
6746 $FS::notify_template::_template::first = $customer->first;
6747 $FS::notify_template::_template::last = $customer->last;
6748 $FS::notify_template::_template::company = $customer->company;
6749 $FS::notify_template::_template::payinfo = $customer->mask_payinfo;
6750 my $payby = $customer->payby;
6751 my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
6752 my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
6754 #credit cards expire at the end of the month/year of their exp date
6755 if ($payby eq 'CARD' || $payby eq 'DCRD') {
6756 $FS::notify_template::_template::payby = 'credit card';
6757 ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
6758 $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
6760 }elsif ($payby eq 'COMP') {
6761 $FS::notify_template::_template::payby = 'complimentary account';
6763 $FS::notify_template::_template::payby = 'current method';
6765 $FS::notify_template::_template::expdate = $expire_time;
6767 for (keys %{$options{extra_fields}}){
6769 ${"FS::notify_template::_template::$_"} = $options{extra_fields}->{$_};
6772 send_email(from => $from,
6774 subject => $subject,
6775 body => $notify_template->fill_in( PACKAGE =>
6776 'FS::notify_template::_template' ),
6781 =item generate_letter CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
6783 Generates a templated notification to the customer (see L<Text::Template>).
6785 OPTIONS is a hash and may include
6787 I<extra_fields> - a hashref of name/value pairs which will be substituted
6788 into the template. These values may override values mentioned below
6789 and those from the customer record.
6791 The following variables are available in the template instead of or in addition
6792 to the fields of the customer record.
6794 I<$payby> - a description of the method of payment for the customer
6795 # would be nice to use FS::payby::shortname
6796 I<$payinfo> - the masked account information used to collect for this customer
6797 I<$expdate> - the expiration of the customer payment method in seconds from epoch
6798 I<$returnaddress> - the return address defaults to invoice_latexreturnaddress or company_address
6802 sub generate_letter {
6803 my ($self, $template, %options) = @_;
6805 return unless $conf->exists($template);
6807 my $letter_template = new Text::Template
6809 SOURCE => [ map "$_\n", $conf->config($template)],
6810 DELIMITERS => [ '[@--', '--@]' ],
6812 or die "can't create new Text::Template object: Text::Template::ERROR";
6814 $letter_template->compile()
6815 or die "can't compile template: Text::Template::ERROR";
6817 my %letter_data = map { $_ => $self->$_ } $self->fields;
6818 $letter_data{payinfo} = $self->mask_payinfo;
6820 #my $paydate = $self->paydate || '2037-12-31';
6821 my $paydate = $self->paydate =~ /^\S+$/ ? $self->paydate : '2037-12-31';
6823 my $payby = $self->payby;
6824 my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
6825 my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
6827 #credit cards expire at the end of the month/year of their exp date
6828 if ($payby eq 'CARD' || $payby eq 'DCRD') {
6829 $letter_data{payby} = 'credit card';
6830 ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
6831 $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
6833 }elsif ($payby eq 'COMP') {
6834 $letter_data{payby} = 'complimentary account';
6836 $letter_data{payby} = 'current method';
6838 $letter_data{expdate} = $expire_time;
6840 for (keys %{$options{extra_fields}}){
6841 $letter_data{$_} = $options{extra_fields}->{$_};
6844 unless(exists($letter_data{returnaddress})){
6845 my $retadd = join("\n", $conf->config_orbase( 'invoice_latexreturnaddress',
6846 $self->agent_template)
6848 if ( length($retadd) ) {
6849 $letter_data{returnaddress} = $retadd;
6850 } elsif ( grep /\S/, $conf->config('company_address') ) {
6851 $letter_data{returnaddress} =
6852 join( '\\*'."\n", map s/( {2,})/'~' x length($1)/eg,
6853 $conf->config('company_address')
6856 $letter_data{returnaddress} = '~';
6860 $letter_data{conf_dir} = "$FS::UID::conf_dir/conf.$FS::UID::datasrc";
6862 $letter_data{company_name} = $conf->config('company_name');
6864 my $dir = $FS::UID::conf_dir."cache.". $FS::UID::datasrc;
6865 my $fh = new File::Temp( TEMPLATE => 'letter.'. $self->custnum. '.XXXXXXXX',
6869 ) or die "can't open temp file: $!\n";
6871 $letter_template->fill_in( OUTPUT => $fh, HASH => \%letter_data );
6873 $fh->filename =~ /^(.*).tex$/ or die "unparsable filename: ". $fh->filename;
6877 =item print_ps TEMPLATE
6879 Returns an postscript letter filled in from TEMPLATE, as a scalar.
6885 my $file = $self->generate_letter(@_);
6886 FS::Misc::generate_ps($file);
6889 =item print TEMPLATE
6891 Prints the filled in template.
6893 TEMPLATE is the name of a L<Text::Template> to fill in and print.
6897 sub queueable_print {
6900 my $self = qsearchs('cust_main', { 'custnum' => $opt{custnum} } )
6901 or die "invalid customer number: " . $opt{custvnum};
6903 my $error = $self->print( $opt{template} );
6904 die $error if $error;
6908 my ($self, $template) = (shift, shift);
6909 do_print [ $self->print_ps($template) ];
6912 sub agent_template {
6914 $self->_agent_plandata('agent_templatename');
6917 sub agent_invoice_from {
6919 $self->_agent_plandata('agent_invoice_from');
6922 sub _agent_plandata {
6923 my( $self, $option ) = @_;
6925 #yuck. this whole thing needs to be reconciled better with 1.9's idea of
6926 #agent-specific Conf
6928 use FS::part_event::Condition;
6930 my $agentnum = $self->agentnum;
6933 if ( driver_name =~ /^Pg/i ) {
6935 } elsif ( driver_name =~ /^mysql/i ) {
6938 die "don't know how to use regular expressions in ". driver_name. " databases";
6941 my $part_event_option =
6943 'select' => 'part_event_option.*',
6944 'table' => 'part_event_option',
6946 LEFT JOIN part_event USING ( eventpart )
6947 LEFT JOIN part_event_option AS peo_agentnum
6948 ON ( part_event.eventpart = peo_agentnum.eventpart
6949 AND peo_agentnum.optionname = 'agentnum'
6950 AND peo_agentnum.optionvalue }. $regexp. q{ '(^|,)}. $agentnum. q{(,|$)'
6952 LEFT JOIN part_event_option AS peo_cust_bill_age
6953 ON ( part_event.eventpart = peo_cust_bill_age.eventpart
6954 AND peo_cust_bill_age.optionname = 'cust_bill_age'
6957 #'hashref' => { 'optionname' => $option },
6958 #'hashref' => { 'part_event_option.optionname' => $option },
6960 " WHERE part_event_option.optionname = ". dbh->quote($option).
6961 " AND action = 'cust_bill_send_agent' ".
6962 " AND ( disabled IS NULL OR disabled != 'Y' ) ".
6963 " AND peo_agentnum.optionname = 'agentnum' ".
6964 " AND agentnum IS NULL OR agentnum = $agentnum ".
6966 CASE WHEN peo_cust_bill_age.optionname != 'cust_bill_age'
6968 ELSE ". FS::part_event::Condition->age2seconds_sql('peo_cust_bill_age.optionvalue').
6970 , part_event.weight".
6974 unless ( $part_event_option ) {
6975 return $self->agent->invoice_template || ''
6976 if $option eq 'agent_templatename';
6980 $part_event_option->optionvalue;
6985 ## actual sub, not a method, designed to be called from the queue.
6986 ## sets up the customer, and calls the bill_and_collect
6987 my (%args) = @_; #, ($time, $invoice_time, $check_freq, $resetup) = @_;
6988 my $cust_main = qsearchs( 'cust_main', { custnum => $args{'custnum'} } );
6989 $cust_main->bill_and_collect(
7000 The delete method should possibly take an FS::cust_main object reference
7001 instead of a scalar customer number.
7003 Bill and collect options should probably be passed as references instead of a
7006 There should probably be a configuration file with a list of allowed credit
7009 No multiple currency support (probably a larger project than just this module).
7011 payinfo_masked false laziness with cust_pay.pm and cust_refund.pm
7013 Birthdates rely on negative epoch values.
7015 The payby for card/check batches is broken. With mixed batching, bad
7018 B<collect> I<invoice_time> should be renamed I<time>, like B<bill>.
7022 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
7023 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
7024 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.