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 timelocal_nocheck);
15 use Digest::MD5 qw(md5_base64);
18 use File::Temp qw( tempfile );
19 use String::Approx qw(amatch);
20 use Business::CreditCard 0.28;
22 use FS::UID qw( getotaker dbh driver_name );
23 use FS::Record qw( qsearchs qsearch dbdef );
24 use FS::Misc qw( generate_email send_email generate_ps do_print );
25 use FS::Msgcat qw(gettext);
29 use FS::cust_bill_pkg;
30 use FS::cust_bill_pkg_display;
32 use FS::cust_pay_pending;
33 use FS::cust_pay_void;
34 use FS::cust_pay_batch;
37 use FS::part_referral;
38 use FS::cust_main_county;
40 use FS::cust_tax_location;
41 use FS::part_pkg_taxrate;
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:
140 Primary key (assigned automatically for new customers)
144 Agent (see L<FS::agent>)
148 Advertising source (see L<FS::part_referral>)
160 Cocial security number (optional)
176 (optional, see L<FS::cust_main_county>)
180 (see L<FS::cust_main_county>)
186 (see L<FS::cust_main_county>)
222 (optional, see L<FS::cust_main_county>)
226 (see L<FS::cust_main_county>)
232 (see L<FS::cust_main_county>)
248 Payment Type (See L<FS::payinfo_Mixin> for valid payby values)
252 Payment Information (See L<FS::payinfo_Mixin> for data format)
256 Masked payinfo (See L<FS::payinfo_Mixin> for how this works)
260 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
264 Expiration date, mm/yyyy, m/yyyy, mm/yy or m/yy
268 Start date month (maestro/solo cards only)
272 Start date year (maestro/solo cards only)
276 Issue number (maestro/solo cards only)
280 Name on card or billing name
284 IP address from which payment information was received
288 Tax exempt, empty or `Y'
292 Order taker (assigned automatically, see L<FS::UID>)
298 =item referral_custnum
300 Referring customer number
304 Enable individual CDR spooling, empty or `Y'
308 A suggestion to events (see L<FS::part_bill_event">) to delay until this unix timestamp
312 Discourage individual CDR printing, empty or `Y'
322 Creates a new customer. To add the customer to the database, see L<"insert">.
324 Note that this stores the hash reference, not a distinct copy of the hash it
325 points to. You can ask the object for a copy with the I<hash> method.
329 sub table { 'cust_main'; }
331 =item insert [ CUST_PKG_HASHREF [ , INVOICING_LIST_ARYREF ] [ , OPTION => VALUE ... ] ]
333 Adds this customer to the database. If there is an error, returns the error,
334 otherwise returns false.
336 CUST_PKG_HASHREF: If you pass a Tie::RefHash data structure to the insert
337 method containing FS::cust_pkg and FS::svc_I<tablename> objects, all records
338 are inserted atomicly, or the transaction is rolled back. Passing an empty
339 hash reference is equivalent to not supplying this parameter. There should be
340 a better explanation of this, but until then, here's an example:
343 tie %hash, 'Tie::RefHash'; #this part is important
345 $cust_pkg => [ $svc_acct ],
348 $cust_main->insert( \%hash );
350 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
351 be set as the invoicing list (see L<"invoicing_list">). Errors return as
352 expected and rollback the entire transaction; it is not necessary to call
353 check_invoicing_list first. The invoicing_list is set after the records in the
354 CUST_PKG_HASHREF above are inserted, so it is now possible to set an
355 invoicing_list destination to the newly-created svc_acct. Here's an example:
357 $cust_main->insert( {}, [ $email, 'POST' ] );
359 Currently available options are: I<depend_jobnum> and I<noexport>.
361 If I<depend_jobnum> is set, all provisioning jobs will have a dependancy
362 on the supplied jobnum (they will not run until the specific job completes).
363 This can be used to defer provisioning until some action completes (such
364 as running the customer's credit card successfully).
366 The I<noexport> option is deprecated. If I<noexport> is set true, no
367 provisioning jobs (exports) are scheduled. (You can schedule them later with
368 the B<reexport> method.)
374 my $cust_pkgs = @_ ? shift : {};
375 my $invoicing_list = @_ ? shift : '';
377 warn "$me insert called with options ".
378 join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
381 local $SIG{HUP} = 'IGNORE';
382 local $SIG{INT} = 'IGNORE';
383 local $SIG{QUIT} = 'IGNORE';
384 local $SIG{TERM} = 'IGNORE';
385 local $SIG{TSTP} = 'IGNORE';
386 local $SIG{PIPE} = 'IGNORE';
388 my $oldAutoCommit = $FS::UID::AutoCommit;
389 local $FS::UID::AutoCommit = 0;
392 my $prepay_identifier = '';
393 my( $amount, $seconds ) = ( 0, 0 );
395 if ( $self->payby eq 'PREPAY' ) {
397 $self->payby('BILL');
398 $prepay_identifier = $self->payinfo;
401 warn " looking up prepaid card $prepay_identifier\n"
404 my $error = $self->get_prepay($prepay_identifier, \$amount, \$seconds);
406 $dbh->rollback if $oldAutoCommit;
407 #return "error applying prepaid card (transaction rolled back): $error";
411 $payby = 'PREP' if $amount;
413 } elsif ( $self->payby =~ /^(CASH|WEST|MCRD)$/ ) {
416 $self->payby('BILL');
417 $amount = $self->paid;
421 warn " inserting $self\n"
424 $self->signupdate(time) unless $self->signupdate;
426 $self->auto_agent_custid()
427 if $conf->config('cust_main-auto_agent_custid') && ! $self->agent_custid;
429 my $error = $self->SUPER::insert;
431 $dbh->rollback if $oldAutoCommit;
432 #return "inserting cust_main record (transaction rolled back): $error";
436 warn " setting invoicing list\n"
439 if ( $invoicing_list ) {
440 $error = $self->check_invoicing_list( $invoicing_list );
442 $dbh->rollback if $oldAutoCommit;
443 #return "checking invoicing_list (transaction rolled back): $error";
446 $self->invoicing_list( $invoicing_list );
449 if ( $conf->config('cust_main-skeleton_tables')
450 && $conf->config('cust_main-skeleton_custnum') ) {
452 warn " inserting skeleton records\n"
455 my $error = $self->start_copy_skel;
457 $dbh->rollback if $oldAutoCommit;
463 warn " ordering packages\n"
466 $error = $self->order_pkgs($cust_pkgs, \$seconds, %options);
468 $dbh->rollback if $oldAutoCommit;
473 $dbh->rollback if $oldAutoCommit;
474 return "No svc_acct record to apply pre-paid time";
478 warn " inserting initial $payby payment of $amount\n"
480 $error = $self->insert_cust_pay($payby, $amount, $prepay_identifier);
482 $dbh->rollback if $oldAutoCommit;
483 return "inserting payment (transaction rolled back): $error";
487 unless ( $import || $skip_fuzzyfiles ) {
488 warn " queueing fuzzyfiles update\n"
490 $error = $self->queue_fuzzyfiles_update;
492 $dbh->rollback if $oldAutoCommit;
493 return "updating fuzzy search cache: $error";
497 warn " insert complete; committing transaction\n"
500 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
505 use File::CounterFile;
506 sub auto_agent_custid {
509 my $format = $conf->config('cust_main-auto_agent_custid');
511 if ( $format eq '1YMMXXXXXXXX' ) {
513 my $counter = new File::CounterFile 'cust_main.agent_custid';
516 my $ym = 100000000000 + time2str('%y%m00000000', time);
517 if ( $ym > $counter->value ) {
518 $counter->{'value'} = $agent_custid = $ym;
519 $counter->{'updated'} = 1;
521 $agent_custid = $counter->inc;
527 die "Unknown cust_main-auto_agent_custid format: $format";
530 $self->agent_custid($agent_custid);
534 sub start_copy_skel {
537 #'mg_user_preference' => {},
538 #'mg_user_indicator_profile.user_indicator_profile_id' => { 'mg_profile_indicator.profile_indicator_id' => { 'mg_profile_details.profile_detail_id' }, },
539 #'mg_watchlist_header.watchlist_header_id' => { 'mg_watchlist_details.watchlist_details_id' },
540 #'mg_user_grid_header.grid_header_id' => { 'mg_user_grid_details.user_grid_details_id' },
541 #'mg_portfolio_header.portfolio_header_id' => { 'mg_portfolio_trades.portfolio_trades_id' => { 'mg_portfolio_trades_positions.portfolio_trades_positions_id' } },
542 my @tables = eval(join('\n',$conf->config('cust_main-skeleton_tables')));
545 _copy_skel( 'cust_main', #tablename
546 $conf->config('cust_main-skeleton_custnum'), #sourceid
547 $self->custnum, #destid
548 @tables, #child tables
552 #recursive subroutine, not a method
554 my( $table, $sourceid, $destid, %child_tables ) = @_;
557 if ( $table =~ /^(\w+)\.(\w+)$/ ) {
558 ( $table, $primary_key ) = ( $1, $2 );
560 my $dbdef_table = dbdef->table($table);
561 $primary_key = $dbdef_table->primary_key
562 or return "$table has no primary key".
563 " (or do you need to run dbdef-create?)";
566 warn " _copy_skel: $table.$primary_key $sourceid to $destid for ".
567 join (', ', keys %child_tables). "\n"
570 foreach my $child_table_def ( keys %child_tables ) {
574 if ( $child_table_def =~ /^(\w+)\.(\w+)$/ ) {
575 ( $child_table, $child_pkey ) = ( $1, $2 );
577 $child_table = $child_table_def;
579 $child_pkey = dbdef->table($child_table)->primary_key;
580 # or return "$table has no primary key".
581 # " (or do you need to run dbdef-create?)\n";
585 if ( keys %{ $child_tables{$child_table_def} } ) {
587 return "$child_table has no primary key".
588 " (run dbdef-create or try specifying it?)\n"
591 #false laziness w/Record::insert and only works on Pg
592 #refactor the proper last-inserted-id stuff out of Record::insert if this
593 # ever gets use for anything besides a quick kludge for one customer
594 my $default = dbdef->table($child_table)->column($child_pkey)->default;
595 $default =~ /^nextval\(\(?'"?([\w\.]+)"?'/i
596 or return "can't parse $child_table.$child_pkey default value ".
597 " for sequence name: $default";
602 my @sel_columns = grep { $_ ne $primary_key }
603 dbdef->table($child_table)->columns;
604 my $sel_columns = join(', ', @sel_columns );
606 my @ins_columns = grep { $_ ne $child_pkey } @sel_columns;
607 my $ins_columns = ' ( '. join(', ', $primary_key, @ins_columns ). ' ) ';
608 my $placeholders = ' ( ?, '. join(', ', map '?', @ins_columns ). ' ) ';
610 my $sel_st = "SELECT $sel_columns FROM $child_table".
611 " WHERE $primary_key = $sourceid";
614 my $sel_sth = dbh->prepare( $sel_st )
615 or return dbh->errstr;
617 $sel_sth->execute or return $sel_sth->errstr;
619 while ( my $row = $sel_sth->fetchrow_hashref ) {
621 warn " selected row: ".
622 join(', ', map { "$_=".$row->{$_} } keys %$row ). "\n"
626 "INSERT INTO $child_table $ins_columns VALUES $placeholders";
627 my $ins_sth =dbh->prepare($statement)
628 or return dbh->errstr;
629 my @param = ( $destid, map $row->{$_}, @ins_columns );
630 warn " $statement: [ ". join(', ', @param). " ]\n"
632 $ins_sth->execute( @param )
633 or return $ins_sth->errstr;
635 #next unless keys %{ $child_tables{$child_table} };
636 next unless $sequence;
638 #another section of that laziness
639 my $seq_sql = "SELECT currval('$sequence')";
640 my $seq_sth = dbh->prepare($seq_sql) or return dbh->errstr;
641 $seq_sth->execute or return $seq_sth->errstr;
642 my $insertid = $seq_sth->fetchrow_arrayref->[0];
644 # don't drink soap! recurse! recurse! okay!
646 _copy_skel( $child_table_def,
647 $row->{$child_pkey}, #sourceid
649 %{ $child_tables{$child_table_def} },
651 return $error if $error;
661 =item order_pkgs HASHREF, [ SECONDSREF, [ , OPTION => VALUE ... ] ]
663 Like the insert method on an existing record, this method orders a package
664 and included services atomicaly. Pass a Tie::RefHash data structure to this
665 method containing FS::cust_pkg and FS::svc_I<tablename> objects. There should
666 be a better explanation of this, but until then, here's an example:
669 tie %hash, 'Tie::RefHash'; #this part is important
671 $cust_pkg => [ $svc_acct ],
674 $cust_main->order_pkgs( \%hash, \'0', 'noexport'=>1 );
676 Services can be new, in which case they are inserted, or existing unaudited
677 services, in which case they are linked to the newly-created package.
679 Currently available options are: I<depend_jobnum> and I<noexport>.
681 If I<depend_jobnum> is set, all provisioning jobs will have a dependancy
682 on the supplied jobnum (they will not run until the specific job completes).
683 This can be used to defer provisioning until some action completes (such
684 as running the customer's credit card successfully).
686 The I<noexport> option is deprecated. If I<noexport> is set true, no
687 provisioning jobs (exports) are scheduled. (You can schedule them later with
688 the B<reexport> method for each cust_pkg object. Using the B<reexport> method
689 on the cust_main object is not recommended, as existing services will also be
696 my $cust_pkgs = shift;
699 my %svc_options = ();
700 $svc_options{'depend_jobnum'} = $options{'depend_jobnum'}
701 if exists $options{'depend_jobnum'};
702 warn "$me order_pkgs called with options ".
703 join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
706 local $SIG{HUP} = 'IGNORE';
707 local $SIG{INT} = 'IGNORE';
708 local $SIG{QUIT} = 'IGNORE';
709 local $SIG{TERM} = 'IGNORE';
710 local $SIG{TSTP} = 'IGNORE';
711 local $SIG{PIPE} = 'IGNORE';
713 my $oldAutoCommit = $FS::UID::AutoCommit;
714 local $FS::UID::AutoCommit = 0;
717 local $FS::svc_Common::noexport_hack = 1 if $options{'noexport'};
719 foreach my $cust_pkg ( keys %$cust_pkgs ) {
720 $cust_pkg->custnum( $self->custnum );
721 my $error = $cust_pkg->insert;
723 $dbh->rollback if $oldAutoCommit;
724 return "inserting cust_pkg (transaction rolled back): $error";
726 foreach my $svc_something ( @{$cust_pkgs->{$cust_pkg}} ) {
727 if ( $svc_something->svcnum ) {
728 my $old_cust_svc = $svc_something->cust_svc;
729 my $new_cust_svc = new FS::cust_svc { $old_cust_svc->hash };
730 $new_cust_svc->pkgnum( $cust_pkg->pkgnum);
731 $error = $new_cust_svc->replace($old_cust_svc);
733 $svc_something->pkgnum( $cust_pkg->pkgnum );
734 if ( $seconds && $$seconds && $svc_something->isa('FS::svc_acct') ) {
735 $svc_something->seconds( $svc_something->seconds + $$seconds );
738 $error = $svc_something->insert(%svc_options);
741 $dbh->rollback if $oldAutoCommit;
742 #return "inserting svc_ (transaction rolled back): $error";
748 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
752 =item recharge_prepay IDENTIFIER | PREPAY_CREDIT_OBJ [ , AMOUNTREF, SECONDSREF, UPBYTEREF, DOWNBYTEREF ]
754 Recharges this (existing) customer with the specified prepaid card (see
755 L<FS::prepay_credit>), specified either by I<identifier> or as an
756 FS::prepay_credit object. If there is an error, returns the error, otherwise
759 Optionally, four scalar references can be passed as well. They will have their
760 values filled in with the amount, number of seconds, and number of upload and
761 download bytes applied by this prepaid
766 sub recharge_prepay {
767 my( $self, $prepay_credit, $amountref, $secondsref,
768 $upbytesref, $downbytesref, $totalbytesref ) = @_;
770 local $SIG{HUP} = 'IGNORE';
771 local $SIG{INT} = 'IGNORE';
772 local $SIG{QUIT} = 'IGNORE';
773 local $SIG{TERM} = 'IGNORE';
774 local $SIG{TSTP} = 'IGNORE';
775 local $SIG{PIPE} = 'IGNORE';
777 my $oldAutoCommit = $FS::UID::AutoCommit;
778 local $FS::UID::AutoCommit = 0;
781 my( $amount, $seconds, $upbytes, $downbytes, $totalbytes) = ( 0, 0, 0, 0, 0 );
783 my $error = $self->get_prepay($prepay_credit, \$amount,
784 \$seconds, \$upbytes, \$downbytes, \$totalbytes)
785 || $self->increment_seconds($seconds)
786 || $self->increment_upbytes($upbytes)
787 || $self->increment_downbytes($downbytes)
788 || $self->increment_totalbytes($totalbytes)
789 || $self->insert_cust_pay_prepay( $amount,
791 ? $prepay_credit->identifier
796 $dbh->rollback if $oldAutoCommit;
800 if ( defined($amountref) ) { $$amountref = $amount; }
801 if ( defined($secondsref) ) { $$secondsref = $seconds; }
802 if ( defined($upbytesref) ) { $$upbytesref = $upbytes; }
803 if ( defined($downbytesref) ) { $$downbytesref = $downbytes; }
804 if ( defined($totalbytesref) ) { $$totalbytesref = $totalbytes; }
806 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
811 =item get_prepay IDENTIFIER | PREPAY_CREDIT_OBJ , AMOUNTREF, SECONDSREF
813 Looks up and deletes a prepaid card (see L<FS::prepay_credit>),
814 specified either by I<identifier> or as an FS::prepay_credit object.
816 References to I<amount> and I<seconds> scalars should be passed as arguments
817 and will be incremented by the values of the prepaid card.
819 If the prepaid card specifies an I<agentnum> (see L<FS::agent>), it is used to
820 check or set this customer's I<agentnum>.
822 If there is an error, returns the error, otherwise returns false.
828 my( $self, $prepay_credit, $amountref, $secondsref,
829 $upref, $downref, $totalref) = @_;
831 local $SIG{HUP} = 'IGNORE';
832 local $SIG{INT} = 'IGNORE';
833 local $SIG{QUIT} = 'IGNORE';
834 local $SIG{TERM} = 'IGNORE';
835 local $SIG{TSTP} = 'IGNORE';
836 local $SIG{PIPE} = 'IGNORE';
838 my $oldAutoCommit = $FS::UID::AutoCommit;
839 local $FS::UID::AutoCommit = 0;
842 unless ( ref($prepay_credit) ) {
844 my $identifier = $prepay_credit;
846 $prepay_credit = qsearchs(
848 { 'identifier' => $prepay_credit },
853 unless ( $prepay_credit ) {
854 $dbh->rollback if $oldAutoCommit;
855 return "Invalid prepaid card: ". $identifier;
860 if ( $prepay_credit->agentnum ) {
861 if ( $self->agentnum && $self->agentnum != $prepay_credit->agentnum ) {
862 $dbh->rollback if $oldAutoCommit;
863 return "prepaid card not valid for agent ". $self->agentnum;
865 $self->agentnum($prepay_credit->agentnum);
868 my $error = $prepay_credit->delete;
870 $dbh->rollback if $oldAutoCommit;
871 return "removing prepay_credit (transaction rolled back): $error";
874 $$amountref += $prepay_credit->amount;
875 $$secondsref += $prepay_credit->seconds;
876 $$upref += $prepay_credit->upbytes;
877 $$downref += $prepay_credit->downbytes;
878 $$totalref += $prepay_credit->totalbytes;
880 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
885 =item increment_upbytes SECONDS
887 Updates this customer's single or primary account (see L<FS::svc_acct>) by
888 the specified number of upbytes. If there is an error, returns the error,
889 otherwise returns false.
893 sub increment_upbytes {
894 _increment_column( shift, 'upbytes', @_);
897 =item increment_downbytes SECONDS
899 Updates this customer's single or primary account (see L<FS::svc_acct>) by
900 the specified number of downbytes. If there is an error, returns the error,
901 otherwise returns false.
905 sub increment_downbytes {
906 _increment_column( shift, 'downbytes', @_);
909 =item increment_totalbytes SECONDS
911 Updates this customer's single or primary account (see L<FS::svc_acct>) by
912 the specified number of totalbytes. If there is an error, returns the error,
913 otherwise returns false.
917 sub increment_totalbytes {
918 _increment_column( shift, 'totalbytes', @_);
921 =item increment_seconds SECONDS
923 Updates this customer's single or primary account (see L<FS::svc_acct>) by
924 the specified number of seconds. If there is an error, returns the error,
925 otherwise returns false.
929 sub increment_seconds {
930 _increment_column( shift, 'seconds', @_);
933 =item _increment_column AMOUNT
935 Updates this customer's single or primary account (see L<FS::svc_acct>) by
936 the specified number of seconds or bytes. If there is an error, returns
937 the error, otherwise returns false.
941 sub _increment_column {
942 my( $self, $column, $amount ) = @_;
943 warn "$me increment_column called: $column, $amount\n"
946 return '' unless $amount;
948 my @cust_pkg = grep { $_->part_pkg->svcpart('svc_acct') }
949 $self->ncancelled_pkgs;
952 return 'No packages with primary or single services found'.
953 ' to apply pre-paid time';
954 } elsif ( scalar(@cust_pkg) > 1 ) {
955 #maybe have a way to specify the package/account?
956 return 'Multiple packages found to apply pre-paid time';
959 my $cust_pkg = $cust_pkg[0];
960 warn " found package pkgnum ". $cust_pkg->pkgnum. "\n"
964 $cust_pkg->cust_svc( $cust_pkg->part_pkg->svcpart('svc_acct') );
967 return 'No account found to apply pre-paid time';
968 } elsif ( scalar(@cust_svc) > 1 ) {
969 return 'Multiple accounts found to apply pre-paid time';
972 my $svc_acct = $cust_svc[0]->svc_x;
973 warn " found service svcnum ". $svc_acct->pkgnum.
974 ' ('. $svc_acct->email. ")\n"
977 $column = "increment_$column";
978 $svc_acct->$column($amount);
982 =item insert_cust_pay_prepay AMOUNT [ PAYINFO ]
984 Inserts a prepayment in the specified amount for this customer. An optional
985 second argument can specify the prepayment identifier for tracking purposes.
986 If there is an error, returns the error, otherwise returns false.
990 sub insert_cust_pay_prepay {
991 shift->insert_cust_pay('PREP', @_);
994 =item insert_cust_pay_cash AMOUNT [ PAYINFO ]
996 Inserts a cash payment in the specified amount for this customer. An optional
997 second argument can specify the payment identifier for tracking purposes.
998 If there is an error, returns the error, otherwise returns false.
1002 sub insert_cust_pay_cash {
1003 shift->insert_cust_pay('CASH', @_);
1006 =item insert_cust_pay_west AMOUNT [ PAYINFO ]
1008 Inserts a Western Union payment in the specified amount for this customer. An
1009 optional second argument can specify the prepayment identifier for tracking
1010 purposes. If there is an error, returns the error, otherwise returns false.
1014 sub insert_cust_pay_west {
1015 shift->insert_cust_pay('WEST', @_);
1018 sub insert_cust_pay {
1019 my( $self, $payby, $amount ) = splice(@_, 0, 3);
1020 my $payinfo = scalar(@_) ? shift : '';
1022 my $cust_pay = new FS::cust_pay {
1023 'custnum' => $self->custnum,
1024 'paid' => sprintf('%.2f', $amount),
1025 #'_date' => #date the prepaid card was purchased???
1027 'payinfo' => $payinfo,
1035 This method is deprecated. See the I<depend_jobnum> option to the insert and
1036 order_pkgs methods for a better way to defer provisioning.
1038 Re-schedules all exports by calling the B<reexport> method of all associated
1039 packages (see L<FS::cust_pkg>). If there is an error, returns the error;
1040 otherwise returns false.
1047 carp "WARNING: FS::cust_main::reexport is deprectated; ".
1048 "use the depend_jobnum option to insert or order_pkgs to delay export";
1050 local $SIG{HUP} = 'IGNORE';
1051 local $SIG{INT} = 'IGNORE';
1052 local $SIG{QUIT} = 'IGNORE';
1053 local $SIG{TERM} = 'IGNORE';
1054 local $SIG{TSTP} = 'IGNORE';
1055 local $SIG{PIPE} = 'IGNORE';
1057 my $oldAutoCommit = $FS::UID::AutoCommit;
1058 local $FS::UID::AutoCommit = 0;
1061 foreach my $cust_pkg ( $self->ncancelled_pkgs ) {
1062 my $error = $cust_pkg->reexport;
1064 $dbh->rollback if $oldAutoCommit;
1069 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1074 =item delete NEW_CUSTNUM
1076 This deletes the customer. If there is an error, returns the error, otherwise
1079 This will completely remove all traces of the customer record. This is not
1080 what you want when a customer cancels service; for that, cancel all of the
1081 customer's packages (see L</cancel>).
1083 If the customer has any uncancelled packages, you need to pass a new (valid)
1084 customer number for those packages to be transferred to. Cancelled packages
1085 will be deleted. Did I mention that this is NOT what you want when a customer
1086 cancels service and that you really should be looking see L<FS::cust_pkg/cancel>?
1088 You can't delete a customer with invoices (see L<FS::cust_bill>),
1089 or credits (see L<FS::cust_credit>), payments (see L<FS::cust_pay>) or
1090 refunds (see L<FS::cust_refund>).
1097 local $SIG{HUP} = 'IGNORE';
1098 local $SIG{INT} = 'IGNORE';
1099 local $SIG{QUIT} = 'IGNORE';
1100 local $SIG{TERM} = 'IGNORE';
1101 local $SIG{TSTP} = 'IGNORE';
1102 local $SIG{PIPE} = 'IGNORE';
1104 my $oldAutoCommit = $FS::UID::AutoCommit;
1105 local $FS::UID::AutoCommit = 0;
1108 if ( $self->cust_bill ) {
1109 $dbh->rollback if $oldAutoCommit;
1110 return "Can't delete a customer with invoices";
1112 if ( $self->cust_credit ) {
1113 $dbh->rollback if $oldAutoCommit;
1114 return "Can't delete a customer with credits";
1116 if ( $self->cust_pay ) {
1117 $dbh->rollback if $oldAutoCommit;
1118 return "Can't delete a customer with payments";
1120 if ( $self->cust_refund ) {
1121 $dbh->rollback if $oldAutoCommit;
1122 return "Can't delete a customer with refunds";
1125 my @cust_pkg = $self->ncancelled_pkgs;
1127 my $new_custnum = shift;
1128 unless ( qsearchs( 'cust_main', { 'custnum' => $new_custnum } ) ) {
1129 $dbh->rollback if $oldAutoCommit;
1130 return "Invalid new customer number: $new_custnum";
1132 foreach my $cust_pkg ( @cust_pkg ) {
1133 my %hash = $cust_pkg->hash;
1134 $hash{'custnum'} = $new_custnum;
1135 my $new_cust_pkg = new FS::cust_pkg ( \%hash );
1136 my $error = $new_cust_pkg->replace($cust_pkg,
1137 options => { $cust_pkg->options },
1140 $dbh->rollback if $oldAutoCommit;
1145 my @cancelled_cust_pkg = $self->all_pkgs;
1146 foreach my $cust_pkg ( @cancelled_cust_pkg ) {
1147 my $error = $cust_pkg->delete;
1149 $dbh->rollback if $oldAutoCommit;
1154 foreach my $cust_main_invoice ( #(email invoice destinations, not invoices)
1155 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } )
1157 my $error = $cust_main_invoice->delete;
1159 $dbh->rollback if $oldAutoCommit;
1164 my $error = $self->SUPER::delete;
1166 $dbh->rollback if $oldAutoCommit;
1170 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1175 =item replace [ OLD_RECORD ] [ INVOICING_LIST_ARYREF ]
1177 Replaces the OLD_RECORD with this one in the database. If there is an error,
1178 returns the error, otherwise returns false.
1180 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
1181 be set as the invoicing list (see L<"invoicing_list">). Errors return as
1182 expected and rollback the entire transaction; it is not necessary to call
1183 check_invoicing_list first. Here's an example:
1185 $new_cust_main->replace( $old_cust_main, [ $email, 'POST' ] );
1192 my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
1194 : $self->replace_old;
1198 warn "$me replace called\n"
1201 my $curuser = $FS::CurrentUser::CurrentUser;
1202 if ( $self->payby eq 'COMP'
1203 && $self->payby ne $old->payby
1204 && ! $curuser->access_right('Complimentary customer')
1207 return "You are not permitted to create complimentary accounts.";
1210 local($ignore_expired_card) = 1
1211 if $old->payby =~ /^(CARD|DCRD)$/
1212 && $self->payby =~ /^(CARD|DCRD)$/
1213 && ( $old->payinfo eq $self->payinfo || $old->paymask eq $self->paymask );
1215 local $SIG{HUP} = 'IGNORE';
1216 local $SIG{INT} = 'IGNORE';
1217 local $SIG{QUIT} = 'IGNORE';
1218 local $SIG{TERM} = 'IGNORE';
1219 local $SIG{TSTP} = 'IGNORE';
1220 local $SIG{PIPE} = 'IGNORE';
1222 my $oldAutoCommit = $FS::UID::AutoCommit;
1223 local $FS::UID::AutoCommit = 0;
1226 my $error = $self->SUPER::replace($old);
1229 $dbh->rollback if $oldAutoCommit;
1233 if ( @param ) { # INVOICING_LIST_ARYREF
1234 my $invoicing_list = shift @param;
1235 $error = $self->check_invoicing_list( $invoicing_list );
1237 $dbh->rollback if $oldAutoCommit;
1240 $self->invoicing_list( $invoicing_list );
1243 if ( $self->payby =~ /^(CARD|CHEK|LECB)$/ &&
1244 grep { $self->get($_) ne $old->get($_) } qw(payinfo paydate payname) ) {
1245 # card/check/lec info has changed, want to retry realtime_ invoice events
1246 my $error = $self->retry_realtime;
1248 $dbh->rollback if $oldAutoCommit;
1253 unless ( $import || $skip_fuzzyfiles ) {
1254 $error = $self->queue_fuzzyfiles_update;
1256 $dbh->rollback if $oldAutoCommit;
1257 return "updating fuzzy search cache: $error";
1261 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1266 =item queue_fuzzyfiles_update
1268 Used by insert & replace to update the fuzzy search cache
1272 sub queue_fuzzyfiles_update {
1275 local $SIG{HUP} = 'IGNORE';
1276 local $SIG{INT} = 'IGNORE';
1277 local $SIG{QUIT} = 'IGNORE';
1278 local $SIG{TERM} = 'IGNORE';
1279 local $SIG{TSTP} = 'IGNORE';
1280 local $SIG{PIPE} = 'IGNORE';
1282 my $oldAutoCommit = $FS::UID::AutoCommit;
1283 local $FS::UID::AutoCommit = 0;
1286 my $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
1287 my $error = $queue->insert( map $self->getfield($_),
1288 qw(first last company)
1291 $dbh->rollback if $oldAutoCommit;
1292 return "queueing job (transaction rolled back): $error";
1295 if ( $self->ship_last ) {
1296 $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
1297 $error = $queue->insert( map $self->getfield("ship_$_"),
1298 qw(first last company)
1301 $dbh->rollback if $oldAutoCommit;
1302 return "queueing job (transaction rolled back): $error";
1306 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1313 Checks all fields to make sure this is a valid customer record. If there is
1314 an error, returns the error, otherwise returns false. Called by the insert
1315 and replace methods.
1322 warn "$me check BEFORE: \n". $self->_dump
1326 $self->ut_numbern('custnum')
1327 || $self->ut_number('agentnum')
1328 || $self->ut_textn('agent_custid')
1329 || $self->ut_number('refnum')
1330 || $self->ut_textn('custbatch')
1331 || $self->ut_name('last')
1332 || $self->ut_name('first')
1333 || $self->ut_snumbern('birthdate')
1334 || $self->ut_snumbern('signupdate')
1335 || $self->ut_textn('company')
1336 || $self->ut_text('address1')
1337 || $self->ut_textn('address2')
1338 || $self->ut_text('city')
1339 || $self->ut_textn('county')
1340 || $self->ut_textn('state')
1341 || $self->ut_country('country')
1342 || $self->ut_anything('comments')
1343 || $self->ut_numbern('referral_custnum')
1344 || $self->ut_textn('stateid')
1345 || $self->ut_textn('stateid_state')
1346 || $self->ut_textn('invoice_terms')
1347 || $self->ut_alphan('geocode')
1350 #barf. need message catalogs. i18n. etc.
1351 $error .= "Please select an advertising source."
1352 if $error =~ /^Illegal or empty \(numeric\) refnum: /;
1353 return $error if $error;
1355 return "Unknown agent"
1356 unless qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
1358 return "Unknown refnum"
1359 unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } );
1361 return "Unknown referring custnum: ". $self->referral_custnum
1362 unless ! $self->referral_custnum
1363 || qsearchs( 'cust_main', { 'custnum' => $self->referral_custnum } );
1365 if ( $self->ss eq '' ) {
1370 $ss =~ /^(\d{3})(\d{2})(\d{4})$/
1371 or return "Illegal social security number: ". $self->ss;
1372 $self->ss("$1-$2-$3");
1376 # bad idea to disable, causes billing to fail because of no tax rates later
1377 # unless ( $import ) {
1378 unless ( qsearch('cust_main_county', {
1379 'country' => $self->country,
1382 return "Unknown state/county/country: ".
1383 $self->state. "/". $self->county. "/". $self->country
1384 unless qsearch('cust_main_county',{
1385 'state' => $self->state,
1386 'county' => $self->county,
1387 'country' => $self->country,
1393 $self->ut_phonen('daytime', $self->country)
1394 || $self->ut_phonen('night', $self->country)
1395 || $self->ut_phonen('fax', $self->country)
1396 || $self->ut_zip('zip', $self->country)
1398 return $error if $error;
1400 if ( $conf->exists('cust_main-require_phone')
1401 && ! length($self->daytime) && ! length($self->night)
1404 my $daytime_label = FS::Msgcat::_gettext('daytime') =~ /^(daytime)?$/
1406 : FS::Msgcat::_gettext('daytime');
1407 my $night_label = FS::Msgcat::_gettext('night') =~ /^(night)?$/
1409 : FS::Msgcat::_gettext('night');
1411 return "$daytime_label or $night_label is required"
1415 if ( $self->has_ship_address
1416 && scalar ( grep { $self->getfield($_) ne $self->getfield("ship_$_") }
1417 $self->addr_fields )
1421 $self->ut_name('ship_last')
1422 || $self->ut_name('ship_first')
1423 || $self->ut_textn('ship_company')
1424 || $self->ut_text('ship_address1')
1425 || $self->ut_textn('ship_address2')
1426 || $self->ut_text('ship_city')
1427 || $self->ut_textn('ship_county')
1428 || $self->ut_textn('ship_state')
1429 || $self->ut_country('ship_country')
1431 return $error if $error;
1433 #false laziness with above
1434 unless ( qsearchs('cust_main_county', {
1435 'country' => $self->ship_country,
1438 return "Unknown ship_state/ship_county/ship_country: ".
1439 $self->ship_state. "/". $self->ship_county. "/". $self->ship_country
1440 unless qsearch('cust_main_county',{
1441 'state' => $self->ship_state,
1442 'county' => $self->ship_county,
1443 'country' => $self->ship_country,
1449 $self->ut_phonen('ship_daytime', $self->ship_country)
1450 || $self->ut_phonen('ship_night', $self->ship_country)
1451 || $self->ut_phonen('ship_fax', $self->ship_country)
1452 || $self->ut_zip('ship_zip', $self->ship_country)
1454 return $error if $error;
1456 return "Unit # is required."
1457 if $self->ship_address2 =~ /^\s*$/
1458 && $conf->exists('cust_main-require_address2');
1460 } else { # ship_ info eq billing info, so don't store dup info in database
1462 $self->setfield("ship_$_", '')
1463 foreach $self->addr_fields;
1465 return "Unit # is required."
1466 if $self->address2 =~ /^\s*$/
1467 && $conf->exists('cust_main-require_address2');
1471 #$self->payby =~ /^(CARD|DCRD|CHEK|DCHK|LECB|BILL|COMP|PREPAY|CASH|WEST|MCRD)$/
1472 # or return "Illegal payby: ". $self->payby;
1474 FS::payby->can_payby($self->table, $self->payby)
1475 or return "Illegal payby: ". $self->payby;
1477 $error = $self->ut_numbern('paystart_month')
1478 || $self->ut_numbern('paystart_year')
1479 || $self->ut_numbern('payissue')
1480 || $self->ut_textn('paytype')
1482 return $error if $error;
1484 if ( $self->payip eq '' ) {
1487 $error = $self->ut_ip('payip');
1488 return $error if $error;
1491 # If it is encrypted and the private key is not availaible then we can't
1492 # check the credit card.
1494 my $check_payinfo = 1;
1496 if ($self->is_encrypted($self->payinfo)) {
1500 if ( $check_payinfo && $self->payby =~ /^(CARD|DCRD)$/ ) {
1502 my $payinfo = $self->payinfo;
1503 $payinfo =~ s/\D//g;
1504 $payinfo =~ /^(\d{13,16})$/
1505 or return gettext('invalid_card'); # . ": ". $self->payinfo;
1507 $self->payinfo($payinfo);
1509 or return gettext('invalid_card'); # . ": ". $self->payinfo;
1511 return gettext('unknown_card_type')
1512 if cardtype($self->payinfo) eq "Unknown";
1514 my $ban = qsearchs('banned_pay', $self->_banned_pay_hashref);
1516 return 'Banned credit card: banned on '.
1517 time2str('%a %h %o at %r', $ban->_date).
1518 ' by '. $ban->otaker.
1519 ' (ban# '. $ban->bannum. ')';
1522 if (length($self->paycvv) && !$self->is_encrypted($self->paycvv)) {
1523 if ( cardtype($self->payinfo) eq 'American Express card' ) {
1524 $self->paycvv =~ /^(\d{4})$/
1525 or return "CVV2 (CID) for American Express cards is four digits.";
1528 $self->paycvv =~ /^(\d{3})$/
1529 or return "CVV2 (CVC2/CID) is three digits.";
1536 my $cardtype = cardtype($payinfo);
1537 if ( $cardtype =~ /^(Switch|Solo)$/i ) {
1539 return "Start date or issue number is required for $cardtype cards"
1540 unless $self->paystart_month && $self->paystart_year or $self->payissue;
1542 return "Start month must be between 1 and 12"
1543 if $self->paystart_month
1544 and $self->paystart_month < 1 || $self->paystart_month > 12;
1546 return "Start year must be 1990 or later"
1547 if $self->paystart_year
1548 and $self->paystart_year < 1990;
1550 return "Issue number must be beween 1 and 99"
1552 and $self->payissue < 1 || $self->payissue > 99;
1555 $self->paystart_month('');
1556 $self->paystart_year('');
1557 $self->payissue('');
1560 } elsif ( $check_payinfo && $self->payby =~ /^(CHEK|DCHK)$/ ) {
1562 my $payinfo = $self->payinfo;
1563 $payinfo =~ s/[^\d\@]//g;
1564 if ( $conf->exists('echeck-nonus') ) {
1565 $payinfo =~ /^(\d+)\@(\d+)$/ or return 'invalid echeck account@aba';
1566 $payinfo = "$1\@$2";
1568 $payinfo =~ /^(\d+)\@(\d{9})$/ or return 'invalid echeck account@aba';
1569 $payinfo = "$1\@$2";
1571 $self->payinfo($payinfo);
1574 my $ban = qsearchs('banned_pay', $self->_banned_pay_hashref);
1576 return 'Banned ACH account: banned on '.
1577 time2str('%a %h %o at %r', $ban->_date).
1578 ' by '. $ban->otaker.
1579 ' (ban# '. $ban->bannum. ')';
1582 } elsif ( $self->payby eq 'LECB' ) {
1584 my $payinfo = $self->payinfo;
1585 $payinfo =~ s/\D//g;
1586 $payinfo =~ /^1?(\d{10})$/ or return 'invalid btn billing telephone number';
1588 $self->payinfo($payinfo);
1591 } elsif ( $self->payby eq 'BILL' ) {
1593 $error = $self->ut_textn('payinfo');
1594 return "Illegal P.O. number: ". $self->payinfo if $error;
1597 } elsif ( $self->payby eq 'COMP' ) {
1599 my $curuser = $FS::CurrentUser::CurrentUser;
1600 if ( ! $self->custnum
1601 && ! $curuser->access_right('Complimentary customer')
1604 return "You are not permitted to create complimentary accounts."
1607 $error = $self->ut_textn('payinfo');
1608 return "Illegal comp account issuer: ". $self->payinfo if $error;
1611 } elsif ( $self->payby eq 'PREPAY' ) {
1613 my $payinfo = $self->payinfo;
1614 $payinfo =~ s/\W//g; #anything else would just confuse things
1615 $self->payinfo($payinfo);
1616 $error = $self->ut_alpha('payinfo');
1617 return "Illegal prepayment identifier: ". $self->payinfo if $error;
1618 return "Unknown prepayment identifier"
1619 unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } );
1624 if ( $self->paydate eq '' || $self->paydate eq '-' ) {
1625 return "Expiration date required"
1626 unless $self->payby =~ /^(BILL|PREPAY|CHEK|DCHK|LECB|CASH|WEST|MCRD)$/;
1630 if ( $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/ ) {
1631 ( $m, $y ) = ( $1, length($2) == 4 ? $2 : "20$2" );
1632 } elsif ( $self->paydate =~ /^(20)?(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) {
1633 ( $m, $y ) = ( $3, "20$2" );
1635 return "Illegal expiration date: ". $self->paydate;
1637 $self->paydate("$y-$m-01");
1638 my($nowm,$nowy)=(localtime(time))[4,5]; $nowm++; $nowy+=1900;
1639 return gettext('expired_card')
1641 && !$ignore_expired_card
1642 && ( $y<$nowy || ( $y==$nowy && $1<$nowm ) );
1645 if ( $self->payname eq '' && $self->payby !~ /^(CHEK|DCHK)$/ &&
1646 ( ! $conf->exists('require_cardname')
1647 || $self->payby !~ /^(CARD|DCRD)$/ )
1649 $self->payname( $self->first. " ". $self->getfield('last') );
1651 $self->payname =~ /^([\w \,\.\-\'\&]+)$/
1652 or return gettext('illegal_name'). " payname: ". $self->payname;
1656 foreach my $flag (qw( tax spool_cdr squelch_cdr )) {
1657 $self->$flag() =~ /^(Y?)$/ or return "Illegal $flag: ". $self->$flag();
1661 $self->otaker(getotaker) unless $self->otaker;
1663 warn "$me check AFTER: \n". $self->_dump
1666 $self->SUPER::check;
1671 Returns a list of fields which have ship_ duplicates.
1676 qw( last first company
1677 address1 address2 city county state zip country
1682 =item has_ship_address
1684 Returns true if this customer record has a separate shipping address.
1688 sub has_ship_address {
1690 scalar( grep { $self->getfield("ship_$_") ne '' } $self->addr_fields );
1695 Returns all packages (see L<FS::cust_pkg>) for this customer.
1702 return $self->num_pkgs unless wantarray;
1705 if ( $self->{'_pkgnum'} ) {
1706 @cust_pkg = values %{ $self->{'_pkgnum'}->cache };
1708 @cust_pkg = qsearch( 'cust_pkg', { 'custnum' => $self->custnum });
1711 sort sort_packages @cust_pkg;
1716 Synonym for B<all_pkgs>.
1721 shift->all_pkgs(@_);
1724 =item ncancelled_pkgs
1726 Returns all non-cancelled packages (see L<FS::cust_pkg>) for this customer.
1730 sub ncancelled_pkgs {
1733 return $self->num_ncancelled_pkgs unless wantarray;
1736 if ( $self->{'_pkgnum'} ) {
1738 warn "$me ncancelled_pkgs: returning cached objects"
1741 @cust_pkg = grep { ! $_->getfield('cancel') }
1742 values %{ $self->{'_pkgnum'}->cache };
1746 warn "$me ncancelled_pkgs: searching for packages with custnum ".
1747 $self->custnum. "\n"
1751 qsearch( 'cust_pkg', {
1752 'custnum' => $self->custnum,
1756 qsearch( 'cust_pkg', {
1757 'custnum' => $self->custnum,
1762 sort sort_packages @cust_pkg;
1766 # This should be generalized to use config options to determine order.
1768 if ( $a->get('cancel') and $b->get('cancel') ) {
1769 $a->pkgnum <=> $b->pkgnum;
1770 } elsif ( $a->get('cancel') or $b->get('cancel') ) {
1771 return -1 if $b->get('cancel');
1772 return 1 if $a->get('cancel');
1775 $a->pkgnum <=> $b->pkgnum;
1779 =item suspended_pkgs
1781 Returns all suspended packages (see L<FS::cust_pkg>) for this customer.
1785 sub suspended_pkgs {
1787 grep { $_->susp } $self->ncancelled_pkgs;
1790 =item unflagged_suspended_pkgs
1792 Returns all unflagged suspended packages (see L<FS::cust_pkg>) for this
1793 customer (thouse packages without the `manual_flag' set).
1797 sub unflagged_suspended_pkgs {
1799 return $self->suspended_pkgs
1800 unless dbdef->table('cust_pkg')->column('manual_flag');
1801 grep { ! $_->manual_flag } $self->suspended_pkgs;
1804 =item unsuspended_pkgs
1806 Returns all unsuspended (and uncancelled) packages (see L<FS::cust_pkg>) for
1811 sub unsuspended_pkgs {
1813 grep { ! $_->susp } $self->ncancelled_pkgs;
1816 =item num_cancelled_pkgs
1818 Returns the number of cancelled packages (see L<FS::cust_pkg>) for this
1823 sub num_cancelled_pkgs {
1824 shift->num_pkgs("cust_pkg.cancel IS NOT NULL AND cust_pkg.cancel != 0");
1827 sub num_ncancelled_pkgs {
1828 shift->num_pkgs("( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )");
1832 my( $self ) = shift;
1833 my $sql = scalar(@_) ? shift : '';
1834 $sql = "AND $sql" if $sql && $sql !~ /^\s*$/ && $sql !~ /^\s*AND/i;
1835 my $sth = dbh->prepare(
1836 "SELECT COUNT(*) FROM cust_pkg WHERE custnum = ? $sql"
1837 ) or die dbh->errstr;
1838 $sth->execute($self->custnum) or die $sth->errstr;
1839 $sth->fetchrow_arrayref->[0];
1844 Unsuspends all unflagged suspended packages (see L</unflagged_suspended_pkgs>
1845 and L<FS::cust_pkg>) for this customer. Always returns a list: an empty list
1846 on success or a list of errors.
1852 grep { $_->unsuspend } $self->suspended_pkgs;
1857 Suspends all unsuspended packages (see L<FS::cust_pkg>) for this customer.
1859 Returns a list: an empty list on success or a list of errors.
1865 grep { $_->suspend(@_) } $self->unsuspended_pkgs;
1868 =item suspend_if_pkgpart HASHREF | PKGPART [ , PKGPART ... ]
1870 Suspends all unsuspended packages (see L<FS::cust_pkg>) matching the listed
1871 PKGPARTs (see L<FS::part_pkg>). Preferred usage is to pass a hashref instead
1872 of a list of pkgparts; the hashref has the following keys:
1876 =item pkgparts - listref of pkgparts
1878 =item (other options are passed to the suspend method)
1883 Returns a list: an empty list on success or a list of errors.
1887 sub suspend_if_pkgpart {
1889 my (@pkgparts, %opt);
1890 if (ref($_[0]) eq 'HASH'){
1891 @pkgparts = @{$_[0]{pkgparts}};
1896 grep { $_->suspend(%opt) }
1897 grep { my $pkgpart = $_->pkgpart; grep { $pkgpart eq $_ } @pkgparts }
1898 $self->unsuspended_pkgs;
1901 =item suspend_unless_pkgpart HASHREF | PKGPART [ , PKGPART ... ]
1903 Suspends all unsuspended packages (see L<FS::cust_pkg>) unless they match the
1904 given PKGPARTs (see L<FS::part_pkg>). Preferred usage is to pass a hashref
1905 instead of a list of pkgparts; the hashref has the following keys:
1909 =item pkgparts - listref of pkgparts
1911 =item (other options are passed to the suspend method)
1915 Returns a list: an empty list on success or a list of errors.
1919 sub suspend_unless_pkgpart {
1921 my (@pkgparts, %opt);
1922 if (ref($_[0]) eq 'HASH'){
1923 @pkgparts = @{$_[0]{pkgparts}};
1928 grep { $_->suspend(%opt) }
1929 grep { my $pkgpart = $_->pkgpart; ! grep { $pkgpart eq $_ } @pkgparts }
1930 $self->unsuspended_pkgs;
1933 =item cancel [ OPTION => VALUE ... ]
1935 Cancels all uncancelled packages (see L<FS::cust_pkg>) for this customer.
1937 Available options are:
1941 =item quiet - can be set true to supress email cancellation notices.
1943 =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.
1945 =item ban - can be set true to ban this customer's credit card or ACH information, if present.
1949 Always returns a list: an empty list on success or a list of errors.
1954 my( $self, %opt ) = @_;
1956 warn "$me cancel called on customer ". $self->custnum. " with options ".
1957 join(', ', map { "$_: $opt{$_}" } keys %opt ). "\n"
1960 return ( 'access denied' )
1961 unless $FS::CurrentUser::CurrentUser->access_right('Cancel customer');
1963 if ( $opt{'ban'} && $self->payby =~ /^(CARD|DCRD|CHEK|DCHK)$/ ) {
1965 #should try decryption (we might have the private key)
1966 # and if not maybe queue a job for the server that does?
1967 return ( "Can't (yet) ban encrypted credit cards" )
1968 if $self->is_encrypted($self->payinfo);
1970 my $ban = new FS::banned_pay $self->_banned_pay_hashref;
1971 my $error = $ban->insert;
1972 return ( $error ) if $error;
1976 my @pkgs = $self->ncancelled_pkgs;
1978 warn "$me cancelling ". scalar($self->ncancelled_pkgs). "/".
1979 scalar(@pkgs). " packages for customer ". $self->custnum. "\n"
1982 grep { $_ } map { $_->cancel(%opt) } $self->ncancelled_pkgs;
1985 sub _banned_pay_hashref {
1996 'payby' => $payby2ban{$self->payby},
1997 'payinfo' => md5_base64($self->payinfo),
1998 #don't ever *search* on reason! #'reason' =>
2004 Returns all notes (see L<FS::cust_main_note>) for this customer.
2011 qsearch( 'cust_main_note',
2012 { 'custnum' => $self->custnum },
2014 'ORDER BY _DATE DESC'
2020 Returns the agent (see L<FS::agent>) for this customer.
2026 qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
2029 =item bill_and_collect
2031 Cancels and suspends any packages due, generates bills, applies payments and
2034 Warns on errors (Does not currently: If there is an error, returns the error, otherwise returns false.)
2036 Options are passed as name-value pairs. Currently available options are:
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 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.
2054 "1d" for the traditional, daily events (the default), or "1m" for the new monthly events (part_event.check_freq)
2058 If set true, re-charges setup fees.
2062 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)
2068 sub bill_and_collect {
2069 my( $self, %options ) = @_;
2075 #$options{actual_time} not $options{time} because freeside-daily -d is for
2076 #pre-printing invoices
2077 my @cancel_pkgs = grep { $_->expire && $_->expire <= $options{actual_time} }
2078 $self->ncancelled_pkgs;
2080 foreach my $cust_pkg ( @cancel_pkgs ) {
2081 my $cpr = $cust_pkg->last_cust_pkg_reason('expire');
2082 my $error = $cust_pkg->cancel($cpr ? ( 'reason' => $cpr->reasonnum,
2083 'reason_otaker' => $cpr->otaker
2087 warn "Error cancelling expired pkg ". $cust_pkg->pkgnum.
2088 " for custnum ". $self->custnum. ": $error"
2096 #$options{actual_time} not $options{time} because freeside-daily -d is for
2097 #pre-printing invoices
2100 && ( ( $_->part_pkg->is_prepaid
2102 && $_->bill < $options{actual_time}
2105 && $_->adjourn <= $options{actual_time}
2109 $self->ncancelled_pkgs;
2111 foreach my $cust_pkg ( @susp_pkgs ) {
2112 my $cpr = $cust_pkg->last_cust_pkg_reason('adjourn')
2113 if ($cust_pkg->adjourn && $cust_pkg->adjourn < $^T);
2114 my $error = $cust_pkg->suspend($cpr ? ( 'reason' => $cpr->reasonnum,
2115 'reason_otaker' => $cpr->otaker
2120 warn "Error suspending package ". $cust_pkg->pkgnum.
2121 " for custnum ". $self->custnum. ": $error"
2129 my $error = $self->bill( %options );
2130 warn "Error billing, custnum ". $self->custnum. ": $error" if $error;
2132 $self->apply_payments_and_credits;
2134 $error = $self->collect( %options );
2135 warn "Error collecting, custnum". $self->custnum. ": $error" if $error;
2141 Generates invoices (see L<FS::cust_bill>) for this customer. Usually used in
2142 conjunction with the collect method by calling B<bill_and_collect>.
2144 If there is an error, returns the error, otherwise returns false.
2146 Options are passed as name-value pairs. Currently available options are:
2152 If set true, re-charges setup fees.
2156 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:
2160 $cust_main->bill( 'time' => str2time('April 20th, 2001') );
2164 An array ref of specific packages (objects) to attempt billing, instead trying all of them.
2166 $cust_main->bill( pkg_list => [$pkg1, $pkg2] );
2170 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.
2177 my( $self, %options ) = @_;
2178 return '' if $self->payby eq 'COMP';
2179 warn "$me bill customer ". $self->custnum. "\n"
2182 my $time = $options{'time'} || time;
2183 my $invoice_time = $options{'invoice_time'} || $time;
2186 local $SIG{HUP} = 'IGNORE';
2187 local $SIG{INT} = 'IGNORE';
2188 local $SIG{QUIT} = 'IGNORE';
2189 local $SIG{TERM} = 'IGNORE';
2190 local $SIG{TSTP} = 'IGNORE';
2191 local $SIG{PIPE} = 'IGNORE';
2193 my $oldAutoCommit = $FS::UID::AutoCommit;
2194 local $FS::UID::AutoCommit = 0;
2197 $self->select_for_update; #mutex
2199 my @cust_bill_pkg = ();
2202 # find the packages which are due for billing, find out how much they are
2203 # & generate invoice database.
2206 my( $total_setup, $total_recur, $postal_charge ) = ( 0, 0, 0 );
2210 my @precommit_hooks = ();
2212 my @cust_pkgs = qsearch('cust_pkg', { 'custnum' => $self->custnum } );
2213 foreach my $cust_pkg (@cust_pkgs) {
2215 #NO!! next if $cust_pkg->cancel;
2216 next if $cust_pkg->getfield('cancel');
2218 warn " bill package ". $cust_pkg->pkgnum. "\n" if $DEBUG > 1;
2220 #? to avoid use of uninitialized value errors... ?
2221 $cust_pkg->setfield('bill', '')
2222 unless defined($cust_pkg->bill);
2224 #my $part_pkg = $cust_pkg->part_pkg;
2226 my $real_pkgpart = $cust_pkg->pkgpart;
2227 my %hash = $cust_pkg->hash;
2229 foreach my $part_pkg ( $cust_pkg->part_pkg->self_and_bill_linked ) {
2231 $cust_pkg->set($_, $hash{$_}) foreach qw ( setup last_bill bill );
2234 $self->_make_lines( 'part_pkg' => $part_pkg,
2235 'cust_pkg' => $cust_pkg,
2236 'precommit_hooks' => \@precommit_hooks,
2237 'line_items' => \@cust_bill_pkg,
2238 'setup' => \$total_setup,
2239 'recur' => \$total_recur,
2240 'tax_matrix' => \%taxlisthash,
2242 'options' => \%options,
2245 $dbh->rollback if $oldAutoCommit;
2249 } #foreach my $part_pkg
2251 } #foreach my $cust_pkg
2253 unless ( @cust_bill_pkg ) { #don't create an invoice w/o line items
2254 #but do commit any package date cycling that happened
2255 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2259 my $postal_pkg = $self->charge_postal_fee();
2260 if ( $postal_pkg && !ref( $postal_pkg ) ) {
2261 $dbh->rollback if $oldAutoCommit;
2262 return "can't charge postal invoice fee for customer ".
2263 $self->custnum. ": $postal_pkg";
2266 ( scalar( grep { $_->recur && $_->recur > 0 } @cust_bill_pkg) ||
2267 !$conf->exists('postal_invoice-recurring_only')
2271 foreach my $part_pkg ( $postal_pkg->part_pkg->self_and_bill_linked ) {
2273 $self->_make_lines( 'part_pkg' => $part_pkg,
2274 'cust_pkg' => $postal_pkg,
2275 'precommit_hooks' => \@precommit_hooks,
2276 'line_items' => \@cust_bill_pkg,
2277 'setup' => \$total_setup,
2278 'recur' => \$total_recur,
2279 'tax_matrix' => \%taxlisthash,
2281 'options' => \%options,
2284 $dbh->rollback if $oldAutoCommit;
2290 warn "having a look at the taxes we found...\n" if $DEBUG > 2;
2291 foreach my $tax ( keys %taxlisthash ) {
2292 my $tax_object = shift @{ $taxlisthash{$tax} };
2293 warn "found ". $tax_object->taxname. " as $tax\n" if $DEBUG > 2;
2294 my $listref_or_error =
2295 $tax_object->taxline( $taxlisthash{$tax},
2296 'custnum' => $self->custnum,
2297 'invoice_time' => $invoice_time
2299 unless (ref($listref_or_error)) {
2300 $dbh->rollback if $oldAutoCommit;
2301 return $listref_or_error;
2303 unshift @{ $taxlisthash{$tax} }, $tax_object;
2305 warn "adding ". $listref_or_error->[1].
2306 " as ". $listref_or_error->[0]. "\n"
2308 $tax{ $tax } += $listref_or_error->[1];
2309 if ( $taxname{ $listref_or_error->[0] } ) {
2310 push @{ $taxname{ $listref_or_error->[0] } }, $tax;
2312 $taxname{ $listref_or_error->[0] } = [ $tax ];
2317 #move the cust_tax_exempt_pkg records to the cust_bill_pkgs we will commit
2318 my %packagemap = map { $_->pkgnum => $_ } @cust_bill_pkg;
2319 foreach my $tax ( keys %taxlisthash ) {
2320 foreach ( @{ $taxlisthash{$tax} }[1 ... scalar(@{ $taxlisthash{$tax} })] ) {
2321 next unless ref($_) eq 'FS::cust_bill_pkg'; # shouldn't happen
2323 push @{ $packagemap{$_->pkgnum}->_cust_tax_exempt_pkg },
2324 splice( @{ $_->_cust_tax_exempt_pkg } );
2328 #some taxes are taxed
2331 warn "finding taxed taxes...\n" if $DEBUG > 2;
2332 foreach my $tax ( keys %taxlisthash ) {
2333 my $tax_object = shift @{ $taxlisthash{$tax} };
2334 warn "found possible taxed tax ". $tax_object->taxname. " we call $tax\n"
2336 next unless $tax_object->can('tax_on_tax');
2338 foreach my $tot ( $tax_object->tax_on_tax( $self ) ) {
2339 my $totname = ref( $tot ). ' '. $tot->taxnum;
2341 warn "checking $totname which we call ". $tot->taxname. " as applicable\n"
2343 next unless exists( $taxlisthash{ $totname } ); # only increase
2345 warn "adding $totname to taxed taxes\n" if $DEBUG > 2;
2346 if ( exists( $totlisthash{ $totname } ) ) {
2347 push @{ $totlisthash{ $totname } }, $tax{ $tax };
2349 $totlisthash{ $totname } = [ $tot, $tax{ $tax } ];
2354 warn "having a look at taxed taxes...\n" if $DEBUG > 2;
2355 foreach my $tax ( keys %totlisthash ) {
2356 my $tax_object = shift @{ $totlisthash{$tax} };
2357 warn "found previously found taxed tax ". $tax_object->taxname. "\n"
2359 my $listref_or_error =
2360 $tax_object->taxline( $totlisthash{$tax},
2361 'custnum' => $self->custnum,
2362 'invoice_time' => $invoice_time
2364 unless (ref($listref_or_error)) {
2365 $dbh->rollback if $oldAutoCommit;
2366 return $listref_or_error;
2369 warn "adding taxed tax amount ". $listref_or_error->[1].
2370 " as ". $tax_object->taxname. "\n"
2372 $tax{ $tax } += $listref_or_error->[1];
2375 #consolidate and create tax line items
2376 warn "consolidating and generating...\n" if $DEBUG > 2;
2377 foreach my $taxname ( keys %taxname ) {
2380 warn "adding $taxname\n" if $DEBUG > 1;
2381 foreach my $taxitem ( @{ $taxname{$taxname} } ) {
2382 $tax += $tax{$taxitem} unless $seen{$taxitem};
2383 $seen{$taxitem} = 1;
2384 warn "adding $tax{$taxitem}\n" if $DEBUG > 1;
2388 $tax = sprintf('%.2f', $tax );
2389 $total_setup = sprintf('%.2f', $total_setup+$tax );
2391 push @cust_bill_pkg, new FS::cust_bill_pkg {
2397 'itemdesc' => $taxname,
2402 my $charged = sprintf('%.2f', $total_setup + $total_recur );
2404 #create the new invoice
2405 my $cust_bill = new FS::cust_bill ( {
2406 'custnum' => $self->custnum,
2407 '_date' => ( $invoice_time ),
2408 'charged' => $charged,
2410 my $error = $cust_bill->insert;
2412 $dbh->rollback if $oldAutoCommit;
2413 return "can't create invoice for customer #". $self->custnum. ": $error";
2416 foreach my $cust_bill_pkg ( @cust_bill_pkg ) {
2417 $cust_bill_pkg->invnum($cust_bill->invnum);
2418 my $error = $cust_bill_pkg->insert;
2420 $dbh->rollback if $oldAutoCommit;
2421 return "can't create invoice line item: $error";
2426 foreach my $hook ( @precommit_hooks ) {
2428 &{$hook}; #($self) ?
2431 $dbh->rollback if $oldAutoCommit;
2432 return "$@ running precommit hook $hook\n";
2436 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2442 my ($self, %params) = @_;
2444 my $part_pkg = $params{part_pkg} or die "no part_pkg specified";
2445 my $cust_pkg = $params{cust_pkg} or die "no cust_pkg specified";
2446 my $precommit_hooks = $params{precommit_hooks} or die "no package specified";
2447 my $cust_bill_pkgs = $params{line_items} or die "no line buffer specified";
2448 my $total_setup = $params{setup} or die "no setup accumulator specified";
2449 my $total_recur = $params{recur} or die "no recur accumulator specified";
2450 my $taxlisthash = $params{tax_matrix} or die "no tax accumulator specified";
2451 my $time = $params{'time'} or die "no time specified";
2452 my (%options) = %{$params{options}}; #hmmm only for 'resetup'
2455 my $real_pkgpart = $cust_pkg->pkgpart;
2456 my %hash = $cust_pkg->hash;
2457 my $old_cust_pkg = new FS::cust_pkg \%hash;
2463 $cust_pkg->pkgpart($part_pkg->pkgpart);
2471 if ( ! $cust_pkg->setup &&
2473 ( $conf->exists('disable_setup_suspended_pkgs') &&
2474 ! $cust_pkg->getfield('susp')
2475 ) || ! $conf->exists('disable_setup_suspended_pkgs')
2477 || $options{'resetup'}
2480 warn " bill setup\n" if $DEBUG > 1;
2483 $setup = eval { $cust_pkg->calc_setup( $time, \@details ) };
2484 return "$@ running calc_setup for $cust_pkg\n"
2487 $unitsetup = $cust_pkg->part_pkg->unit_setup || $setup; #XXX uuh
2489 $cust_pkg->setfield('setup', $time)
2490 unless $cust_pkg->setup;
2491 #do need it, but it won't get written to the db
2492 #|| $cust_pkg->pkgpart != $real_pkgpart;
2497 # bill recurring fee
2500 #XXX unit stuff here too
2504 if ( ! $cust_pkg->getfield('susp') and
2505 ( $part_pkg->getfield('freq') ne '0' &&
2506 ( $cust_pkg->getfield('bill') || 0 ) <= $time
2508 || ( $part_pkg->plan eq 'voip_cdr'
2509 && $part_pkg->option('bill_every_call')
2513 # XXX should this be a package event? probably. events are called
2514 # at collection time at the moment, though...
2515 $part_pkg->reset_usage($cust_pkg, 'debug'=>$DEBUG)
2516 if $part_pkg->can('reset_usage');
2517 #don't want to reset usage just cause we want a line item??
2518 #&& $part_pkg->pkgpart == $real_pkgpart;
2520 warn " bill recur\n" if $DEBUG > 1;
2523 # XXX shared with $recur_prog
2524 $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
2526 #over two params! lets at least switch to a hashref for the rest...
2527 my $increment_next_bill = ( $part_pkg->freq ne '0'
2528 && ( $cust_pkg->getfield('bill') || 0 ) <= $time
2530 my %param = ( 'precommit_hooks' => $precommit_hooks,
2531 'increment_next_bill' => $increment_next_bill,
2534 $recur = eval { $cust_pkg->calc_recur( \$sdate, \@details, \%param ) };
2535 return "$@ running calc_recur for $cust_pkg\n"
2538 if ( $increment_next_bill ) {
2540 #change this bit to use Date::Manip? CAREFUL with timezones (see
2541 # mailing list archive)
2542 my ($sec,$min,$hour,$mday,$mon,$year) =
2543 (localtime($sdate) )[0,1,2,3,4,5];
2545 #pro-rating magic - if $recur_prog fiddles $sdate, want to use that
2546 # only for figuring next bill date, nothing else, so, reset $sdate again
2548 $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
2549 #no need, its in $hash{last_bill}# my $last_bill = $cust_pkg->last_bill;
2550 $cust_pkg->last_bill($sdate);
2552 if ( $part_pkg->freq =~ /^\d+$/ ) {
2553 $mon += $part_pkg->freq;
2554 until ( $mon < 12 ) { $mon -= 12; $year++; }
2555 } elsif ( $part_pkg->freq =~ /^(\d+)w$/ ) {
2557 $mday += $weeks * 7;
2558 } elsif ( $part_pkg->freq =~ /^(\d+)d$/ ) {
2561 } elsif ( $part_pkg->freq =~ /^(\d+)h$/ ) {
2565 return "unparsable frequency: ". $part_pkg->freq;
2567 $cust_pkg->setfield('bill',
2568 timelocal_nocheck($sec,$min,$hour,$mday,$mon,$year));
2574 warn "\$setup is undefined" unless defined($setup);
2575 warn "\$recur is undefined" unless defined($recur);
2576 warn "\$cust_pkg->bill is undefined" unless defined($cust_pkg->bill);
2579 # If there's line items, create em cust_bill_pkg records
2580 # If $cust_pkg has been modified, update it (if we're a real pkgpart)
2585 if ( $cust_pkg->modified && $cust_pkg->pkgpart == $real_pkgpart ) {
2586 # hmm.. and if just the options are modified in some weird price plan?
2588 warn " package ". $cust_pkg->pkgnum. " modified; updating\n"
2591 my $error = $cust_pkg->replace( $old_cust_pkg,
2592 'options' => { $cust_pkg->options },
2594 return "Error modifying pkgnum ". $cust_pkg->pkgnum. ": $error"
2595 if $error; #just in case
2598 $setup = sprintf( "%.2f", $setup );
2599 $recur = sprintf( "%.2f", $recur );
2600 if ( $setup < 0 && ! $conf->exists('allow_negative_charges') ) {
2601 return "negative setup $setup for pkgnum ". $cust_pkg->pkgnum;
2603 if ( $recur < 0 && ! $conf->exists('allow_negative_charges') ) {
2604 return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum;
2607 if ( $setup != 0 || $recur != 0 ) {
2609 warn " charges (setup=$setup, recur=$recur); adding line items\n"
2612 my @cust_pkg_detail = map { $_->detail } $cust_pkg->cust_pkg_detail('I');
2614 warn " adding customer package invoice detail: $_\n"
2615 foreach @cust_pkg_detail;
2617 push @details, @cust_pkg_detail;
2619 my $cust_bill_pkg = new FS::cust_bill_pkg {
2620 'pkgnum' => $cust_pkg->pkgnum,
2622 'unitsetup' => $unitsetup,
2624 'unitrecur' => $unitrecur,
2625 'quantity' => $cust_pkg->quantity,
2626 'details' => \@details,
2629 if ( $part_pkg->option('recur_temporality', 1) eq 'preceding' ) {
2630 $cust_bill_pkg->sdate( $hash{last_bill} );
2631 $cust_bill_pkg->edate( $sdate - 86399 ); #60s*60m*24h-1
2632 } else { #if ( $part_pkg->option('recur_temporality', 1) eq 'upcoming' ) {
2633 $cust_bill_pkg->sdate( $sdate );
2634 $cust_bill_pkg->edate( $cust_pkg->bill );
2637 $cust_bill_pkg->pkgpart_override($part_pkg->pkgpart)
2638 unless $part_pkg->pkgpart == $real_pkgpart;
2640 $$total_setup += $setup;
2641 $$total_recur += $recur;
2648 $self->_handle_taxes($part_pkg, $taxlisthash, $cust_bill_pkg, $cust_pkg);
2649 return $error if $error;
2651 push @$cust_bill_pkgs, $cust_bill_pkg;
2653 } #if $setup != 0 || $recur != 0
2663 my $part_pkg = shift;
2664 my $taxlisthash = shift;
2665 my $cust_bill_pkg = shift;
2666 my $cust_pkg = shift;
2668 my %cust_bill_pkg = ();
2672 ( $conf->exists('tax-ship_address') && length($self->ship_last) )
2677 #push @classes, $cust_bill_pkg->usage_classes if $cust_bill_pkg->type eq 'U';
2678 push @classes, $cust_bill_pkg->usage_classes if $cust_bill_pkg->usage;
2679 push @classes, 'setup' if $cust_bill_pkg->setup;
2680 push @classes, 'recur' if $cust_bill_pkg->recur;
2682 if ( $conf->exists('enable_taxproducts')
2683 && (scalar($part_pkg->part_pkg_taxoverride) || $part_pkg->has_taxproduct)
2684 && ( $self->tax !~ /Y/i && $self->payby ne 'COMP' )
2688 foreach my $class (@classes) {
2689 my $err_or_ref = $self->_gather_taxes( $part_pkg, $class, $prefix );
2690 return $err_or_ref unless ref($err_or_ref);
2691 $taxes{$class} = $err_or_ref;
2694 unless (exists $taxes{''}) {
2695 my $err_or_ref = $self->_gather_taxes( $part_pkg, '', $prefix );
2696 return $err_or_ref unless ref($err_or_ref);
2697 $taxes{''} = $err_or_ref;
2700 } elsif ( $self->tax !~ /Y/i && $self->payby ne 'COMP' ) {
2702 my %taxhash = map { $_ => $self->get("$prefix$_") }
2703 qw( state county country );
2705 $taxhash{'taxclass'} = $part_pkg->taxclass;
2707 my @taxes = qsearch( 'cust_main_county', \%taxhash );
2710 $taxhash{'taxclass'} = '';
2711 @taxes = qsearch( 'cust_main_county', \%taxhash );
2714 #one more try at a whole-country tax rate
2716 $taxhash{$_} = '' foreach qw( state county );
2717 @taxes = qsearch( 'cust_main_county', \%taxhash );
2720 $taxes{''} = [ @taxes ];
2721 $taxes{'setup'} = [ @taxes ];
2722 $taxes{'recur'} = [ @taxes ];
2723 $taxes{$_} = [ @taxes ] foreach (@classes);
2725 # maybe eliminate this entirely, along with all the 0% records
2728 "fatal: can't find tax rate for state/county/country/taxclass ".
2729 join('/', ( map $self->get("$prefix$_"),
2730 qw(state county country)
2732 $part_pkg->taxclass ). "\n";
2735 } #if $conf->exists('enable_taxproducts') ...
2738 if ( $conf->exists('separate_usage') ) {
2739 my $section = $cust_pkg->part_pkg->option('usage_section', 'Hush!');
2740 my $summary = $cust_pkg->part_pkg->option('summarize_usage', 'Hush!');
2741 push @display, new FS::cust_bill_pkg_display { type => 'S' };
2742 push @display, new FS::cust_bill_pkg_display { type => 'R' };
2743 push @display, new FS::cust_bill_pkg_display { type => 'U',
2746 if ($section && $summary) {
2747 $display[2]->post_total('Y');
2748 push @display, new FS::cust_bill_pkg_display { type => 'U',
2753 $cust_bill_pkg->set('display', \@display);
2755 my %tax_cust_bill_pkg = $cust_bill_pkg->disintegrate;
2756 foreach my $key (keys %tax_cust_bill_pkg) {
2757 my @taxes = @{ $taxes{$key} || [] };
2758 my $tax_cust_bill_pkg = $tax_cust_bill_pkg{$key};
2760 foreach my $tax ( @taxes ) {
2761 my $taxname = ref( $tax ). ' '. $tax->taxnum;
2762 if ( exists( $taxlisthash->{ $taxname } ) ) {
2763 push @{ $taxlisthash->{ $taxname } }, $tax_cust_bill_pkg;
2765 $taxlisthash->{ $taxname } = [ $tax, $tax_cust_bill_pkg ];
2775 my $part_pkg = shift;
2780 my $geocode = $self->geocode('cch');
2782 my @taxclassnums = map { $_->taxclassnum }
2783 $part_pkg->part_pkg_taxoverride($class);
2785 unless (@taxclassnums) {
2786 @taxclassnums = map { $_->taxclassnum }
2787 $part_pkg->part_pkg_taxrate('cch', $geocode, $class);
2789 warn "Found taxclassnum values of ". join(',', @taxclassnums)
2794 join(' OR ', map { "taxclassnum = $_" } @taxclassnums ). ")";
2796 @taxes = qsearch({ 'table' => 'tax_rate',
2797 'hashref' => { 'geocode' => $geocode, },
2798 'extra_sql' => $extra_sql,
2800 if scalar(@taxclassnums);
2802 # maybe eliminate this entirely, along with all the 0% records
2805 "fatal: can't find tax rate for zip/taxproduct/pkgpart ".
2806 join('/', ( map $self->get("$prefix$_"),
2809 $part_pkg->taxproduct_description,
2810 $part_pkg->pkgpart ). "\n";
2813 warn "Found taxes ".
2814 join(',', map{ ref($_). " ". $_->get($_->primary_key) } @taxes). "\n"
2821 =item collect OPTIONS
2823 (Attempt to) collect money for this customer's outstanding invoices (see
2824 L<FS::cust_bill>). Usually used after the bill method.
2826 Actions are now triggered by billing events; see L<FS::part_event> and the
2827 billing events web interface. Old-style invoice events (see
2828 L<FS::part_bill_event>) have been deprecated.
2830 If there is an error, returns the error, otherwise returns false.
2832 Options are passed as name-value pairs.
2834 Currently available options are:
2840 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.
2844 Retry card/echeck/LEC transactions even when not scheduled by invoice events.
2848 set true to surpress email card/ACH decline notices.
2852 "1d" for the traditional, daily events (the default), or "1m" for the new monthly events (part_event.check_freq)
2856 allows for one time override of normal customer billing method
2860 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)
2868 my( $self, %options ) = @_;
2869 my $invoice_time = $options{'invoice_time'} || time;
2872 local $SIG{HUP} = 'IGNORE';
2873 local $SIG{INT} = 'IGNORE';
2874 local $SIG{QUIT} = 'IGNORE';
2875 local $SIG{TERM} = 'IGNORE';
2876 local $SIG{TSTP} = 'IGNORE';
2877 local $SIG{PIPE} = 'IGNORE';
2879 my $oldAutoCommit = $FS::UID::AutoCommit;
2880 local $FS::UID::AutoCommit = 0;
2883 $self->select_for_update; #mutex
2886 my $balance = $self->balance;
2887 warn "$me collect customer ". $self->custnum. ": balance $balance\n"
2890 if ( exists($options{'retry_card'}) ) {
2891 carp 'retry_card option passed to collect is deprecated; use retry';
2892 $options{'retry'} ||= $options{'retry_card'};
2894 if ( exists($options{'retry'}) && $options{'retry'} ) {
2895 my $error = $self->retry_realtime;
2897 $dbh->rollback if $oldAutoCommit;
2902 # false laziness w/pay_batch::import_results
2904 my $due_cust_event = $self->due_cust_event(
2905 'debug' => ( $options{'debug'} || 0 ),
2906 'time' => $invoice_time,
2907 'check_freq' => $options{'check_freq'},
2909 unless( ref($due_cust_event) ) {
2910 $dbh->rollback if $oldAutoCommit;
2911 return $due_cust_event;
2914 foreach my $cust_event ( @$due_cust_event ) {
2918 #re-eval event conditions (a previous event could have changed things)
2919 unless ( $cust_event->test_conditions( 'time' => $invoice_time ) ) {
2920 #don't leave stray "new/locked" records around
2921 my $error = $cust_event->delete;
2923 #gah, even with transactions
2924 $dbh->commit if $oldAutoCommit; #well.
2931 local $realtime_bop_decline_quiet = 1 if $options{'quiet'};
2932 warn " running cust_event ". $cust_event->eventnum. "\n"
2936 #if ( my $error = $cust_event->do_event(%options) ) { #XXX %options?
2937 if ( my $error = $cust_event->do_event() ) {
2938 #XXX wtf is this? figure out a proper dealio with return value
2940 # gah, even with transactions.
2941 $dbh->commit if $oldAutoCommit; #well.
2948 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2953 =item due_cust_event [ HASHREF | OPTION => VALUE ... ]
2955 Inserts database records for and returns an ordered listref of new events due
2956 for this customer, as FS::cust_event objects (see L<FS::cust_event>). If no
2957 events are due, an empty listref is returned. If there is an error, returns a
2958 scalar error message.
2960 To actually run the events, call each event's test_condition method, and if
2961 still true, call the event's do_event method.
2963 Options are passed as a hashref or as a list of name-value pairs. Available
2970 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.
2974 "Current time" for the events.
2978 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)
2982 Only return events for the specified eventtable (by default, events of all eventtables are returned)
2986 Explicitly pass the objects to be tested (typically used with eventtable).
2990 Set to true to return the objects, but not actually insert them into the
2997 sub due_cust_event {
2999 my %opt = ref($_[0]) ? %{ $_[0] } : @_;
3002 #my $DEBUG = $opt{'debug'}
3003 local($DEBUG) = $opt{'debug'}
3004 if defined($opt{'debug'}) && $opt{'debug'} > $DEBUG;
3006 warn "$me due_cust_event called with options ".
3007 join(', ', map { "$_: $opt{$_}" } keys %opt). "\n"
3010 $opt{'time'} ||= time;
3012 local $SIG{HUP} = 'IGNORE';
3013 local $SIG{INT} = 'IGNORE';
3014 local $SIG{QUIT} = 'IGNORE';
3015 local $SIG{TERM} = 'IGNORE';
3016 local $SIG{TSTP} = 'IGNORE';
3017 local $SIG{PIPE} = 'IGNORE';
3019 my $oldAutoCommit = $FS::UID::AutoCommit;
3020 local $FS::UID::AutoCommit = 0;
3023 $self->select_for_update #mutex
3024 unless $opt{testonly};
3027 # 1: find possible events (initial search)
3030 my @cust_event = ();
3032 my @eventtable = $opt{'eventtable'}
3033 ? ( $opt{'eventtable'} )
3034 : FS::part_event->eventtables_runorder;
3036 foreach my $eventtable ( @eventtable ) {
3039 if ( $opt{'objects'} ) {
3041 @objects = @{ $opt{'objects'} };
3045 #my @objects = $self->eventtable(); # sub cust_main { @{ [ $self ] }; }
3046 @objects = ( $eventtable eq 'cust_main' )
3048 : ( $self->$eventtable() );
3052 my @e_cust_event = ();
3054 my $cross = "CROSS JOIN $eventtable";
3055 $cross .= ' LEFT JOIN cust_main USING ( custnum )'
3056 unless $eventtable eq 'cust_main';
3058 foreach my $object ( @objects ) {
3060 #this first search uses the condition_sql magic for optimization.
3061 #the more possible events we can eliminate in this step the better
3063 my $cross_where = '';
3064 my $pkey = $object->primary_key;
3065 $cross_where = "$eventtable.$pkey = ". $object->$pkey();
3067 my $join = FS::part_event_condition->join_conditions_sql( $eventtable );
3069 FS::part_event_condition->where_conditions_sql( $eventtable,
3070 'time'=>$opt{'time'}
3072 my $order = FS::part_event_condition->order_conditions_sql( $eventtable );
3074 $extra_sql = "AND $extra_sql" if $extra_sql;
3076 #here is the agent virtualization
3077 $extra_sql .= " AND ( part_event.agentnum IS NULL
3078 OR part_event.agentnum = ". $self->agentnum. ' )';
3080 $extra_sql .= " $order";
3082 warn "searching for events for $eventtable ". $object->$pkey. "\n"
3083 if $opt{'debug'} > 2;
3084 my @part_event = qsearch( {
3085 'debug' => ( $opt{'debug'} > 3 ? 1 : 0 ),
3086 'select' => 'part_event.*',
3087 'table' => 'part_event',
3088 'addl_from' => "$cross $join",
3089 'hashref' => { 'check_freq' => ( $opt{'check_freq'} || '1d' ),
3090 'eventtable' => $eventtable,
3093 'extra_sql' => "AND $cross_where $extra_sql",
3097 my $pkey = $object->primary_key;
3098 warn " ". scalar(@part_event).
3099 " possible events found for $eventtable ". $object->$pkey(). "\n";
3102 push @e_cust_event, map { $_->new_cust_event($object) } @part_event;
3106 warn " ". scalar(@e_cust_event).
3107 " subtotal possible cust events found for $eventtable\n"
3110 push @cust_event, @e_cust_event;
3114 warn " ". scalar(@cust_event).
3115 " total possible cust events found in initial search\n"
3119 # 2: test conditions
3124 @cust_event = grep $_->test_conditions( 'time' => $opt{'time'},
3125 'stats_hashref' => \%unsat ),
3128 warn " ". scalar(@cust_event). " cust events left satisfying conditions\n"
3131 warn " invalid conditions not eliminated with condition_sql:\n".
3132 join('', map " $_: ".$unsat{$_}."\n", keys %unsat )
3139 unless( $opt{testonly} ) {
3140 foreach my $cust_event ( @cust_event ) {
3142 my $error = $cust_event->insert();
3144 $dbh->rollback if $oldAutoCommit;
3151 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3157 warn " returning events: ". Dumper(@cust_event). "\n"
3164 =item retry_realtime
3166 Schedules realtime / batch credit card / electronic check / LEC billing
3167 events for for retry. Useful if card information has changed or manual
3168 retry is desired. The 'collect' method must be called to actually retry
3171 Implementation details: For either this customer, or for each of this
3172 customer's open invoices, changes the status of the first "done" (with
3173 statustext error) realtime processing event to "failed".
3177 sub retry_realtime {
3180 local $SIG{HUP} = 'IGNORE';
3181 local $SIG{INT} = 'IGNORE';
3182 local $SIG{QUIT} = 'IGNORE';
3183 local $SIG{TERM} = 'IGNORE';
3184 local $SIG{TSTP} = 'IGNORE';
3185 local $SIG{PIPE} = 'IGNORE';
3187 my $oldAutoCommit = $FS::UID::AutoCommit;
3188 local $FS::UID::AutoCommit = 0;
3191 #a little false laziness w/due_cust_event (not too bad, really)
3193 my $join = FS::part_event_condition->join_conditions_sql;
3194 my $order = FS::part_event_condition->order_conditions_sql;
3197 . join ( ' OR ' , map {
3198 "( part_event.eventtable = " . dbh->quote($_)
3199 . " AND tablenum IN( SELECT " . dbdef->table($_)->primary_key . " from $_ where custnum = " . dbh->quote( $self->custnum ) . "))" ;
3200 } FS::part_event->eventtables)
3203 #here is the agent virtualization
3204 my $agent_virt = " ( part_event.agentnum IS NULL
3205 OR part_event.agentnum = ". $self->agentnum. ' )';
3207 #XXX this shouldn't be hardcoded, actions should declare it...
3208 my @realtime_events = qw(
3209 cust_bill_realtime_card
3210 cust_bill_realtime_check
3211 cust_bill_realtime_lec
3215 my $is_realtime_event = ' ( '. join(' OR ', map "part_event.action = '$_'",
3220 my @cust_event = qsearchs({
3221 'table' => 'cust_event',
3222 'select' => 'cust_event.*',
3223 'addl_from' => "LEFT JOIN part_event USING ( eventpart ) $join",
3224 'hashref' => { 'status' => 'done' },
3225 'extra_sql' => " AND statustext IS NOT NULL AND statustext != '' ".
3226 " AND $mine AND $is_realtime_event AND $agent_virt $order" # LIMIT 1"
3229 my %seen_invnum = ();
3230 foreach my $cust_event (@cust_event) {
3232 #max one for the customer, one for each open invoice
3233 my $cust_X = $cust_event->cust_X;
3234 next if $seen_invnum{ $cust_event->part_event->eventtable eq 'cust_bill'
3238 or $cust_event->part_event->eventtable eq 'cust_bill'
3241 my $error = $cust_event->retry;
3243 $dbh->rollback if $oldAutoCommit;
3244 return "error scheduling event for retry: $error";
3249 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3254 =item realtime_bop METHOD AMOUNT [ OPTION => VALUE ... ]
3256 Runs a realtime credit card, ACH (electronic check) or phone bill transaction
3257 via a Business::OnlinePayment realtime gateway. See
3258 L<http://420.am/business-onlinepayment> for supported gateways.
3260 Available methods are: I<CC>, I<ECHECK> and I<LEC>
3262 Available options are: I<description>, I<invnum>, I<quiet>, I<paynum_ref>, I<payunique>
3264 The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
3265 I<zip>, I<payinfo> and I<paydate> are also available. Any of these options,
3266 if set, will override the value from the customer record.
3268 I<description> is a free-text field passed to the gateway. It defaults to
3269 "Internet services".
3271 If an I<invnum> is specified, this payment (if successful) is applied to the
3272 specified invoice. If you don't specify an I<invnum> you might want to
3273 call the B<apply_payments> method.
3275 I<quiet> can be set true to surpress email decline notices.
3277 I<paynum_ref> can be set to a scalar reference. It will be filled in with the
3278 resulting paynum, if any.
3280 I<payunique> is a unique identifier for this payment.
3282 (moved from cust_bill) (probably should get realtime_{card,ach,lec} here too)
3287 my( $self, $method, $amount, %options ) = @_;
3289 warn "$me realtime_bop: $method $amount\n";
3290 warn " $_ => $options{$_}\n" foreach keys %options;
3293 $options{'description'} ||= 'Internet services';
3295 return $self->fake_bop($method, $amount, %options) if $options{'fake'};
3297 eval "use Business::OnlinePayment";
3300 my $payinfo = exists($options{'payinfo'})
3301 ? $options{'payinfo'}
3304 my %method2payby = (
3311 # check for banned credit card/ACH
3314 my $ban = qsearchs('banned_pay', {
3315 'payby' => $method2payby{$method},
3316 'payinfo' => md5_base64($payinfo),
3318 return "Banned credit card" if $ban;
3325 if ( $options{'invnum'} ) {
3326 my $cust_bill = qsearchs('cust_bill', { 'invnum' => $options{'invnum'} } );
3327 die "invnum ". $options{'invnum'}. " not found" unless $cust_bill;
3329 map { $_->part_pkg->taxclass }
3331 map { $_->cust_pkg }
3332 $cust_bill->cust_bill_pkg;
3333 unless ( grep { $taxclasses[0] ne $_ } @taxclasses ) { #unless there are
3334 #different taxclasses
3335 $taxclass = $taxclasses[0];
3339 #look for an agent gateway override first
3341 if ( $method eq 'CC' ) {
3342 $cardtype = cardtype($payinfo);
3343 } elsif ( $method eq 'ECHECK' ) {
3346 $cardtype = $method;
3350 qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
3351 cardtype => $cardtype,
3352 taxclass => $taxclass, } )
3353 || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
3355 taxclass => $taxclass, } )
3356 || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
3357 cardtype => $cardtype,
3359 || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
3361 taxclass => '', } );
3363 my $payment_gateway = '';
3364 my( $processor, $login, $password, $action, @bop_options );
3365 if ( $override ) { #use a payment gateway override
3367 $payment_gateway = $override->payment_gateway;
3369 $processor = $payment_gateway->gateway_module;
3370 $login = $payment_gateway->gateway_username;
3371 $password = $payment_gateway->gateway_password;
3372 $action = $payment_gateway->gateway_action;
3373 @bop_options = $payment_gateway->options;
3375 } else { #use the standard settings from the config
3377 ( $processor, $login, $password, $action, @bop_options ) =
3378 $self->default_payment_gateway($method);
3386 my $address = exists($options{'address1'})
3387 ? $options{'address1'}
3389 my $address2 = exists($options{'address2'})
3390 ? $options{'address2'}
3392 $address .= ", ". $address2 if length($address2);
3394 my $o_payname = exists($options{'payname'})
3395 ? $options{'payname'}
3397 my($payname, $payfirst, $paylast);
3398 if ( $o_payname && $method ne 'ECHECK' ) {
3399 ($payname = $o_payname) =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
3400 or return "Illegal payname $payname";
3401 ($payfirst, $paylast) = ($1, $2);
3403 $payfirst = $self->getfield('first');
3404 $paylast = $self->getfield('last');
3405 $payname = "$payfirst $paylast";
3408 my @invoicing_list = $self->invoicing_list_emailonly;
3409 if ( $conf->exists('emailinvoiceautoalways')
3410 || $conf->exists('emailinvoiceauto') && ! @invoicing_list
3411 || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
3412 push @invoicing_list, $self->all_emails;
3415 my $email = ($conf->exists('business-onlinepayment-email-override'))
3416 ? $conf->config('business-onlinepayment-email-override')
3417 : $invoicing_list[0];
3421 my $payip = exists($options{'payip'})
3424 $content{customer_ip} = $payip
3427 $content{invoice_number} = $options{'invnum'}
3428 if exists($options{'invnum'}) && length($options{'invnum'});
3430 $content{email_customer} =
3431 ( $conf->exists('business-onlinepayment-email_customer')
3432 || $conf->exists('business-onlinepayment-email-override') );
3435 if ( $method eq 'CC' ) {
3437 $content{card_number} = $payinfo;
3438 $paydate = exists($options{'paydate'})
3439 ? $options{'paydate'}
3441 $paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
3442 $content{expiration} = "$2/$1";
3444 my $paycvv = exists($options{'paycvv'})
3445 ? $options{'paycvv'}
3447 $content{cvv2} = $paycvv
3450 my $paystart_month = exists($options{'paystart_month'})
3451 ? $options{'paystart_month'}
3452 : $self->paystart_month;
3454 my $paystart_year = exists($options{'paystart_year'})
3455 ? $options{'paystart_year'}
3456 : $self->paystart_year;
3458 $content{card_start} = "$paystart_month/$paystart_year"
3459 if $paystart_month && $paystart_year;
3461 my $payissue = exists($options{'payissue'})
3462 ? $options{'payissue'}
3464 $content{issue_number} = $payissue if $payissue;
3466 $content{recurring_billing} = 'YES'
3467 if qsearch('cust_pay', { 'custnum' => $self->custnum,
3469 'payinfo' => $payinfo,
3471 || qsearch('cust_pay', { 'custnum' => $self->custnum,
3473 'paymask' => $self->mask_payinfo('CARD', $payinfo),
3477 } elsif ( $method eq 'ECHECK' ) {
3478 ( $content{account_number}, $content{routing_code} ) =
3479 split('@', $payinfo);
3480 $content{bank_name} = $o_payname;
3481 $content{bank_state} = exists($options{'paystate'})
3482 ? $options{'paystate'}
3483 : $self->getfield('paystate');
3484 $content{account_type} = exists($options{'paytype'})
3485 ? uc($options{'paytype'}) || 'CHECKING'
3486 : uc($self->getfield('paytype')) || 'CHECKING';
3487 $content{account_name} = $payname;
3488 $content{customer_org} = $self->company ? 'B' : 'I';
3489 $content{state_id} = exists($options{'stateid'})
3490 ? $options{'stateid'}
3491 : $self->getfield('stateid');
3492 $content{state_id_state} = exists($options{'stateid_state'})
3493 ? $options{'stateid_state'}
3494 : $self->getfield('stateid_state');
3495 $content{customer_ssn} = exists($options{'ss'})
3498 } elsif ( $method eq 'LEC' ) {
3499 $content{phone} = $payinfo;
3503 # run transaction(s)
3506 my $balance = exists( $options{'balance'} )
3507 ? $options{'balance'}
3510 $self->select_for_update; #mutex ... just until we get our pending record in
3512 #the checks here are intended to catch concurrent payments
3513 #double-form-submission prevention is taken care of in cust_pay_pending::check
3516 return "The customer's balance has changed; $method transaction aborted."
3517 if $self->balance < $balance;
3518 #&& $self->balance < $amount; #might as well anyway?
3520 #also check and make sure there aren't *other* pending payments for this cust
3522 my @pending = qsearch('cust_pay_pending', {
3523 'custnum' => $self->custnum,
3524 'status' => { op=>'!=', value=>'done' }
3526 return "A payment is already being processed for this customer (".
3527 join(', ', map 'paypendingnum '. $_->paypendingnum, @pending ).
3528 "); $method transaction aborted."
3529 if scalar(@pending);
3531 #okay, good to go, if we're a duplicate, cust_pay_pending will kick us out
3533 my $cust_pay_pending = new FS::cust_pay_pending {
3534 'custnum' => $self->custnum,
3535 #'invnum' => $options{'invnum'},
3538 'payby' => $method2payby{$method},
3539 'payinfo' => $payinfo,
3540 'paydate' => $paydate,
3542 'gatewaynum' => ( $payment_gateway ? $payment_gateway->gatewaynum : '' ),
3544 $cust_pay_pending->payunique( $options{payunique} )
3545 if defined($options{payunique}) && length($options{payunique});
3546 my $cpp_new_err = $cust_pay_pending->insert; #mutex lost when this is inserted
3547 return $cpp_new_err if $cpp_new_err;
3549 my( $action1, $action2 ) = split(/\s*\,\s*/, $action );
3551 my $transaction = new Business::OnlinePayment( $processor, @bop_options );
3552 $transaction->content(
3555 'password' => $password,
3556 'action' => $action1,
3557 'description' => $options{'description'},
3558 'amount' => $amount,
3559 #'invoice_number' => $options{'invnum'},
3560 'customer_id' => $self->custnum,
3561 'last_name' => $paylast,
3562 'first_name' => $payfirst,
3564 'address' => $address,
3565 'city' => ( exists($options{'city'})
3568 'state' => ( exists($options{'state'})
3571 'zip' => ( exists($options{'zip'})
3574 'country' => ( exists($options{'country'})
3575 ? $options{'country'}
3577 'referer' => 'http://cleanwhisker.420.am/',
3579 'phone' => $self->daytime || $self->night,
3583 $cust_pay_pending->status('pending');
3584 my $cpp_pending_err = $cust_pay_pending->replace;
3585 return $cpp_pending_err if $cpp_pending_err;
3588 my $BOP_TESTING = 0;
3589 my $BOP_TESTING_SUCCESS = 1;
3591 unless ( $BOP_TESTING ) {
3592 $transaction->submit();
3594 if ( $BOP_TESTING_SUCCESS ) {
3595 $transaction->is_success(1);
3596 $transaction->authorization('fake auth');
3598 $transaction->is_success(0);
3599 $transaction->error_message('fake failure');
3603 if ( $transaction->is_success() && $action2 ) {
3605 $cust_pay_pending->status('authorized');
3606 my $cpp_authorized_err = $cust_pay_pending->replace;
3607 return $cpp_authorized_err if $cpp_authorized_err;
3609 my $auth = $transaction->authorization;
3610 my $ordernum = $transaction->can('order_number')
3611 ? $transaction->order_number
3615 new Business::OnlinePayment( $processor, @bop_options );
3622 password => $password,
3623 order_number => $ordernum,
3625 authorization => $auth,
3626 description => $options{'description'},
3629 foreach my $field (qw( authorization_source_code returned_ACI
3630 transaction_identifier validation_code
3631 transaction_sequence_num local_transaction_date
3632 local_transaction_time AVS_result_code )) {
3633 $capture{$field} = $transaction->$field() if $transaction->can($field);
3636 $capture->content( %capture );
3640 unless ( $capture->is_success ) {
3641 my $e = "Authorization successful but capture failed, custnum #".
3642 $self->custnum. ': '. $capture->result_code.
3643 ": ". $capture->error_message;
3650 $cust_pay_pending->status($transaction->is_success() ? 'captured' : 'declined');
3651 my $cpp_captured_err = $cust_pay_pending->replace;
3652 return $cpp_captured_err if $cpp_captured_err;
3655 # remove paycvv after initial transaction
3658 #false laziness w/misc/process/payment.cgi - check both to make sure working
3660 if ( defined $self->dbdef_table->column('paycvv')
3661 && length($self->paycvv)
3662 && ! grep { $_ eq cardtype($payinfo) } $conf->config('cvv-save')
3664 my $error = $self->remove_cvv;
3666 warn "WARNING: error removing cvv: $error\n";
3674 if ( $transaction->is_success() ) {
3677 if ( $payment_gateway ) { # agent override
3678 $paybatch = $payment_gateway->gatewaynum. '-';
3681 $paybatch .= "$processor:". $transaction->authorization;
3683 $paybatch .= ':'. $transaction->order_number
3684 if $transaction->can('order_number')
3685 && length($transaction->order_number);
3687 my $cust_pay = new FS::cust_pay ( {
3688 'custnum' => $self->custnum,
3689 'invnum' => $options{'invnum'},
3692 'payby' => $method2payby{$method},
3693 'payinfo' => $payinfo,
3694 'paybatch' => $paybatch,
3695 'paydate' => $paydate,
3697 #doesn't hurt to know, even though the dup check is in cust_pay_pending now
3698 $cust_pay->payunique( $options{payunique} )
3699 if defined($options{payunique}) && length($options{payunique});
3701 my $oldAutoCommit = $FS::UID::AutoCommit;
3702 local $FS::UID::AutoCommit = 0;
3705 #start a transaction, insert the cust_pay and set cust_pay_pending.status to done in a single transction
3707 my $error = $cust_pay->insert($options{'manual'} ? ( 'manual' => 1 ) : () );
3710 $cust_pay->invnum(''); #try again with no specific invnum
3711 my $error2 = $cust_pay->insert( $options{'manual'} ?
3712 ( 'manual' => 1 ) : ()
3715 # gah. but at least we have a record of the state we had to abort in
3716 # from cust_pay_pending now.
3717 my $e = "WARNING: $method captured but payment not recorded - ".
3718 "error inserting payment ($processor): $error2".
3719 " (previously tried insert with invnum #$options{'invnum'}" .
3720 ": $error ) - pending payment saved as paypendingnum ".
3721 $cust_pay_pending->paypendingnum. "\n";
3727 if ( $options{'paynum_ref'} ) {
3728 ${ $options{'paynum_ref'} } = $cust_pay->paynum;
3731 $cust_pay_pending->status('done');
3732 $cust_pay_pending->statustext('captured');
3733 my $cpp_done_err = $cust_pay_pending->replace;
3735 if ( $cpp_done_err ) {
3737 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
3738 my $e = "WARNING: $method captured but payment not recorded - ".
3739 "error updating status for paypendingnum ".
3740 $cust_pay_pending->paypendingnum. ": $cpp_done_err \n";
3746 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3747 return ''; #no error
3753 my $perror = "$processor error: ". $transaction->error_message;
3755 unless ( $transaction->error_message ) {
3758 if ( $transaction->can('response_page') ) {
3760 'page' => ( $transaction->can('response_page')
3761 ? $transaction->response_page
3764 'code' => ( $transaction->can('response_code')
3765 ? $transaction->response_code
3768 'headers' => ( $transaction->can('response_headers')
3769 ? $transaction->response_headers
3775 "No additional debugging information available for $processor";
3778 $perror .= "No error_message returned from $processor -- ".
3779 ( ref($t_response) ? Dumper($t_response) : $t_response );
3783 if ( !$options{'quiet'} && !$realtime_bop_decline_quiet
3784 && $conf->exists('emaildecline')
3785 && grep { $_ ne 'POST' } $self->invoicing_list
3786 && ! grep { $transaction->error_message =~ /$_/ }
3787 $conf->config('emaildecline-exclude')
3789 my @templ = $conf->config('declinetemplate');
3790 my $template = new Text::Template (
3792 SOURCE => [ map "$_\n", @templ ],
3793 ) or return "($perror) can't create template: $Text::Template::ERROR";
3794 $template->compile()
3795 or return "($perror) can't compile template: $Text::Template::ERROR";
3797 my $templ_hash = { error => $transaction->error_message };
3799 my $error = send_email(
3800 'from' => $conf->config('invoice_from'),
3801 'to' => [ grep { $_ ne 'POST' } $self->invoicing_list ],
3802 'subject' => 'Your payment could not be processed',
3803 'body' => [ $template->fill_in(HASH => $templ_hash) ],
3806 $perror .= " (also received error sending decline notification: $error)"
3811 $cust_pay_pending->status('done');
3812 $cust_pay_pending->statustext("declined: $perror");
3813 my $cpp_done_err = $cust_pay_pending->replace;
3814 if ( $cpp_done_err ) {
3815 my $e = "WARNING: $method declined but pending payment not resolved - ".
3816 "error updating status for paypendingnum ".
3817 $cust_pay_pending->paypendingnum. ": $cpp_done_err \n";
3819 $perror = "$e ($perror)";
3832 my( $self, $method, $amount, %options ) = @_;
3834 if ( $options{'fake_failure'} ) {
3835 return "Error: No error; test failure requested with fake_failure";
3838 my %method2payby = (
3845 #if ( $payment_gateway ) { # agent override
3846 # $paybatch = $payment_gateway->gatewaynum. '-';
3849 #$paybatch .= "$processor:". $transaction->authorization;
3851 #$paybatch .= ':'. $transaction->order_number
3852 # if $transaction->can('order_number')
3853 # && length($transaction->order_number);
3855 my $paybatch = 'FakeProcessor:54:32';
3857 my $cust_pay = new FS::cust_pay ( {
3858 'custnum' => $self->custnum,
3859 'invnum' => $options{'invnum'},
3862 'payby' => $method2payby{$method},
3863 #'payinfo' => $payinfo,
3864 'payinfo' => '4111111111111111',
3865 'paybatch' => $paybatch,
3866 #'paydate' => $paydate,
3867 'paydate' => '2012-05-01',
3869 $cust_pay->payunique( $options{payunique} ) if length($options{payunique});
3871 my $error = $cust_pay->insert($options{'manual'} ? ( 'manual' => 1 ) : () );
3874 $cust_pay->invnum(''); #try again with no specific invnum
3875 my $error2 = $cust_pay->insert( $options{'manual'} ?
3876 ( 'manual' => 1 ) : ()
3879 # gah, even with transactions.
3880 my $e = 'WARNING: Card/ACH debited but database not updated - '.
3881 "error inserting (fake!) payment: $error2".
3882 " (previously tried insert with invnum #$options{'invnum'}" .
3889 if ( $options{'paynum_ref'} ) {
3890 ${ $options{'paynum_ref'} } = $cust_pay->paynum;
3893 return ''; #no error
3897 =item default_payment_gateway
3901 sub default_payment_gateway {
3902 my( $self, $method ) = @_;
3904 die "Real-time processing not enabled\n"
3905 unless $conf->exists('business-onlinepayment');
3908 my $bop_config = 'business-onlinepayment';
3909 $bop_config .= '-ach'
3910 if $method =~ /^(ECHECK|CHEK)$/ && $conf->exists($bop_config. '-ach');
3911 my ( $processor, $login, $password, $action, @bop_options ) =
3912 $conf->config($bop_config);
3913 $action ||= 'normal authorization';
3914 pop @bop_options if scalar(@bop_options) % 2 && $bop_options[-1] =~ /^\s*$/;
3915 die "No real-time processor is enabled - ".
3916 "did you set the business-onlinepayment configuration value?\n"
3919 ( $processor, $login, $password, $action, @bop_options )
3924 Removes the I<paycvv> field from the database directly.
3926 If there is an error, returns the error, otherwise returns false.
3932 my $sth = dbh->prepare("UPDATE cust_main SET paycvv = '' WHERE custnum = ?")
3933 or return dbh->errstr;
3934 $sth->execute($self->custnum)
3935 or return $sth->errstr;
3940 =item realtime_refund_bop METHOD [ OPTION => VALUE ... ]
3942 Refunds a realtime credit card, ACH (electronic check) or phone bill transaction
3943 via a Business::OnlinePayment realtime gateway. See
3944 L<http://420.am/business-onlinepayment> for supported gateways.
3946 Available methods are: I<CC>, I<ECHECK> and I<LEC>
3948 Available options are: I<amount>, I<reason>, I<paynum>, I<paydate>
3950 Most gateways require a reference to an original payment transaction to refund,
3951 so you probably need to specify a I<paynum>.
3953 I<amount> defaults to the original amount of the payment if not specified.
3955 I<reason> specifies a reason for the refund.
3957 I<paydate> specifies the expiration date for a credit card overriding the
3958 value from the customer record or the payment record. Specified as yyyy-mm-dd
3960 Implementation note: If I<amount> is unspecified or equal to the amount of the
3961 orignal payment, first an attempt is made to "void" the transaction via
3962 the gateway (to cancel a not-yet settled transaction) and then if that fails,
3963 the normal attempt is made to "refund" ("credit") the transaction via the
3964 gateway is attempted.
3966 #The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
3967 #I<zip>, I<payinfo> and I<paydate> are also available. Any of these options,
3968 #if set, will override the value from the customer record.
3970 #If an I<invnum> is specified, this payment (if successful) is applied to the
3971 #specified invoice. If you don't specify an I<invnum> you might want to
3972 #call the B<apply_payments> method.
3976 #some false laziness w/realtime_bop, not enough to make it worth merging
3977 #but some useful small subs should be pulled out
3978 sub realtime_refund_bop {
3979 my( $self, $method, %options ) = @_;
3981 warn "$me realtime_refund_bop: $method refund\n";
3982 warn " $_ => $options{$_}\n" foreach keys %options;
3985 eval "use Business::OnlinePayment";
3989 # look up the original payment and optionally a gateway for that payment
3993 my $amount = $options{'amount'};
3995 my( $processor, $login, $password, @bop_options ) ;
3996 my( $auth, $order_number ) = ( '', '', '' );
3998 if ( $options{'paynum'} ) {
4000 warn " paynum: $options{paynum}\n" if $DEBUG > 1;
4001 $cust_pay = qsearchs('cust_pay', { paynum=>$options{'paynum'} } )
4002 or return "Unknown paynum $options{'paynum'}";
4003 $amount ||= $cust_pay->paid;
4005 $cust_pay->paybatch =~ /^((\d+)\-)?(\w+):\s*([\w\-\/ ]*)(:([\w\-]+))?$/
4006 or return "Can't parse paybatch for paynum $options{'paynum'}: ".
4007 $cust_pay->paybatch;
4008 my $gatewaynum = '';
4009 ( $gatewaynum, $processor, $auth, $order_number ) = ( $2, $3, $4, $6 );
4011 if ( $gatewaynum ) { #gateway for the payment to be refunded
4013 my $payment_gateway =
4014 qsearchs('payment_gateway', { 'gatewaynum' => $gatewaynum } );
4015 die "payment gateway $gatewaynum not found"
4016 unless $payment_gateway;
4018 $processor = $payment_gateway->gateway_module;
4019 $login = $payment_gateway->gateway_username;
4020 $password = $payment_gateway->gateway_password;
4021 @bop_options = $payment_gateway->options;
4023 } else { #try the default gateway
4025 my( $conf_processor, $unused_action );
4026 ( $conf_processor, $login, $password, $unused_action, @bop_options ) =
4027 $self->default_payment_gateway($method);
4029 return "processor of payment $options{'paynum'} $processor does not".
4030 " match default processor $conf_processor"
4031 unless $processor eq $conf_processor;
4036 } else { # didn't specify a paynum, so look for agent gateway overrides
4037 # like a normal transaction
4040 if ( $method eq 'CC' ) {
4041 $cardtype = cardtype($self->payinfo);
4042 } elsif ( $method eq 'ECHECK' ) {
4045 $cardtype = $method;
4048 qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
4049 cardtype => $cardtype,
4051 || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
4053 taxclass => '', } );
4055 if ( $override ) { #use a payment gateway override
4057 my $payment_gateway = $override->payment_gateway;
4059 $processor = $payment_gateway->gateway_module;
4060 $login = $payment_gateway->gateway_username;
4061 $password = $payment_gateway->gateway_password;
4062 #$action = $payment_gateway->gateway_action;
4063 @bop_options = $payment_gateway->options;
4065 } else { #use the standard settings from the config
4068 ( $processor, $login, $password, $unused_action, @bop_options ) =
4069 $self->default_payment_gateway($method);
4074 return "neither amount nor paynum specified" unless $amount;
4079 'password' => $password,
4080 'order_number' => $order_number,
4081 'amount' => $amount,
4082 'referer' => 'http://cleanwhisker.420.am/',
4084 $content{authorization} = $auth
4085 if length($auth); #echeck/ACH transactions have an order # but no auth
4086 #(at least with authorize.net)
4088 my $disable_void_after;
4089 if ($conf->exists('disable_void_after')
4090 && $conf->config('disable_void_after') =~ /^(\d+)$/) {
4091 $disable_void_after = $1;
4094 #first try void if applicable
4095 if ( $cust_pay && $cust_pay->paid == $amount
4097 ( not defined($disable_void_after) )
4098 || ( time < ($cust_pay->_date + $disable_void_after ) )
4101 warn " attempting void\n" if $DEBUG > 1;
4102 my $void = new Business::OnlinePayment( $processor, @bop_options );
4103 $void->content( 'action' => 'void', %content );
4105 if ( $void->is_success ) {
4106 my $error = $cust_pay->void($options{'reason'});
4108 # gah, even with transactions.
4109 my $e = 'WARNING: Card/ACH voided but database not updated - '.
4110 "error voiding payment: $error";
4114 warn " void successful\n" if $DEBUG > 1;
4119 warn " void unsuccessful, trying refund\n"
4123 my $address = $self->address1;
4124 $address .= ", ". $self->address2 if $self->address2;
4126 my($payname, $payfirst, $paylast);
4127 if ( $self->payname && $method ne 'ECHECK' ) {
4128 $payname = $self->payname;
4129 $payname =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
4130 or return "Illegal payname $payname";
4131 ($payfirst, $paylast) = ($1, $2);
4133 $payfirst = $self->getfield('first');
4134 $paylast = $self->getfield('last');
4135 $payname = "$payfirst $paylast";
4138 my @invoicing_list = $self->invoicing_list_emailonly;
4139 if ( $conf->exists('emailinvoiceautoalways')
4140 || $conf->exists('emailinvoiceauto') && ! @invoicing_list
4141 || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
4142 push @invoicing_list, $self->all_emails;
4145 my $email = ($conf->exists('business-onlinepayment-email-override'))
4146 ? $conf->config('business-onlinepayment-email-override')
4147 : $invoicing_list[0];
4149 my $payip = exists($options{'payip'})
4152 $content{customer_ip} = $payip
4156 if ( $method eq 'CC' ) {
4159 $content{card_number} = $payinfo = $cust_pay->payinfo;
4160 (exists($options{'paydate'}) ? $options{'paydate'} : $cust_pay->paydate)
4161 =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/ &&
4162 ($content{expiration} = "$2/$1"); # where available
4164 $content{card_number} = $payinfo = $self->payinfo;
4165 (exists($options{'paydate'}) ? $options{'paydate'} : $self->paydate)
4166 =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
4167 $content{expiration} = "$2/$1";
4170 } elsif ( $method eq 'ECHECK' ) {
4173 $payinfo = $cust_pay->payinfo;
4175 $payinfo = $self->payinfo;
4177 ( $content{account_number}, $content{routing_code} )= split('@', $payinfo );
4178 $content{bank_name} = $self->payname;
4179 $content{account_type} = 'CHECKING';
4180 $content{account_name} = $payname;
4181 $content{customer_org} = $self->company ? 'B' : 'I';
4182 $content{customer_ssn} = $self->ss;
4183 } elsif ( $method eq 'LEC' ) {
4184 $content{phone} = $payinfo = $self->payinfo;
4188 my $refund = new Business::OnlinePayment( $processor, @bop_options );
4189 my %sub_content = $refund->content(
4190 'action' => 'credit',
4191 'customer_id' => $self->custnum,
4192 'last_name' => $paylast,
4193 'first_name' => $payfirst,
4195 'address' => $address,
4196 'city' => $self->city,
4197 'state' => $self->state,
4198 'zip' => $self->zip,
4199 'country' => $self->country,
4201 'phone' => $self->daytime || $self->night,
4204 warn join('', map { " $_ => $sub_content{$_}\n" } keys %sub_content )
4208 return "$processor error: ". $refund->error_message
4209 unless $refund->is_success();
4211 my %method2payby = (
4217 my $paybatch = "$processor:". $refund->authorization;
4218 $paybatch .= ':'. $refund->order_number
4219 if $refund->can('order_number') && $refund->order_number;
4221 while ( $cust_pay && $cust_pay->unapplied < $amount ) {
4222 my @cust_bill_pay = $cust_pay->cust_bill_pay;
4223 last unless @cust_bill_pay;
4224 my $cust_bill_pay = pop @cust_bill_pay;
4225 my $error = $cust_bill_pay->delete;
4229 my $cust_refund = new FS::cust_refund ( {
4230 'custnum' => $self->custnum,
4231 'paynum' => $options{'paynum'},
4232 'refund' => $amount,
4234 'payby' => $method2payby{$method},
4235 'payinfo' => $payinfo,
4236 'paybatch' => $paybatch,
4237 'reason' => $options{'reason'} || 'card or ACH refund',
4239 my $error = $cust_refund->insert;
4241 $cust_refund->paynum(''); #try again with no specific paynum
4242 my $error2 = $cust_refund->insert;
4244 # gah, even with transactions.
4245 my $e = 'WARNING: Card/ACH refunded but database not updated - '.
4246 "error inserting refund ($processor): $error2".
4247 " (previously tried insert with paynum #$options{'paynum'}" .
4258 =item batch_card OPTION => VALUE...
4260 Adds a payment for this invoice to the pending credit card batch (see
4261 L<FS::cust_pay_batch>), or, if the B<realtime> option is set to a true value,
4262 runs the payment using a realtime gateway.
4267 my ($self, %options) = @_;
4270 if (exists($options{amount})) {
4271 $amount = $options{amount};
4273 $amount = sprintf("%.2f", $self->balance - $self->in_transit_payments);
4275 return '' unless $amount > 0;
4277 my $invnum = delete $options{invnum};
4278 my $payby = $options{invnum} || $self->payby; #dubious
4280 if ($options{'realtime'}) {
4281 return $self->realtime_bop( FS::payby->payby2bop($self->payby),
4287 my $oldAutoCommit = $FS::UID::AutoCommit;
4288 local $FS::UID::AutoCommit = 0;
4291 #this needs to handle mysql as well as Pg, like svc_acct.pm
4292 #(make it into a common function if folks need to do batching with mysql)
4293 $dbh->do("LOCK TABLE pay_batch IN SHARE ROW EXCLUSIVE MODE")
4294 or return "Cannot lock pay_batch: " . $dbh->errstr;
4298 'payby' => FS::payby->payby2payment($payby),
4301 my $pay_batch = qsearchs( 'pay_batch', \%pay_batch );
4303 unless ( $pay_batch ) {
4304 $pay_batch = new FS::pay_batch \%pay_batch;
4305 my $error = $pay_batch->insert;
4307 $dbh->rollback if $oldAutoCommit;
4308 die "error creating new batch: $error\n";
4312 my $old_cust_pay_batch = qsearchs('cust_pay_batch', {
4313 'batchnum' => $pay_batch->batchnum,
4314 'custnum' => $self->custnum,
4317 foreach (qw( address1 address2 city state zip country payby payinfo paydate
4319 $options{$_} = '' unless exists($options{$_});
4322 my $cust_pay_batch = new FS::cust_pay_batch ( {
4323 'batchnum' => $pay_batch->batchnum,
4324 'invnum' => $invnum || 0, # is there a better value?
4325 # this field should be
4327 # cust_bill_pay_batch now
4328 'custnum' => $self->custnum,
4329 'last' => $self->getfield('last'),
4330 'first' => $self->getfield('first'),
4331 'address1' => $options{address1} || $self->address1,
4332 'address2' => $options{address2} || $self->address2,
4333 'city' => $options{city} || $self->city,
4334 'state' => $options{state} || $self->state,
4335 'zip' => $options{zip} || $self->zip,
4336 'country' => $options{country} || $self->country,
4337 'payby' => $options{payby} || $self->payby,
4338 'payinfo' => $options{payinfo} || $self->payinfo,
4339 'exp' => $options{paydate} || $self->paydate,
4340 'payname' => $options{payname} || $self->payname,
4341 'amount' => $amount, # consolidating
4344 $cust_pay_batch->paybatchnum($old_cust_pay_batch->paybatchnum)
4345 if $old_cust_pay_batch;
4348 if ($old_cust_pay_batch) {
4349 $error = $cust_pay_batch->replace($old_cust_pay_batch)
4351 $error = $cust_pay_batch->insert;
4355 $dbh->rollback if $oldAutoCommit;
4359 my $unapplied = $self->total_unapplied_credits
4360 + $self->total_unapplied_payments
4361 + $self->in_transit_payments;
4362 foreach my $cust_bill ($self->open_cust_bill) {
4363 #$dbh->commit or die $dbh->errstr if $oldAutoCommit;
4364 my $cust_bill_pay_batch = new FS::cust_bill_pay_batch {
4365 'invnum' => $cust_bill->invnum,
4366 'paybatchnum' => $cust_pay_batch->paybatchnum,
4367 'amount' => $cust_bill->owed,
4370 if ($unapplied >= $cust_bill_pay_batch->amount){
4371 $unapplied -= $cust_bill_pay_batch->amount;
4374 $cust_bill_pay_batch->amount(sprintf ( "%.2f",
4375 $cust_bill_pay_batch->amount - $unapplied )); $unapplied = 0;
4377 $error = $cust_bill_pay_batch->insert;
4379 $dbh->rollback if $oldAutoCommit;
4384 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4388 =item apply_payments_and_credits
4390 Applies unapplied payments and credits.
4392 In most cases, this new method should be used in place of sequential
4393 apply_payments and apply_credits methods.
4395 If there is an error, returns the error, otherwise returns false.
4399 sub apply_payments_and_credits {
4402 local $SIG{HUP} = 'IGNORE';
4403 local $SIG{INT} = 'IGNORE';
4404 local $SIG{QUIT} = 'IGNORE';
4405 local $SIG{TERM} = 'IGNORE';
4406 local $SIG{TSTP} = 'IGNORE';
4407 local $SIG{PIPE} = 'IGNORE';
4409 my $oldAutoCommit = $FS::UID::AutoCommit;
4410 local $FS::UID::AutoCommit = 0;
4413 $self->select_for_update; #mutex
4415 foreach my $cust_bill ( $self->open_cust_bill ) {
4416 my $error = $cust_bill->apply_payments_and_credits;
4418 $dbh->rollback if $oldAutoCommit;
4419 return "Error applying: $error";
4423 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4428 =item apply_credits OPTION => VALUE ...
4430 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
4431 to outstanding invoice balances in chronological order (or reverse
4432 chronological order if the I<order> option is set to B<newest>) and returns the
4433 value of any remaining unapplied credits available for refund (see
4434 L<FS::cust_refund>).
4436 Dies if there is an error.
4444 local $SIG{HUP} = 'IGNORE';
4445 local $SIG{INT} = 'IGNORE';
4446 local $SIG{QUIT} = 'IGNORE';
4447 local $SIG{TERM} = 'IGNORE';
4448 local $SIG{TSTP} = 'IGNORE';
4449 local $SIG{PIPE} = 'IGNORE';
4451 my $oldAutoCommit = $FS::UID::AutoCommit;
4452 local $FS::UID::AutoCommit = 0;
4455 $self->select_for_update; #mutex
4457 unless ( $self->total_unapplied_credits ) {
4458 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4462 my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
4463 qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
4465 my @invoices = $self->open_cust_bill;
4466 @invoices = sort { $b->_date <=> $a->_date } @invoices
4467 if defined($opt{'order'}) && $opt{'order'} eq 'newest';
4470 foreach my $cust_bill ( @invoices ) {
4473 if ( !defined($credit) || $credit->credited == 0) {
4474 $credit = pop @credits or last;
4477 if ($cust_bill->owed >= $credit->credited) {
4478 $amount=$credit->credited;
4480 $amount=$cust_bill->owed;
4483 my $cust_credit_bill = new FS::cust_credit_bill ( {
4484 'crednum' => $credit->crednum,
4485 'invnum' => $cust_bill->invnum,
4486 'amount' => $amount,
4488 my $error = $cust_credit_bill->insert;
4490 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
4494 redo if ($cust_bill->owed > 0);
4498 my $total_unapplied_credits = $self->total_unapplied_credits;
4500 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4502 return $total_unapplied_credits;
4505 =item apply_payments
4507 Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
4508 to outstanding invoice balances in chronological order.
4510 #and returns the value of any remaining unapplied payments.
4512 Dies if there is an error.
4516 sub apply_payments {
4519 local $SIG{HUP} = 'IGNORE';
4520 local $SIG{INT} = 'IGNORE';
4521 local $SIG{QUIT} = 'IGNORE';
4522 local $SIG{TERM} = 'IGNORE';
4523 local $SIG{TSTP} = 'IGNORE';
4524 local $SIG{PIPE} = 'IGNORE';
4526 my $oldAutoCommit = $FS::UID::AutoCommit;
4527 local $FS::UID::AutoCommit = 0;
4530 $self->select_for_update; #mutex
4534 my @payments = sort { $b->_date <=> $a->_date }
4535 grep { $_->unapplied > 0 }
4538 my @invoices = sort { $a->_date <=> $b->_date}
4539 grep { $_->owed > 0 }
4544 foreach my $cust_bill ( @invoices ) {
4547 if ( !defined($payment) || $payment->unapplied == 0 ) {
4548 $payment = pop @payments or last;
4551 if ( $cust_bill->owed >= $payment->unapplied ) {
4552 $amount = $payment->unapplied;
4554 $amount = $cust_bill->owed;
4557 my $cust_bill_pay = new FS::cust_bill_pay ( {
4558 'paynum' => $payment->paynum,
4559 'invnum' => $cust_bill->invnum,
4560 'amount' => $amount,
4562 my $error = $cust_bill_pay->insert;
4564 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
4568 redo if ( $cust_bill->owed > 0);
4572 my $total_unapplied_payments = $self->total_unapplied_payments;
4574 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4576 return $total_unapplied_payments;
4581 Returns the total owed for this customer on all invoices
4582 (see L<FS::cust_bill/owed>).
4588 $self->total_owed_date(2145859200); #12/31/2037
4591 =item total_owed_date TIME
4593 Returns the total owed for this customer on all invoices with date earlier than
4594 TIME. TIME is specified as a UNIX timestamp; see L<perlfunc/"time">). Also
4595 see L<Time::Local> and L<Date::Parse> for conversion functions.
4599 sub total_owed_date {
4603 foreach my $cust_bill (
4604 grep { $_->_date <= $time }
4605 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
4607 $total_bill += $cust_bill->owed;
4609 sprintf( "%.2f", $total_bill );
4614 Returns the total amount of all payments.
4621 $total += $_->paid foreach $self->cust_pay;
4622 sprintf( "%.2f", $total );
4625 =item total_unapplied_credits
4627 Returns the total outstanding credit (see L<FS::cust_credit>) for this
4628 customer. See L<FS::cust_credit/credited>.
4630 =item total_credited
4632 Old name for total_unapplied_credits. Don't use.
4636 sub total_credited {
4637 #carp "total_credited deprecated, use total_unapplied_credits";
4638 shift->total_unapplied_credits(@_);
4641 sub total_unapplied_credits {
4643 my $total_credit = 0;
4644 $total_credit += $_->credited foreach $self->cust_credit;
4645 sprintf( "%.2f", $total_credit );
4648 =item total_unapplied_payments
4650 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
4651 See L<FS::cust_pay/unapplied>.
4655 sub total_unapplied_payments {
4657 my $total_unapplied = 0;
4658 $total_unapplied += $_->unapplied foreach $self->cust_pay;
4659 sprintf( "%.2f", $total_unapplied );
4662 =item total_unapplied_refunds
4664 Returns the total unrefunded refunds (see L<FS::cust_refund>) for this
4665 customer. See L<FS::cust_refund/unapplied>.
4669 sub total_unapplied_refunds {
4671 my $total_unapplied = 0;
4672 $total_unapplied += $_->unapplied foreach $self->cust_refund;
4673 sprintf( "%.2f", $total_unapplied );
4678 Returns the balance for this customer (total_owed plus total_unrefunded, minus
4679 total_unapplied_credits minus total_unapplied_payments).
4687 + $self->total_unapplied_refunds
4688 - $self->total_unapplied_credits
4689 - $self->total_unapplied_payments
4693 =item balance_date TIME
4695 Returns the balance for this customer, only considering invoices with date
4696 earlier than TIME (total_owed_date minus total_credited minus
4697 total_unapplied_payments). TIME is specified as a UNIX timestamp; see
4698 L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion
4707 $self->total_owed_date($time)
4708 + $self->total_unapplied_refunds
4709 - $self->total_unapplied_credits
4710 - $self->total_unapplied_payments
4714 =item in_transit_payments
4716 Returns the total of requests for payments for this customer pending in
4717 batches in transit to the bank. See L<FS::pay_batch> and L<FS::cust_pay_batch>
4721 sub in_transit_payments {
4723 my $in_transit_payments = 0;
4724 foreach my $pay_batch ( qsearch('pay_batch', {
4727 foreach my $cust_pay_batch ( qsearch('cust_pay_batch', {
4728 'batchnum' => $pay_batch->batchnum,
4729 'custnum' => $self->custnum,
4731 $in_transit_payments += $cust_pay_batch->amount;
4734 sprintf( "%.2f", $in_transit_payments );
4737 =item paydate_monthyear
4739 Returns a two-element list consisting of the month and year of this customer's
4740 paydate (credit card expiration date for CARD customers)
4744 sub paydate_monthyear {
4746 if ( $self->paydate =~ /^(\d{4})-(\d{1,2})-\d{1,2}$/ ) { #Pg date format
4748 } elsif ( $self->paydate =~ /^(\d{1,2})-(\d{1,2}-)?(\d{4}$)/ ) {
4755 =item invoicing_list [ ARRAYREF ]
4757 If an arguement is given, sets these email addresses as invoice recipients
4758 (see L<FS::cust_main_invoice>). Errors are not fatal and are not reported
4759 (except as warnings), so use check_invoicing_list first.
4761 Returns a list of email addresses (with svcnum entries expanded).
4763 Note: You can clear the invoicing list by passing an empty ARRAYREF. You can
4764 check it without disturbing anything by passing nothing.
4766 This interface may change in the future.
4770 sub invoicing_list {
4771 my( $self, $arrayref ) = @_;
4774 my @cust_main_invoice;
4775 if ( $self->custnum ) {
4776 @cust_main_invoice =
4777 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
4779 @cust_main_invoice = ();
4781 foreach my $cust_main_invoice ( @cust_main_invoice ) {
4782 #warn $cust_main_invoice->destnum;
4783 unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
4784 #warn $cust_main_invoice->destnum;
4785 my $error = $cust_main_invoice->delete;
4786 warn $error if $error;
4789 if ( $self->custnum ) {
4790 @cust_main_invoice =
4791 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
4793 @cust_main_invoice = ();
4795 my %seen = map { $_->address => 1 } @cust_main_invoice;
4796 foreach my $address ( @{$arrayref} ) {
4797 next if exists $seen{$address} && $seen{$address};
4798 $seen{$address} = 1;
4799 my $cust_main_invoice = new FS::cust_main_invoice ( {
4800 'custnum' => $self->custnum,
4803 my $error = $cust_main_invoice->insert;
4804 warn $error if $error;
4808 if ( $self->custnum ) {
4810 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
4817 =item check_invoicing_list ARRAYREF
4819 Checks these arguements as valid input for the invoicing_list method. If there
4820 is an error, returns the error, otherwise returns false.
4824 sub check_invoicing_list {
4825 my( $self, $arrayref ) = @_;
4827 foreach my $address ( @$arrayref ) {
4829 if ($address eq 'FAX' and $self->getfield('fax') eq '') {
4830 return 'Can\'t add FAX invoice destination with a blank FAX number.';
4833 my $cust_main_invoice = new FS::cust_main_invoice ( {
4834 'custnum' => $self->custnum,
4837 my $error = $self->custnum
4838 ? $cust_main_invoice->check
4839 : $cust_main_invoice->checkdest
4841 return $error if $error;
4845 return "Email address required"
4846 if $conf->exists('cust_main-require_invoicing_list_email')
4847 && ! grep { $_ !~ /^([A-Z]+)$/ } @$arrayref;
4852 =item set_default_invoicing_list
4854 Sets the invoicing list to all accounts associated with this customer,
4855 overwriting any previous invoicing list.
4859 sub set_default_invoicing_list {
4861 $self->invoicing_list($self->all_emails);
4866 Returns the email addresses of all accounts provisioned for this customer.
4873 foreach my $cust_pkg ( $self->all_pkgs ) {
4874 my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
4876 map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
4877 grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
4879 $list{$_}=1 foreach map { $_->email } @svc_acct;
4884 =item invoicing_list_addpost
4886 Adds postal invoicing to this customer. If this customer is already configured
4887 to receive postal invoices, does nothing.
4891 sub invoicing_list_addpost {
4893 return if grep { $_ eq 'POST' } $self->invoicing_list;
4894 my @invoicing_list = $self->invoicing_list;
4895 push @invoicing_list, 'POST';
4896 $self->invoicing_list(\@invoicing_list);
4899 =item invoicing_list_emailonly
4901 Returns the list of email invoice recipients (invoicing_list without non-email
4902 destinations such as POST and FAX).
4906 sub invoicing_list_emailonly {
4908 warn "$me invoicing_list_emailonly called"
4910 grep { $_ !~ /^([A-Z]+)$/ } $self->invoicing_list;
4913 =item invoicing_list_emailonly_scalar
4915 Returns the list of email invoice recipients (invoicing_list without non-email
4916 destinations such as POST and FAX) as a comma-separated scalar.
4920 sub invoicing_list_emailonly_scalar {
4922 warn "$me invoicing_list_emailonly_scalar called"
4924 join(', ', $self->invoicing_list_emailonly);
4927 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
4929 Returns an array of customers referred by this customer (referral_custnum set
4930 to this custnum). If DEPTH is given, recurses up to the given depth, returning
4931 customers referred by customers referred by this customer and so on, inclusive.
4932 The default behavior is DEPTH 1 (no recursion).
4936 sub referral_cust_main {
4938 my $depth = @_ ? shift : 1;
4939 my $exclude = @_ ? shift : {};
4942 map { $exclude->{$_->custnum}++; $_; }
4943 grep { ! $exclude->{ $_->custnum } }
4944 qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
4948 map { $_->referral_cust_main($depth-1, $exclude) }
4955 =item referral_cust_main_ncancelled
4957 Same as referral_cust_main, except only returns customers with uncancelled
4962 sub referral_cust_main_ncancelled {
4964 grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
4967 =item referral_cust_pkg [ DEPTH ]
4969 Like referral_cust_main, except returns a flat list of all unsuspended (and
4970 uncancelled) packages for each customer. The number of items in this list may
4971 be useful for comission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
4975 sub referral_cust_pkg {
4977 my $depth = @_ ? shift : 1;
4979 map { $_->unsuspended_pkgs }
4980 grep { $_->unsuspended_pkgs }
4981 $self->referral_cust_main($depth);
4984 =item referring_cust_main
4986 Returns the single cust_main record for the customer who referred this customer
4987 (referral_custnum), or false.
4991 sub referring_cust_main {
4993 return '' unless $self->referral_custnum;
4994 qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
4997 =item credit AMOUNT, REASON [ , OPTION => VALUE ... ]
4999 Applies a credit to this customer. If there is an error, returns the error,
5000 otherwise returns false.
5002 REASON can be a text string, an FS::reason object, or a scalar reference to
5003 a reasonnum. If a text string, it will be automatically inserted as a new
5004 reason, and a 'reason_type' option must be passed to indicate the
5005 FS::reason_type for the new reason.
5007 An I<addlinfo> option may be passed to set the credit's I<addlinfo> field.
5009 Any other options are passed to FS::cust_credit::insert.
5014 my( $self, $amount, $reason, %options ) = @_;
5016 my $cust_credit = new FS::cust_credit {
5017 'custnum' => $self->custnum,
5018 'amount' => $amount,
5021 if ( ref($reason) ) {
5023 if ( ref($reason) eq 'SCALAR' ) {
5024 $cust_credit->reasonnum( $$reason );
5026 $cust_credit->reasonnum( $reason->reasonnum );
5030 $cust_credit->set('reason', $reason)
5033 $cust_credit->addlinfo( delete $options{'addlinfo'} )
5034 if exists($options{'addlinfo'});
5036 $cust_credit->insert(%options);
5040 =item charge AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
5042 Creates a one-time charge for this customer. If there is an error, returns
5043 the error, otherwise returns false.
5049 my ( $amount, $quantity, $pkg, $comment, $taxclass, $additional, $classnum );
5050 my ( $taxproduct, $override );
5051 if ( ref( $_[0] ) ) {
5052 $amount = $_[0]->{amount};
5053 $quantity = exists($_[0]->{quantity}) ? $_[0]->{quantity} : 1;
5054 $pkg = exists($_[0]->{pkg}) ? $_[0]->{pkg} : 'One-time charge';
5055 $comment = exists($_[0]->{comment}) ? $_[0]->{comment}
5056 : '$'. sprintf("%.2f",$amount);
5057 $taxclass = exists($_[0]->{taxclass}) ? $_[0]->{taxclass} : '';
5058 $classnum = exists($_[0]->{classnum}) ? $_[0]->{classnum} : '';
5059 $additional = $_[0]->{additional};
5060 $taxproduct = $_[0]->{taxproductnum};
5061 $override = { '' => $_[0]->{tax_override} };
5065 $pkg = @_ ? shift : 'One-time charge';
5066 $comment = @_ ? shift : '$'. sprintf("%.2f",$amount);
5067 $taxclass = @_ ? shift : '';
5071 local $SIG{HUP} = 'IGNORE';
5072 local $SIG{INT} = 'IGNORE';
5073 local $SIG{QUIT} = 'IGNORE';
5074 local $SIG{TERM} = 'IGNORE';
5075 local $SIG{TSTP} = 'IGNORE';
5076 local $SIG{PIPE} = 'IGNORE';
5078 my $oldAutoCommit = $FS::UID::AutoCommit;
5079 local $FS::UID::AutoCommit = 0;
5082 my $part_pkg = new FS::part_pkg ( {
5084 'comment' => $comment,
5088 'classnum' => $classnum ? $classnum : '',
5089 'taxclass' => $taxclass,
5090 'taxproductnum' => $taxproduct,
5093 my %options = ( ( map { ("additional_info$_" => $additional->[$_] ) }
5094 ( 0 .. @$additional - 1 )
5096 'additional_count' => scalar(@$additional),
5097 'setup_fee' => $amount,
5100 my $error = $part_pkg->insert( options => \%options,
5101 tax_overrides => $override,
5104 $dbh->rollback if $oldAutoCommit;
5108 my $pkgpart = $part_pkg->pkgpart;
5109 my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
5110 unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
5111 my $type_pkgs = new FS::type_pkgs \%type_pkgs;
5112 $error = $type_pkgs->insert;
5114 $dbh->rollback if $oldAutoCommit;
5119 my $cust_pkg = new FS::cust_pkg ( {
5120 'custnum' => $self->custnum,
5121 'pkgpart' => $pkgpart,
5122 'quantity' => $quantity,
5125 $error = $cust_pkg->insert;
5127 $dbh->rollback if $oldAutoCommit;
5131 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
5136 #=item charge_postal_fee
5138 #Applies a one time charge this customer. If there is an error,
5139 #returns the error, returns the cust_pkg charge object or false
5140 #if there was no charge.
5144 # This should be a customer event. For that to work requires that bill
5145 # also be a customer event.
5147 sub charge_postal_fee {
5150 my $pkgpart = $conf->config('postal_invoice-fee_pkgpart');
5151 return '' unless ($pkgpart && grep { $_ eq 'POST' } $self->invoicing_list);
5153 my $cust_pkg = new FS::cust_pkg ( {
5154 'custnum' => $self->custnum,
5155 'pkgpart' => $pkgpart,
5159 my $error = $cust_pkg->insert;
5160 $error ? $error : $cust_pkg;
5165 Returns all the invoices (see L<FS::cust_bill>) for this customer.
5171 sort { $a->_date <=> $b->_date }
5172 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
5175 =item open_cust_bill
5177 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
5182 sub open_cust_bill {
5184 grep { $_->owed > 0 } $self->cust_bill;
5189 Returns all the credits (see L<FS::cust_credit>) for this customer.
5195 sort { $a->_date <=> $b->_date }
5196 qsearch( 'cust_credit', { 'custnum' => $self->custnum } )
5201 Returns all the payments (see L<FS::cust_pay>) for this customer.
5207 sort { $a->_date <=> $b->_date }
5208 qsearch( 'cust_pay', { 'custnum' => $self->custnum } )
5213 Returns all voided payments (see L<FS::cust_pay_void>) for this customer.
5219 sort { $a->_date <=> $b->_date }
5220 qsearch( 'cust_pay_void', { 'custnum' => $self->custnum } )
5223 =item cust_pay_batch
5225 Returns all batched payments (see L<FS::cust_pay_void>) for this customer.
5229 sub cust_pay_batch {
5231 sort { $a->_date <=> $b->_date }
5232 qsearch( 'cust_pay_batch', { 'custnum' => $self->custnum } )
5237 Returns all the refunds (see L<FS::cust_refund>) for this customer.
5243 sort { $a->_date <=> $b->_date }
5244 qsearch( 'cust_refund', { 'custnum' => $self->custnum } )
5247 =item display_custnum
5249 Returns the displayed customer number for this customer: agent_custid if
5250 cust_main-default_agent_custid is set and it has a value, custnum otherwise.
5254 sub display_custnum {
5256 if ( $conf->exists('cust_main-default_agent_custid') && $self->agent_custid ){
5257 return $self->agent_custid;
5259 return $self->custnum;
5265 Returns a name string for this customer, either "Company (Last, First)" or
5272 my $name = $self->contact;
5273 $name = $self->company. " ($name)" if $self->company;
5279 Returns a name string for this (service/shipping) contact, either
5280 "Company (Last, First)" or "Last, First".
5286 if ( $self->get('ship_last') ) {
5287 my $name = $self->ship_contact;
5288 $name = $self->ship_company. " ($name)" if $self->ship_company;
5297 Returns this customer's full (billing) contact name only, "Last, First"
5303 $self->get('last'). ', '. $self->first;
5308 Returns this customer's full (shipping) contact name only, "Last, First"
5314 $self->get('ship_last')
5315 ? $self->get('ship_last'). ', '. $self->ship_first
5321 Returns this customer's full country name
5327 code2country($self->country);
5330 =item geocode DATA_VENDOR
5332 Returns a value for the customer location as encoded by DATA_VENDOR.
5333 Currently this only makes sense for "CCH" as DATA_VENDOR.
5338 my ($self, $data_vendor) = (shift, shift); #always cch for now
5340 my $geocode = $self->get('geocode'); #XXX only one data_vendor for geocode
5341 return $geocode if $geocode;
5343 my $prefix = ( $conf->exists('tax-ship_address') && length($self->ship_last) )
5347 my ($zip,$plus4) = split /-/, $self->get("${prefix}zip")
5348 if $self->country eq 'US';
5350 #CCH specific location stuff
5351 my $extra_sql = "AND plus4lo <= '$plus4' AND plus4hi >= '$plus4'";
5353 my @cust_tax_location =
5355 'table' => 'cust_tax_location',
5356 'hashref' => { 'zip' => $zip, 'data_vendor' => $data_vendor },
5357 'extra_sql' => $extra_sql,
5358 'order_by' => 'ORDER BY plus4hi',#overlapping with distinct ends
5361 $geocode = $cust_tax_location[0]->geocode
5362 if scalar(@cust_tax_location);
5371 Returns a status string for this customer, currently:
5375 =item prospect - No packages have ever been ordered
5377 =item active - One or more recurring packages is active
5379 =item inactive - No active recurring packages, but otherwise unsuspended/uncancelled (the inactive status is new - previously inactive customers were mis-identified as cancelled)
5381 =item suspended - All non-cancelled recurring packages are suspended
5383 =item cancelled - All recurring packages are cancelled
5389 sub status { shift->cust_status(@_); }
5393 for my $status (qw( prospect active inactive suspended cancelled )) {
5394 my $method = $status.'_sql';
5395 my $numnum = ( my $sql = $self->$method() ) =~ s/cust_main\.custnum/?/g;
5396 my $sth = dbh->prepare("SELECT $sql") or die dbh->errstr;
5397 $sth->execute( ($self->custnum) x $numnum )
5398 or die "Error executing 'SELECT $sql': ". $sth->errstr;
5399 return $status if $sth->fetchrow_arrayref->[0];
5403 =item ucfirst_cust_status
5405 =item ucfirst_status
5407 Returns the status with the first character capitalized.
5411 sub ucfirst_status { shift->ucfirst_cust_status(@_); }
5413 sub ucfirst_cust_status {
5415 ucfirst($self->cust_status);
5420 Returns a hex triplet color string for this customer's status.
5424 use vars qw(%statuscolor);
5425 tie %statuscolor, 'Tie::IxHash',
5426 'prospect' => '7e0079', #'000000', #black? naw, purple
5427 'active' => '00CC00', #green
5428 'inactive' => '0000CC', #blue
5429 'suspended' => 'FF9900', #yellow
5430 'cancelled' => 'FF0000', #red
5433 sub statuscolor { shift->cust_statuscolor(@_); }
5435 sub cust_statuscolor {
5437 $statuscolor{$self->cust_status};
5442 Returns an array of hashes representing the customer's RT tickets.
5449 my $num = $conf->config('cust_main-max_tickets') || 10;
5452 unless ( $conf->config('ticket_system-custom_priority_field') ) {
5454 @tickets = @{ FS::TicketSystem->customer_tickets($self->custnum, $num) };
5458 foreach my $priority (
5459 $conf->config('ticket_system-custom_priority_field-values'), ''
5461 last if scalar(@tickets) >= $num;
5463 @{ FS::TicketSystem->customer_tickets( $self->custnum,
5464 $num - scalar(@tickets),
5473 # Return services representing svc_accts in customer support packages
5474 sub support_services {
5476 my %packages = map { $_ => 1 } $conf->config('support_packages');
5478 grep { $_->pkg_svc && $_->pkg_svc->primary_svc eq 'Y' }
5479 grep { $_->part_svc->svcdb eq 'svc_acct' }
5480 map { $_->cust_svc }
5481 grep { exists $packages{ $_->pkgpart } }
5482 $self->ncancelled_pkgs;
5488 =head1 CLASS METHODS
5494 Class method that returns the list of possible status strings for customers
5495 (see L<the status method|/status>). For example:
5497 @statuses = FS::cust_main->statuses();
5502 #my $self = shift; #could be class...
5508 Returns an SQL expression identifying prospective cust_main records (customers
5509 with no packages ever ordered)
5513 use vars qw($select_count_pkgs);
5514 $select_count_pkgs =
5515 "SELECT COUNT(*) FROM cust_pkg
5516 WHERE cust_pkg.custnum = cust_main.custnum";
5518 sub select_count_pkgs_sql {
5522 sub prospect_sql { "
5523 0 = ( $select_count_pkgs )
5528 Returns an SQL expression identifying active cust_main records (customers with
5529 active recurring packages).
5534 0 < ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. "
5540 Returns an SQL expression identifying inactive cust_main records (customers with
5541 no active recurring packages, but otherwise unsuspended/uncancelled).
5545 sub inactive_sql { "
5546 0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " )
5548 0 < ( $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " )
5554 Returns an SQL expression identifying suspended cust_main records.
5559 sub suspended_sql { susp_sql(@_); }
5561 0 < ( $select_count_pkgs AND ". FS::cust_pkg->suspended_sql. " )
5563 0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " )
5569 Returns an SQL expression identifying cancelled cust_main records.
5573 sub cancelled_sql { cancel_sql(@_); }
5576 my $recurring_sql = FS::cust_pkg->recurring_sql;
5577 my $cancelled_sql = FS::cust_pkg->cancelled_sql;
5580 0 < ( $select_count_pkgs )
5581 AND 0 < ( $select_count_pkgs AND $recurring_sql AND $cancelled_sql )
5582 AND 0 = ( $select_count_pkgs AND $recurring_sql
5583 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
5585 AND 0 = ( $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " )
5591 =item uncancelled_sql
5593 Returns an SQL expression identifying un-cancelled cust_main records.
5597 sub uncancelled_sql { uncancel_sql(@_); }
5598 sub uncancel_sql { "
5599 ( 0 < ( $select_count_pkgs
5600 AND ( cust_pkg.cancel IS NULL
5601 OR cust_pkg.cancel = 0
5604 OR 0 = ( $select_count_pkgs )
5610 Returns an SQL fragment to retreive the balance.
5615 ( SELECT COALESCE( SUM(charged), 0 ) FROM cust_bill
5616 WHERE cust_bill.custnum = cust_main.custnum )
5617 - ( SELECT COALESCE( SUM(paid), 0 ) FROM cust_pay
5618 WHERE cust_pay.custnum = cust_main.custnum )
5619 - ( SELECT COALESCE( SUM(amount), 0 ) FROM cust_credit
5620 WHERE cust_credit.custnum = cust_main.custnum )
5621 + ( SELECT COALESCE( SUM(refund), 0 ) FROM cust_refund
5622 WHERE cust_refund.custnum = cust_main.custnum )
5625 =item balance_date_sql START_TIME [ END_TIME [ OPTION => VALUE ... ] ]
5627 Returns an SQL fragment to retreive the balance for this customer, only
5628 considering invoices with date earlier than START_TIME, and optionally not
5629 later than END_TIME (total_owed_date minus total_unapplied_credits minus
5630 total_unapplied_payments).
5632 Times are specified as SQL fragments or numeric
5633 UNIX timestamps; see L<perlfunc/"time">). Also see L<Time::Local> and
5634 L<Date::Parse> for conversion functions. The empty string can be passed
5635 to disable that time constraint completely.
5637 Available options are:
5641 =item unapplied_date
5643 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)
5648 set to true to remove all customer comparison clauses, for totals
5653 WHERE clause hashref (elements "AND"ed together) (typically used with the total option)
5658 JOIN clause (typically used with the total option)
5664 sub balance_date_sql {
5665 my( $class, $start, $end, %opt ) = @_;
5667 my $owed = FS::cust_bill->owed_sql;
5668 my $unapp_refund = FS::cust_refund->unapplied_sql;
5669 my $unapp_credit = FS::cust_credit->unapplied_sql;
5670 my $unapp_pay = FS::cust_pay->unapplied_sql;
5672 my $j = $opt{'join'} || '';
5674 my $owed_wh = $class->_money_table_where( 'cust_bill', $start,$end,%opt );
5675 my $refund_wh = $class->_money_table_where( 'cust_refund', $start,$end,%opt );
5676 my $credit_wh = $class->_money_table_where( 'cust_credit', $start,$end,%opt );
5677 my $pay_wh = $class->_money_table_where( 'cust_pay', $start,$end,%opt );
5679 " ( SELECT COALESCE(SUM($owed), 0) FROM cust_bill $j $owed_wh )
5680 + ( SELECT COALESCE(SUM($unapp_refund), 0) FROM cust_refund $j $refund_wh )
5681 - ( SELECT COALESCE(SUM($unapp_credit), 0) FROM cust_credit $j $credit_wh )
5682 - ( SELECT COALESCE(SUM($unapp_pay), 0) FROM cust_pay $j $pay_wh )
5687 =item _money_table_where TABLE START_TIME [ END_TIME [ OPTION => VALUE ... ] ]
5689 Helper method for balance_date_sql; name (and usage) subject to change
5690 (suggestions welcome).
5692 Returns a WHERE clause for the specified monetary TABLE (cust_bill,
5693 cust_refund, cust_credit or cust_pay).
5695 If TABLE is "cust_bill" or the unapplied_date option is true, only
5696 considers records with date earlier than START_TIME, and optionally not
5697 later than END_TIME .
5701 sub _money_table_where {
5702 my( $class, $table, $start, $end, %opt ) = @_;
5705 push @where, "cust_main.custnum = $table.custnum" unless $opt{'total'};
5706 if ( $table eq 'cust_bill' || $opt{'unapplied_date'} ) {
5707 push @where, "$table._date <= $start" if defined($start) && length($start);
5708 push @where, "$table._date > $end" if defined($end) && length($end);
5710 push @where, @{$opt{'where'}} if $opt{'where'};
5711 my $where = scalar(@where) ? 'WHERE '. join(' AND ', @where ) : '';
5717 =item search_sql HASHREF
5721 Returns a qsearch hash expression to search for parameters specified in HREF.
5722 Valid parameters are
5730 =item cancelled_pkgs
5736 listref of start date, end date
5742 =item current_balance
5744 listref (list returned by FS::UI::Web::parse_lt_gt($cgi, 'current_balance'))
5748 =item flattened_pkgs
5757 my ($class, $params) = @_;
5768 if ( $params->{'agentnum'} =~ /^(\d+)$/ and $1 ) {
5770 "cust_main.agentnum = $1";
5777 #prospect active inactive suspended cancelled
5778 if ( grep { $params->{'status'} eq $_ } FS::cust_main->statuses() ) {
5779 my $method = $params->{'status'}. '_sql';
5780 #push @where, $class->$method();
5781 push @where, FS::cust_main->$method();
5785 # parse cancelled package checkbox
5790 $pkgwhere .= "AND (cancel = 0 or cancel is null)"
5791 unless $params->{'cancelled_pkgs'};
5797 foreach my $field (qw( signupdate )) {
5799 next unless exists($params->{$field});
5801 my($beginning, $ending) = @{$params->{$field}};
5804 "cust_main.$field IS NOT NULL",
5805 "cust_main.$field >= $beginning",
5806 "cust_main.$field <= $ending";
5808 $orderby ||= "ORDER BY cust_main.$field";
5816 my @payby = grep /^([A-Z]{4})$/, @{ $params->{'payby'} };
5818 push @where, '( '. join(' OR ', map "cust_main.payby = '$_'", @payby). ' )';
5825 #my $balance_sql = $class->balance_sql();
5826 my $balance_sql = FS::cust_main->balance_sql();
5828 push @where, map { s/current_balance/$balance_sql/; $_ }
5829 @{ $params->{'current_balance'} };
5835 if ( $params->{'custbatch'} =~ /^([\w\/\-\:\.]+)$/ and $1 ) {
5837 "cust_main.custbatch = '$1'";
5841 # setup queries, subs, etc. for the search
5844 $orderby ||= 'ORDER BY custnum';
5846 # here is the agent virtualization
5847 push @where, $FS::CurrentUser::CurrentUser->agentnums_sql;
5849 my $extra_sql = scalar(@where) ? ' WHERE '. join(' AND ', @where) : '';
5851 my $addl_from = 'LEFT JOIN cust_pkg USING ( custnum ) ';
5853 my $count_query = "SELECT COUNT(*) FROM cust_main $extra_sql";
5855 my $select = join(', ',
5856 'cust_main.custnum',
5857 FS::UI::Web::cust_sql_fields($params->{'cust_fields'}),
5860 my(@extra_headers) = ();
5861 my(@extra_fields) = ();
5863 if ($params->{'flattened_pkgs'}) {
5865 if ($dbh->{Driver}->{Name} eq 'Pg') {
5867 $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";
5869 }elsif ($dbh->{Driver}->{Name} =~ /^mysql/i) {
5870 $select .= ", GROUP_CONCAT(pkg SEPARATOR '|') as magic";
5871 $addl_from .= " LEFT JOIN part_pkg using ( pkgpart )";
5873 warn "warning: unknown database type ". $dbh->{Driver}->{Name}.
5874 "omitting packing information from report.";
5877 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";
5879 my $sth = dbh->prepare($header_query) or die dbh->errstr;
5880 $sth->execute() or die $sth->errstr;
5881 my $headerrow = $sth->fetchrow_arrayref;
5882 my $headercount = $headerrow ? $headerrow->[0] : 0;
5883 while($headercount) {
5884 unshift @extra_headers, "Package ". $headercount;
5885 unshift @extra_fields, eval q!sub {my $c = shift;
5886 my @a = split '\|', $c->magic;
5887 my $p = $a[!.--$headercount. q!];
5895 'table' => 'cust_main',
5896 'select' => $select,
5898 'extra_sql' => $extra_sql,
5899 'order_by' => $orderby,
5900 'count_query' => $count_query,
5901 'extra_headers' => \@extra_headers,
5902 'extra_fields' => \@extra_fields,
5907 =item email_search_sql HASHREF
5911 Emails a notice to the specified customers.
5913 Valid parameters are those of the L<search_sql> method, plus the following:
5935 Optional job queue job for status updates.
5939 Returns an error message, or false for success.
5941 If an error occurs during any email, stops the enture send and returns that
5942 error. Presumably if you're getting SMTP errors aborting is better than
5943 retrying everything.
5947 sub email_search_sql {
5948 my($class, $params) = @_;
5950 my $from = delete $params->{from};
5951 my $subject = delete $params->{subject};
5952 my $html_body = delete $params->{html_body};
5953 my $text_body = delete $params->{text_body};
5955 my $job = delete $params->{'job'};
5957 my $sql_query = $class->search_sql($params);
5959 my $count_query = delete($sql_query->{'count_query'});
5960 my $count_sth = dbh->prepare($count_query)
5961 or die "Error preparing $count_query: ". dbh->errstr;
5963 or die "Error executing $count_query: ". $count_sth->errstr;
5964 my $count_arrayref = $count_sth->fetchrow_arrayref;
5965 my $num_cust = $count_arrayref->[0];
5967 #my @extra_headers = @{ delete($sql_query->{'extra_headers'}) };
5968 #my @extra_fields = @{ delete($sql_query->{'extra_fields'}) };
5971 my( $num, $last, $min_sec ) = (0, time, 5); #progresbar foo
5973 #eventually order+limit magic to reduce memory use?
5974 foreach my $cust_main ( qsearch($sql_query) ) {
5976 my $to = $cust_main->invoicing_list_emailonly_scalar;
5979 my $error = send_email(
5983 'subject' => $subject,
5984 'html_body' => $html_body,
5985 'text_body' => $text_body,
5988 return $error if $error;
5990 if ( $job ) { #progressbar foo
5992 if ( time - $min_sec > $last ) {
5993 my $error = $job->update_statustext(
5994 int( 100 * $num / $num_cust )
5996 die $error if $error;
6006 use Storable qw(thaw);
6009 sub process_email_search_sql {
6011 #warn "$me process_re_X $method for job $job\n" if $DEBUG;
6013 my $param = thaw(decode_base64(shift));
6014 warn Dumper($param) if $DEBUG;
6016 $param->{'job'} = $job;
6018 my $error = FS::cust_main->email_search_sql( $param );
6019 die $error if $error;
6023 =item fuzzy_search FUZZY_HASHREF [ HASHREF, SELECT, EXTRA_SQL, CACHE_OBJ ]
6025 Performs a fuzzy (approximate) search and returns the matching FS::cust_main
6026 records. Currently, I<first>, I<last> and/or I<company> may be specified (the
6027 appropriate ship_ field is also searched).
6029 Additional options are the same as FS::Record::qsearch
6034 my( $self, $fuzzy, $hash, @opt) = @_;
6039 check_and_rebuild_fuzzyfiles();
6040 foreach my $field ( keys %$fuzzy ) {
6042 my $all = $self->all_X($field);
6043 next unless scalar(@$all);
6046 $match{$_}=1 foreach ( amatch( $fuzzy->{$field}, ['i'], @$all ) );
6049 foreach ( keys %match ) {
6050 push @fcust, qsearch('cust_main', { %$hash, $field=>$_}, @opt);
6051 push @fcust, qsearch('cust_main', { %$hash, "ship_$field"=>$_}, @opt);
6054 push @cust_main, grep { ! $fsaw{$_->custnum}++ } @fcust;
6057 # we want the components of $fuzzy ANDed, not ORed, but still don't want dupes
6059 @cust_main = grep { ++$saw{$_->custnum} == scalar(keys %$fuzzy) } @cust_main;
6067 Returns a masked version of the named field
6072 my ($self,$field) = @_;
6076 'x'x(length($self->getfield($field))-4).
6077 substr($self->getfield($field), (length($self->getfield($field))-4));
6087 =item smart_search OPTION => VALUE ...
6089 Accepts the following options: I<search>, the string to search for. The string
6090 will be searched for as a customer number, phone number, name or company name,
6091 as an exact, or, in some cases, a substring or fuzzy match (see the source code
6092 for the exact heuristics used); I<no_fuzzy_on_exact>, causes smart_search to
6093 skip fuzzy matching when an exact match is found.
6095 Any additional options are treated as an additional qualifier on the search
6098 Returns a (possibly empty) array of FS::cust_main objects.
6105 #here is the agent virtualization
6106 my $agentnums_sql = $FS::CurrentUser::CurrentUser->agentnums_sql;
6110 my $skip_fuzzy = delete $options{'no_fuzzy_on_exact'};
6111 my $search = delete $options{'search'};
6112 ( my $alphanum_search = $search ) =~ s/\W//g;
6114 if ( $alphanum_search =~ /^1?(\d{3})(\d{3})(\d{4})(\d*)$/ ) { #phone# search
6116 #false laziness w/Record::ut_phone
6117 my $phonen = "$1-$2-$3";
6118 $phonen .= " x$4" if $4;
6120 push @cust_main, qsearch( {
6121 'table' => 'cust_main',
6122 'hashref' => { %options },
6123 'extra_sql' => ( scalar(keys %options) ? ' AND ' : ' WHERE ' ).
6125 join(' OR ', map "$_ = '$phonen'",
6126 qw( daytime night fax
6127 ship_daytime ship_night ship_fax )
6130 " AND $agentnums_sql", #agent virtualization
6133 unless ( @cust_main || $phonen =~ /x\d+$/ ) { #no exact match
6134 #try looking for matches with extensions unless one was specified
6136 push @cust_main, qsearch( {
6137 'table' => 'cust_main',
6138 'hashref' => { %options },
6139 'extra_sql' => ( scalar(keys %options) ? ' AND ' : ' WHERE ' ).
6141 join(' OR ', map "$_ LIKE '$phonen\%'",
6143 ship_daytime ship_night )
6146 " AND $agentnums_sql", #agent virtualization
6151 # custnum search (also try agent_custid), with some tweaking options if your
6152 # legacy cust "numbers" have letters
6155 if ( $search =~ /^\s*(\d+)\s*$/
6156 || ( $conf->config('cust_main-agent_custid-format') eq 'ww?d+'
6157 && $search =~ /^\s*(\w\w?\d+)\s*$/
6164 if ( $num <= 2147483647 ) { #need a bigint custnum? wow.
6165 push @cust_main, qsearch( {
6166 'table' => 'cust_main',
6167 'hashref' => { 'custnum' => $num, %options },
6168 'extra_sql' => " AND $agentnums_sql", #agent virtualization
6172 push @cust_main, qsearch( {
6173 'table' => 'cust_main',
6174 'hashref' => { 'agent_custid' => $num, %options },
6175 'extra_sql' => " AND $agentnums_sql", #agent virtualization
6178 } elsif ( $search =~ /^\s*(\S.*\S)\s+\((.+), ([^,]+)\)\s*$/ ) {
6180 my($company, $last, $first) = ( $1, $2, $3 );
6182 # "Company (Last, First)"
6183 #this is probably something a browser remembered,
6184 #so just do an exact search
6186 foreach my $prefix ( '', 'ship_' ) {
6187 push @cust_main, qsearch( {
6188 'table' => 'cust_main',
6189 'hashref' => { $prefix.'first' => $first,
6190 $prefix.'last' => $last,
6191 $prefix.'company' => $company,
6194 'extra_sql' => " AND $agentnums_sql",
6198 } elsif ( $search =~ /^\s*(\S.*\S)\s*$/ ) { # value search
6199 # try (ship_){last,company}
6203 # # remove "(Last, First)" in "Company (Last, First)", otherwise the
6204 # # full strings the browser remembers won't work
6205 # $value =~ s/\([\w \,\.\-\']*\)$//; #false laziness w/Record::ut_name
6207 use Lingua::EN::NameParse;
6208 my $NameParse = new Lingua::EN::NameParse(
6210 allow_reversed => 1,
6213 my($last, $first) = ( '', '' );
6214 #maybe disable this too and just rely on NameParse?
6215 if ( $value =~ /^(.+),\s*([^,]+)$/ ) { # Last, First
6217 ($last, $first) = ( $1, $2 );
6219 #} elsif ( $value =~ /^(.+)\s+(.+)$/ ) {
6220 } elsif ( ! $NameParse->parse($value) ) {
6222 my %name = $NameParse->components;
6223 $first = $name{'given_name_1'};
6224 $last = $name{'surname_1'};
6228 if ( $first && $last ) {
6230 my($q_last, $q_first) = ( dbh->quote($last), dbh->quote($first) );
6233 my $sql = scalar(keys %options) ? ' AND ' : ' WHERE ';
6235 ( ( LOWER(last) = $q_last AND LOWER(first) = $q_first )
6236 OR ( LOWER(ship_last) = $q_last AND LOWER(ship_first) = $q_first )
6239 push @cust_main, qsearch( {
6240 'table' => 'cust_main',
6241 'hashref' => \%options,
6242 'extra_sql' => "$sql AND $agentnums_sql", #agent virtualization
6245 # or it just be something that was typed in... (try that in a sec)
6249 my $q_value = dbh->quote($value);
6252 my $sql = scalar(keys %options) ? ' AND ' : ' WHERE ';
6253 $sql .= " ( LOWER(last) = $q_value
6254 OR LOWER(company) = $q_value
6255 OR LOWER(ship_last) = $q_value
6256 OR LOWER(ship_company) = $q_value
6259 push @cust_main, qsearch( {
6260 'table' => 'cust_main',
6261 'hashref' => \%options,
6262 'extra_sql' => "$sql AND $agentnums_sql", #agent virtualization
6265 #no exact match, trying substring/fuzzy
6266 #always do substring & fuzzy (unless they're explicity config'ed off)
6267 #getting complaints searches are not returning enough
6268 unless ( @cust_main && $skip_fuzzy || $conf->exists('disable-fuzzy') ) {
6270 #still some false laziness w/search_sql (was search/cust_main.cgi)
6275 { 'company' => { op=>'ILIKE', value=>"%$value%" }, },
6276 { 'ship_company' => { op=>'ILIKE', value=>"%$value%" }, },
6279 if ( $first && $last ) {
6282 { 'first' => { op=>'ILIKE', value=>"%$first%" },
6283 'last' => { op=>'ILIKE', value=>"%$last%" },
6285 { 'ship_first' => { op=>'ILIKE', value=>"%$first%" },
6286 'ship_last' => { op=>'ILIKE', value=>"%$last%" },
6293 { 'last' => { op=>'ILIKE', value=>"%$value%" }, },
6294 { 'ship_last' => { op=>'ILIKE', value=>"%$value%" }, },
6298 foreach my $hashref ( @hashrefs ) {
6300 push @cust_main, qsearch( {
6301 'table' => 'cust_main',
6302 'hashref' => { %$hashref,
6305 'extra_sql' => " AND $agentnums_sql", #agent virtualizaiton
6314 " AND $agentnums_sql", #extra_sql #agent virtualization
6317 if ( $first && $last ) {
6318 push @cust_main, FS::cust_main->fuzzy_search(
6319 { 'last' => $last, #fuzzy hashref
6320 'first' => $first }, #
6324 foreach my $field ( 'last', 'company' ) {
6326 FS::cust_main->fuzzy_search( { $field => $value }, @fuzopts );
6331 #eliminate duplicates
6333 @cust_main = grep { !$saw{$_->custnum}++ } @cust_main;
6343 Accepts the following options: I<email>, the email address to search for. The
6344 email address will be searched for as an email invoice destination and as an
6347 #Any additional options are treated as an additional qualifier on the search
6348 #(i.e. I<agentnum>).
6350 Returns a (possibly empty) array of FS::cust_main objects (but usually just
6360 my $email = delete $options{'email'};
6362 #we're only being used by RT at the moment... no agent virtualization yet
6363 #my $agentnums_sql = $FS::CurrentUser::CurrentUser->agentnums_sql;
6367 if ( $email =~ /([^@]+)\@([^@]+)/ ) {
6369 my ( $user, $domain ) = ( $1, $2 );
6371 warn "$me smart_search: searching for $user in domain $domain"
6377 'table' => 'cust_main_invoice',
6378 'hashref' => { 'dest' => $email },
6385 map $_->cust_svc->cust_pkg,
6387 'table' => 'svc_acct',
6388 'hashref' => { 'username' => $user, },
6390 'AND ( SELECT domain FROM svc_domain
6391 WHERE svc_acct.domsvc = svc_domain.svcnum
6392 ) = '. dbh->quote($domain),
6398 @cust_main = grep { !$saw{$_->custnum}++ } @cust_main;
6400 warn "$me smart_search: found ". scalar(@cust_main). " unique customers"
6407 =item check_and_rebuild_fuzzyfiles
6411 use vars qw(@fuzzyfields);
6412 @fuzzyfields = ( 'last', 'first', 'company' );
6414 sub check_and_rebuild_fuzzyfiles {
6415 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
6416 rebuild_fuzzyfiles() if grep { ! -e "$dir/cust_main.$_" } @fuzzyfields
6419 =item rebuild_fuzzyfiles
6423 sub rebuild_fuzzyfiles {
6425 use Fcntl qw(:flock);
6427 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
6428 mkdir $dir, 0700 unless -d $dir;
6430 foreach my $fuzzy ( @fuzzyfields ) {
6432 open(LOCK,">>$dir/cust_main.$fuzzy")
6433 or die "can't open $dir/cust_main.$fuzzy: $!";
6435 or die "can't lock $dir/cust_main.$fuzzy: $!";
6437 open (CACHE,">$dir/cust_main.$fuzzy.tmp")
6438 or die "can't open $dir/cust_main.$fuzzy.tmp: $!";
6440 foreach my $field ( $fuzzy, "ship_$fuzzy" ) {
6441 my $sth = dbh->prepare("SELECT $field FROM cust_main".
6442 " WHERE $field != '' AND $field IS NOT NULL");
6443 $sth->execute or die $sth->errstr;
6445 while ( my $row = $sth->fetchrow_arrayref ) {
6446 print CACHE $row->[0]. "\n";
6451 close CACHE or die "can't close $dir/cust_main.$fuzzy.tmp: $!";
6453 rename "$dir/cust_main.$fuzzy.tmp", "$dir/cust_main.$fuzzy";
6464 my( $self, $field ) = @_;
6465 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
6466 open(CACHE,"<$dir/cust_main.$field")
6467 or die "can't open $dir/cust_main.$field: $!";
6468 my @array = map { chomp; $_; } <CACHE>;
6473 =item append_fuzzyfiles LASTNAME COMPANY
6477 sub append_fuzzyfiles {
6478 #my( $first, $last, $company ) = @_;
6480 &check_and_rebuild_fuzzyfiles;
6482 use Fcntl qw(:flock);
6484 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
6486 foreach my $field (qw( first last company )) {
6491 open(CACHE,">>$dir/cust_main.$field")
6492 or die "can't open $dir/cust_main.$field: $!";
6493 flock(CACHE,LOCK_EX)
6494 or die "can't lock $dir/cust_main.$field: $!";
6496 print CACHE "$value\n";
6498 flock(CACHE,LOCK_UN)
6499 or die "can't unlock $dir/cust_main.$field: $!";
6514 #warn join('-',keys %$param);
6515 my $fh = $param->{filehandle};
6516 my @fields = @{$param->{fields}};
6518 eval "use Text::CSV_XS;";
6521 my $csv = new Text::CSV_XS;
6528 local $SIG{HUP} = 'IGNORE';
6529 local $SIG{INT} = 'IGNORE';
6530 local $SIG{QUIT} = 'IGNORE';
6531 local $SIG{TERM} = 'IGNORE';
6532 local $SIG{TSTP} = 'IGNORE';
6533 local $SIG{PIPE} = 'IGNORE';
6535 my $oldAutoCommit = $FS::UID::AutoCommit;
6536 local $FS::UID::AutoCommit = 0;
6539 #while ( $columns = $csv->getline($fh) ) {
6541 while ( defined($line=<$fh>) ) {
6543 $csv->parse($line) or do {
6544 $dbh->rollback if $oldAutoCommit;
6545 return "can't parse: ". $csv->error_input();
6548 my @columns = $csv->fields();
6549 #warn join('-',@columns);
6552 foreach my $field ( @fields ) {
6553 $row{$field} = shift @columns;
6556 my $cust_main = qsearchs('cust_main', { 'custnum' => $row{'custnum'} } );
6557 unless ( $cust_main ) {
6558 $dbh->rollback if $oldAutoCommit;
6559 return "unknown custnum $row{'custnum'}";
6562 if ( $row{'amount'} > 0 ) {
6563 my $error = $cust_main->charge($row{'amount'}, $row{'pkg'});
6565 $dbh->rollback if $oldAutoCommit;
6569 } elsif ( $row{'amount'} < 0 ) {
6570 my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ),
6573 $dbh->rollback if $oldAutoCommit;
6583 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
6585 return "Empty file!" unless $imported;
6591 =item notify CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
6593 Sends a templated email notification to the customer (see L<Text::Template>).
6595 OPTIONS is a hash and may include
6597 I<from> - the email sender (default is invoice_from)
6599 I<to> - comma-separated scalar or arrayref of recipients
6600 (default is invoicing_list)
6602 I<subject> - The subject line of the sent email notification
6603 (default is "Notice from company_name")
6605 I<extra_fields> - a hashref of name/value pairs which will be substituted
6608 The following variables are vavailable in the template.
6610 I<$first> - the customer first name
6611 I<$last> - the customer last name
6612 I<$company> - the customer company
6613 I<$payby> - a description of the method of payment for the customer
6614 # would be nice to use FS::payby::shortname
6615 I<$payinfo> - the account information used to collect for this customer
6616 I<$expdate> - the expiration of the customer payment in seconds from epoch
6621 my ($customer, $template, %options) = @_;
6623 return unless $conf->exists($template);
6625 my $from = $conf->config('invoice_from') if $conf->exists('invoice_from');
6626 $from = $options{from} if exists($options{from});
6628 my $to = join(',', $customer->invoicing_list_emailonly);
6629 $to = $options{to} if exists($options{to});
6631 my $subject = "Notice from " . $conf->config('company_name')
6632 if $conf->exists('company_name');
6633 $subject = $options{subject} if exists($options{subject});
6635 my $notify_template = new Text::Template (TYPE => 'ARRAY',
6636 SOURCE => [ map "$_\n",
6637 $conf->config($template)]
6639 or die "can't create new Text::Template object: Text::Template::ERROR";
6640 $notify_template->compile()
6641 or die "can't compile template: Text::Template::ERROR";
6643 $FS::notify_template::_template::company_name = $conf->config('company_name');
6644 $FS::notify_template::_template::company_address =
6645 join("\n", $conf->config('company_address') ). "\n";
6647 my $paydate = $customer->paydate || '2037-12-31';
6648 $FS::notify_template::_template::first = $customer->first;
6649 $FS::notify_template::_template::last = $customer->last;
6650 $FS::notify_template::_template::company = $customer->company;
6651 $FS::notify_template::_template::payinfo = $customer->mask_payinfo;
6652 my $payby = $customer->payby;
6653 my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
6654 my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
6656 #credit cards expire at the end of the month/year of their exp date
6657 if ($payby eq 'CARD' || $payby eq 'DCRD') {
6658 $FS::notify_template::_template::payby = 'credit card';
6659 ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
6660 $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
6662 }elsif ($payby eq 'COMP') {
6663 $FS::notify_template::_template::payby = 'complimentary account';
6665 $FS::notify_template::_template::payby = 'current method';
6667 $FS::notify_template::_template::expdate = $expire_time;
6669 for (keys %{$options{extra_fields}}){
6671 ${"FS::notify_template::_template::$_"} = $options{extra_fields}->{$_};
6674 send_email(from => $from,
6676 subject => $subject,
6677 body => $notify_template->fill_in( PACKAGE =>
6678 'FS::notify_template::_template' ),
6683 =item generate_letter CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
6685 Generates a templated notification to the customer (see L<Text::Template>).
6687 OPTIONS is a hash and may include
6689 I<extra_fields> - a hashref of name/value pairs which will be substituted
6690 into the template. These values may override values mentioned below
6691 and those from the customer record.
6693 The following variables are available in the template instead of or in addition
6694 to the fields of the customer record.
6696 I<$payby> - a description of the method of payment for the customer
6697 # would be nice to use FS::payby::shortname
6698 I<$payinfo> - the masked account information used to collect for this customer
6699 I<$expdate> - the expiration of the customer payment method in seconds from epoch
6700 I<$returnaddress> - the return address defaults to invoice_latexreturnaddress or company_address
6704 sub generate_letter {
6705 my ($self, $template, %options) = @_;
6707 return unless $conf->exists($template);
6709 my $letter_template = new Text::Template
6711 SOURCE => [ map "$_\n", $conf->config($template)],
6712 DELIMITERS => [ '[@--', '--@]' ],
6714 or die "can't create new Text::Template object: Text::Template::ERROR";
6716 $letter_template->compile()
6717 or die "can't compile template: Text::Template::ERROR";
6719 my %letter_data = map { $_ => $self->$_ } $self->fields;
6720 $letter_data{payinfo} = $self->mask_payinfo;
6722 #my $paydate = $self->paydate || '2037-12-31';
6723 my $paydate = $self->paydate =~ /^\S+$/ ? $self->paydate : '2037-12-31';
6725 my $payby = $self->payby;
6726 my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
6727 my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
6729 #credit cards expire at the end of the month/year of their exp date
6730 if ($payby eq 'CARD' || $payby eq 'DCRD') {
6731 $letter_data{payby} = 'credit card';
6732 ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
6733 $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
6735 }elsif ($payby eq 'COMP') {
6736 $letter_data{payby} = 'complimentary account';
6738 $letter_data{payby} = 'current method';
6740 $letter_data{expdate} = $expire_time;
6742 for (keys %{$options{extra_fields}}){
6743 $letter_data{$_} = $options{extra_fields}->{$_};
6746 unless(exists($letter_data{returnaddress})){
6747 my $retadd = join("\n", $conf->config_orbase( 'invoice_latexreturnaddress',
6748 $self->agent_template)
6750 if ( length($retadd) ) {
6751 $letter_data{returnaddress} = $retadd;
6752 } elsif ( grep /\S/, $conf->config('company_address') ) {
6753 $letter_data{returnaddress} =
6754 join( '\\*'."\n", map s/( {2,})/'~' x length($1)/eg,
6755 $conf->config('company_address')
6758 $letter_data{returnaddress} = '~';
6762 $letter_data{conf_dir} = "$FS::UID::conf_dir/conf.$FS::UID::datasrc";
6764 $letter_data{company_name} = $conf->config('company_name');
6766 my $dir = $FS::UID::conf_dir."/cache.". $FS::UID::datasrc;
6767 my $fh = new File::Temp( TEMPLATE => 'letter.'. $self->custnum. '.XXXXXXXX',
6771 ) or die "can't open temp file: $!\n";
6773 $letter_template->fill_in( OUTPUT => $fh, HASH => \%letter_data );
6775 $fh->filename =~ /^(.*).tex$/ or die "unparsable filename: ". $fh->filename;
6779 =item print_ps TEMPLATE
6781 Returns an postscript letter filled in from TEMPLATE, as a scalar.
6787 my $file = $self->generate_letter(@_);
6788 FS::Misc::generate_ps($file);
6791 =item print TEMPLATE
6793 Prints the filled in template.
6795 TEMPLATE is the name of a L<Text::Template> to fill in and print.
6799 sub queueable_print {
6802 my $self = qsearchs('cust_main', { 'custnum' => $opt{custnum} } )
6803 or die "invalid customer number: " . $opt{custvnum};
6805 my $error = $self->print( $opt{template} );
6806 die $error if $error;
6810 my ($self, $template) = (shift, shift);
6811 do_print [ $self->print_ps($template) ];
6814 sub agent_template {
6816 $self->_agent_plandata('agent_templatename');
6819 sub agent_invoice_from {
6821 $self->_agent_plandata('agent_invoice_from');
6824 sub _agent_plandata {
6825 my( $self, $option ) = @_;
6827 #yuck. this whole thing needs to be reconciled better with 1.9's idea of
6828 #agent-specific Conf
6830 use FS::part_event::Condition;
6832 my $agentnum = $self->agentnum;
6835 if ( driver_name =~ /^Pg/i ) {
6837 } elsif ( driver_name =~ /^mysql/i ) {
6840 die "don't know how to use regular expressions in ". driver_name. " databases";
6843 my $part_event_option =
6845 'select' => 'part_event_option.*',
6846 'table' => 'part_event_option',
6848 LEFT JOIN part_event USING ( eventpart )
6849 LEFT JOIN part_event_option AS peo_agentnum
6850 ON ( part_event.eventpart = peo_agentnum.eventpart
6851 AND peo_agentnum.optionname = 'agentnum'
6852 AND peo_agentnum.optionvalue }. $regexp. q{ '(^|,)}. $agentnum. q{(,|$)'
6854 LEFT JOIN part_event_option AS peo_cust_bill_age
6855 ON ( part_event.eventpart = peo_cust_bill_age.eventpart
6856 AND peo_cust_bill_age.optionname = 'cust_bill_age'
6859 #'hashref' => { 'optionname' => $option },
6860 #'hashref' => { 'part_event_option.optionname' => $option },
6862 " WHERE part_event_option.optionname = ". dbh->quote($option).
6863 " AND action = 'cust_bill_send_agent' ".
6864 " AND ( disabled IS NULL OR disabled != 'Y' ) ".
6865 " AND peo_agentnum.optionname = 'agentnum' ".
6866 " AND ( agentnum IS NULL OR agentnum = $agentnum ) ".
6868 CASE WHEN peo_cust_bill_age.optionname != 'cust_bill_age'
6870 ELSE ". FS::part_event::Condition->age2seconds_sql('peo_cust_bill_age.optionvalue').
6872 , part_event.weight".
6876 unless ( $part_event_option ) {
6877 return $self->agent->invoice_template || ''
6878 if $option eq 'agent_templatename';
6882 $part_event_option->optionvalue;
6887 ## actual sub, not a method, designed to be called from the queue.
6888 ## sets up the customer, and calls the bill_and_collect
6889 my (%args) = @_; #, ($time, $invoice_time, $check_freq, $resetup) = @_;
6890 my $cust_main = qsearchs( 'cust_main', { custnum => $args{'custnum'} } );
6891 $cust_main->bill_and_collect(
6902 The delete method should possibly take an FS::cust_main object reference
6903 instead of a scalar customer number.
6905 Bill and collect options should probably be passed as references instead of a
6908 There should probably be a configuration file with a list of allowed credit
6911 No multiple currency support (probably a larger project than just this module).
6913 payinfo_masked false laziness with cust_pay.pm and cust_refund.pm
6915 Birthdates rely on negative epoch values.
6917 The payby for card/check batches is broken. With mixed batching, bad
6920 B<collect> I<invoice_time> should be renamed I<time>, like B<bill>.
6924 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
6925 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
6926 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.