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);
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);
30 use FS::cust_bill_pkg;
31 use FS::cust_bill_pkg_display;
32 use FS::cust_bill_pkg_tax_location;
33 use FS::cust_bill_pkg_tax_rate_location;
35 use FS::cust_pay_pending;
36 use FS::cust_pay_void;
37 use FS::cust_pay_batch;
40 use FS::part_referral;
41 use FS::cust_main_county;
42 use FS::cust_location;
44 use FS::tax_rate_location;
45 use FS::cust_tax_location;
46 use FS::part_pkg_taxrate;
48 use FS::cust_main_invoice;
49 use FS::cust_credit_bill;
50 use FS::cust_bill_pay;
51 use FS::prepay_credit;
55 use FS::part_event_condition;
58 use FS::payment_gateway;
59 use FS::agent_payment_gateway;
61 use FS::payinfo_Mixin;
64 @ISA = qw( FS::payinfo_Mixin FS::Record );
66 @EXPORT_OK = qw( smart_search );
68 $realtime_bop_decline_quiet = 0;
70 # 1 is mostly method/subroutine entry and options
71 # 2 traces progress of some operations
72 # 3 is even more information including possibly sensitive data
74 $me = '[FS::cust_main]';
78 $ignore_expired_card = 0;
80 @encrypted_fields = ('payinfo', 'paycvv');
81 sub nohistory_fields { ('paycvv'); }
83 @paytypes = ('', 'Personal checking', 'Personal savings', 'Business checking', 'Business savings');
85 #ask FS::UID to run this stuff for us later
86 #$FS::UID::callback{'FS::cust_main'} = sub {
87 install_callback FS::UID sub {
89 #yes, need it for stuff below (prolly should be cached)
94 my ( $hashref, $cache ) = @_;
95 if ( exists $hashref->{'pkgnum'} ) {
96 #@{ $self->{'_pkgnum'} } = ();
97 my $subcache = $cache->subcache( 'pkgnum', 'cust_pkg', $hashref->{custnum});
98 $self->{'_pkgnum'} = $subcache;
99 #push @{ $self->{'_pkgnum'} },
100 FS::cust_pkg->new_or_cached($hashref, $subcache) if $hashref->{pkgnum};
106 FS::cust_main - Object methods for cust_main records
112 $record = new FS::cust_main \%hash;
113 $record = new FS::cust_main { 'column' => 'value' };
115 $error = $record->insert;
117 $error = $new_record->replace($old_record);
119 $error = $record->delete;
121 $error = $record->check;
123 @cust_pkg = $record->all_pkgs;
125 @cust_pkg = $record->ncancelled_pkgs;
127 @cust_pkg = $record->suspended_pkgs;
129 $error = $record->bill;
130 $error = $record->bill %options;
131 $error = $record->bill 'time' => $time;
133 $error = $record->collect;
134 $error = $record->collect %options;
135 $error = $record->collect 'invoice_time' => $time,
140 An FS::cust_main object represents a customer. FS::cust_main inherits from
141 FS::Record. The following fields are currently supported:
147 Primary key (assigned automatically for new customers)
151 Agent (see L<FS::agent>)
155 Advertising source (see L<FS::part_referral>)
167 Cocial security number (optional)
183 (optional, see L<FS::cust_main_county>)
187 (see L<FS::cust_main_county>)
193 (see L<FS::cust_main_county>)
229 (optional, see L<FS::cust_main_county>)
233 (see L<FS::cust_main_county>)
239 (see L<FS::cust_main_county>)
255 Payment Type (See L<FS::payinfo_Mixin> for valid payby values)
259 Payment Information (See L<FS::payinfo_Mixin> for data format)
263 Masked payinfo (See L<FS::payinfo_Mixin> for how this works)
267 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
271 Expiration date, mm/yyyy, m/yyyy, mm/yy or m/yy
275 Start date month (maestro/solo cards only)
279 Start date year (maestro/solo cards only)
283 Issue number (maestro/solo cards only)
287 Name on card or billing name
291 IP address from which payment information was received
295 Tax exempt, empty or `Y'
299 Order taker (assigned automatically, see L<FS::UID>)
305 =item referral_custnum
307 Referring customer number
311 Enable individual CDR spooling, empty or `Y'
315 A suggestion to events (see L<FS::part_bill_event">) to delay until this unix timestamp
319 Discourage individual CDR printing, empty or `Y'
329 Creates a new customer. To add the customer to the database, see L<"insert">.
331 Note that this stores the hash reference, not a distinct copy of the hash it
332 points to. You can ask the object for a copy with the I<hash> method.
336 sub table { 'cust_main'; }
338 =item insert [ CUST_PKG_HASHREF [ , INVOICING_LIST_ARYREF ] [ , OPTION => VALUE ... ] ]
340 Adds this customer to the database. If there is an error, returns the error,
341 otherwise returns false.
343 CUST_PKG_HASHREF: If you pass a Tie::RefHash data structure to the insert
344 method containing FS::cust_pkg and FS::svc_I<tablename> objects, all records
345 are inserted atomicly, or the transaction is rolled back. Passing an empty
346 hash reference is equivalent to not supplying this parameter. There should be
347 a better explanation of this, but until then, here's an example:
350 tie %hash, 'Tie::RefHash'; #this part is important
352 $cust_pkg => [ $svc_acct ],
355 $cust_main->insert( \%hash );
357 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
358 be set as the invoicing list (see L<"invoicing_list">). Errors return as
359 expected and rollback the entire transaction; it is not necessary to call
360 check_invoicing_list first. The invoicing_list is set after the records in the
361 CUST_PKG_HASHREF above are inserted, so it is now possible to set an
362 invoicing_list destination to the newly-created svc_acct. Here's an example:
364 $cust_main->insert( {}, [ $email, 'POST' ] );
366 Currently available options are: I<depend_jobnum> and I<noexport>.
368 If I<depend_jobnum> is set, all provisioning jobs will have a dependancy
369 on the supplied jobnum (they will not run until the specific job completes).
370 This can be used to defer provisioning until some action completes (such
371 as running the customer's credit card successfully).
373 The I<noexport> option is deprecated. If I<noexport> is set true, no
374 provisioning jobs (exports) are scheduled. (You can schedule them later with
375 the B<reexport> method.)
381 my $cust_pkgs = @_ ? shift : {};
382 my $invoicing_list = @_ ? shift : '';
384 warn "$me insert called with options ".
385 join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
388 local $SIG{HUP} = 'IGNORE';
389 local $SIG{INT} = 'IGNORE';
390 local $SIG{QUIT} = 'IGNORE';
391 local $SIG{TERM} = 'IGNORE';
392 local $SIG{TSTP} = 'IGNORE';
393 local $SIG{PIPE} = 'IGNORE';
395 my $oldAutoCommit = $FS::UID::AutoCommit;
396 local $FS::UID::AutoCommit = 0;
399 my $prepay_identifier = '';
400 my( $amount, $seconds, $upbytes, $downbytes, $totalbytes ) = (0, 0, 0, 0, 0);
402 if ( $self->payby eq 'PREPAY' ) {
404 $self->payby('BILL');
405 $prepay_identifier = $self->payinfo;
408 warn " looking up prepaid card $prepay_identifier\n"
411 my $error = $self->get_prepay( $prepay_identifier,
412 'amount_ref' => \$amount,
413 'seconds_ref' => \$seconds,
414 'upbytes_ref' => \$upbytes,
415 'downbytes_ref' => \$downbytes,
416 'totalbytes_ref' => \$totalbytes,
419 $dbh->rollback if $oldAutoCommit;
420 #return "error applying prepaid card (transaction rolled back): $error";
424 $payby = 'PREP' if $amount;
426 } elsif ( $self->payby =~ /^(CASH|WEST|MCRD)$/ ) {
429 $self->payby('BILL');
430 $amount = $self->paid;
434 warn " inserting $self\n"
437 $self->signupdate(time) unless $self->signupdate;
439 $self->auto_agent_custid()
440 if $conf->config('cust_main-auto_agent_custid') && ! $self->agent_custid;
442 my $error = $self->SUPER::insert;
444 $dbh->rollback if $oldAutoCommit;
445 #return "inserting cust_main record (transaction rolled back): $error";
449 warn " setting invoicing list\n"
452 if ( $invoicing_list ) {
453 $error = $self->check_invoicing_list( $invoicing_list );
455 $dbh->rollback if $oldAutoCommit;
456 #return "checking invoicing_list (transaction rolled back): $error";
459 $self->invoicing_list( $invoicing_list );
462 if ( $conf->config('cust_main-skeleton_tables')
463 && $conf->config('cust_main-skeleton_custnum') ) {
465 warn " inserting skeleton records\n"
468 my $error = $self->start_copy_skel;
470 $dbh->rollback if $oldAutoCommit;
476 warn " ordering packages\n"
479 $error = $self->order_pkgs( $cust_pkgs,
481 'seconds_ref' => \$seconds,
482 'upbytes_ref' => \$upbytes,
483 'downbytes_ref' => \$downbytes,
484 'totalbytes_ref' => \$totalbytes,
487 $dbh->rollback if $oldAutoCommit;
492 $dbh->rollback if $oldAutoCommit;
493 return "No svc_acct record to apply pre-paid time";
495 if ( $upbytes || $downbytes || $totalbytes ) {
496 $dbh->rollback if $oldAutoCommit;
497 return "No svc_acct record to apply pre-paid data";
501 warn " inserting initial $payby payment of $amount\n"
503 $error = $self->insert_cust_pay($payby, $amount, $prepay_identifier);
505 $dbh->rollback if $oldAutoCommit;
506 return "inserting payment (transaction rolled back): $error";
510 unless ( $import || $skip_fuzzyfiles ) {
511 warn " queueing fuzzyfiles update\n"
513 $error = $self->queue_fuzzyfiles_update;
515 $dbh->rollback if $oldAutoCommit;
516 return "updating fuzzy search cache: $error";
520 warn " insert complete; committing transaction\n"
523 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
528 use File::CounterFile;
529 sub auto_agent_custid {
532 my $format = $conf->config('cust_main-auto_agent_custid');
534 if ( $format eq '1YMMXXXXXXXX' ) {
536 my $counter = new File::CounterFile 'cust_main.agent_custid';
539 my $ym = 100000000000 + time2str('%y%m00000000', time);
540 if ( $ym > $counter->value ) {
541 $counter->{'value'} = $agent_custid = $ym;
542 $counter->{'updated'} = 1;
544 $agent_custid = $counter->inc;
550 die "Unknown cust_main-auto_agent_custid format: $format";
553 $self->agent_custid($agent_custid);
557 sub start_copy_skel {
560 #'mg_user_preference' => {},
561 #'mg_user_indicator_profile.user_indicator_profile_id' => { 'mg_profile_indicator.profile_indicator_id' => { 'mg_profile_details.profile_detail_id' }, },
562 #'mg_watchlist_header.watchlist_header_id' => { 'mg_watchlist_details.watchlist_details_id' },
563 #'mg_user_grid_header.grid_header_id' => { 'mg_user_grid_details.user_grid_details_id' },
564 #'mg_portfolio_header.portfolio_header_id' => { 'mg_portfolio_trades.portfolio_trades_id' => { 'mg_portfolio_trades_positions.portfolio_trades_positions_id' } },
565 my @tables = eval(join('\n',$conf->config('cust_main-skeleton_tables')));
568 _copy_skel( 'cust_main', #tablename
569 $conf->config('cust_main-skeleton_custnum'), #sourceid
570 $self->custnum, #destid
571 @tables, #child tables
575 #recursive subroutine, not a method
577 my( $table, $sourceid, $destid, %child_tables ) = @_;
580 if ( $table =~ /^(\w+)\.(\w+)$/ ) {
581 ( $table, $primary_key ) = ( $1, $2 );
583 my $dbdef_table = dbdef->table($table);
584 $primary_key = $dbdef_table->primary_key
585 or return "$table has no primary key".
586 " (or do you need to run dbdef-create?)";
589 warn " _copy_skel: $table.$primary_key $sourceid to $destid for ".
590 join (', ', keys %child_tables). "\n"
593 foreach my $child_table_def ( keys %child_tables ) {
597 if ( $child_table_def =~ /^(\w+)\.(\w+)$/ ) {
598 ( $child_table, $child_pkey ) = ( $1, $2 );
600 $child_table = $child_table_def;
602 $child_pkey = dbdef->table($child_table)->primary_key;
603 # or return "$table has no primary key".
604 # " (or do you need to run dbdef-create?)\n";
608 if ( keys %{ $child_tables{$child_table_def} } ) {
610 return "$child_table has no primary key".
611 " (run dbdef-create or try specifying it?)\n"
614 #false laziness w/Record::insert and only works on Pg
615 #refactor the proper last-inserted-id stuff out of Record::insert if this
616 # ever gets use for anything besides a quick kludge for one customer
617 my $default = dbdef->table($child_table)->column($child_pkey)->default;
618 $default =~ /^nextval\(\(?'"?([\w\.]+)"?'/i
619 or return "can't parse $child_table.$child_pkey default value ".
620 " for sequence name: $default";
625 my @sel_columns = grep { $_ ne $primary_key }
626 dbdef->table($child_table)->columns;
627 my $sel_columns = join(', ', @sel_columns );
629 my @ins_columns = grep { $_ ne $child_pkey } @sel_columns;
630 my $ins_columns = ' ( '. join(', ', $primary_key, @ins_columns ). ' ) ';
631 my $placeholders = ' ( ?, '. join(', ', map '?', @ins_columns ). ' ) ';
633 my $sel_st = "SELECT $sel_columns FROM $child_table".
634 " WHERE $primary_key = $sourceid";
637 my $sel_sth = dbh->prepare( $sel_st )
638 or return dbh->errstr;
640 $sel_sth->execute or return $sel_sth->errstr;
642 while ( my $row = $sel_sth->fetchrow_hashref ) {
644 warn " selected row: ".
645 join(', ', map { "$_=".$row->{$_} } keys %$row ). "\n"
649 "INSERT INTO $child_table $ins_columns VALUES $placeholders";
650 my $ins_sth =dbh->prepare($statement)
651 or return dbh->errstr;
652 my @param = ( $destid, map $row->{$_}, @ins_columns );
653 warn " $statement: [ ". join(', ', @param). " ]\n"
655 $ins_sth->execute( @param )
656 or return $ins_sth->errstr;
658 #next unless keys %{ $child_tables{$child_table} };
659 next unless $sequence;
661 #another section of that laziness
662 my $seq_sql = "SELECT currval('$sequence')";
663 my $seq_sth = dbh->prepare($seq_sql) or return dbh->errstr;
664 $seq_sth->execute or return $seq_sth->errstr;
665 my $insertid = $seq_sth->fetchrow_arrayref->[0];
667 # don't drink soap! recurse! recurse! okay!
669 _copy_skel( $child_table_def,
670 $row->{$child_pkey}, #sourceid
672 %{ $child_tables{$child_table_def} },
674 return $error if $error;
684 =item order_pkg HASHREF | OPTION => VALUE ...
686 Orders a single package.
688 Options may be passed as a list of key/value pairs or as a hash reference.
699 Optional FS::cust_location object
703 Optional arryaref of FS::svc_* service objects.
707 If this option is set to a job queue jobnum (see L<FS::queue>), all provisioning
708 jobs will have a dependancy on the supplied job (they will not run until the
709 specific job completes). This can be used to defer provisioning until some
710 action completes (such as running the customer's credit card successfully).
718 my $opt = ref($_[0]) ? shift : { @_ };
720 warn "$me order_pkg called with options ".
721 join(', ', map { "$_: $opt->{$_}" } keys %$opt ). "\n"
724 my $cust_pkg = $opt->{'cust_pkg'};
725 my $svcs = $opt->{'svcs'} || [];
727 my %svc_options = ();
728 $svc_options{'depend_jobnum'} = $opt->{'depend_jobnum'}
729 if exists($opt->{'depend_jobnum'}) && $opt->{'depend_jobnum'};
731 local $SIG{HUP} = 'IGNORE';
732 local $SIG{INT} = 'IGNORE';
733 local $SIG{QUIT} = 'IGNORE';
734 local $SIG{TERM} = 'IGNORE';
735 local $SIG{TSTP} = 'IGNORE';
736 local $SIG{PIPE} = 'IGNORE';
738 my $oldAutoCommit = $FS::UID::AutoCommit;
739 local $FS::UID::AutoCommit = 0;
742 if ( $opt->{'cust_location'} &&
743 ( ! $cust_pkg->locationnum || $cust_pkg->locationnum == -1 ) ) {
744 my $error = $opt->{'cust_location'}->insert;
746 $dbh->rollback if $oldAutoCommit;
747 return "inserting cust_location (transaction rolled back): $error";
749 $cust_pkg->locationnum($opt->{'cust_location'}->locationnum);
752 $cust_pkg->custnum( $self->custnum );
754 my $error = $cust_pkg->insert;
756 $dbh->rollback if $oldAutoCommit;
757 return "inserting cust_pkg (transaction rolled back): $error";
760 foreach my $svc_something ( @{ $opt->{'svcs'} } ) {
761 if ( $svc_something->svcnum ) {
762 my $old_cust_svc = $svc_something->cust_svc;
763 my $new_cust_svc = new FS::cust_svc { $old_cust_svc->hash };
764 $new_cust_svc->pkgnum( $cust_pkg->pkgnum);
765 $error = $new_cust_svc->replace($old_cust_svc);
767 $svc_something->pkgnum( $cust_pkg->pkgnum );
768 if ( $svc_something->isa('FS::svc_acct') ) {
769 foreach ( grep { $opt->{$_.'_ref'} && ${ $opt->{$_.'_ref'} } }
770 qw( seconds upbytes downbytes totalbytes ) ) {
771 $svc_something->$_( $svc_something->$_() + ${ $opt->{$_.'_ref'} } );
772 ${ $opt->{$_.'_ref'} } = 0;
775 $error = $svc_something->insert(%svc_options);
778 $dbh->rollback if $oldAutoCommit;
779 return "inserting svc_ (transaction rolled back): $error";
783 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
788 #deprecated #=item order_pkgs HASHREF [ , SECONDSREF ] [ , OPTION => VALUE ... ]
789 =item order_pkgs HASHREF [ , OPTION => VALUE ... ]
791 Like the insert method on an existing record, this method orders multiple
792 packages and included services atomicaly. Pass a Tie::RefHash data structure
793 to this method containing FS::cust_pkg and FS::svc_I<tablename> objects.
794 There should be a better explanation of this, but until then, here's an
798 tie %hash, 'Tie::RefHash'; #this part is important
800 $cust_pkg => [ $svc_acct ],
803 $cust_main->order_pkgs( \%hash, 'noexport'=>1 );
805 Services can be new, in which case they are inserted, or existing unaudited
806 services, in which case they are linked to the newly-created package.
808 Currently available options are: I<depend_jobnum>, I<noexport>, I<seconds_ref>,
809 I<upbytes_ref>, I<downbytes_ref>, and I<totalbytes_ref>.
811 If I<depend_jobnum> is set, all provisioning jobs will have a dependancy
812 on the supplied jobnum (they will not run until the specific job completes).
813 This can be used to defer provisioning until some action completes (such
814 as running the customer's credit card successfully).
816 The I<noexport> option is deprecated. If I<noexport> is set true, no
817 provisioning jobs (exports) are scheduled. (You can schedule them later with
818 the B<reexport> method for each cust_pkg object. Using the B<reexport> method
819 on the cust_main object is not recommended, as existing services will also be
822 If I<seconds_ref>, I<upbytes_ref>, I<downbytes_ref>, or I<totalbytes_ref> is
823 provided, the scalars (provided by references) will be incremented by the
824 values of the prepaid card.`
830 my $cust_pkgs = shift;
831 my $seconds_ref = ref($_[0]) ? shift : ''; #deprecated
833 $seconds_ref ||= $options{'seconds_ref'};
835 warn "$me order_pkgs called with options ".
836 join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
839 local $SIG{HUP} = 'IGNORE';
840 local $SIG{INT} = 'IGNORE';
841 local $SIG{QUIT} = 'IGNORE';
842 local $SIG{TERM} = 'IGNORE';
843 local $SIG{TSTP} = 'IGNORE';
844 local $SIG{PIPE} = 'IGNORE';
846 my $oldAutoCommit = $FS::UID::AutoCommit;
847 local $FS::UID::AutoCommit = 0;
850 local $FS::svc_Common::noexport_hack = 1 if $options{'noexport'};
852 foreach my $cust_pkg ( keys %$cust_pkgs ) {
854 my $error = $self->order_pkg(
855 'cust_pkg' => $cust_pkg,
856 'svcs' => $cust_pkgs->{$cust_pkg},
857 'seconds_ref' => $seconds_ref,
858 map { $_ => $options{$_} } qw( upbytes_ref downbytes_ref totalbytes_ref
863 $dbh->rollback if $oldAutoCommit;
869 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
873 =item recharge_prepay IDENTIFIER | PREPAY_CREDIT_OBJ [ , AMOUNTREF, SECONDSREF, UPBYTEREF, DOWNBYTEREF ]
875 Recharges this (existing) customer with the specified prepaid card (see
876 L<FS::prepay_credit>), specified either by I<identifier> or as an
877 FS::prepay_credit object. If there is an error, returns the error, otherwise
880 Optionally, five scalar references can be passed as well. They will have their
881 values filled in with the amount, number of seconds, and number of upload,
882 download, and total bytes applied by this prepaid card.
886 #the ref bullshit here should be refactored like get_prepay. MyAccount.pm is
887 #the only place that uses these args
888 sub recharge_prepay {
889 my( $self, $prepay_credit, $amountref, $secondsref,
890 $upbytesref, $downbytesref, $totalbytesref ) = @_;
892 local $SIG{HUP} = 'IGNORE';
893 local $SIG{INT} = 'IGNORE';
894 local $SIG{QUIT} = 'IGNORE';
895 local $SIG{TERM} = 'IGNORE';
896 local $SIG{TSTP} = 'IGNORE';
897 local $SIG{PIPE} = 'IGNORE';
899 my $oldAutoCommit = $FS::UID::AutoCommit;
900 local $FS::UID::AutoCommit = 0;
903 my( $amount, $seconds, $upbytes, $downbytes, $totalbytes) = ( 0, 0, 0, 0, 0 );
905 my $error = $self->get_prepay( $prepay_credit,
906 'amount_ref' => \$amount,
907 'seconds_ref' => \$seconds,
908 'upbytes_ref' => \$upbytes,
909 'downbytes_ref' => \$downbytes,
910 'totalbytes_ref' => \$totalbytes,
912 || $self->increment_seconds($seconds)
913 || $self->increment_upbytes($upbytes)
914 || $self->increment_downbytes($downbytes)
915 || $self->increment_totalbytes($totalbytes)
916 || $self->insert_cust_pay_prepay( $amount,
918 ? $prepay_credit->identifier
923 $dbh->rollback if $oldAutoCommit;
927 if ( defined($amountref) ) { $$amountref = $amount; }
928 if ( defined($secondsref) ) { $$secondsref = $seconds; }
929 if ( defined($upbytesref) ) { $$upbytesref = $upbytes; }
930 if ( defined($downbytesref) ) { $$downbytesref = $downbytes; }
931 if ( defined($totalbytesref) ) { $$totalbytesref = $totalbytes; }
933 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
938 =item get_prepay IDENTIFIER | PREPAY_CREDIT_OBJ [ , OPTION => VALUE ... ]
940 Looks up and deletes a prepaid card (see L<FS::prepay_credit>),
941 specified either by I<identifier> or as an FS::prepay_credit object.
943 Available options are: I<amount_ref>, I<seconds_ref>, I<upbytes_ref>, I<downbytes_ref>, and I<totalbytes_ref>. The scalars (provided by references) will be
944 incremented by the values of the prepaid card.
946 If the prepaid card specifies an I<agentnum> (see L<FS::agent>), it is used to
947 check or set this customer's I<agentnum>.
949 If there is an error, returns the error, otherwise returns false.
955 my( $self, $prepay_credit, %opt ) = @_;
957 local $SIG{HUP} = 'IGNORE';
958 local $SIG{INT} = 'IGNORE';
959 local $SIG{QUIT} = 'IGNORE';
960 local $SIG{TERM} = 'IGNORE';
961 local $SIG{TSTP} = 'IGNORE';
962 local $SIG{PIPE} = 'IGNORE';
964 my $oldAutoCommit = $FS::UID::AutoCommit;
965 local $FS::UID::AutoCommit = 0;
968 unless ( ref($prepay_credit) ) {
970 my $identifier = $prepay_credit;
972 $prepay_credit = qsearchs(
974 { 'identifier' => $prepay_credit },
979 unless ( $prepay_credit ) {
980 $dbh->rollback if $oldAutoCommit;
981 return "Invalid prepaid card: ". $identifier;
986 if ( $prepay_credit->agentnum ) {
987 if ( $self->agentnum && $self->agentnum != $prepay_credit->agentnum ) {
988 $dbh->rollback if $oldAutoCommit;
989 return "prepaid card not valid for agent ". $self->agentnum;
991 $self->agentnum($prepay_credit->agentnum);
994 my $error = $prepay_credit->delete;
996 $dbh->rollback if $oldAutoCommit;
997 return "removing prepay_credit (transaction rolled back): $error";
1000 ${ $opt{$_.'_ref'} } += $prepay_credit->$_()
1001 for grep $opt{$_.'_ref'}, qw( amount seconds upbytes downbytes totalbytes );
1003 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1008 =item increment_upbytes SECONDS
1010 Updates this customer's single or primary account (see L<FS::svc_acct>) by
1011 the specified number of upbytes. If there is an error, returns the error,
1012 otherwise returns false.
1016 sub increment_upbytes {
1017 _increment_column( shift, 'upbytes', @_);
1020 =item increment_downbytes SECONDS
1022 Updates this customer's single or primary account (see L<FS::svc_acct>) by
1023 the specified number of downbytes. If there is an error, returns the error,
1024 otherwise returns false.
1028 sub increment_downbytes {
1029 _increment_column( shift, 'downbytes', @_);
1032 =item increment_totalbytes SECONDS
1034 Updates this customer's single or primary account (see L<FS::svc_acct>) by
1035 the specified number of totalbytes. If there is an error, returns the error,
1036 otherwise returns false.
1040 sub increment_totalbytes {
1041 _increment_column( shift, 'totalbytes', @_);
1044 =item increment_seconds SECONDS
1046 Updates this customer's single or primary account (see L<FS::svc_acct>) by
1047 the specified number of seconds. If there is an error, returns the error,
1048 otherwise returns false.
1052 sub increment_seconds {
1053 _increment_column( shift, 'seconds', @_);
1056 =item _increment_column AMOUNT
1058 Updates this customer's single or primary account (see L<FS::svc_acct>) by
1059 the specified number of seconds or bytes. If there is an error, returns
1060 the error, otherwise returns false.
1064 sub _increment_column {
1065 my( $self, $column, $amount ) = @_;
1066 warn "$me increment_column called: $column, $amount\n"
1069 return '' unless $amount;
1071 my @cust_pkg = grep { $_->part_pkg->svcpart('svc_acct') }
1072 $self->ncancelled_pkgs;
1074 if ( ! @cust_pkg ) {
1075 return 'No packages with primary or single services found'.
1076 ' to apply pre-paid time';
1077 } elsif ( scalar(@cust_pkg) > 1 ) {
1078 #maybe have a way to specify the package/account?
1079 return 'Multiple packages found to apply pre-paid time';
1082 my $cust_pkg = $cust_pkg[0];
1083 warn " found package pkgnum ". $cust_pkg->pkgnum. "\n"
1087 $cust_pkg->cust_svc( $cust_pkg->part_pkg->svcpart('svc_acct') );
1089 if ( ! @cust_svc ) {
1090 return 'No account found to apply pre-paid time';
1091 } elsif ( scalar(@cust_svc) > 1 ) {
1092 return 'Multiple accounts found to apply pre-paid time';
1095 my $svc_acct = $cust_svc[0]->svc_x;
1096 warn " found service svcnum ". $svc_acct->pkgnum.
1097 ' ('. $svc_acct->email. ")\n"
1100 $column = "increment_$column";
1101 $svc_acct->$column($amount);
1105 =item insert_cust_pay_prepay AMOUNT [ PAYINFO ]
1107 Inserts a prepayment in the specified amount for this customer. An optional
1108 second argument can specify the prepayment identifier for tracking purposes.
1109 If there is an error, returns the error, otherwise returns false.
1113 sub insert_cust_pay_prepay {
1114 shift->insert_cust_pay('PREP', @_);
1117 =item insert_cust_pay_cash AMOUNT [ PAYINFO ]
1119 Inserts a cash payment in the specified amount for this customer. An optional
1120 second argument can specify the payment identifier for tracking purposes.
1121 If there is an error, returns the error, otherwise returns false.
1125 sub insert_cust_pay_cash {
1126 shift->insert_cust_pay('CASH', @_);
1129 =item insert_cust_pay_west AMOUNT [ PAYINFO ]
1131 Inserts a Western Union payment in the specified amount for this customer. An
1132 optional second argument can specify the prepayment identifier for tracking
1133 purposes. If there is an error, returns the error, otherwise returns false.
1137 sub insert_cust_pay_west {
1138 shift->insert_cust_pay('WEST', @_);
1141 sub insert_cust_pay {
1142 my( $self, $payby, $amount ) = splice(@_, 0, 3);
1143 my $payinfo = scalar(@_) ? shift : '';
1145 my $cust_pay = new FS::cust_pay {
1146 'custnum' => $self->custnum,
1147 'paid' => sprintf('%.2f', $amount),
1148 #'_date' => #date the prepaid card was purchased???
1150 'payinfo' => $payinfo,
1158 This method is deprecated. See the I<depend_jobnum> option to the insert and
1159 order_pkgs methods for a better way to defer provisioning.
1161 Re-schedules all exports by calling the B<reexport> method of all associated
1162 packages (see L<FS::cust_pkg>). If there is an error, returns the error;
1163 otherwise returns false.
1170 carp "WARNING: FS::cust_main::reexport is deprectated; ".
1171 "use the depend_jobnum option to insert or order_pkgs to delay export";
1173 local $SIG{HUP} = 'IGNORE';
1174 local $SIG{INT} = 'IGNORE';
1175 local $SIG{QUIT} = 'IGNORE';
1176 local $SIG{TERM} = 'IGNORE';
1177 local $SIG{TSTP} = 'IGNORE';
1178 local $SIG{PIPE} = 'IGNORE';
1180 my $oldAutoCommit = $FS::UID::AutoCommit;
1181 local $FS::UID::AutoCommit = 0;
1184 foreach my $cust_pkg ( $self->ncancelled_pkgs ) {
1185 my $error = $cust_pkg->reexport;
1187 $dbh->rollback if $oldAutoCommit;
1192 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1197 =item delete NEW_CUSTNUM
1199 This deletes the customer. If there is an error, returns the error, otherwise
1202 This will completely remove all traces of the customer record. This is not
1203 what you want when a customer cancels service; for that, cancel all of the
1204 customer's packages (see L</cancel>).
1206 If the customer has any uncancelled packages, you need to pass a new (valid)
1207 customer number for those packages to be transferred to. Cancelled packages
1208 will be deleted. Did I mention that this is NOT what you want when a customer
1209 cancels service and that you really should be looking see L<FS::cust_pkg/cancel>?
1211 You can't delete a customer with invoices (see L<FS::cust_bill>),
1212 or credits (see L<FS::cust_credit>), payments (see L<FS::cust_pay>) or
1213 refunds (see L<FS::cust_refund>).
1220 local $SIG{HUP} = 'IGNORE';
1221 local $SIG{INT} = 'IGNORE';
1222 local $SIG{QUIT} = 'IGNORE';
1223 local $SIG{TERM} = 'IGNORE';
1224 local $SIG{TSTP} = 'IGNORE';
1225 local $SIG{PIPE} = 'IGNORE';
1227 my $oldAutoCommit = $FS::UID::AutoCommit;
1228 local $FS::UID::AutoCommit = 0;
1231 if ( $self->cust_bill ) {
1232 $dbh->rollback if $oldAutoCommit;
1233 return "Can't delete a customer with invoices";
1235 if ( $self->cust_credit ) {
1236 $dbh->rollback if $oldAutoCommit;
1237 return "Can't delete a customer with credits";
1239 if ( $self->cust_pay ) {
1240 $dbh->rollback if $oldAutoCommit;
1241 return "Can't delete a customer with payments";
1243 if ( $self->cust_refund ) {
1244 $dbh->rollback if $oldAutoCommit;
1245 return "Can't delete a customer with refunds";
1248 my @cust_pkg = $self->ncancelled_pkgs;
1250 my $new_custnum = shift;
1251 unless ( qsearchs( 'cust_main', { 'custnum' => $new_custnum } ) ) {
1252 $dbh->rollback if $oldAutoCommit;
1253 return "Invalid new customer number: $new_custnum";
1255 foreach my $cust_pkg ( @cust_pkg ) {
1256 my %hash = $cust_pkg->hash;
1257 $hash{'custnum'} = $new_custnum;
1258 my $new_cust_pkg = new FS::cust_pkg ( \%hash );
1259 my $error = $new_cust_pkg->replace($cust_pkg,
1260 options => { $cust_pkg->options },
1263 $dbh->rollback if $oldAutoCommit;
1268 my @cancelled_cust_pkg = $self->all_pkgs;
1269 foreach my $cust_pkg ( @cancelled_cust_pkg ) {
1270 my $error = $cust_pkg->delete;
1272 $dbh->rollback if $oldAutoCommit;
1277 foreach my $cust_main_invoice ( #(email invoice destinations, not invoices)
1278 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } )
1280 my $error = $cust_main_invoice->delete;
1282 $dbh->rollback if $oldAutoCommit;
1287 my $error = $self->SUPER::delete;
1289 $dbh->rollback if $oldAutoCommit;
1293 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1298 =item replace [ OLD_RECORD ] [ INVOICING_LIST_ARYREF ]
1300 Replaces the OLD_RECORD with this one in the database. If there is an error,
1301 returns the error, otherwise returns false.
1303 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
1304 be set as the invoicing list (see L<"invoicing_list">). Errors return as
1305 expected and rollback the entire transaction; it is not necessary to call
1306 check_invoicing_list first. Here's an example:
1308 $new_cust_main->replace( $old_cust_main, [ $email, 'POST' ] );
1315 my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
1317 : $self->replace_old;
1321 warn "$me replace called\n"
1324 my $curuser = $FS::CurrentUser::CurrentUser;
1325 if ( $self->payby eq 'COMP'
1326 && $self->payby ne $old->payby
1327 && ! $curuser->access_right('Complimentary customer')
1330 return "You are not permitted to create complimentary accounts.";
1333 local($ignore_expired_card) = 1
1334 if $old->payby =~ /^(CARD|DCRD)$/
1335 && $self->payby =~ /^(CARD|DCRD)$/
1336 && ( $old->payinfo eq $self->payinfo || $old->paymask eq $self->paymask );
1338 local $SIG{HUP} = 'IGNORE';
1339 local $SIG{INT} = 'IGNORE';
1340 local $SIG{QUIT} = 'IGNORE';
1341 local $SIG{TERM} = 'IGNORE';
1342 local $SIG{TSTP} = 'IGNORE';
1343 local $SIG{PIPE} = 'IGNORE';
1345 my $oldAutoCommit = $FS::UID::AutoCommit;
1346 local $FS::UID::AutoCommit = 0;
1349 my $error = $self->SUPER::replace($old);
1352 $dbh->rollback if $oldAutoCommit;
1356 if ( @param ) { # INVOICING_LIST_ARYREF
1357 my $invoicing_list = shift @param;
1358 $error = $self->check_invoicing_list( $invoicing_list );
1360 $dbh->rollback if $oldAutoCommit;
1363 $self->invoicing_list( $invoicing_list );
1366 if ( $self->payby =~ /^(CARD|CHEK|LECB)$/ &&
1367 grep { $self->get($_) ne $old->get($_) } qw(payinfo paydate payname) ) {
1368 # card/check/lec info has changed, want to retry realtime_ invoice events
1369 my $error = $self->retry_realtime;
1371 $dbh->rollback if $oldAutoCommit;
1376 unless ( $import || $skip_fuzzyfiles ) {
1377 $error = $self->queue_fuzzyfiles_update;
1379 $dbh->rollback if $oldAutoCommit;
1380 return "updating fuzzy search cache: $error";
1384 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1389 =item queue_fuzzyfiles_update
1391 Used by insert & replace to update the fuzzy search cache
1395 sub queue_fuzzyfiles_update {
1398 local $SIG{HUP} = 'IGNORE';
1399 local $SIG{INT} = 'IGNORE';
1400 local $SIG{QUIT} = 'IGNORE';
1401 local $SIG{TERM} = 'IGNORE';
1402 local $SIG{TSTP} = 'IGNORE';
1403 local $SIG{PIPE} = 'IGNORE';
1405 my $oldAutoCommit = $FS::UID::AutoCommit;
1406 local $FS::UID::AutoCommit = 0;
1409 my $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
1410 my $error = $queue->insert( map $self->getfield($_),
1411 qw(first last company)
1414 $dbh->rollback if $oldAutoCommit;
1415 return "queueing job (transaction rolled back): $error";
1418 if ( $self->ship_last ) {
1419 $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
1420 $error = $queue->insert( map $self->getfield("ship_$_"),
1421 qw(first last company)
1424 $dbh->rollback if $oldAutoCommit;
1425 return "queueing job (transaction rolled back): $error";
1429 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1436 Checks all fields to make sure this is a valid customer record. If there is
1437 an error, returns the error, otherwise returns false. Called by the insert
1438 and replace methods.
1445 warn "$me check BEFORE: \n". $self->_dump
1449 $self->ut_numbern('custnum')
1450 || $self->ut_number('agentnum')
1451 || $self->ut_textn('agent_custid')
1452 || $self->ut_number('refnum')
1453 || $self->ut_textn('custbatch')
1454 || $self->ut_name('last')
1455 || $self->ut_name('first')
1456 || $self->ut_snumbern('birthdate')
1457 || $self->ut_snumbern('signupdate')
1458 || $self->ut_textn('company')
1459 || $self->ut_text('address1')
1460 || $self->ut_textn('address2')
1461 || $self->ut_text('city')
1462 || $self->ut_textn('county')
1463 || $self->ut_textn('state')
1464 || $self->ut_country('country')
1465 || $self->ut_anything('comments')
1466 || $self->ut_numbern('referral_custnum')
1467 || $self->ut_textn('stateid')
1468 || $self->ut_textn('stateid_state')
1469 || $self->ut_textn('invoice_terms')
1470 || $self->ut_alphan('geocode')
1473 #barf. need message catalogs. i18n. etc.
1474 $error .= "Please select an advertising source."
1475 if $error =~ /^Illegal or empty \(numeric\) refnum: /;
1476 return $error if $error;
1478 return "Unknown agent"
1479 unless qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
1481 return "Unknown refnum"
1482 unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } );
1484 return "Unknown referring custnum: ". $self->referral_custnum
1485 unless ! $self->referral_custnum
1486 || qsearchs( 'cust_main', { 'custnum' => $self->referral_custnum } );
1488 if ( $self->ss eq '' ) {
1493 $ss =~ /^(\d{3})(\d{2})(\d{4})$/
1494 or return "Illegal social security number: ". $self->ss;
1495 $self->ss("$1-$2-$3");
1499 # bad idea to disable, causes billing to fail because of no tax rates later
1500 # unless ( $import ) {
1501 unless ( qsearch('cust_main_county', {
1502 'country' => $self->country,
1505 return "Unknown state/county/country: ".
1506 $self->state. "/". $self->county. "/". $self->country
1507 unless qsearch('cust_main_county',{
1508 'state' => $self->state,
1509 'county' => $self->county,
1510 'country' => $self->country,
1516 $self->ut_phonen('daytime', $self->country)
1517 || $self->ut_phonen('night', $self->country)
1518 || $self->ut_phonen('fax', $self->country)
1519 || $self->ut_zip('zip', $self->country)
1521 return $error if $error;
1523 if ( $conf->exists('cust_main-require_phone')
1524 && ! length($self->daytime) && ! length($self->night)
1527 my $daytime_label = FS::Msgcat::_gettext('daytime') =~ /^(daytime)?$/
1529 : FS::Msgcat::_gettext('daytime');
1530 my $night_label = FS::Msgcat::_gettext('night') =~ /^(night)?$/
1532 : FS::Msgcat::_gettext('night');
1534 return "$daytime_label or $night_label is required"
1538 if ( $self->has_ship_address
1539 && scalar ( grep { $self->getfield($_) ne $self->getfield("ship_$_") }
1540 $self->addr_fields )
1544 $self->ut_name('ship_last')
1545 || $self->ut_name('ship_first')
1546 || $self->ut_textn('ship_company')
1547 || $self->ut_text('ship_address1')
1548 || $self->ut_textn('ship_address2')
1549 || $self->ut_text('ship_city')
1550 || $self->ut_textn('ship_county')
1551 || $self->ut_textn('ship_state')
1552 || $self->ut_country('ship_country')
1554 return $error if $error;
1556 #false laziness with above
1557 unless ( qsearchs('cust_main_county', {
1558 'country' => $self->ship_country,
1561 return "Unknown ship_state/ship_county/ship_country: ".
1562 $self->ship_state. "/". $self->ship_county. "/". $self->ship_country
1563 unless qsearch('cust_main_county',{
1564 'state' => $self->ship_state,
1565 'county' => $self->ship_county,
1566 'country' => $self->ship_country,
1572 $self->ut_phonen('ship_daytime', $self->ship_country)
1573 || $self->ut_phonen('ship_night', $self->ship_country)
1574 || $self->ut_phonen('ship_fax', $self->ship_country)
1575 || $self->ut_zip('ship_zip', $self->ship_country)
1577 return $error if $error;
1579 return "Unit # is required."
1580 if $self->ship_address2 =~ /^\s*$/
1581 && $conf->exists('cust_main-require_address2');
1583 } else { # ship_ info eq billing info, so don't store dup info in database
1585 $self->setfield("ship_$_", '')
1586 foreach $self->addr_fields;
1588 return "Unit # is required."
1589 if $self->address2 =~ /^\s*$/
1590 && $conf->exists('cust_main-require_address2');
1594 #$self->payby =~ /^(CARD|DCRD|CHEK|DCHK|LECB|BILL|COMP|PREPAY|CASH|WEST|MCRD)$/
1595 # or return "Illegal payby: ". $self->payby;
1597 FS::payby->can_payby($self->table, $self->payby)
1598 or return "Illegal payby: ". $self->payby;
1600 $error = $self->ut_numbern('paystart_month')
1601 || $self->ut_numbern('paystart_year')
1602 || $self->ut_numbern('payissue')
1603 || $self->ut_textn('paytype')
1605 return $error if $error;
1607 if ( $self->payip eq '' ) {
1610 $error = $self->ut_ip('payip');
1611 return $error if $error;
1614 # If it is encrypted and the private key is not availaible then we can't
1615 # check the credit card.
1617 my $check_payinfo = 1;
1619 if ($self->is_encrypted($self->payinfo)) {
1623 if ( $check_payinfo && $self->payby =~ /^(CARD|DCRD)$/ ) {
1625 my $payinfo = $self->payinfo;
1626 $payinfo =~ s/\D//g;
1627 $payinfo =~ /^(\d{13,16})$/
1628 or return gettext('invalid_card'); # . ": ". $self->payinfo;
1630 $self->payinfo($payinfo);
1632 or return gettext('invalid_card'); # . ": ". $self->payinfo;
1634 return gettext('unknown_card_type')
1635 if cardtype($self->payinfo) eq "Unknown";
1637 my $ban = qsearchs('banned_pay', $self->_banned_pay_hashref);
1639 return 'Banned credit card: banned on '.
1640 time2str('%a %h %o at %r', $ban->_date).
1641 ' by '. $ban->otaker.
1642 ' (ban# '. $ban->bannum. ')';
1645 if (length($self->paycvv) && !$self->is_encrypted($self->paycvv)) {
1646 if ( cardtype($self->payinfo) eq 'American Express card' ) {
1647 $self->paycvv =~ /^(\d{4})$/
1648 or return "CVV2 (CID) for American Express cards is four digits.";
1651 $self->paycvv =~ /^(\d{3})$/
1652 or return "CVV2 (CVC2/CID) is three digits.";
1659 my $cardtype = cardtype($payinfo);
1660 if ( $cardtype =~ /^(Switch|Solo)$/i ) {
1662 return "Start date or issue number is required for $cardtype cards"
1663 unless $self->paystart_month && $self->paystart_year or $self->payissue;
1665 return "Start month must be between 1 and 12"
1666 if $self->paystart_month
1667 and $self->paystart_month < 1 || $self->paystart_month > 12;
1669 return "Start year must be 1990 or later"
1670 if $self->paystart_year
1671 and $self->paystart_year < 1990;
1673 return "Issue number must be beween 1 and 99"
1675 and $self->payissue < 1 || $self->payissue > 99;
1678 $self->paystart_month('');
1679 $self->paystart_year('');
1680 $self->payissue('');
1683 } elsif ( $check_payinfo && $self->payby =~ /^(CHEK|DCHK)$/ ) {
1685 my $payinfo = $self->payinfo;
1686 $payinfo =~ s/[^\d\@]//g;
1687 if ( $conf->exists('echeck-nonus') ) {
1688 $payinfo =~ /^(\d+)\@(\d+)$/ or return 'invalid echeck account@aba';
1689 $payinfo = "$1\@$2";
1691 $payinfo =~ /^(\d+)\@(\d{9})$/ or return 'invalid echeck account@aba';
1692 $payinfo = "$1\@$2";
1694 $self->payinfo($payinfo);
1697 my $ban = qsearchs('banned_pay', $self->_banned_pay_hashref);
1699 return 'Banned ACH account: banned on '.
1700 time2str('%a %h %o at %r', $ban->_date).
1701 ' by '. $ban->otaker.
1702 ' (ban# '. $ban->bannum. ')';
1705 } elsif ( $self->payby eq 'LECB' ) {
1707 my $payinfo = $self->payinfo;
1708 $payinfo =~ s/\D//g;
1709 $payinfo =~ /^1?(\d{10})$/ or return 'invalid btn billing telephone number';
1711 $self->payinfo($payinfo);
1714 } elsif ( $self->payby eq 'BILL' ) {
1716 $error = $self->ut_textn('payinfo');
1717 return "Illegal P.O. number: ". $self->payinfo if $error;
1720 } elsif ( $self->payby eq 'COMP' ) {
1722 my $curuser = $FS::CurrentUser::CurrentUser;
1723 if ( ! $self->custnum
1724 && ! $curuser->access_right('Complimentary customer')
1727 return "You are not permitted to create complimentary accounts."
1730 $error = $self->ut_textn('payinfo');
1731 return "Illegal comp account issuer: ". $self->payinfo if $error;
1734 } elsif ( $self->payby eq 'PREPAY' ) {
1736 my $payinfo = $self->payinfo;
1737 $payinfo =~ s/\W//g; #anything else would just confuse things
1738 $self->payinfo($payinfo);
1739 $error = $self->ut_alpha('payinfo');
1740 return "Illegal prepayment identifier: ". $self->payinfo if $error;
1741 return "Unknown prepayment identifier"
1742 unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } );
1747 if ( $self->paydate eq '' || $self->paydate eq '-' ) {
1748 return "Expiration date required"
1749 unless $self->payby =~ /^(BILL|PREPAY|CHEK|DCHK|LECB|CASH|WEST|MCRD)$/;
1753 if ( $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/ ) {
1754 ( $m, $y ) = ( $1, length($2) == 4 ? $2 : "20$2" );
1755 } elsif ( $self->paydate =~ /^(20)?(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) {
1756 ( $m, $y ) = ( $3, "20$2" );
1758 return "Illegal expiration date: ". $self->paydate;
1760 $self->paydate("$y-$m-01");
1761 my($nowm,$nowy)=(localtime(time))[4,5]; $nowm++; $nowy+=1900;
1762 return gettext('expired_card')
1764 && !$ignore_expired_card
1765 && ( $y<$nowy || ( $y==$nowy && $1<$nowm ) );
1768 if ( $self->payname eq '' && $self->payby !~ /^(CHEK|DCHK)$/ &&
1769 ( ! $conf->exists('require_cardname')
1770 || $self->payby !~ /^(CARD|DCRD)$/ )
1772 $self->payname( $self->first. " ". $self->getfield('last') );
1774 $self->payname =~ /^([\w \,\.\-\'\&]+)$/
1775 or return gettext('illegal_name'). " payname: ". $self->payname;
1779 foreach my $flag (qw( tax spool_cdr squelch_cdr archived )) {
1780 $self->$flag() =~ /^(Y?)$/ or return "Illegal $flag: ". $self->$flag();
1784 $self->otaker(getotaker) unless $self->otaker;
1786 warn "$me check AFTER: \n". $self->_dump
1789 $self->SUPER::check;
1794 Returns a list of fields which have ship_ duplicates.
1799 qw( last first company
1800 address1 address2 city county state zip country
1805 =item has_ship_address
1807 Returns true if this customer record has a separate shipping address.
1811 sub has_ship_address {
1813 scalar( grep { $self->getfield("ship_$_") ne '' } $self->addr_fields );
1816 =item all_pkgs [ EXTRA_QSEARCH_PARAMS_HASHREF ]
1818 Returns all packages (see L<FS::cust_pkg>) for this customer.
1824 my $extra_qsearch = ref($_[0]) ? shift : {};
1826 return $self->num_pkgs unless wantarray || keys(%$extra_qsearch);
1829 if ( $self->{'_pkgnum'} ) {
1830 @cust_pkg = values %{ $self->{'_pkgnum'}->cache };
1832 @cust_pkg = $self->_cust_pkg($extra_qsearch);
1835 sort sort_packages @cust_pkg;
1840 Synonym for B<all_pkgs>.
1845 shift->all_pkgs(@_);
1850 Returns all locations (see L<FS::cust_location>) for this customer.
1856 qsearch('cust_location', { 'custnum' => $self->custnum } );
1859 =item ncancelled_pkgs [ EXTRA_QSEARCH_PARAMS_HASHREF ]
1861 Returns all non-cancelled packages (see L<FS::cust_pkg>) for this customer.
1865 sub ncancelled_pkgs {
1867 my $extra_qsearch = ref($_[0]) ? shift : {};
1869 return $self->num_ncancelled_pkgs unless wantarray;
1872 if ( $self->{'_pkgnum'} ) {
1874 warn "$me ncancelled_pkgs: returning cached objects"
1877 @cust_pkg = grep { ! $_->getfield('cancel') }
1878 values %{ $self->{'_pkgnum'}->cache };
1882 warn "$me ncancelled_pkgs: searching for packages with custnum ".
1883 $self->custnum. "\n"
1886 $extra_qsearch->{'extra_sql'} .= ' AND ( cancel IS NULL OR cancel = 0 ) ';
1888 @cust_pkg = $self->_cust_pkg($extra_qsearch);
1892 sort sort_packages @cust_pkg;
1898 my $extra_qsearch = ref($_[0]) ? shift : {};
1900 $extra_qsearch->{'select'} ||= '*';
1901 $extra_qsearch->{'select'} .=
1902 ',( SELECT COUNT(*) FROM cust_svc WHERE cust_pkg.pkgnum = cust_svc.pkgnum )
1906 $_->{'_num_cust_svc'} = $_->get('_num_cust_svc');
1911 'table' => 'cust_pkg',
1912 'hashref' => { 'custnum' => $self->custnum },
1917 # This should be generalized to use config options to determine order.
1920 if ( $a->get('cancel') xor $b->get('cancel') ) {
1921 return -1 if $b->get('cancel');
1922 return 1 if $a->get('cancel');
1923 #shouldn't get here...
1926 my $a_num_cust_svc = $a->num_cust_svc;
1927 my $b_num_cust_svc = $b->num_cust_svc;
1928 return 0 if !$a_num_cust_svc && !$b_num_cust_svc;
1929 return -1 if $a_num_cust_svc && !$b_num_cust_svc;
1930 return 1 if !$a_num_cust_svc && $b_num_cust_svc;
1931 my @a_cust_svc = $a->cust_svc;
1932 my @b_cust_svc = $b->cust_svc;
1933 $a_cust_svc[0]->svc_x->label cmp $b_cust_svc[0]->svc_x->label;
1938 =item suspended_pkgs
1940 Returns all suspended packages (see L<FS::cust_pkg>) for this customer.
1944 sub suspended_pkgs {
1946 grep { $_->susp } $self->ncancelled_pkgs;
1949 =item unflagged_suspended_pkgs
1951 Returns all unflagged suspended packages (see L<FS::cust_pkg>) for this
1952 customer (thouse packages without the `manual_flag' set).
1956 sub unflagged_suspended_pkgs {
1958 return $self->suspended_pkgs
1959 unless dbdef->table('cust_pkg')->column('manual_flag');
1960 grep { ! $_->manual_flag } $self->suspended_pkgs;
1963 =item unsuspended_pkgs
1965 Returns all unsuspended (and uncancelled) packages (see L<FS::cust_pkg>) for
1970 sub unsuspended_pkgs {
1972 grep { ! $_->susp } $self->ncancelled_pkgs;
1975 =item num_cancelled_pkgs
1977 Returns the number of cancelled packages (see L<FS::cust_pkg>) for this
1982 sub num_cancelled_pkgs {
1983 shift->num_pkgs("cust_pkg.cancel IS NOT NULL AND cust_pkg.cancel != 0");
1986 sub num_ncancelled_pkgs {
1987 shift->num_pkgs("( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )");
1991 my( $self ) = shift;
1992 my $sql = scalar(@_) ? shift : '';
1993 $sql = "AND $sql" if $sql && $sql !~ /^\s*$/ && $sql !~ /^\s*AND/i;
1994 my $sth = dbh->prepare(
1995 "SELECT COUNT(*) FROM cust_pkg WHERE custnum = ? $sql"
1996 ) or die dbh->errstr;
1997 $sth->execute($self->custnum) or die $sth->errstr;
1998 $sth->fetchrow_arrayref->[0];
2003 Unsuspends all unflagged suspended packages (see L</unflagged_suspended_pkgs>
2004 and L<FS::cust_pkg>) for this customer. Always returns a list: an empty list
2005 on success or a list of errors.
2011 grep { $_->unsuspend } $self->suspended_pkgs;
2016 Suspends all unsuspended packages (see L<FS::cust_pkg>) for this customer.
2018 Returns a list: an empty list on success or a list of errors.
2024 grep { $_->suspend(@_) } $self->unsuspended_pkgs;
2027 =item suspend_if_pkgpart HASHREF | PKGPART [ , PKGPART ... ]
2029 Suspends all unsuspended packages (see L<FS::cust_pkg>) matching the listed
2030 PKGPARTs (see L<FS::part_pkg>). Preferred usage is to pass a hashref instead
2031 of a list of pkgparts; the hashref has the following keys:
2035 =item pkgparts - listref of pkgparts
2037 =item (other options are passed to the suspend method)
2042 Returns a list: an empty list on success or a list of errors.
2046 sub suspend_if_pkgpart {
2048 my (@pkgparts, %opt);
2049 if (ref($_[0]) eq 'HASH'){
2050 @pkgparts = @{$_[0]{pkgparts}};
2055 grep { $_->suspend(%opt) }
2056 grep { my $pkgpart = $_->pkgpart; grep { $pkgpart eq $_ } @pkgparts }
2057 $self->unsuspended_pkgs;
2060 =item suspend_unless_pkgpart HASHREF | PKGPART [ , PKGPART ... ]
2062 Suspends all unsuspended packages (see L<FS::cust_pkg>) unless they match the
2063 given PKGPARTs (see L<FS::part_pkg>). Preferred usage is to pass a hashref
2064 instead of a list of pkgparts; the hashref has the following keys:
2068 =item pkgparts - listref of pkgparts
2070 =item (other options are passed to the suspend method)
2074 Returns a list: an empty list on success or a list of errors.
2078 sub suspend_unless_pkgpart {
2080 my (@pkgparts, %opt);
2081 if (ref($_[0]) eq 'HASH'){
2082 @pkgparts = @{$_[0]{pkgparts}};
2087 grep { $_->suspend(%opt) }
2088 grep { my $pkgpart = $_->pkgpart; ! grep { $pkgpart eq $_ } @pkgparts }
2089 $self->unsuspended_pkgs;
2092 =item cancel [ OPTION => VALUE ... ]
2094 Cancels all uncancelled packages (see L<FS::cust_pkg>) for this customer.
2096 Available options are:
2100 =item quiet - can be set true to supress email cancellation notices.
2102 =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.
2104 =item ban - can be set true to ban this customer's credit card or ACH information, if present.
2108 Always returns a list: an empty list on success or a list of errors.
2113 my( $self, %opt ) = @_;
2115 warn "$me cancel called on customer ". $self->custnum. " with options ".
2116 join(', ', map { "$_: $opt{$_}" } keys %opt ). "\n"
2119 return ( 'access denied' )
2120 unless $FS::CurrentUser::CurrentUser->access_right('Cancel customer');
2122 if ( $opt{'ban'} && $self->payby =~ /^(CARD|DCRD|CHEK|DCHK)$/ ) {
2124 #should try decryption (we might have the private key)
2125 # and if not maybe queue a job for the server that does?
2126 return ( "Can't (yet) ban encrypted credit cards" )
2127 if $self->is_encrypted($self->payinfo);
2129 my $ban = new FS::banned_pay $self->_banned_pay_hashref;
2130 my $error = $ban->insert;
2131 return ( $error ) if $error;
2135 my @pkgs = $self->ncancelled_pkgs;
2137 warn "$me cancelling ". scalar($self->ncancelled_pkgs). "/".
2138 scalar(@pkgs). " packages for customer ". $self->custnum. "\n"
2141 grep { $_ } map { $_->cancel(%opt) } $self->ncancelled_pkgs;
2144 sub _banned_pay_hashref {
2155 'payby' => $payby2ban{$self->payby},
2156 'payinfo' => md5_base64($self->payinfo),
2157 #don't ever *search* on reason! #'reason' =>
2163 Returns all notes (see L<FS::cust_main_note>) for this customer.
2170 qsearch( 'cust_main_note',
2171 { 'custnum' => $self->custnum },
2173 'ORDER BY _DATE DESC'
2179 Returns the agent (see L<FS::agent>) for this customer.
2185 qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
2188 =item bill_and_collect
2190 Cancels and suspends any packages due, generates bills, applies payments and
2193 Warns on errors (Does not currently: If there is an error, returns the error, otherwise returns false.)
2195 Options are passed as name-value pairs. Currently available options are:
2201 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:
2205 $cust_main->bill( 'time' => str2time('April 20th, 2001') );
2209 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.
2213 "1d" for the traditional, daily events (the default), or "1m" for the new monthly events (part_event.check_freq)
2217 If set true, re-charges setup fees.
2221 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)
2227 sub bill_and_collect {
2228 my( $self, %options ) = @_;
2230 #$options{actual_time} not $options{time} because freeside-daily -d is for
2231 #pre-printing invoices
2232 $self->cancel_expired_pkgs( $options{actual_time} );
2233 $self->suspend_adjourned_pkgs( $options{actual_time} );
2235 my $error = $self->bill( %options );
2236 warn "Error billing, custnum ". $self->custnum. ": $error" if $error;
2238 $self->apply_payments_and_credits;
2240 unless ( $conf->exists('cancelled_cust-noevents')
2241 && ! $self->num_ncancelled_pkgs
2244 $error = $self->collect( %options );
2245 warn "Error collecting, custnum". $self->custnum. ": $error" if $error;
2251 sub cancel_expired_pkgs {
2252 my ( $self, $time ) = @_;
2254 my @cancel_pkgs = grep { $_->expire && $_->expire <= $time }
2255 $self->ncancelled_pkgs;
2257 foreach my $cust_pkg ( @cancel_pkgs ) {
2258 my $cpr = $cust_pkg->last_cust_pkg_reason('expire');
2259 my $error = $cust_pkg->cancel($cpr ? ( 'reason' => $cpr->reasonnum,
2260 'reason_otaker' => $cpr->otaker
2264 warn "Error cancelling expired pkg ". $cust_pkg->pkgnum.
2265 " for custnum ". $self->custnum. ": $error"
2271 sub suspend_adjourned_pkgs {
2272 my ( $self, $time ) = @_;
2276 && ( ( $_->part_pkg->is_prepaid
2281 && $_->adjourn <= $time
2285 $self->ncancelled_pkgs;
2287 foreach my $cust_pkg ( @susp_pkgs ) {
2288 my $cpr = $cust_pkg->last_cust_pkg_reason('adjourn')
2289 if ($cust_pkg->adjourn && $cust_pkg->adjourn < $^T);
2290 my $error = $cust_pkg->suspend($cpr ? ( 'reason' => $cpr->reasonnum,
2291 'reason_otaker' => $cpr->otaker
2296 warn "Error suspending package ". $cust_pkg->pkgnum.
2297 " for custnum ". $self->custnum. ": $error"
2305 Generates invoices (see L<FS::cust_bill>) for this customer. Usually used in
2306 conjunction with the collect method by calling B<bill_and_collect>.
2308 If there is an error, returns the error, otherwise returns false.
2310 Options are passed as name-value pairs. Currently available options are:
2316 If set true, re-charges setup fees.
2320 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:
2324 $cust_main->bill( 'time' => str2time('April 20th, 2001') );
2328 An array ref of specific packages (objects) to attempt billing, instead trying all of them.
2330 $cust_main->bill( pkg_list => [$pkg1, $pkg2] );
2334 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.
2341 my( $self, %options ) = @_;
2342 return '' if $self->payby eq 'COMP';
2343 warn "$me bill customer ". $self->custnum. "\n"
2346 my $time = $options{'time'} || time;
2347 my $invoice_time = $options{'invoice_time'} || $time;
2350 local $SIG{HUP} = 'IGNORE';
2351 local $SIG{INT} = 'IGNORE';
2352 local $SIG{QUIT} = 'IGNORE';
2353 local $SIG{TERM} = 'IGNORE';
2354 local $SIG{TSTP} = 'IGNORE';
2355 local $SIG{PIPE} = 'IGNORE';
2357 my $oldAutoCommit = $FS::UID::AutoCommit;
2358 local $FS::UID::AutoCommit = 0;
2361 $self->select_for_update; #mutex
2363 my @cust_bill_pkg = ();
2366 # find the packages which are due for billing, find out how much they are
2367 # & generate invoice database.
2370 my( $total_setup, $total_recur, $postal_charge ) = ( 0, 0, 0 );
2372 my @precommit_hooks = ();
2374 my @cust_pkgs = qsearch('cust_pkg', { 'custnum' => $self->custnum } );
2375 foreach my $cust_pkg (@cust_pkgs) {
2377 #NO!! next if $cust_pkg->cancel;
2378 next if $cust_pkg->getfield('cancel');
2380 warn " bill package ". $cust_pkg->pkgnum. "\n" if $DEBUG > 1;
2382 #? to avoid use of uninitialized value errors... ?
2383 $cust_pkg->setfield('bill', '')
2384 unless defined($cust_pkg->bill);
2386 #my $part_pkg = $cust_pkg->part_pkg;
2388 my $real_pkgpart = $cust_pkg->pkgpart;
2389 my %hash = $cust_pkg->hash;
2391 foreach my $part_pkg ( $cust_pkg->part_pkg->self_and_bill_linked ) {
2393 $cust_pkg->set($_, $hash{$_}) foreach qw ( setup last_bill bill );
2396 $self->_make_lines( 'part_pkg' => $part_pkg,
2397 'cust_pkg' => $cust_pkg,
2398 'precommit_hooks' => \@precommit_hooks,
2399 'line_items' => \@cust_bill_pkg,
2400 'setup' => \$total_setup,
2401 'recur' => \$total_recur,
2402 'tax_matrix' => \%taxlisthash,
2404 'options' => \%options,
2407 $dbh->rollback if $oldAutoCommit;
2411 } #foreach my $part_pkg
2413 } #foreach my $cust_pkg
2415 unless ( @cust_bill_pkg ) { #don't create an invoice w/o line items
2416 #but do commit any package date cycling that happened
2417 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2421 my $postal_pkg = $self->charge_postal_fee();
2422 if ( $postal_pkg && !ref( $postal_pkg ) ) {
2423 $dbh->rollback if $oldAutoCommit;
2424 return "can't charge postal invoice fee for customer ".
2425 $self->custnum. ": $postal_pkg";
2428 ( scalar( grep { $_->recur && $_->recur > 0 } @cust_bill_pkg) ||
2429 !$conf->exists('postal_invoice-recurring_only')
2433 foreach my $part_pkg ( $postal_pkg->part_pkg->self_and_bill_linked ) {
2435 $self->_make_lines( 'part_pkg' => $part_pkg,
2436 'cust_pkg' => $postal_pkg,
2437 'precommit_hooks' => \@precommit_hooks,
2438 'line_items' => \@cust_bill_pkg,
2439 'setup' => \$total_setup,
2440 'recur' => \$total_recur,
2441 'tax_matrix' => \%taxlisthash,
2443 'options' => \%options,
2446 $dbh->rollback if $oldAutoCommit;
2452 warn "having a look at the taxes we found...\n" if $DEBUG > 2;
2454 # keys are tax names (as printed on invoices / itemdesc )
2455 # values are listrefs of taxlisthash keys (internal identifiers)
2458 # keys are taxlisthash keys (internal identifiers)
2459 # values are (cumulative) amounts
2462 # keys are taxlisthash keys (internal identifiers)
2463 # values are listrefs of cust_bill_pkg_tax_location hashrefs
2464 my %tax_location = ();
2466 # keys are taxlisthash keys (internal identifiers)
2467 # values are listrefs of cust_bill_pkg_tax_rate_location hashrefs
2468 my %tax_rate_location = ();
2470 foreach my $tax ( keys %taxlisthash ) {
2471 my $tax_object = shift @{ $taxlisthash{$tax} };
2472 warn "found ". $tax_object->taxname. " as $tax\n" if $DEBUG > 2;
2473 warn " ". join('/', @{ $taxlisthash{$tax} } ). "\n" if $DEBUG > 2;
2474 my $hashref_or_error =
2475 $tax_object->taxline( $taxlisthash{$tax},
2476 'custnum' => $self->custnum,
2477 'invoice_time' => $invoice_time
2479 unless ( ref($hashref_or_error) ) {
2480 $dbh->rollback if $oldAutoCommit;
2481 return $hashref_or_error;
2483 unshift @{ $taxlisthash{$tax} }, $tax_object;
2485 my $name = $hashref_or_error->{'name'};
2486 my $amount = $hashref_or_error->{'amount'};
2488 #warn "adding $amount as $name\n";
2489 $taxname{ $name } ||= [];
2490 push @{ $taxname{ $name } }, $tax;
2492 $tax{ $tax } += $amount;
2494 $tax_location{ $tax } ||= [];
2495 if ( $tax_object->get('pkgnum') || $tax_object->get('locationnum') ) {
2496 push @{ $tax_location{ $tax } },
2498 'taxnum' => $tax_object->taxnum,
2499 'taxtype' => ref($tax_object),
2500 'pkgnum' => $tax_object->get('pkgnum'),
2501 'locationnum' => $tax_object->get('locationnum'),
2502 'amount' => sprintf('%.2f', $amount ),
2506 $tax_rate_location{ $tax } ||= [];
2507 if ( ref($tax_object) eq 'FS::tax_rate' ) {
2508 my $taxratelocationnum =
2509 $tax_object->tax_rate_location->taxratelocationnum;
2510 push @{ $tax_rate_location{ $tax } },
2512 'taxnum' => $tax_object->taxnum,
2513 'taxtype' => ref($tax_object),
2514 'amount' => sprintf('%.2f', $amount ),
2515 'locationtaxid' => $tax_object->location,
2516 'taxratelocationnum' => $taxratelocationnum,
2522 #move the cust_tax_exempt_pkg records to the cust_bill_pkgs we will commit
2523 my %packagemap = map { $_->pkgnum => $_ } @cust_bill_pkg;
2524 foreach my $tax ( keys %taxlisthash ) {
2525 foreach ( @{ $taxlisthash{$tax} }[1 ... scalar(@{ $taxlisthash{$tax} })] ) {
2526 next unless ref($_) eq 'FS::cust_bill_pkg';
2528 push @{ $packagemap{$_->pkgnum}->_cust_tax_exempt_pkg },
2529 splice( @{ $_->_cust_tax_exempt_pkg } );
2533 #consolidate and create tax line items
2534 warn "consolidating and generating...\n" if $DEBUG > 2;
2535 foreach my $taxname ( keys %taxname ) {
2538 my @cust_bill_pkg_tax_location = ();
2539 my @cust_bill_pkg_tax_rate_location = ();
2540 warn "adding $taxname\n" if $DEBUG > 1;
2541 foreach my $taxitem ( @{ $taxname{$taxname} } ) {
2542 next if $seen{$taxitem}++;
2543 warn "adding $tax{$taxitem}\n" if $DEBUG > 1;
2544 $tax += $tax{$taxitem};
2545 push @cust_bill_pkg_tax_location,
2546 map { new FS::cust_bill_pkg_tax_location $_ }
2547 @{ $tax_location{ $taxitem } };
2548 push @cust_bill_pkg_tax_rate_location,
2549 map { new FS::cust_bill_pkg_tax_rate_location $_ }
2550 @{ $tax_rate_location{ $taxitem } };
2554 $tax = sprintf('%.2f', $tax );
2555 $total_setup = sprintf('%.2f', $total_setup+$tax );
2557 push @cust_bill_pkg, new FS::cust_bill_pkg {
2563 'itemdesc' => $taxname,
2564 'cust_bill_pkg_tax_location' => \@cust_bill_pkg_tax_location,
2565 'cust_bill_pkg_tax_rate_location' => \@cust_bill_pkg_tax_rate_location,
2570 my $charged = sprintf('%.2f', $total_setup + $total_recur );
2572 #create the new invoice
2573 my $cust_bill = new FS::cust_bill ( {
2574 'custnum' => $self->custnum,
2575 '_date' => ( $invoice_time ),
2576 'charged' => $charged,
2578 my $error = $cust_bill->insert;
2580 $dbh->rollback if $oldAutoCommit;
2581 return "can't create invoice for customer #". $self->custnum. ": $error";
2584 foreach my $cust_bill_pkg ( @cust_bill_pkg ) {
2585 $cust_bill_pkg->invnum($cust_bill->invnum);
2586 my $error = $cust_bill_pkg->insert;
2588 $dbh->rollback if $oldAutoCommit;
2589 return "can't create invoice line item: $error";
2594 foreach my $hook ( @precommit_hooks ) {
2596 &{$hook}; #($self) ?
2599 $dbh->rollback if $oldAutoCommit;
2600 return "$@ running precommit hook $hook\n";
2604 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2610 my ($self, %params) = @_;
2612 my $part_pkg = $params{part_pkg} or die "no part_pkg specified";
2613 my $cust_pkg = $params{cust_pkg} or die "no cust_pkg specified";
2614 my $precommit_hooks = $params{precommit_hooks} or die "no package specified";
2615 my $cust_bill_pkgs = $params{line_items} or die "no line buffer specified";
2616 my $total_setup = $params{setup} or die "no setup accumulator specified";
2617 my $total_recur = $params{recur} or die "no recur accumulator specified";
2618 my $taxlisthash = $params{tax_matrix} or die "no tax accumulator specified";
2619 my $time = $params{'time'} or die "no time specified";
2620 my (%options) = %{$params{options}};
2623 my $real_pkgpart = $cust_pkg->pkgpart;
2624 my %hash = $cust_pkg->hash;
2625 my $old_cust_pkg = new FS::cust_pkg \%hash;
2631 $cust_pkg->pkgpart($part_pkg->pkgpart);
2639 if ( ! $cust_pkg->setup &&
2641 ( $conf->exists('disable_setup_suspended_pkgs') &&
2642 ! $cust_pkg->getfield('susp')
2643 ) || ! $conf->exists('disable_setup_suspended_pkgs')
2645 || $options{'resetup'}
2648 warn " bill setup\n" if $DEBUG > 1;
2651 $setup = eval { $cust_pkg->calc_setup( $time, \@details ) };
2652 return "$@ running calc_setup for $cust_pkg\n"
2655 $unitsetup = $cust_pkg->part_pkg->unit_setup || $setup; #XXX uuh
2657 $cust_pkg->setfield('setup', $time)
2658 unless $cust_pkg->setup;
2659 #do need it, but it won't get written to the db
2660 #|| $cust_pkg->pkgpart != $real_pkgpart;
2665 # bill recurring fee
2668 #XXX unit stuff here too
2672 if ( ! $cust_pkg->getfield('susp') and
2673 ( $part_pkg->getfield('freq') ne '0' &&
2674 ( $cust_pkg->getfield('bill') || 0 ) <= $time
2676 || ( $part_pkg->plan eq 'voip_cdr'
2677 && $part_pkg->option('bill_every_call')
2681 # XXX should this be a package event? probably. events are called
2682 # at collection time at the moment, though...
2683 $part_pkg->reset_usage($cust_pkg, 'debug'=>$DEBUG)
2684 if $part_pkg->can('reset_usage');
2685 #don't want to reset usage just cause we want a line item??
2686 #&& $part_pkg->pkgpart == $real_pkgpart;
2688 warn " bill recur\n" if $DEBUG > 1;
2691 # XXX shared with $recur_prog
2692 $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
2694 #over two params! lets at least switch to a hashref for the rest...
2695 my $increment_next_bill = ( $part_pkg->freq ne '0'
2696 && ( $cust_pkg->getfield('bill') || 0 ) <= $time
2698 my %param = ( 'precommit_hooks' => $precommit_hooks,
2699 'increment_next_bill' => $increment_next_bill,
2702 $recur = eval { $cust_pkg->calc_recur( \$sdate, \@details, \%param ) };
2703 return "$@ running calc_recur for $cust_pkg\n"
2706 if ( $increment_next_bill ) {
2708 my $next_bill = $part_pkg->add_freq($sdate);
2709 return "unparsable frequency: ". $part_pkg->freq
2710 if $next_bill == -1;
2712 #pro-rating magic - if $recur_prog fiddled $sdate, want to use that
2713 # only for figuring next bill date, nothing else, so, reset $sdate again
2715 $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
2716 #no need, its in $hash{last_bill}# my $last_bill = $cust_pkg->last_bill;
2717 $cust_pkg->last_bill($sdate);
2719 $cust_pkg->setfield('bill', $next_bill );
2725 warn "\$setup is undefined" unless defined($setup);
2726 warn "\$recur is undefined" unless defined($recur);
2727 warn "\$cust_pkg->bill is undefined" unless defined($cust_pkg->bill);
2730 # If there's line items, create em cust_bill_pkg records
2731 # If $cust_pkg has been modified, update it (if we're a real pkgpart)
2736 if ( $cust_pkg->modified && $cust_pkg->pkgpart == $real_pkgpart ) {
2737 # hmm.. and if just the options are modified in some weird price plan?
2739 warn " package ". $cust_pkg->pkgnum. " modified; updating\n"
2742 my $error = $cust_pkg->replace( $old_cust_pkg,
2743 'options' => { $cust_pkg->options },
2745 return "Error modifying pkgnum ". $cust_pkg->pkgnum. ": $error"
2746 if $error; #just in case
2749 $setup = sprintf( "%.2f", $setup );
2750 $recur = sprintf( "%.2f", $recur );
2751 if ( $setup < 0 && ! $conf->exists('allow_negative_charges') ) {
2752 return "negative setup $setup for pkgnum ". $cust_pkg->pkgnum;
2754 if ( $recur < 0 && ! $conf->exists('allow_negative_charges') ) {
2755 return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum;
2758 if ( $setup != 0 || $recur != 0 ) {
2760 warn " charges (setup=$setup, recur=$recur); adding line items\n"
2763 my @cust_pkg_detail = map { $_->detail } $cust_pkg->cust_pkg_detail('I');
2765 warn " adding customer package invoice detail: $_\n"
2766 foreach @cust_pkg_detail;
2768 push @details, @cust_pkg_detail;
2770 my $cust_bill_pkg = new FS::cust_bill_pkg {
2771 'pkgnum' => $cust_pkg->pkgnum,
2773 'unitsetup' => $unitsetup,
2775 'unitrecur' => $unitrecur,
2776 'quantity' => $cust_pkg->quantity,
2777 'details' => \@details,
2780 if ( $part_pkg->option('recur_temporality', 1) eq 'preceding' ) {
2781 $cust_bill_pkg->sdate( $hash{last_bill} );
2782 $cust_bill_pkg->edate( $sdate - 86399 ); #60s*60m*24h-1
2783 } else { #if ( $part_pkg->option('recur_temporality', 1) eq 'upcoming' ) {
2784 $cust_bill_pkg->sdate( $sdate );
2785 $cust_bill_pkg->edate( $cust_pkg->bill );
2788 $cust_bill_pkg->pkgpart_override($part_pkg->pkgpart)
2789 unless $part_pkg->pkgpart == $real_pkgpart;
2791 $$total_setup += $setup;
2792 $$total_recur += $recur;
2799 $self->_handle_taxes($part_pkg, $taxlisthash, $cust_bill_pkg, $cust_pkg, $options{invoice_time});
2800 return $error if $error;
2802 push @$cust_bill_pkgs, $cust_bill_pkg;
2804 } #if $setup != 0 || $recur != 0
2814 my $part_pkg = shift;
2815 my $taxlisthash = shift;
2816 my $cust_bill_pkg = shift;
2817 my $cust_pkg = shift;
2818 my $invoice_time = shift;
2820 my %cust_bill_pkg = ();
2824 #push @classes, $cust_bill_pkg->usage_classes if $cust_bill_pkg->type eq 'U';
2825 push @classes, $cust_bill_pkg->usage_classes if $cust_bill_pkg->usage;
2826 push @classes, 'setup' if $cust_bill_pkg->setup;
2827 push @classes, 'recur' if $cust_bill_pkg->recur;
2829 if ( $self->tax !~ /Y/i && $self->payby ne 'COMP' ) {
2831 if ( $conf->exists('enable_taxproducts')
2832 && ( scalar($part_pkg->part_pkg_taxoverride)
2833 || $part_pkg->has_taxproduct
2838 if ( $conf->exists('tax-pkg_address') && $cust_pkg->locationnum ) {
2839 return "fatal: Can't (yet) use tax-pkg_address with taxproducts";
2842 foreach my $class (@classes) {
2843 my $err_or_ref = $self->_gather_taxes( $part_pkg, $class );
2844 return $err_or_ref unless ref($err_or_ref);
2845 $taxes{$class} = $err_or_ref;
2848 unless (exists $taxes{''}) {
2849 my $err_or_ref = $self->_gather_taxes( $part_pkg, '' );
2850 return $err_or_ref unless ref($err_or_ref);
2851 $taxes{''} = $err_or_ref;
2856 my @loc_keys = qw( state county country );
2858 if ( $conf->exists('tax-pkg_address') && $cust_pkg->locationnum ) {
2859 my $cust_location = $cust_pkg->cust_location;
2860 %taxhash = map { $_ => $cust_location->$_() } @loc_keys;
2863 ( $conf->exists('tax-ship_address') && length($self->ship_last) )
2866 %taxhash = map { $_ => $self->get("$prefix$_") } @loc_keys;
2869 $taxhash{'taxclass'} = $part_pkg->taxclass;
2871 my @taxes = qsearch( 'cust_main_county', \%taxhash );
2873 my %taxhash_elim = %taxhash;
2875 my @elim = qw( taxclass county state );
2876 while ( !scalar(@taxes) && scalar(@elim) ) {
2877 $taxhash_elim{ shift(@elim) } = '';
2878 @taxes = qsearch( 'cust_main_county', \%taxhash_elim );
2881 if ( $conf->exists('tax-pkg_address') && $cust_pkg->locationnum ) {
2883 $_->set('pkgnum', $cust_pkg->pkgnum );
2884 $_->set('locationnum', $cust_pkg->locationnum );
2888 $taxes{''} = [ @taxes ];
2889 $taxes{'setup'} = [ @taxes ];
2890 $taxes{'recur'} = [ @taxes ];
2891 $taxes{$_} = [ @taxes ] foreach (@classes);
2893 # maybe eliminate this entirely, along with all the 0% records
2896 "fatal: can't find tax rate for state/county/country/taxclass ".
2897 join('/', map $taxhash{$_}, qw(state county country taxclass) );
2900 } #if $conf->exists('enable_taxproducts') ...
2905 if ( $conf->exists('separate_usage') ) {
2906 my $section = $cust_pkg->part_pkg->option('usage_section', 'Hush!');
2907 my $summary = $cust_pkg->part_pkg->option('summarize_usage', 'Hush!');
2908 push @display, new FS::cust_bill_pkg_display { type => 'S' };
2909 push @display, new FS::cust_bill_pkg_display { type => 'R' };
2910 push @display, new FS::cust_bill_pkg_display { type => 'U',
2913 if ($section && $summary) {
2914 $display[2]->post_total('Y');
2915 push @display, new FS::cust_bill_pkg_display { type => 'U',
2920 $cust_bill_pkg->set('display', \@display);
2922 my %tax_cust_bill_pkg = $cust_bill_pkg->disintegrate;
2923 foreach my $key (keys %tax_cust_bill_pkg) {
2924 my @taxes = @{ $taxes{$key} || [] };
2925 my $tax_cust_bill_pkg = $tax_cust_bill_pkg{$key};
2927 my %localtaxlisthash = ();
2928 foreach my $tax ( @taxes ) {
2930 my $taxname = ref( $tax ). ' '. $tax->taxnum;
2931 # $taxname .= ' pkgnum'. $cust_pkg->pkgnum.
2932 # ' locationnum'. $cust_pkg->locationnum
2933 # if $conf->exists('tax-pkg_address') && $cust_pkg->locationnum;
2935 $taxlisthash->{ $taxname } ||= [ $tax ];
2936 push @{ $taxlisthash->{ $taxname } }, $tax_cust_bill_pkg;
2938 $localtaxlisthash{ $taxname } ||= [ $tax ];
2939 push @{ $localtaxlisthash{ $taxname } }, $tax_cust_bill_pkg;
2943 warn "finding taxed taxes...\n" if $DEBUG > 2;
2944 foreach my $tax ( keys %localtaxlisthash ) {
2945 my $tax_object = shift @{ $localtaxlisthash{$tax} };
2946 warn "found possible taxed tax ". $tax_object->taxname. " we call $tax\n"
2948 next unless $tax_object->can('tax_on_tax');
2950 foreach my $tot ( $tax_object->tax_on_tax( $self ) ) {
2951 my $totname = ref( $tot ). ' '. $tot->taxnum;
2953 warn "checking $totname which we call ". $tot->taxname. " as applicable\n"
2955 next unless exists( $localtaxlisthash{ $totname } ); # only increase
2957 warn "adding $totname to taxed taxes\n" if $DEBUG > 2;
2958 my $hashref_or_error =
2959 $tax_object->taxline( $localtaxlisthash{$tax},
2960 'custnum' => $self->custnum,
2961 'invoice_time' => $invoice_time,
2963 return $hashref_or_error
2964 unless ref($hashref_or_error);
2966 $taxlisthash->{ $totname } ||= [ $tot ];
2967 push @{ $taxlisthash->{ $totname } }, $hashref_or_error->{amount};
2979 my $part_pkg = shift;
2983 my $geocode = $self->geocode('cch');
2985 my @taxclassnums = map { $_->taxclassnum }
2986 $part_pkg->part_pkg_taxoverride($class);
2988 unless (@taxclassnums) {
2989 @taxclassnums = map { $_->taxclassnum }
2990 $part_pkg->part_pkg_taxrate('cch', $geocode, $class);
2992 warn "Found taxclassnum values of ". join(',', @taxclassnums)
2997 join(' OR ', map { "taxclassnum = $_" } @taxclassnums ). ")";
2999 @taxes = qsearch({ 'table' => 'tax_rate',
3000 'hashref' => { 'geocode' => $geocode, },
3001 'extra_sql' => $extra_sql,
3003 if scalar(@taxclassnums);
3005 warn "Found taxes ".
3006 join(',', map{ ref($_). " ". $_->get($_->primary_key) } @taxes). "\n"
3013 =item collect OPTIONS
3015 (Attempt to) collect money for this customer's outstanding invoices (see
3016 L<FS::cust_bill>). Usually used after the bill method.
3018 Actions are now triggered by billing events; see L<FS::part_event> and the
3019 billing events web interface. Old-style invoice events (see
3020 L<FS::part_bill_event>) have been deprecated.
3022 If there is an error, returns the error, otherwise returns false.
3024 Options are passed as name-value pairs.
3026 Currently available options are:
3032 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.
3036 Retry card/echeck/LEC transactions even when not scheduled by invoice events.
3040 set true to surpress email card/ACH decline notices.
3044 "1d" for the traditional, daily events (the default), or "1m" for the new monthly events (part_event.check_freq)
3048 allows for one time override of normal customer billing method
3052 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)
3060 my( $self, %options ) = @_;
3061 my $invoice_time = $options{'invoice_time'} || time;
3064 local $SIG{HUP} = 'IGNORE';
3065 local $SIG{INT} = 'IGNORE';
3066 local $SIG{QUIT} = 'IGNORE';
3067 local $SIG{TERM} = 'IGNORE';
3068 local $SIG{TSTP} = 'IGNORE';
3069 local $SIG{PIPE} = 'IGNORE';
3071 my $oldAutoCommit = $FS::UID::AutoCommit;
3072 local $FS::UID::AutoCommit = 0;
3075 $self->select_for_update; #mutex
3078 my $balance = $self->balance;
3079 warn "$me collect customer ". $self->custnum. ": balance $balance\n"
3082 if ( exists($options{'retry_card'}) ) {
3083 carp 'retry_card option passed to collect is deprecated; use retry';
3084 $options{'retry'} ||= $options{'retry_card'};
3086 if ( exists($options{'retry'}) && $options{'retry'} ) {
3087 my $error = $self->retry_realtime;
3089 $dbh->rollback if $oldAutoCommit;
3094 # false laziness w/pay_batch::import_results
3096 my $due_cust_event = $self->due_cust_event(
3097 'debug' => ( $options{'debug'} || 0 ),
3098 'time' => $invoice_time,
3099 'check_freq' => $options{'check_freq'},
3101 unless( ref($due_cust_event) ) {
3102 $dbh->rollback if $oldAutoCommit;
3103 return $due_cust_event;
3106 foreach my $cust_event ( @$due_cust_event ) {
3110 #re-eval event conditions (a previous event could have changed things)
3111 unless ( $cust_event->test_conditions( 'time' => $invoice_time ) ) {
3112 #don't leave stray "new/locked" records around
3113 my $error = $cust_event->delete;
3115 #gah, even with transactions
3116 $dbh->commit if $oldAutoCommit; #well.
3123 local $realtime_bop_decline_quiet = 1 if $options{'quiet'};
3124 warn " running cust_event ". $cust_event->eventnum. "\n"
3128 #if ( my $error = $cust_event->do_event(%options) ) { #XXX %options?
3129 if ( my $error = $cust_event->do_event() ) {
3130 #XXX wtf is this? figure out a proper dealio with return value
3132 # gah, even with transactions.
3133 $dbh->commit if $oldAutoCommit; #well.
3140 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3145 =item due_cust_event [ HASHREF | OPTION => VALUE ... ]
3147 Inserts database records for and returns an ordered listref of new events due
3148 for this customer, as FS::cust_event objects (see L<FS::cust_event>). If no
3149 events are due, an empty listref is returned. If there is an error, returns a
3150 scalar error message.
3152 To actually run the events, call each event's test_condition method, and if
3153 still true, call the event's do_event method.
3155 Options are passed as a hashref or as a list of name-value pairs. Available
3162 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.
3166 "Current time" for the events.
3170 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)
3174 Only return events for the specified eventtable (by default, events of all eventtables are returned)
3178 Explicitly pass the objects to be tested (typically used with eventtable).
3182 Set to true to return the objects, but not actually insert them into the
3189 sub due_cust_event {
3191 my %opt = ref($_[0]) ? %{ $_[0] } : @_;
3194 #my $DEBUG = $opt{'debug'}
3195 local($DEBUG) = $opt{'debug'}
3196 if defined($opt{'debug'}) && $opt{'debug'} > $DEBUG;
3198 warn "$me due_cust_event called with options ".
3199 join(', ', map { "$_: $opt{$_}" } keys %opt). "\n"
3202 $opt{'time'} ||= time;
3204 local $SIG{HUP} = 'IGNORE';
3205 local $SIG{INT} = 'IGNORE';
3206 local $SIG{QUIT} = 'IGNORE';
3207 local $SIG{TERM} = 'IGNORE';
3208 local $SIG{TSTP} = 'IGNORE';
3209 local $SIG{PIPE} = 'IGNORE';
3211 my $oldAutoCommit = $FS::UID::AutoCommit;
3212 local $FS::UID::AutoCommit = 0;
3215 $self->select_for_update #mutex
3216 unless $opt{testonly};
3219 # 1: find possible events (initial search)
3222 my @cust_event = ();
3224 my @eventtable = $opt{'eventtable'}
3225 ? ( $opt{'eventtable'} )
3226 : FS::part_event->eventtables_runorder;
3228 foreach my $eventtable ( @eventtable ) {
3231 if ( $opt{'objects'} ) {
3233 @objects = @{ $opt{'objects'} };
3237 #my @objects = $self->eventtable(); # sub cust_main { @{ [ $self ] }; }
3238 @objects = ( $eventtable eq 'cust_main' )
3240 : ( $self->$eventtable() );
3244 my @e_cust_event = ();
3246 my $cross = "CROSS JOIN $eventtable";
3247 $cross .= ' LEFT JOIN cust_main USING ( custnum )'
3248 unless $eventtable eq 'cust_main';
3250 foreach my $object ( @objects ) {
3252 #this first search uses the condition_sql magic for optimization.
3253 #the more possible events we can eliminate in this step the better
3255 my $cross_where = '';
3256 my $pkey = $object->primary_key;
3257 $cross_where = "$eventtable.$pkey = ". $object->$pkey();
3259 my $join = FS::part_event_condition->join_conditions_sql( $eventtable );
3261 FS::part_event_condition->where_conditions_sql( $eventtable,
3262 'time'=>$opt{'time'}
3264 my $order = FS::part_event_condition->order_conditions_sql( $eventtable );
3266 $extra_sql = "AND $extra_sql" if $extra_sql;
3268 #here is the agent virtualization
3269 $extra_sql .= " AND ( part_event.agentnum IS NULL
3270 OR part_event.agentnum = ". $self->agentnum. ' )';
3272 $extra_sql .= " $order";
3274 warn "searching for events for $eventtable ". $object->$pkey. "\n"
3275 if $opt{'debug'} > 2;
3276 my @part_event = qsearch( {
3277 'debug' => ( $opt{'debug'} > 3 ? 1 : 0 ),
3278 'select' => 'part_event.*',
3279 'table' => 'part_event',
3280 'addl_from' => "$cross $join",
3281 'hashref' => { 'check_freq' => ( $opt{'check_freq'} || '1d' ),
3282 'eventtable' => $eventtable,
3285 'extra_sql' => "AND $cross_where $extra_sql",
3289 my $pkey = $object->primary_key;
3290 warn " ". scalar(@part_event).
3291 " possible events found for $eventtable ". $object->$pkey(). "\n";
3294 push @e_cust_event, map { $_->new_cust_event($object) } @part_event;
3298 warn " ". scalar(@e_cust_event).
3299 " subtotal possible cust events found for $eventtable\n"
3302 push @cust_event, @e_cust_event;
3306 warn " ". scalar(@cust_event).
3307 " total possible cust events found in initial search\n"
3311 # 2: test conditions
3316 @cust_event = grep $_->test_conditions( 'time' => $opt{'time'},
3317 'stats_hashref' => \%unsat ),
3320 warn " ". scalar(@cust_event). " cust events left satisfying conditions\n"
3323 warn " invalid conditions not eliminated with condition_sql:\n".
3324 join('', map " $_: ".$unsat{$_}."\n", keys %unsat )
3331 unless( $opt{testonly} ) {
3332 foreach my $cust_event ( @cust_event ) {
3334 my $error = $cust_event->insert();
3336 $dbh->rollback if $oldAutoCommit;
3343 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3349 warn " returning events: ". Dumper(@cust_event). "\n"
3356 =item retry_realtime
3358 Schedules realtime / batch credit card / electronic check / LEC billing
3359 events for for retry. Useful if card information has changed or manual
3360 retry is desired. The 'collect' method must be called to actually retry
3363 Implementation details: For either this customer, or for each of this
3364 customer's open invoices, changes the status of the first "done" (with
3365 statustext error) realtime processing event to "failed".
3369 sub retry_realtime {
3372 local $SIG{HUP} = 'IGNORE';
3373 local $SIG{INT} = 'IGNORE';
3374 local $SIG{QUIT} = 'IGNORE';
3375 local $SIG{TERM} = 'IGNORE';
3376 local $SIG{TSTP} = 'IGNORE';
3377 local $SIG{PIPE} = 'IGNORE';
3379 my $oldAutoCommit = $FS::UID::AutoCommit;
3380 local $FS::UID::AutoCommit = 0;
3383 #a little false laziness w/due_cust_event (not too bad, really)
3385 my $join = FS::part_event_condition->join_conditions_sql;
3386 my $order = FS::part_event_condition->order_conditions_sql;
3389 . join ( ' OR ' , map {
3390 "( part_event.eventtable = " . dbh->quote($_)
3391 . " AND tablenum IN( SELECT " . dbdef->table($_)->primary_key . " from $_ where custnum = " . dbh->quote( $self->custnum ) . "))" ;
3392 } FS::part_event->eventtables)
3395 #here is the agent virtualization
3396 my $agent_virt = " ( part_event.agentnum IS NULL
3397 OR part_event.agentnum = ". $self->agentnum. ' )';
3399 #XXX this shouldn't be hardcoded, actions should declare it...
3400 my @realtime_events = qw(
3401 cust_bill_realtime_card
3402 cust_bill_realtime_check
3403 cust_bill_realtime_lec
3407 my $is_realtime_event = ' ( '. join(' OR ', map "part_event.action = '$_'",
3412 my @cust_event = qsearchs({
3413 'table' => 'cust_event',
3414 'select' => 'cust_event.*',
3415 'addl_from' => "LEFT JOIN part_event USING ( eventpart ) $join",
3416 'hashref' => { 'status' => 'done' },
3417 'extra_sql' => " AND statustext IS NOT NULL AND statustext != '' ".
3418 " AND $mine AND $is_realtime_event AND $agent_virt $order" # LIMIT 1"
3421 my %seen_invnum = ();
3422 foreach my $cust_event (@cust_event) {
3424 #max one for the customer, one for each open invoice
3425 my $cust_X = $cust_event->cust_X;
3426 next if $seen_invnum{ $cust_event->part_event->eventtable eq 'cust_bill'
3430 or $cust_event->part_event->eventtable eq 'cust_bill'
3433 my $error = $cust_event->retry;
3435 $dbh->rollback if $oldAutoCommit;
3436 return "error scheduling event for retry: $error";
3441 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3446 # some horrid false laziness here to avoid refactor fallout
3447 # eventually realtime realtime_bop and realtime_refund_bop should go
3448 # away and be replaced by _new_realtime_bop and _new_realtime_refund_bop
3450 =item realtime_bop METHOD AMOUNT [ OPTION => VALUE ... ]
3452 Runs a realtime credit card, ACH (electronic check) or phone bill transaction
3453 via a Business::OnlinePayment realtime gateway. See
3454 L<http://420.am/business-onlinepayment> for supported gateways.
3456 Available methods are: I<CC>, I<ECHECK> and I<LEC>
3458 Available options are: I<description>, I<invnum>, I<quiet>, I<paynum_ref>, I<payunique>
3460 The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
3461 I<zip>, I<payinfo> and I<paydate> are also available. Any of these options,
3462 if set, will override the value from the customer record.
3464 I<description> is a free-text field passed to the gateway. It defaults to
3465 "Internet services".
3467 If an I<invnum> is specified, this payment (if successful) is applied to the
3468 specified invoice. If you don't specify an I<invnum> you might want to
3469 call the B<apply_payments> method.
3471 I<quiet> can be set true to surpress email decline notices.
3473 I<paynum_ref> can be set to a scalar reference. It will be filled in with the
3474 resulting paynum, if any.
3476 I<payunique> is a unique identifier for this payment.
3478 (moved from cust_bill) (probably should get realtime_{card,ach,lec} here too)
3485 return $self->_new_realtime_bop(@_)
3486 if $self->_new_bop_required();
3488 my( $method, $amount, %options ) = @_;
3490 warn "$me realtime_bop: $method $amount\n";
3491 warn " $_ => $options{$_}\n" foreach keys %options;
3494 $options{'description'} ||= 'Internet services';
3496 return $self->fake_bop($method, $amount, %options) if $options{'fake'};
3498 eval "use Business::OnlinePayment";
3501 my $payinfo = exists($options{'payinfo'})
3502 ? $options{'payinfo'}
3505 my %method2payby = (
3512 # check for banned credit card/ACH
3515 my $ban = qsearchs('banned_pay', {
3516 'payby' => $method2payby{$method},
3517 'payinfo' => md5_base64($payinfo),
3519 return "Banned credit card" if $ban;
3522 # set taxclass and trans_is_recur based on invnum if there is one
3526 my $trans_is_recur = 0;
3527 if ( $options{'invnum'} ) {
3529 my $cust_bill = qsearchs('cust_bill', { 'invnum' => $options{'invnum'} } );
3530 die "invnum ". $options{'invnum'}. " not found" unless $cust_bill;
3533 map { $_->part_pkg }
3535 map { $_->cust_pkg }
3536 $cust_bill->cust_bill_pkg;
3538 my @taxclasses = map $_->taxclass, @part_pkg;
3539 $taxclass = $taxclasses[0]
3540 unless grep { $taxclasses[0] ne $_ } @taxclasses; #unless there are
3541 #different taxclasses
3543 if grep { $_->freq ne '0' } @part_pkg;
3551 #look for an agent gateway override first
3553 if ( $method eq 'CC' ) {
3554 $cardtype = cardtype($payinfo);
3555 } elsif ( $method eq 'ECHECK' ) {
3558 $cardtype = $method;
3562 qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
3563 cardtype => $cardtype,
3564 taxclass => $taxclass, } )
3565 || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
3567 taxclass => $taxclass, } )
3568 || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
3569 cardtype => $cardtype,
3571 || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
3573 taxclass => '', } );
3575 my $payment_gateway = '';
3576 my( $processor, $login, $password, $action, @bop_options );
3577 if ( $override ) { #use a payment gateway override
3579 $payment_gateway = $override->payment_gateway;
3581 $processor = $payment_gateway->gateway_module;
3582 $login = $payment_gateway->gateway_username;
3583 $password = $payment_gateway->gateway_password;
3584 $action = $payment_gateway->gateway_action;
3585 @bop_options = $payment_gateway->options;
3587 } else { #use the standard settings from the config
3589 ( $processor, $login, $password, $action, @bop_options ) =
3590 $self->default_payment_gateway($method);
3598 my $address = exists($options{'address1'})
3599 ? $options{'address1'}
3601 my $address2 = exists($options{'address2'})
3602 ? $options{'address2'}
3604 $address .= ", ". $address2 if length($address2);
3606 my $o_payname = exists($options{'payname'})
3607 ? $options{'payname'}
3609 my($payname, $payfirst, $paylast);
3610 if ( $o_payname && $method ne 'ECHECK' ) {
3611 ($payname = $o_payname) =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
3612 or return "Illegal payname $payname";
3613 ($payfirst, $paylast) = ($1, $2);
3615 $payfirst = $self->getfield('first');
3616 $paylast = $self->getfield('last');
3617 $payname = "$payfirst $paylast";
3620 my @invoicing_list = $self->invoicing_list_emailonly;
3621 if ( $conf->exists('emailinvoiceautoalways')
3622 || $conf->exists('emailinvoiceauto') && ! @invoicing_list
3623 || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
3624 push @invoicing_list, $self->all_emails;
3627 my $email = ($conf->exists('business-onlinepayment-email-override'))
3628 ? $conf->config('business-onlinepayment-email-override')
3629 : $invoicing_list[0];
3633 my $payip = exists($options{'payip'})
3636 $content{customer_ip} = $payip
3639 $content{invoice_number} = $options{'invnum'}
3640 if exists($options{'invnum'}) && length($options{'invnum'});
3642 $content{email_customer} =
3643 ( $conf->exists('business-onlinepayment-email_customer')
3644 || $conf->exists('business-onlinepayment-email-override') );
3647 if ( $method eq 'CC' ) {
3649 $content{card_number} = $payinfo;
3650 $paydate = exists($options{'paydate'})
3651 ? $options{'paydate'}
3653 $paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
3654 $content{expiration} = "$2/$1";
3656 my $paycvv = exists($options{'paycvv'})
3657 ? $options{'paycvv'}
3659 $content{cvv2} = $paycvv
3662 my $paystart_month = exists($options{'paystart_month'})
3663 ? $options{'paystart_month'}
3664 : $self->paystart_month;
3666 my $paystart_year = exists($options{'paystart_year'})
3667 ? $options{'paystart_year'}
3668 : $self->paystart_year;
3670 $content{card_start} = "$paystart_month/$paystart_year"
3671 if $paystart_month && $paystart_year;
3673 my $payissue = exists($options{'payissue'})
3674 ? $options{'payissue'}
3676 $content{issue_number} = $payissue if $payissue;
3678 if ( $self->_bop_recurring_billing( 'payinfo' => $payinfo,
3679 'trans_is_recur' => $trans_is_recur,
3683 $content{recurring_billing} = 'YES';
3684 $content{acct_code} = 'rebill'
3685 if $conf->exists('credit_card-recurring_billing_acct_code');
3688 } elsif ( $method eq 'ECHECK' ) {
3689 ( $content{account_number}, $content{routing_code} ) =
3690 split('@', $payinfo);
3691 $content{bank_name} = $o_payname;
3692 $content{bank_state} = exists($options{'paystate'})
3693 ? $options{'paystate'}
3694 : $self->getfield('paystate');
3695 $content{account_type} = exists($options{'paytype'})
3696 ? uc($options{'paytype'}) || 'CHECKING'
3697 : uc($self->getfield('paytype')) || 'CHECKING';
3698 $content{account_name} = $payname;
3699 $content{customer_org} = $self->company ? 'B' : 'I';
3700 $content{state_id} = exists($options{'stateid'})
3701 ? $options{'stateid'}
3702 : $self->getfield('stateid');
3703 $content{state_id_state} = exists($options{'stateid_state'})
3704 ? $options{'stateid_state'}
3705 : $self->getfield('stateid_state');
3706 $content{customer_ssn} = exists($options{'ss'})
3709 } elsif ( $method eq 'LEC' ) {
3710 $content{phone} = $payinfo;
3714 # run transaction(s)
3717 my $balance = exists( $options{'balance'} )
3718 ? $options{'balance'}
3721 $self->select_for_update; #mutex ... just until we get our pending record in
3723 #the checks here are intended to catch concurrent payments
3724 #double-form-submission prevention is taken care of in cust_pay_pending::check
3727 return "The customer's balance has changed; $method transaction aborted."
3728 if $self->balance < $balance;
3729 #&& $self->balance < $amount; #might as well anyway?
3731 #also check and make sure there aren't *other* pending payments for this cust
3733 my @pending = qsearch('cust_pay_pending', {
3734 'custnum' => $self->custnum,
3735 'status' => { op=>'!=', value=>'done' }
3737 return "A payment is already being processed for this customer (".
3738 join(', ', map 'paypendingnum '. $_->paypendingnum, @pending ).
3739 "); $method transaction aborted."
3740 if scalar(@pending);
3742 #okay, good to go, if we're a duplicate, cust_pay_pending will kick us out
3744 my $cust_pay_pending = new FS::cust_pay_pending {
3745 'custnum' => $self->custnum,
3746 #'invnum' => $options{'invnum'},
3749 'payby' => $method2payby{$method},
3750 'payinfo' => $payinfo,
3751 'paydate' => $paydate,
3752 'recurring_billing' => $content{recurring_billing},
3754 'gatewaynum' => ( $payment_gateway ? $payment_gateway->gatewaynum : '' ),
3756 $cust_pay_pending->payunique( $options{payunique} )
3757 if defined($options{payunique}) && length($options{payunique});
3758 my $cpp_new_err = $cust_pay_pending->insert; #mutex lost when this is inserted
3759 return $cpp_new_err if $cpp_new_err;
3761 my( $action1, $action2 ) = split(/\s*\,\s*/, $action );
3763 my $transaction = new Business::OnlinePayment( $processor, @bop_options );
3764 $transaction->content(
3767 'password' => $password,
3768 'action' => $action1,
3769 'description' => $options{'description'},
3770 'amount' => $amount,
3771 #'invoice_number' => $options{'invnum'},
3772 'customer_id' => $self->custnum,
3773 'last_name' => $paylast,
3774 'first_name' => $payfirst,
3776 'address' => $address,
3777 'city' => ( exists($options{'city'})
3780 'state' => ( exists($options{'state'})
3783 'zip' => ( exists($options{'zip'})
3786 'country' => ( exists($options{'country'})
3787 ? $options{'country'}
3789 'referer' => 'http://cleanwhisker.420.am/', #XXX fix referer :/
3791 'phone' => $self->daytime || $self->night,
3795 $cust_pay_pending->status('pending');
3796 my $cpp_pending_err = $cust_pay_pending->replace;
3797 return $cpp_pending_err if $cpp_pending_err;
3800 my $BOP_TESTING = 0;
3801 my $BOP_TESTING_SUCCESS = 1;
3803 unless ( $BOP_TESTING ) {
3804 $transaction->submit();
3806 if ( $BOP_TESTING_SUCCESS ) {
3807 $transaction->is_success(1);
3808 $transaction->authorization('fake auth');
3810 $transaction->is_success(0);
3811 $transaction->error_message('fake failure');
3815 if ( $transaction->is_success() && $action2 ) {
3817 $cust_pay_pending->status('authorized');
3818 my $cpp_authorized_err = $cust_pay_pending->replace;
3819 return $cpp_authorized_err if $cpp_authorized_err;
3821 my $auth = $transaction->authorization;
3822 my $ordernum = $transaction->can('order_number')
3823 ? $transaction->order_number
3827 new Business::OnlinePayment( $processor, @bop_options );
3834 password => $password,
3835 order_number => $ordernum,
3837 authorization => $auth,
3838 description => $options{'description'},
3841 foreach my $field (qw( authorization_source_code returned_ACI
3842 transaction_identifier validation_code
3843 transaction_sequence_num local_transaction_date
3844 local_transaction_time AVS_result_code )) {
3845 $capture{$field} = $transaction->$field() if $transaction->can($field);
3848 $capture->content( %capture );
3852 unless ( $capture->is_success ) {
3853 my $e = "Authorization successful but capture failed, custnum #".
3854 $self->custnum. ': '. $capture->result_code.
3855 ": ". $capture->error_message;
3862 $cust_pay_pending->status($transaction->is_success() ? 'captured' : 'declined');
3863 my $cpp_captured_err = $cust_pay_pending->replace;
3864 return $cpp_captured_err if $cpp_captured_err;
3867 # remove paycvv after initial transaction
3870 #false laziness w/misc/process/payment.cgi - check both to make sure working
3872 if ( defined $self->dbdef_table->column('paycvv')
3873 && length($self->paycvv)
3874 && ! grep { $_ eq cardtype($payinfo) } $conf->config('cvv-save')
3876 my $error = $self->remove_cvv;
3878 warn "WARNING: error removing cvv: $error\n";
3886 if ( $transaction->is_success() ) {
3889 if ( $payment_gateway ) { # agent override
3890 $paybatch = $payment_gateway->gatewaynum. '-';
3893 $paybatch .= "$processor:". $transaction->authorization;
3895 $paybatch .= ':'. $transaction->order_number
3896 if $transaction->can('order_number')
3897 && length($transaction->order_number);
3899 my $cust_pay = new FS::cust_pay ( {
3900 'custnum' => $self->custnum,
3901 'invnum' => $options{'invnum'},
3904 'payby' => $method2payby{$method},
3905 'payinfo' => $payinfo,
3906 'paybatch' => $paybatch,
3907 'paydate' => $paydate,
3909 #doesn't hurt to know, even though the dup check is in cust_pay_pending now
3910 $cust_pay->payunique( $options{payunique} )
3911 if defined($options{payunique}) && length($options{payunique});
3913 my $oldAutoCommit = $FS::UID::AutoCommit;
3914 local $FS::UID::AutoCommit = 0;
3917 #start a transaction, insert the cust_pay and set cust_pay_pending.status to done in a single transction
3919 my $error = $cust_pay->insert($options{'manual'} ? ( 'manual' => 1 ) : () );
3922 $cust_pay->invnum(''); #try again with no specific invnum
3923 my $error2 = $cust_pay->insert( $options{'manual'} ?
3924 ( 'manual' => 1 ) : ()
3927 # gah. but at least we have a record of the state we had to abort in
3928 # from cust_pay_pending now.
3929 my $e = "WARNING: $method captured but payment not recorded - ".
3930 "error inserting payment ($processor): $error2".
3931 " (previously tried insert with invnum #$options{'invnum'}" .
3932 ": $error ) - pending payment saved as paypendingnum ".
3933 $cust_pay_pending->paypendingnum. "\n";
3939 if ( $options{'paynum_ref'} ) {
3940 ${ $options{'paynum_ref'} } = $cust_pay->paynum;
3943 $cust_pay_pending->status('done');
3944 $cust_pay_pending->statustext('captured');
3945 $cust_pay_pending->paynum($cust_pay->paynum);
3946 my $cpp_done_err = $cust_pay_pending->replace;
3948 if ( $cpp_done_err ) {
3950 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
3951 my $e = "WARNING: $method captured but payment not recorded - ".
3952 "error updating status for paypendingnum ".
3953 $cust_pay_pending->paypendingnum. ": $cpp_done_err \n";
3959 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3960 return ''; #no error
3966 my $perror = "$processor error: ". $transaction->error_message;
3968 unless ( $transaction->error_message ) {
3971 if ( $transaction->can('response_page') ) {
3973 'page' => ( $transaction->can('response_page')
3974 ? $transaction->response_page
3977 'code' => ( $transaction->can('response_code')
3978 ? $transaction->response_code
3981 'headers' => ( $transaction->can('response_headers')
3982 ? $transaction->response_headers
3988 "No additional debugging information available for $processor";
3991 $perror .= "No error_message returned from $processor -- ".
3992 ( ref($t_response) ? Dumper($t_response) : $t_response );
3996 if ( !$options{'quiet'} && !$realtime_bop_decline_quiet
3997 && $conf->exists('emaildecline')
3998 && grep { $_ ne 'POST' } $self->invoicing_list
3999 && ! grep { $transaction->error_message =~ /$_/ }
4000 $conf->config('emaildecline-exclude')
4002 my @templ = $conf->config('declinetemplate');
4003 my $template = new Text::Template (
4005 SOURCE => [ map "$_\n", @templ ],
4006 ) or return "($perror) can't create template: $Text::Template::ERROR";
4007 $template->compile()
4008 or return "($perror) can't compile template: $Text::Template::ERROR";
4010 my $templ_hash = { error => $transaction->error_message };
4012 my $error = send_email(
4013 'from' => $conf->config('invoice_from', $self->agentnum ),
4014 'to' => [ grep { $_ ne 'POST' } $self->invoicing_list ],
4015 'subject' => 'Your payment could not be processed',
4016 'body' => [ $template->fill_in(HASH => $templ_hash) ],
4019 $perror .= " (also received error sending decline notification: $error)"
4024 $cust_pay_pending->status('done');
4025 $cust_pay_pending->statustext("declined: $perror");
4026 my $cpp_done_err = $cust_pay_pending->replace;
4027 if ( $cpp_done_err ) {
4028 my $e = "WARNING: $method declined but pending payment not resolved - ".
4029 "error updating status for paypendingnum ".
4030 $cust_pay_pending->paypendingnum. ": $cpp_done_err \n";
4032 $perror = "$e ($perror)";
4040 sub _bop_recurring_billing {
4041 my( $self, %opt ) = @_;
4043 my $method = $conf->config('credit_card-recurring_billing_flag');
4045 if ( $method eq 'transaction_is_recur' ) {
4047 return 1 if $opt{'trans_is_recur'};
4051 my %hash = ( 'custnum' => $self->custnum,
4056 if qsearch('cust_pay', { %hash, 'payinfo' => $opt{'payinfo'} } )
4057 || qsearch('cust_pay', { %hash, 'paymask' => $self->mask_payinfo('CARD',
4068 =item realtime_refund_bop METHOD [ OPTION => VALUE ... ]
4070 Refunds a realtime credit card, ACH (electronic check) or phone bill transaction
4071 via a Business::OnlinePayment realtime gateway. See
4072 L<http://420.am/business-onlinepayment> for supported gateways.
4074 Available methods are: I<CC>, I<ECHECK> and I<LEC>
4076 Available options are: I<amount>, I<reason>, I<paynum>, I<paydate>
4078 Most gateways require a reference to an original payment transaction to refund,
4079 so you probably need to specify a I<paynum>.
4081 I<amount> defaults to the original amount of the payment if not specified.
4083 I<reason> specifies a reason for the refund.
4085 I<paydate> specifies the expiration date for a credit card overriding the
4086 value from the customer record or the payment record. Specified as yyyy-mm-dd
4088 Implementation note: If I<amount> is unspecified or equal to the amount of the
4089 orignal payment, first an attempt is made to "void" the transaction via
4090 the gateway (to cancel a not-yet settled transaction) and then if that fails,
4091 the normal attempt is made to "refund" ("credit") the transaction via the
4092 gateway is attempted.
4094 #The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
4095 #I<zip>, I<payinfo> and I<paydate> are also available. Any of these options,
4096 #if set, will override the value from the customer record.
4098 #If an I<invnum> is specified, this payment (if successful) is applied to the
4099 #specified invoice. If you don't specify an I<invnum> you might want to
4100 #call the B<apply_payments> method.
4104 #some false laziness w/realtime_bop, not enough to make it worth merging
4105 #but some useful small subs should be pulled out
4106 sub realtime_refund_bop {
4109 return $self->_new_realtime_refund_bop(@_)
4110 if $self->_new_bop_required();
4112 my( $method, %options ) = @_;
4114 warn "$me realtime_refund_bop: $method refund\n";
4115 warn " $_ => $options{$_}\n" foreach keys %options;
4118 eval "use Business::OnlinePayment";
4122 # look up the original payment and optionally a gateway for that payment
4126 my $amount = $options{'amount'};
4128 my( $processor, $login, $password, @bop_options ) ;
4129 my( $auth, $order_number ) = ( '', '', '' );
4131 if ( $options{'paynum'} ) {
4133 warn " paynum: $options{paynum}\n" if $DEBUG > 1;
4134 $cust_pay = qsearchs('cust_pay', { paynum=>$options{'paynum'} } )
4135 or return "Unknown paynum $options{'paynum'}";
4136 $amount ||= $cust_pay->paid;
4138 $cust_pay->paybatch =~ /^((\d+)\-)?(\w+):\s*([\w\-\/ ]*)(:([\w\-]+))?$/
4139 or return "Can't parse paybatch for paynum $options{'paynum'}: ".
4140 $cust_pay->paybatch;
4141 my $gatewaynum = '';
4142 ( $gatewaynum, $processor, $auth, $order_number ) = ( $2, $3, $4, $6 );
4144 if ( $gatewaynum ) { #gateway for the payment to be refunded
4146 my $payment_gateway =
4147 qsearchs('payment_gateway', { 'gatewaynum' => $gatewaynum } );
4148 die "payment gateway $gatewaynum not found"
4149 unless $payment_gateway;
4151 $processor = $payment_gateway->gateway_module;
4152 $login = $payment_gateway->gateway_username;
4153 $password = $payment_gateway->gateway_password;
4154 @bop_options = $payment_gateway->options;
4156 } else { #try the default gateway
4158 my( $conf_processor, $unused_action );
4159 ( $conf_processor, $login, $password, $unused_action, @bop_options ) =
4160 $self->default_payment_gateway($method);
4162 return "processor of payment $options{'paynum'} $processor does not".
4163 " match default processor $conf_processor"
4164 unless $processor eq $conf_processor;
4169 } else { # didn't specify a paynum, so look for agent gateway overrides
4170 # like a normal transaction
4173 if ( $method eq 'CC' ) {
4174 $cardtype = cardtype($self->payinfo);
4175 } elsif ( $method eq 'ECHECK' ) {
4178 $cardtype = $method;
4181 qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
4182 cardtype => $cardtype,
4184 || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
4186 taxclass => '', } );
4188 if ( $override ) { #use a payment gateway override
4190 my $payment_gateway = $override->payment_gateway;
4192 $processor = $payment_gateway->gateway_module;
4193 $login = $payment_gateway->gateway_username;
4194 $password = $payment_gateway->gateway_password;
4195 #$action = $payment_gateway->gateway_action;
4196 @bop_options = $payment_gateway->options;
4198 } else { #use the standard settings from the config
4201 ( $processor, $login, $password, $unused_action, @bop_options ) =
4202 $self->default_payment_gateway($method);
4207 return "neither amount nor paynum specified" unless $amount;
4212 'password' => $password,
4213 'order_number' => $order_number,
4214 'amount' => $amount,
4215 'referer' => 'http://cleanwhisker.420.am/', #XXX fix referer :/
4217 $content{authorization} = $auth
4218 if length($auth); #echeck/ACH transactions have an order # but no auth
4219 #(at least with authorize.net)
4221 my $disable_void_after;
4222 if ($conf->exists('disable_void_after')
4223 && $conf->config('disable_void_after') =~ /^(\d+)$/) {
4224 $disable_void_after = $1;
4227 #first try void if applicable
4228 if ( $cust_pay && $cust_pay->paid == $amount
4230 ( not defined($disable_void_after) )
4231 || ( time < ($cust_pay->_date + $disable_void_after ) )
4234 warn " attempting void\n" if $DEBUG > 1;
4235 my $void = new Business::OnlinePayment( $processor, @bop_options );
4236 $void->content( 'action' => 'void', %content );
4238 if ( $void->is_success ) {
4239 my $error = $cust_pay->void($options{'reason'});
4241 # gah, even with transactions.
4242 my $e = 'WARNING: Card/ACH voided but database not updated - '.
4243 "error voiding payment: $error";
4247 warn " void successful\n" if $DEBUG > 1;
4252 warn " void unsuccessful, trying refund\n"
4256 my $address = $self->address1;
4257 $address .= ", ". $self->address2 if $self->address2;
4259 my($payname, $payfirst, $paylast);
4260 if ( $self->payname && $method ne 'ECHECK' ) {
4261 $payname = $self->payname;
4262 $payname =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
4263 or return "Illegal payname $payname";
4264 ($payfirst, $paylast) = ($1, $2);
4266 $payfirst = $self->getfield('first');
4267 $paylast = $self->getfield('last');
4268 $payname = "$payfirst $paylast";
4271 my @invoicing_list = $self->invoicing_list_emailonly;
4272 if ( $conf->exists('emailinvoiceautoalways')
4273 || $conf->exists('emailinvoiceauto') && ! @invoicing_list
4274 || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
4275 push @invoicing_list, $self->all_emails;
4278 my $email = ($conf->exists('business-onlinepayment-email-override'))
4279 ? $conf->config('business-onlinepayment-email-override')
4280 : $invoicing_list[0];
4282 my $payip = exists($options{'payip'})
4285 $content{customer_ip} = $payip
4289 if ( $method eq 'CC' ) {
4292 $content{card_number} = $payinfo = $cust_pay->payinfo;
4293 (exists($options{'paydate'}) ? $options{'paydate'} : $cust_pay->paydate)
4294 =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/ &&
4295 ($content{expiration} = "$2/$1"); # where available
4297 $content{card_number} = $payinfo = $self->payinfo;
4298 (exists($options{'paydate'}) ? $options{'paydate'} : $self->paydate)
4299 =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
4300 $content{expiration} = "$2/$1";
4303 } elsif ( $method eq 'ECHECK' ) {
4306 $payinfo = $cust_pay->payinfo;
4308 $payinfo = $self->payinfo;
4310 ( $content{account_number}, $content{routing_code} )= split('@', $payinfo );
4311 $content{bank_name} = $self->payname;
4312 $content{account_type} = 'CHECKING';
4313 $content{account_name} = $payname;
4314 $content{customer_org} = $self->company ? 'B' : 'I';
4315 $content{customer_ssn} = $self->ss;
4316 } elsif ( $method eq 'LEC' ) {
4317 $content{phone} = $payinfo = $self->payinfo;
4321 my $refund = new Business::OnlinePayment( $processor, @bop_options );
4322 my %sub_content = $refund->content(
4323 'action' => 'credit',
4324 'customer_id' => $self->custnum,
4325 'last_name' => $paylast,
4326 'first_name' => $payfirst,
4328 'address' => $address,
4329 'city' => $self->city,
4330 'state' => $self->state,
4331 'zip' => $self->zip,
4332 'country' => $self->country,
4334 'phone' => $self->daytime || $self->night,
4337 warn join('', map { " $_ => $sub_content{$_}\n" } keys %sub_content )
4341 return "$processor error: ". $refund->error_message
4342 unless $refund->is_success();
4344 my %method2payby = (
4350 my $paybatch = "$processor:". $refund->authorization;
4351 $paybatch .= ':'. $refund->order_number
4352 if $refund->can('order_number') && $refund->order_number;
4354 while ( $cust_pay && $cust_pay->unapplied < $amount ) {
4355 my @cust_bill_pay = $cust_pay->cust_bill_pay;
4356 last unless @cust_bill_pay;
4357 my $cust_bill_pay = pop @cust_bill_pay;
4358 my $error = $cust_bill_pay->delete;
4362 my $cust_refund = new FS::cust_refund ( {
4363 'custnum' => $self->custnum,
4364 'paynum' => $options{'paynum'},
4365 'refund' => $amount,
4367 'payby' => $method2payby{$method},
4368 'payinfo' => $payinfo,
4369 'paybatch' => $paybatch,
4370 'reason' => $options{'reason'} || 'card or ACH refund',
4372 my $error = $cust_refund->insert;
4374 $cust_refund->paynum(''); #try again with no specific paynum
4375 my $error2 = $cust_refund->insert;
4377 # gah, even with transactions.
4378 my $e = 'WARNING: Card/ACH refunded but database not updated - '.
4379 "error inserting refund ($processor): $error2".
4380 " (previously tried insert with paynum #$options{'paynum'}" .
4391 # does the configuration indicate the new bop routines are required?
4393 sub _new_bop_required {
4396 my $botpp = 'Business::OnlineThirdPartyPayment';
4399 if ( $conf->config('business-onlinepayment-namespace') eq $botpp ||
4400 scalar( grep { $_->gateway_namespace eq $botpp }
4401 qsearch( 'payment_gateway', { 'disabled' => '' } )
4410 =item realtime_collect [ OPTION => VALUE ... ]
4412 Runs a realtime credit card, ACH (electronic check) or phone bill transaction
4413 via a Business::OnlinePayment or Business::OnlineThirdPartyPayment realtime
4414 gateway. See L<http://420.am/business-onlinepayment> and
4415 L<http://420.am/business-onlinethirdpartypayment> for supported gateways.
4417 On failure returns an error message.
4419 Returns false or a hashref upon success. The hashref contains keys popup_url reference, and collectitems. The first is a URL to which a browser should be redirected for completion of collection. The second is a reference id for the transaction suitable for the end user. The collectitems is a reference to a list of name value pairs suitable for assigning to a html form and posted to popup_url.
4421 Available options are: I<method>, I<amount>, I<description>, I<invnum>, I<quiet>, I<paynum_ref>, I<payunique>, I<session_id>
4423 I<method> is one of: I<CC>, I<ECHECK> and I<LEC>. If none is specified
4424 then it is deduced from the customer record.
4426 If no I<amount> is specified, then the customer balance is used.
4428 The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
4429 I<zip>, I<payinfo> and I<paydate> are also available. Any of these options,
4430 if set, will override the value from the customer record.
4432 I<description> is a free-text field passed to the gateway. It defaults to
4433 "Internet services".
4435 If an I<invnum> is specified, this payment (if successful) is applied to the
4436 specified invoice. If you don't specify an I<invnum> you might want to
4437 call the B<apply_payments> method.
4439 I<quiet> can be set true to surpress email decline notices.
4441 I<paynum_ref> can be set to a scalar reference. It will be filled in with the
4442 resulting paynum, if any.
4444 I<payunique> is a unique identifier for this payment.
4446 I<session_id> is a session identifier associated with this payment.
4448 I<depend_jobnum> allows payment capture to unlock export jobs
4452 sub realtime_collect {
4453 my( $self, %options ) = @_;
4456 warn "$me realtime_collect:\n";
4457 warn " $_ => $options{$_}\n" foreach keys %options;
4460 $options{amount} = $self->balance unless exists( $options{amount} );
4461 $options{method} = FS::payby->payby2bop($self->payby)
4462 unless exists( $options{method} );
4464 return $self->realtime_bop({%options});
4468 =item _realtime_bop { [ ARG => VALUE ... ] }
4470 Runs a realtime credit card, ACH (electronic check) or phone bill transaction
4471 via a Business::OnlinePayment realtime gateway. See
4472 L<http://420.am/business-onlinepayment> for supported gateways.
4474 Required arguments in the hashref are I<method>, and I<amount>
4476 Available methods are: I<CC>, I<ECHECK> and I<LEC>
4478 Available optional arguments are: I<description>, I<invnum>, I<quiet>, I<paynum_ref>, I<payunique>, I<session_id>
4480 The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
4481 I<zip>, I<payinfo> and I<paydate> are also available. Any of these options,
4482 if set, will override the value from the customer record.
4484 I<description> is a free-text field passed to the gateway. It defaults to
4485 "Internet services".
4487 If an I<invnum> is specified, this payment (if successful) is applied to the
4488 specified invoice. If you don't specify an I<invnum> you might want to
4489 call the B<apply_payments> method.
4491 I<quiet> can be set true to surpress email decline notices.
4493 I<paynum_ref> can be set to a scalar reference. It will be filled in with the
4494 resulting paynum, if any.
4496 I<payunique> is a unique identifier for this payment.
4498 I<session_id> is a session identifier associated with this payment.
4500 I<depend_jobnum> allows payment capture to unlock export jobs
4502 (moved from cust_bill) (probably should get realtime_{card,ach,lec} here too)
4506 # some helper routines
4507 sub _payment_gateway {
4508 my ($self, $options) = @_;
4510 $options->{payment_gateway} = $self->agent->payment_gateway( %$options )
4511 unless exists($options->{payment_gateway});
4513 $options->{payment_gateway};
4517 my ($self, $options) = @_;
4520 'login' => $options->{payment_gateway}->gateway_username,
4521 'password' => $options->{payment_gateway}->gateway_password,
4526 my ($self, $options) = @_;
4528 $options->{payment_gateway}->gatewaynum
4529 ? $options->{payment_gateway}->options
4530 : @{ $options->{payment_gateway}->get('options') };
4534 my ($self, $options) = @_;
4536 $options->{description} ||= 'Internet services';
4537 $options->{payinfo} = $self->payinfo unless exists( $options->{payinfo} );
4538 $options->{invnum} ||= '';
4539 $options->{payname} = $self->payname unless exists( $options->{payname} );
4543 my ($self, $options) = @_;
4546 $content{address} = exists($options->{'address1'})
4547 ? $options->{'address1'}
4549 my $address2 = exists($options->{'address2'})
4550 ? $options->{'address2'}
4552 $content{address} .= ", ". $address2 if length($address2);
4554 my $payip = exists($options->{'payip'}) ? $options->{'payip'} : $self->payip;
4555 $content{customer_ip} = $payip if length($payip);
4557 $content{invoice_number} = $options->{'invnum'}
4558 if exists($options->{'invnum'}) && length($options->{'invnum'});
4560 $content{email_customer} =
4561 ( $conf->exists('business-onlinepayment-email_customer')
4562 || $conf->exists('business-onlinepayment-email-override') );
4564 $content{payfirst} = $self->getfield('first');
4565 $content{paylast} = $self->getfield('last');
4567 $content{account_name} = "$content{payfirst} $content{paylast}"
4568 if $options->{method} eq 'ECHECK';
4570 $content{name} = $options->{payname};
4571 $content{name} = $content{account_name} if exists($content{account_name});
4573 $content{city} = exists($options->{city})
4576 $content{state} = exists($options->{state})
4579 $content{zip} = exists($options->{zip})
4582 $content{country} = exists($options->{country})
4583 ? $options->{country}
4585 $content{referer} = 'http://cleanwhisker.420.am/'; #XXX fix referer :/
4586 $content{phone} = $self->daytime || $self->night;
4591 my %bop_method2payby = (
4597 sub _new_realtime_bop {
4601 if (ref($_[0]) eq 'HASH') {
4602 %options = %{$_[0]};
4604 my ( $method, $amount ) = ( shift, shift );
4606 $options{method} = $method;
4607 $options{amount} = $amount;
4611 warn "$me realtime_bop (new): $options{method} $options{amount}\n";
4612 warn " $_ => $options{$_}\n" foreach keys %options;
4615 return $self->fake_bop(%options) if $options{'fake'};
4617 $self->_bop_defaults(\%options);
4620 # set trans_is_recur based on invnum if there is one
4623 my $trans_is_recur = 0;
4624 if ( $options{'invnum'} ) {
4626 my $cust_bill = qsearchs('cust_bill', { 'invnum' => $options{'invnum'} } );
4627 die "invnum ". $options{'invnum'}. " not found" unless $cust_bill;
4630 map { $_->part_pkg }
4632 map { $_->cust_pkg }
4633 $cust_bill->cust_bill_pkg;
4636 if grep { $_->freq ne '0' } @part_pkg;
4644 my $payment_gateway = $self->_payment_gateway( \%options );
4645 my $namespace = $payment_gateway->gateway_namespace;
4647 eval "use $namespace";
4651 # check for banned credit card/ACH
4654 my $ban = qsearchs('banned_pay', {
4655 'payby' => $bop_method2payby{$options{method}},
4656 'payinfo' => md5_base64($options{payinfo}),
4658 return "Banned credit card" if $ban;
4664 my (%bop_content) = $self->_bop_content(\%options);
4666 if ( $options{method} ne 'ECHECK' ) {
4667 $options{payname} =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
4668 or return "Illegal payname $options{payname}";
4669 ($bop_content{payfirst}, $bop_content{paylast}) = ($1, $2);
4672 my @invoicing_list = $self->invoicing_list_emailonly;
4673 if ( $conf->exists('emailinvoiceautoalways')
4674 || $conf->exists('emailinvoiceauto') && ! @invoicing_list
4675 || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
4676 push @invoicing_list, $self->all_emails;
4679 my $email = ($conf->exists('business-onlinepayment-email-override'))
4680 ? $conf->config('business-onlinepayment-email-override')
4681 : $invoicing_list[0];
4685 if ( $namespace eq 'Business::OnlinePayment' && $options{method} eq 'CC' ) {
4687 $content{card_number} = $options{payinfo};
4688 $paydate = exists($options{'paydate'})
4689 ? $options{'paydate'}
4691 $paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
4692 $content{expiration} = "$2/$1";
4694 my $paycvv = exists($options{'paycvv'})
4695 ? $options{'paycvv'}
4697 $content{cvv2} = $paycvv
4700 my $paystart_month = exists($options{'paystart_month'})
4701 ? $options{'paystart_month'}
4702 : $self->paystart_month;
4704 my $paystart_year = exists($options{'paystart_year'})
4705 ? $options{'paystart_year'}
4706 : $self->paystart_year;
4708 $content{card_start} = "$paystart_month/$paystart_year"
4709 if $paystart_month && $paystart_year;
4711 my $payissue = exists($options{'payissue'})
4712 ? $options{'payissue'}
4714 $content{issue_number} = $payissue if $payissue;
4716 if ( $self->_bop_recurring_billing( 'payinfo' => $options{'payinfo'},
4717 'trans_is_recur' => $trans_is_recur,
4721 $content{recurring_billing} = 'YES';
4722 $content{acct_code} = 'rebill'
4723 if $conf->exists('credit_card-recurring_billing_acct_code');
4726 } elsif ( $namespace eq 'Business::OnlinePayment' && $options{method} eq 'ECHECK' ){
4727 ( $content{account_number}, $content{routing_code} ) =
4728 split('@', $options{payinfo});
4729 $content{bank_name} = $options{payname};
4730 $content{bank_state} = exists($options{'paystate'})
4731 ? $options{'paystate'}
4732 : $self->getfield('paystate');
4733 $content{account_type} = exists($options{'paytype'})
4734 ? uc($options{'paytype'}) || 'CHECKING'
4735 : uc($self->getfield('paytype')) || 'CHECKING';
4736 $content{customer_org} = $self->company ? 'B' : 'I';
4737 $content{state_id} = exists($options{'stateid'})
4738 ? $options{'stateid'}
4739 : $self->getfield('stateid');
4740 $content{state_id_state} = exists($options{'stateid_state'})
4741 ? $options{'stateid_state'}
4742 : $self->getfield('stateid_state');
4743 $content{customer_ssn} = exists($options{'ss'})
4746 } elsif ( $namespace eq 'Business::OnlinePayment' && $options{method} eq 'LEC' ) {
4747 $content{phone} = $options{payinfo};
4748 } elsif ( $namespace eq 'Business::OnlineThirdPartyPayment' ) {
4755 # run transaction(s)
4758 my $balance = exists( $options{'balance'} )
4759 ? $options{'balance'}
4762 $self->select_for_update; #mutex ... just until we get our pending record in
4764 #the checks here are intended to catch concurrent payments
4765 #double-form-submission prevention is taken care of in cust_pay_pending::check
4768 return "The customer's balance has changed; $options{method} transaction aborted."
4769 if $self->balance < $balance;
4770 #&& $self->balance < $options{amount}; #might as well anyway?
4772 #also check and make sure there aren't *other* pending payments for this cust
4774 my @pending = qsearch('cust_pay_pending', {
4775 'custnum' => $self->custnum,
4776 'status' => { op=>'!=', value=>'done' }
4778 return "A payment is already being processed for this customer (".
4779 join(', ', map 'paypendingnum '. $_->paypendingnum, @pending ).
4780 "); $options{method} transaction aborted."
4781 if scalar(@pending);
4783 #okay, good to go, if we're a duplicate, cust_pay_pending will kick us out
4785 my $cust_pay_pending = new FS::cust_pay_pending {
4786 'custnum' => $self->custnum,
4787 #'invnum' => $options{'invnum'},
4788 'paid' => $options{amount},
4790 'payby' => $bop_method2payby{$options{method}},
4791 'payinfo' => $options{payinfo},
4792 'paydate' => $paydate,
4793 'recurring_billing' => $content{recurring_billing},
4795 'gatewaynum' => $payment_gateway->gatewaynum || '',
4796 'session_id' => $options{session_id} || '',
4797 'jobnum' => $options{depend_jobnum} || '',
4799 $cust_pay_pending->payunique( $options{payunique} )
4800 if defined($options{payunique}) && length($options{payunique});
4801 my $cpp_new_err = $cust_pay_pending->insert; #mutex lost when this is inserted
4802 return $cpp_new_err if $cpp_new_err;
4804 my( $action1, $action2 ) =
4805 split( /\s*\,\s*/, $payment_gateway->gateway_action );
4807 my $transaction = new $namespace( $payment_gateway->gateway_module,
4808 $self->_bop_options(\%options),
4811 $transaction->content(
4812 'type' => $options{method},
4813 $self->_bop_auth(\%options),
4814 'action' => $action1,
4815 'description' => $options{'description'},
4816 'amount' => $options{amount},
4817 #'invoice_number' => $options{'invnum'},
4818 'customer_id' => $self->custnum,
4820 'reference' => $cust_pay_pending->paypendingnum, #for now
4825 $cust_pay_pending->status('pending');
4826 my $cpp_pending_err = $cust_pay_pending->replace;
4827 return $cpp_pending_err if $cpp_pending_err;
4830 my $BOP_TESTING = 0;
4831 my $BOP_TESTING_SUCCESS = 1;
4833 unless ( $BOP_TESTING ) {
4834 $transaction->submit();
4836 if ( $BOP_TESTING_SUCCESS ) {
4837 $transaction->is_success(1);
4838 $transaction->authorization('fake auth');
4840 $transaction->is_success(0);
4841 $transaction->error_message('fake failure');
4845 if ( $transaction->is_success() && $namespace eq 'Business::OnlineThirdPartyPayment' ) {
4847 return { reference => $cust_pay_pending->paypendingnum,
4848 map { $_ => $transaction->$_ } qw ( popup_url collectitems ) };
4850 } elsif ( $transaction->is_success() && $action2 ) {
4852 $cust_pay_pending->status('authorized');
4853 my $cpp_authorized_err = $cust_pay_pending->replace;
4854 return $cpp_authorized_err if $cpp_authorized_err;
4856 my $auth = $transaction->authorization;
4857 my $ordernum = $transaction->can('order_number')
4858 ? $transaction->order_number
4862 new Business::OnlinePayment( $payment_gateway->gateway_module,
4863 $self->_bop_options(\%options),
4868 type => $options{method},
4870 $self->_bop_auth(\%options),
4871 order_number => $ordernum,
4872 amount => $options{amount},
4873 authorization => $auth,
4874 description => $options{'description'},
4877 foreach my $field (qw( authorization_source_code returned_ACI
4878 transaction_identifier validation_code
4879 transaction_sequence_num local_transaction_date
4880 local_transaction_time AVS_result_code )) {
4881 $capture{$field} = $transaction->$field() if $transaction->can($field);
4884 $capture->content( %capture );
4888 unless ( $capture->is_success ) {
4889 my $e = "Authorization successful but capture failed, custnum #".
4890 $self->custnum. ': '. $capture->result_code.
4891 ": ". $capture->error_message;
4899 # remove paycvv after initial transaction
4902 #false laziness w/misc/process/payment.cgi - check both to make sure working
4904 if ( defined $self->dbdef_table->column('paycvv')
4905 && length($self->paycvv)
4906 && ! grep { $_ eq cardtype($options{payinfo}) } $conf->config('cvv-save')
4908 my $error = $self->remove_cvv;
4910 warn "WARNING: error removing cvv: $error\n";
4918 $self->_realtime_bop_result( $cust_pay_pending, $transaction, %options );
4930 if (ref($_[0]) eq 'HASH') {
4931 %options = %{$_[0]};
4933 my ( $method, $amount ) = ( shift, shift );
4935 $options{method} = $method;
4936 $options{amount} = $amount;
4939 if ( $options{'fake_failure'} ) {
4940 return "Error: No error; test failure requested with fake_failure";
4944 #if ( $payment_gateway->gatewaynum ) { # agent override
4945 # $paybatch = $payment_gateway->gatewaynum. '-';
4948 #$paybatch .= "$processor:". $transaction->authorization;
4950 #$paybatch .= ':'. $transaction->order_number
4951 # if $transaction->can('order_number')
4952 # && length($transaction->order_number);
4954 my $paybatch = 'FakeProcessor:54:32';
4956 my $cust_pay = new FS::cust_pay ( {
4957 'custnum' => $self->custnum,
4958 'invnum' => $options{'invnum'},
4959 'paid' => $options{amount},
4961 'payby' => $bop_method2payby{$options{method}},
4962 #'payinfo' => $payinfo,
4963 'payinfo' => '4111111111111111',
4964 'paybatch' => $paybatch,
4965 #'paydate' => $paydate,
4966 'paydate' => '2012-05-01',
4968 $cust_pay->payunique( $options{payunique} ) if length($options{payunique});
4970 my $error = $cust_pay->insert($options{'manual'} ? ( 'manual' => 1 ) : () );
4973 $cust_pay->invnum(''); #try again with no specific invnum
4974 my $error2 = $cust_pay->insert( $options{'manual'} ?
4975 ( 'manual' => 1 ) : ()
4978 # gah, even with transactions.
4979 my $e = 'WARNING: Card/ACH debited but database not updated - '.
4980 "error inserting (fake!) payment: $error2".
4981 " (previously tried insert with invnum #$options{'invnum'}" .
4988 if ( $options{'paynum_ref'} ) {
4989 ${ $options{'paynum_ref'} } = $cust_pay->paynum;
4992 return ''; #no error
4997 # item _realtime_bop_result CUST_PAY_PENDING, BOP_OBJECT [ OPTION => VALUE ... ]
4999 # Wraps up processing of a realtime credit card, ACH (electronic check) or
5000 # phone bill transaction.
5002 sub _realtime_bop_result {
5003 my( $self, $cust_pay_pending, $transaction, %options ) = @_;
5005 warn "$me _realtime_bop_result: pending transaction ".
5006 $cust_pay_pending->paypendingnum. "\n";
5007 warn " $_ => $options{$_}\n" foreach keys %options;
5010 my $payment_gateway = $options{payment_gateway}
5011 or return "no payment gateway in arguments to _realtime_bop_result";
5013 $cust_pay_pending->status($transaction->is_success() ? 'captured' : 'declined');
5014 my $cpp_captured_err = $cust_pay_pending->replace;
5015 return $cpp_captured_err if $cpp_captured_err;
5017 if ( $transaction->is_success() ) {
5020 if ( $payment_gateway->gatewaynum ) { # agent override
5021 $paybatch = $payment_gateway->gatewaynum. '-';
5024 $paybatch .= $payment_gateway->gateway_module. ":".
5025 $transaction->authorization;
5027 $paybatch .= ':'. $transaction->order_number
5028 if $transaction->can('order_number')
5029 && length($transaction->order_number);
5031 my $cust_pay = new FS::cust_pay ( {
5032 'custnum' => $self->custnum,
5033 'invnum' => $options{'invnum'},
5034 'paid' => $cust_pay_pending->paid,
5036 'payby' => $cust_pay_pending->payby,
5037 #'payinfo' => $payinfo,
5038 'paybatch' => $paybatch,
5039 'paydate' => $cust_pay_pending->paydate,
5041 #doesn't hurt to know, even though the dup check is in cust_pay_pending now
5042 $cust_pay->payunique( $options{payunique} )
5043 if defined($options{payunique}) && length($options{payunique});
5045 my $oldAutoCommit = $FS::UID::AutoCommit;
5046 local $FS::UID::AutoCommit = 0;
5049 #start a transaction, insert the cust_pay and set cust_pay_pending.status to done in a single transction
5051 my $error = $cust_pay->insert($options{'manual'} ? ( 'manual' => 1 ) : () );
5054 $cust_pay->invnum(''); #try again with no specific invnum
5055 my $error2 = $cust_pay->insert( $options{'manual'} ?
5056 ( 'manual' => 1 ) : ()
5059 # gah. but at least we have a record of the state we had to abort in
5060 # from cust_pay_pending now.
5061 my $e = "WARNING: $options{method} captured but payment not recorded -".
5062 " error inserting payment (". $payment_gateway->gateway_module.
5064 " (previously tried insert with invnum #$options{'invnum'}" .
5065 ": $error ) - pending payment saved as paypendingnum ".
5066 $cust_pay_pending->paypendingnum. "\n";
5072 my $jobnum = $cust_pay_pending->jobnum;
5074 my $placeholder = qsearchs( 'queue', { 'jobnum' => $jobnum } );
5076 unless ( $placeholder ) {
5077 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
5078 my $e = "WARNING: $options{method} captured but job $jobnum not ".
5079 "found for paypendingnum ". $cust_pay_pending->paypendingnum. "\n";
5084 $error = $placeholder->delete;
5087 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
5088 my $e = "WARNING: $options{method} captured but could not delete ".
5089 "job $jobnum for paypendingnum ".
5090 $cust_pay_pending->paypendingnum. ": $error\n";
5097 if ( $options{'paynum_ref'} ) {
5098 ${ $options{'paynum_ref'} } = $cust_pay->paynum;
5101 $cust_pay_pending->status('done');
5102 $cust_pay_pending->statustext('captured');
5103 $cust_pay_pending->paynum($cust_pay->paynum);
5104 my $cpp_done_err = $cust_pay_pending->replace;
5106 if ( $cpp_done_err ) {
5108 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
5109 my $e = "WARNING: $options{method} captured but payment not recorded - ".
5110 "error updating status for paypendingnum ".
5111 $cust_pay_pending->paypendingnum. ": $cpp_done_err \n";
5117 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
5118 return ''; #no error
5124 my $perror = $payment_gateway->gateway_module. " error: ".
5125 $transaction->error_message;
5127 my $jobnum = $cust_pay_pending->jobnum;
5129 my $placeholder = qsearchs( 'queue', { 'jobnum' => $jobnum } );
5131 if ( $placeholder ) {
5132 my $error = $placeholder->depended_delete;
5133 $error ||= $placeholder->delete;
5134 warn "error removing provisioning jobs after declined paypendingnum ".
5135 $cust_pay_pending->paypendingnum. "\n";
5137 my $e = "error finding job $jobnum for declined paypendingnum ".
5138 $cust_pay_pending->paypendingnum. "\n";
5144 unless ( $transaction->error_message ) {
5147 if ( $transaction->can('response_page') ) {
5149 'page' => ( $transaction->can('response_page')
5150 ? $transaction->response_page
5153 'code' => ( $transaction->can('response_code')
5154 ? $transaction->response_code
5157 'headers' => ( $transaction->can('response_headers')
5158 ? $transaction->response_headers
5164 "No additional debugging information available for ".
5165 $payment_gateway->gateway_module;
5168 $perror .= "No error_message returned from ".
5169 $payment_gateway->gateway_module. " -- ".
5170 ( ref($t_response) ? Dumper($t_response) : $t_response );
5174 if ( !$options{'quiet'} && !$realtime_bop_decline_quiet
5175 && $conf->exists('emaildecline')
5176 && grep { $_ ne 'POST' } $self->invoicing_list
5177 && ! grep { $transaction->error_message =~ /$_/ }
5178 $conf->config('emaildecline-exclude')
5180 my @templ = $conf->config('declinetemplate');
5181 my $template = new Text::Template (
5183 SOURCE => [ map "$_\n", @templ ],
5184 ) or return "($perror) can't create template: $Text::Template::ERROR";
5185 $template->compile()
5186 or return "($perror) can't compile template: $Text::Template::ERROR";
5188 my $templ_hash = { error => $transaction->error_message };
5190 my $error = send_email(
5191 'from' => $conf->config('invoice_from', $self->agentnum ),
5192 'to' => [ grep { $_ ne 'POST' } $self->invoicing_list ],
5193 'subject' => 'Your payment could not be processed',
5194 'body' => [ $template->fill_in(HASH => $templ_hash) ],
5197 $perror .= " (also received error sending decline notification: $error)"
5202 $cust_pay_pending->status('done');
5203 $cust_pay_pending->statustext("declined: $perror");
5204 my $cpp_done_err = $cust_pay_pending->replace;
5205 if ( $cpp_done_err ) {
5206 my $e = "WARNING: $options{method} declined but pending payment not ".
5207 "resolved - error updating status for paypendingnum ".
5208 $cust_pay_pending->paypendingnum. ": $cpp_done_err \n";
5210 $perror = "$e ($perror)";
5218 =item realtime_botpp_capture CUST_PAY_PENDING [ OPTION => VALUE ... ]
5220 Verifies successful third party processing of a realtime credit card,
5221 ACH (electronic check) or phone bill transaction via a
5222 Business::OnlineThirdPartyPayment realtime gateway. See
5223 L<http://420.am/business-onlinethirdpartypayment> for supported gateways.
5225 Available options are: I<description>, I<invnum>, I<quiet>, I<paynum_ref>, I<payunique>
5227 The additional options I<payname>, I<city>, I<state>,
5228 I<zip>, I<payinfo> and I<paydate> are also available. Any of these options,
5229 if set, will override the value from the customer record.
5231 I<description> is a free-text field passed to the gateway. It defaults to
5232 "Internet services".
5234 If an I<invnum> is specified, this payment (if successful) is applied to the
5235 specified invoice. If you don't specify an I<invnum> you might want to
5236 call the B<apply_payments> method.
5238 I<quiet> can be set true to surpress email decline notices.
5240 I<paynum_ref> can be set to a scalar reference. It will be filled in with the
5241 resulting paynum, if any.
5243 I<payunique> is a unique identifier for this payment.
5245 Returns a hashref containing elements bill_error (which will be undefined
5246 upon success) and session_id of any associated session.
5250 sub realtime_botpp_capture {
5251 my( $self, $cust_pay_pending, %options ) = @_;
5253 warn "$me realtime_botpp_capture: pending transaction $cust_pay_pending\n";
5254 warn " $_ => $options{$_}\n" foreach keys %options;
5257 eval "use Business::OnlineThirdPartyPayment";
5261 # select the gateway
5264 my $method = FS::payby->payby2bop($cust_pay_pending->payby);
5266 my $payment_gateway = $cust_pay_pending->gatewaynum
5267 ? qsearchs( 'payment_gateway',
5268 { gatewaynum => $cust_pay_pending->gatewaynum }
5270 : $self->agent->payment_gateway( 'method' => $method,
5271 # 'invnum' => $cust_pay_pending->invnum,
5272 # 'payinfo' => $cust_pay_pending->payinfo,
5275 $options{payment_gateway} = $payment_gateway; # for the helper subs
5281 my @invoicing_list = $self->invoicing_list_emailonly;
5282 if ( $conf->exists('emailinvoiceautoalways')
5283 || $conf->exists('emailinvoiceauto') && ! @invoicing_list
5284 || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
5285 push @invoicing_list, $self->all_emails;
5288 my $email = ($conf->exists('business-onlinepayment-email-override'))
5289 ? $conf->config('business-onlinepayment-email-override')
5290 : $invoicing_list[0];
5294 $content{email_customer} =
5295 ( $conf->exists('business-onlinepayment-email_customer')
5296 || $conf->exists('business-onlinepayment-email-override') );
5299 # run transaction(s)
5303 new Business::OnlineThirdPartyPayment( $payment_gateway->gateway_module,
5304 $self->_bop_options(\%options),
5307 $transaction->reference({ %options });
5309 $transaction->content(
5311 $self->_bop_auth(\%options),
5312 'action' => 'Post Authorization',
5313 'description' => $options{'description'},
5314 'amount' => $cust_pay_pending->paid,
5315 #'invoice_number' => $options{'invnum'},
5316 'customer_id' => $self->custnum,
5317 'referer' => 'http://cleanwhisker.420.am/',
5318 'reference' => $cust_pay_pending->paypendingnum,
5320 'phone' => $self->daytime || $self->night,
5322 # plus whatever is required for bogus capture avoidance
5325 $transaction->submit();
5328 $self->_realtime_bop_result( $cust_pay_pending, $transaction, %options );
5331 bill_error => $error,
5332 session_id => $cust_pay_pending->session_id,
5337 =item default_payment_gateway DEPRECATED -- use agent->payment_gateway
5341 sub default_payment_gateway {
5342 my( $self, $method ) = @_;
5344 die "Real-time processing not enabled\n"
5345 unless $conf->exists('business-onlinepayment');
5347 #warn "default_payment_gateway deprecated -- use agent->payment_gateway\n";
5350 my $bop_config = 'business-onlinepayment';
5351 $bop_config .= '-ach'
5352 if $method =~ /^(ECHECK|CHEK)$/ && $conf->exists($bop_config. '-ach');
5353 my ( $processor, $login, $password, $action, @bop_options ) =
5354 $conf->config($bop_config);
5355 $action ||= 'normal authorization';
5356 pop @bop_options if scalar(@bop_options) % 2 && $bop_options[-1] =~ /^\s*$/;
5357 die "No real-time processor is enabled - ".
5358 "did you set the business-onlinepayment configuration value?\n"
5361 ( $processor, $login, $password, $action, @bop_options )
5366 Removes the I<paycvv> field from the database directly.
5368 If there is an error, returns the error, otherwise returns false.
5374 my $sth = dbh->prepare("UPDATE cust_main SET paycvv = '' WHERE custnum = ?")
5375 or return dbh->errstr;
5376 $sth->execute($self->custnum)
5377 or return $sth->errstr;
5382 =item _new_realtime_refund_bop METHOD [ OPTION => VALUE ... ]
5384 Refunds a realtime credit card, ACH (electronic check) or phone bill transaction
5385 via a Business::OnlinePayment realtime gateway. See
5386 L<http://420.am/business-onlinepayment> for supported gateways.
5388 Available methods are: I<CC>, I<ECHECK> and I<LEC>
5390 Available options are: I<amount>, I<reason>, I<paynum>, I<paydate>
5392 Most gateways require a reference to an original payment transaction to refund,
5393 so you probably need to specify a I<paynum>.
5395 I<amount> defaults to the original amount of the payment if not specified.
5397 I<reason> specifies a reason for the refund.
5399 I<paydate> specifies the expiration date for a credit card overriding the
5400 value from the customer record or the payment record. Specified as yyyy-mm-dd
5402 Implementation note: If I<amount> is unspecified or equal to the amount of the
5403 orignal payment, first an attempt is made to "void" the transaction via
5404 the gateway (to cancel a not-yet settled transaction) and then if that fails,
5405 the normal attempt is made to "refund" ("credit") the transaction via the
5406 gateway is attempted.
5408 #The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
5409 #I<zip>, I<payinfo> and I<paydate> are also available. Any of these options,
5410 #if set, will override the value from the customer record.
5412 #If an I<invnum> is specified, this payment (if successful) is applied to the
5413 #specified invoice. If you don't specify an I<invnum> you might want to
5414 #call the B<apply_payments> method.
5418 #some false laziness w/realtime_bop, not enough to make it worth merging
5419 #but some useful small subs should be pulled out
5420 sub _new_realtime_refund_bop {
5424 if (ref($_[0]) ne 'HASH') {
5425 %options = %{$_[0]};
5429 $options{method} = $method;
5433 warn "$me realtime_refund_bop (new): $options{method} refund\n";
5434 warn " $_ => $options{$_}\n" foreach keys %options;
5438 # look up the original payment and optionally a gateway for that payment
5442 my $amount = $options{'amount'};
5444 my( $processor, $login, $password, @bop_options, $namespace ) ;
5445 my( $auth, $order_number ) = ( '', '', '' );
5447 if ( $options{'paynum'} ) {
5449 warn " paynum: $options{paynum}\n" if $DEBUG > 1;
5450 $cust_pay = qsearchs('cust_pay', { paynum=>$options{'paynum'} } )
5451 or return "Unknown paynum $options{'paynum'}";
5452 $amount ||= $cust_pay->paid;
5454 $cust_pay->paybatch =~ /^((\d+)\-)?(\w+):\s*([\w\-\/ ]*)(:([\w\-]+))?$/
5455 or return "Can't parse paybatch for paynum $options{'paynum'}: ".
5456 $cust_pay->paybatch;
5457 my $gatewaynum = '';
5458 ( $gatewaynum, $processor, $auth, $order_number ) = ( $2, $3, $4, $6 );
5460 if ( $gatewaynum ) { #gateway for the payment to be refunded
5462 my $payment_gateway =
5463 qsearchs('payment_gateway', { 'gatewaynum' => $gatewaynum } );
5464 die "payment gateway $gatewaynum not found"
5465 unless $payment_gateway;
5467 $processor = $payment_gateway->gateway_module;
5468 $login = $payment_gateway->gateway_username;
5469 $password = $payment_gateway->gateway_password;
5470 $namespace = $payment_gateway->gateway_namespace;
5471 @bop_options = $payment_gateway->options;
5473 } else { #try the default gateway
5476 my $payment_gateway =
5477 $self->agent->payment_gateway('method' => $options{method});
5479 ( $conf_processor, $login, $password, $namespace ) =
5480 map { my $method = "gateway_$_"; $payment_gateway->$method }
5481 qw( module username password namespace );
5483 @bop_options = $payment_gateway->gatewaynum
5484 ? $payment_gateway->options
5485 : @{ $payment_gateway->get('options') };
5487 return "processor of payment $options{'paynum'} $processor does not".
5488 " match default processor $conf_processor"
5489 unless $processor eq $conf_processor;
5494 } else { # didn't specify a paynum, so look for agent gateway overrides
5495 # like a normal transaction
5497 my $payment_gateway =
5498 $self->agent->payment_gateway( 'method' => $options{method},
5499 #'payinfo' => $payinfo,
5501 my( $processor, $login, $password, $namespace ) =
5502 map { my $method = "gateway_$_"; $payment_gateway->$method }
5503 qw( module username password namespace );
5505 my @bop_options = $payment_gateway->gatewaynum
5506 ? $payment_gateway->options
5507 : @{ $payment_gateway->get('options') };
5510 return "neither amount nor paynum specified" unless $amount;
5512 eval "use $namespace";
5516 'type' => $options{method},
5518 'password' => $password,
5519 'order_number' => $order_number,
5520 'amount' => $amount,
5521 'referer' => 'http://cleanwhisker.420.am/', #XXX fix referer :/
5523 $content{authorization} = $auth
5524 if length($auth); #echeck/ACH transactions have an order # but no auth
5525 #(at least with authorize.net)
5527 my $disable_void_after;
5528 if ($conf->exists('disable_void_after')
5529 && $conf->config('disable_void_after') =~ /^(\d+)$/) {
5530 $disable_void_after = $1;
5533 #first try void if applicable
5534 if ( $cust_pay && $cust_pay->paid == $amount
5536 ( not defined($disable_void_after) )
5537 || ( time < ($cust_pay->_date + $disable_void_after ) )
5540 warn " attempting void\n" if $DEBUG > 1;
5541 my $void = new Business::OnlinePayment( $processor, @bop_options );
5542 $void->content( 'action' => 'void', %content );
5544 if ( $void->is_success ) {
5545 my $error = $cust_pay->void($options{'reason'});
5547 # gah, even with transactions.
5548 my $e = 'WARNING: Card/ACH voided but database not updated - '.
5549 "error voiding payment: $error";
5553 warn " void successful\n" if $DEBUG > 1;
5558 warn " void unsuccessful, trying refund\n"
5562 my $address = $self->address1;
5563 $address .= ", ". $self->address2 if $self->address2;
5565 my($payname, $payfirst, $paylast);
5566 if ( $self->payname && $options{method} ne 'ECHECK' ) {
5567 $payname = $self->payname;
5568 $payname =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
5569 or return "Illegal payname $payname";
5570 ($payfirst, $paylast) = ($1, $2);
5572 $payfirst = $self->getfield('first');
5573 $paylast = $self->getfield('last');
5574 $payname = "$payfirst $paylast";
5577 my @invoicing_list = $self->invoicing_list_emailonly;
5578 if ( $conf->exists('emailinvoiceautoalways')
5579 || $conf->exists('emailinvoiceauto') && ! @invoicing_list
5580 || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
5581 push @invoicing_list, $self->all_emails;
5584 my $email = ($conf->exists('business-onlinepayment-email-override'))
5585 ? $conf->config('business-onlinepayment-email-override')
5586 : $invoicing_list[0];
5588 my $payip = exists($options{'payip'})
5591 $content{customer_ip} = $payip
5595 if ( $options{method} eq 'CC' ) {
5598 $content{card_number} = $payinfo = $cust_pay->payinfo;
5599 (exists($options{'paydate'}) ? $options{'paydate'} : $cust_pay->paydate)
5600 =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/ &&
5601 ($content{expiration} = "$2/$1"); # where available
5603 $content{card_number} = $payinfo = $self->payinfo;
5604 (exists($options{'paydate'}) ? $options{'paydate'} : $self->paydate)
5605 =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
5606 $content{expiration} = "$2/$1";
5609 } elsif ( $options{method} eq 'ECHECK' ) {
5612 $payinfo = $cust_pay->payinfo;
5614 $payinfo = $self->payinfo;
5616 ( $content{account_number}, $content{routing_code} )= split('@', $payinfo );
5617 $content{bank_name} = $self->payname;
5618 $content{account_type} = 'CHECKING';
5619 $content{account_name} = $payname;
5620 $content{customer_org} = $self->company ? 'B' : 'I';
5621 $content{customer_ssn} = $self->ss;
5622 } elsif ( $options{method} eq 'LEC' ) {
5623 $content{phone} = $payinfo = $self->payinfo;
5627 my $refund = new Business::OnlinePayment( $processor, @bop_options );
5628 my %sub_content = $refund->content(
5629 'action' => 'credit',
5630 'customer_id' => $self->custnum,
5631 'last_name' => $paylast,
5632 'first_name' => $payfirst,
5634 'address' => $address,
5635 'city' => $self->city,
5636 'state' => $self->state,
5637 'zip' => $self->zip,
5638 'country' => $self->country,
5640 'phone' => $self->daytime || $self->night,
5643 warn join('', map { " $_ => $sub_content{$_}\n" } keys %sub_content )
5647 return "$processor error: ". $refund->error_message
5648 unless $refund->is_success();
5650 my $paybatch = "$processor:". $refund->authorization;
5651 $paybatch .= ':'. $refund->order_number
5652 if $refund->can('order_number') && $refund->order_number;
5654 while ( $cust_pay && $cust_pay->unapplied < $amount ) {
5655 my @cust_bill_pay = $cust_pay->cust_bill_pay;
5656 last unless @cust_bill_pay;
5657 my $cust_bill_pay = pop @cust_bill_pay;
5658 my $error = $cust_bill_pay->delete;
5662 my $cust_refund = new FS::cust_refund ( {
5663 'custnum' => $self->custnum,
5664 'paynum' => $options{'paynum'},
5665 'refund' => $amount,
5667 'payby' => $bop_method2payby{$options{method}},
5668 'payinfo' => $payinfo,
5669 'paybatch' => $paybatch,
5670 'reason' => $options{'reason'} || 'card or ACH refund',
5672 my $error = $cust_refund->insert;
5674 $cust_refund->paynum(''); #try again with no specific paynum
5675 my $error2 = $cust_refund->insert;
5677 # gah, even with transactions.
5678 my $e = 'WARNING: Card/ACH refunded but database not updated - '.
5679 "error inserting refund ($processor): $error2".
5680 " (previously tried insert with paynum #$options{'paynum'}" .
5691 =item batch_card OPTION => VALUE...
5693 Adds a payment for this invoice to the pending credit card batch (see
5694 L<FS::cust_pay_batch>), or, if the B<realtime> option is set to a true value,
5695 runs the payment using a realtime gateway.
5700 my ($self, %options) = @_;
5703 if (exists($options{amount})) {
5704 $amount = $options{amount};
5706 $amount = sprintf("%.2f", $self->balance - $self->in_transit_payments);
5708 return '' unless $amount > 0;
5710 my $invnum = delete $options{invnum};
5711 my $payby = $options{invnum} || $self->payby; #dubious
5713 if ($options{'realtime'}) {
5714 return $self->realtime_bop( FS::payby->payby2bop($self->payby),
5720 my $oldAutoCommit = $FS::UID::AutoCommit;
5721 local $FS::UID::AutoCommit = 0;
5724 #this needs to handle mysql as well as Pg, like svc_acct.pm
5725 #(make it into a common function if folks need to do batching with mysql)
5726 $dbh->do("LOCK TABLE pay_batch IN SHARE ROW EXCLUSIVE MODE")
5727 or return "Cannot lock pay_batch: " . $dbh->errstr;
5731 'payby' => FS::payby->payby2payment($payby),
5734 my $pay_batch = qsearchs( 'pay_batch', \%pay_batch );
5736 unless ( $pay_batch ) {
5737 $pay_batch = new FS::pay_batch \%pay_batch;
5738 my $error = $pay_batch->insert;
5740 $dbh->rollback if $oldAutoCommit;
5741 die "error creating new batch: $error\n";
5745 my $old_cust_pay_batch = qsearchs('cust_pay_batch', {
5746 'batchnum' => $pay_batch->batchnum,
5747 'custnum' => $self->custnum,
5750 foreach (qw( address1 address2 city state zip country payby payinfo paydate
5752 $options{$_} = '' unless exists($options{$_});
5755 my $cust_pay_batch = new FS::cust_pay_batch ( {
5756 'batchnum' => $pay_batch->batchnum,
5757 'invnum' => $invnum || 0, # is there a better value?
5758 # this field should be
5760 # cust_bill_pay_batch now
5761 'custnum' => $self->custnum,
5762 'last' => $self->getfield('last'),
5763 'first' => $self->getfield('first'),
5764 'address1' => $options{address1} || $self->address1,
5765 'address2' => $options{address2} || $self->address2,
5766 'city' => $options{city} || $self->city,
5767 'state' => $options{state} || $self->state,
5768 'zip' => $options{zip} || $self->zip,
5769 'country' => $options{country} || $self->country,
5770 'payby' => $options{payby} || $self->payby,
5771 'payinfo' => $options{payinfo} || $self->payinfo,
5772 'exp' => $options{paydate} || $self->paydate,
5773 'payname' => $options{payname} || $self->payname,
5774 'amount' => $amount, # consolidating
5777 $cust_pay_batch->paybatchnum($old_cust_pay_batch->paybatchnum)
5778 if $old_cust_pay_batch;
5781 if ($old_cust_pay_batch) {
5782 $error = $cust_pay_batch->replace($old_cust_pay_batch)
5784 $error = $cust_pay_batch->insert;
5788 $dbh->rollback if $oldAutoCommit;
5792 my $unapplied = $self->total_unapplied_credits
5793 + $self->total_unapplied_payments
5794 + $self->in_transit_payments;
5795 foreach my $cust_bill ($self->open_cust_bill) {
5796 #$dbh->commit or die $dbh->errstr if $oldAutoCommit;
5797 my $cust_bill_pay_batch = new FS::cust_bill_pay_batch {
5798 'invnum' => $cust_bill->invnum,
5799 'paybatchnum' => $cust_pay_batch->paybatchnum,
5800 'amount' => $cust_bill->owed,
5803 if ($unapplied >= $cust_bill_pay_batch->amount){
5804 $unapplied -= $cust_bill_pay_batch->amount;
5807 $cust_bill_pay_batch->amount(sprintf ( "%.2f",
5808 $cust_bill_pay_batch->amount - $unapplied )); $unapplied = 0;
5810 $error = $cust_bill_pay_batch->insert;
5812 $dbh->rollback if $oldAutoCommit;
5817 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
5821 =item apply_payments_and_credits
5823 Applies unapplied payments and credits.
5825 In most cases, this new method should be used in place of sequential
5826 apply_payments and apply_credits methods.
5828 If there is an error, returns the error, otherwise returns false.
5832 sub apply_payments_and_credits {
5835 local $SIG{HUP} = 'IGNORE';
5836 local $SIG{INT} = 'IGNORE';
5837 local $SIG{QUIT} = 'IGNORE';
5838 local $SIG{TERM} = 'IGNORE';
5839 local $SIG{TSTP} = 'IGNORE';
5840 local $SIG{PIPE} = 'IGNORE';
5842 my $oldAutoCommit = $FS::UID::AutoCommit;
5843 local $FS::UID::AutoCommit = 0;
5846 $self->select_for_update; #mutex
5848 foreach my $cust_bill ( $self->open_cust_bill ) {
5849 my $error = $cust_bill->apply_payments_and_credits;
5851 $dbh->rollback if $oldAutoCommit;
5852 return "Error applying: $error";
5856 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
5861 =item apply_credits OPTION => VALUE ...
5863 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
5864 to outstanding invoice balances in chronological order (or reverse
5865 chronological order if the I<order> option is set to B<newest>) and returns the
5866 value of any remaining unapplied credits available for refund (see
5867 L<FS::cust_refund>).
5869 Dies if there is an error.
5877 local $SIG{HUP} = 'IGNORE';
5878 local $SIG{INT} = 'IGNORE';
5879 local $SIG{QUIT} = 'IGNORE';
5880 local $SIG{TERM} = 'IGNORE';
5881 local $SIG{TSTP} = 'IGNORE';
5882 local $SIG{PIPE} = 'IGNORE';
5884 my $oldAutoCommit = $FS::UID::AutoCommit;
5885 local $FS::UID::AutoCommit = 0;
5888 $self->select_for_update; #mutex
5890 unless ( $self->total_unapplied_credits ) {
5891 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
5895 my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
5896 qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
5898 my @invoices = $self->open_cust_bill;
5899 @invoices = sort { $b->_date <=> $a->_date } @invoices
5900 if defined($opt{'order'}) && $opt{'order'} eq 'newest';
5903 foreach my $cust_bill ( @invoices ) {
5906 if ( !defined($credit) || $credit->credited == 0) {
5907 $credit = pop @credits or last;
5910 if ($cust_bill->owed >= $credit->credited) {
5911 $amount=$credit->credited;
5913 $amount=$cust_bill->owed;
5916 my $cust_credit_bill = new FS::cust_credit_bill ( {
5917 'crednum' => $credit->crednum,
5918 'invnum' => $cust_bill->invnum,
5919 'amount' => $amount,
5921 my $error = $cust_credit_bill->insert;
5923 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
5927 redo if ($cust_bill->owed > 0);
5931 my $total_unapplied_credits = $self->total_unapplied_credits;
5933 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
5935 return $total_unapplied_credits;
5938 =item apply_payments
5940 Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
5941 to outstanding invoice balances in chronological order.
5943 #and returns the value of any remaining unapplied payments.
5945 Dies if there is an error.
5949 sub apply_payments {
5952 local $SIG{HUP} = 'IGNORE';
5953 local $SIG{INT} = 'IGNORE';
5954 local $SIG{QUIT} = 'IGNORE';
5955 local $SIG{TERM} = 'IGNORE';
5956 local $SIG{TSTP} = 'IGNORE';
5957 local $SIG{PIPE} = 'IGNORE';
5959 my $oldAutoCommit = $FS::UID::AutoCommit;
5960 local $FS::UID::AutoCommit = 0;
5963 $self->select_for_update; #mutex
5967 my @payments = sort { $b->_date <=> $a->_date }
5968 grep { $_->unapplied > 0 }
5971 my @invoices = sort { $a->_date <=> $b->_date}
5972 grep { $_->owed > 0 }
5977 foreach my $cust_bill ( @invoices ) {
5980 if ( !defined($payment) || $payment->unapplied == 0 ) {
5981 $payment = pop @payments or last;
5984 if ( $cust_bill->owed >= $payment->unapplied ) {
5985 $amount = $payment->unapplied;
5987 $amount = $cust_bill->owed;
5990 my $cust_bill_pay = new FS::cust_bill_pay ( {
5991 'paynum' => $payment->paynum,
5992 'invnum' => $cust_bill->invnum,
5993 'amount' => $amount,
5995 my $error = $cust_bill_pay->insert;
5997 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
6001 redo if ( $cust_bill->owed > 0);
6005 my $total_unapplied_payments = $self->total_unapplied_payments;
6007 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
6009 return $total_unapplied_payments;
6014 Returns the total owed for this customer on all invoices
6015 (see L<FS::cust_bill/owed>).
6021 $self->total_owed_date(2145859200); #12/31/2037
6024 =item total_owed_date TIME
6026 Returns the total owed for this customer on all invoices with date earlier than
6027 TIME. TIME is specified as a UNIX timestamp; see L<perlfunc/"time">). Also
6028 see L<Time::Local> and L<Date::Parse> for conversion functions.
6032 sub total_owed_date {
6036 foreach my $cust_bill (
6037 grep { $_->_date <= $time }
6038 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
6040 $total_bill += $cust_bill->owed;
6042 sprintf( "%.2f", $total_bill );
6047 Returns the total amount of all payments.
6054 $total += $_->paid foreach $self->cust_pay;
6055 sprintf( "%.2f", $total );
6058 =item total_unapplied_credits
6060 Returns the total outstanding credit (see L<FS::cust_credit>) for this
6061 customer. See L<FS::cust_credit/credited>.
6063 =item total_credited
6065 Old name for total_unapplied_credits. Don't use.
6069 sub total_credited {
6070 #carp "total_credited deprecated, use total_unapplied_credits";
6071 shift->total_unapplied_credits(@_);
6074 sub total_unapplied_credits {
6076 my $total_credit = 0;
6077 $total_credit += $_->credited foreach $self->cust_credit;
6078 sprintf( "%.2f", $total_credit );
6081 =item total_unapplied_payments
6083 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
6084 See L<FS::cust_pay/unapplied>.
6088 sub total_unapplied_payments {
6090 my $total_unapplied = 0;
6091 $total_unapplied += $_->unapplied foreach $self->cust_pay;
6092 sprintf( "%.2f", $total_unapplied );
6095 =item total_unapplied_refunds
6097 Returns the total unrefunded refunds (see L<FS::cust_refund>) for this
6098 customer. See L<FS::cust_refund/unapplied>.
6102 sub total_unapplied_refunds {
6104 my $total_unapplied = 0;
6105 $total_unapplied += $_->unapplied foreach $self->cust_refund;
6106 sprintf( "%.2f", $total_unapplied );
6111 Returns the balance for this customer (total_owed plus total_unrefunded, minus
6112 total_unapplied_credits minus total_unapplied_payments).
6120 + $self->total_unapplied_refunds
6121 - $self->total_unapplied_credits
6122 - $self->total_unapplied_payments
6126 =item balance_date TIME
6128 Returns the balance for this customer, only considering invoices with date
6129 earlier than TIME (total_owed_date minus total_credited minus
6130 total_unapplied_payments). TIME is specified as a UNIX timestamp; see
6131 L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion
6140 $self->total_owed_date($time)
6141 + $self->total_unapplied_refunds
6142 - $self->total_unapplied_credits
6143 - $self->total_unapplied_payments
6147 =item in_transit_payments
6149 Returns the total of requests for payments for this customer pending in
6150 batches in transit to the bank. See L<FS::pay_batch> and L<FS::cust_pay_batch>
6154 sub in_transit_payments {
6156 my $in_transit_payments = 0;
6157 foreach my $pay_batch ( qsearch('pay_batch', {
6160 foreach my $cust_pay_batch ( qsearch('cust_pay_batch', {
6161 'batchnum' => $pay_batch->batchnum,
6162 'custnum' => $self->custnum,
6164 $in_transit_payments += $cust_pay_batch->amount;
6167 sprintf( "%.2f", $in_transit_payments );
6172 Returns a hash of useful information for making a payment.
6182 'CARD' (credit card - automatic), 'DCRD' (credit card - on-demand),
6183 'CHEK' (electronic check - automatic), 'DCHK' (electronic check - on-demand),
6184 'LECB' (Phone bill billing), 'BILL' (billing), or 'COMP' (free).
6188 For credit card transactions:
6200 For electronic check transactions:
6215 $return{balance} = $self->balance;
6217 $return{payname} = $self->payname
6218 || ( $self->first. ' '. $self->get('last') );
6220 $return{$_} = $self->get($_) for qw(address1 address2 city state zip);
6222 $return{payby} = $self->payby;
6223 $return{stateid_state} = $self->stateid_state;
6225 if ( $self->payby =~ /^(CARD|DCRD)$/ ) {
6226 $return{card_type} = cardtype($self->payinfo);
6227 $return{payinfo} = $self->paymask;
6229 @return{'month', 'year'} = $self->paydate_monthyear;
6233 if ( $self->payby =~ /^(CHEK|DCHK)$/ ) {
6234 my ($payinfo1, $payinfo2) = split '@', $self->paymask;
6235 $return{payinfo1} = $payinfo1;
6236 $return{payinfo2} = $payinfo2;
6237 $return{paytype} = $self->paytype;
6238 $return{paystate} = $self->paystate;
6242 #doubleclick protection
6244 $return{paybatch} = "webui-MyAccount-$_date-$$-". rand() * 2**32;
6250 =item paydate_monthyear
6252 Returns a two-element list consisting of the month and year of this customer's
6253 paydate (credit card expiration date for CARD customers)
6257 sub paydate_monthyear {
6259 if ( $self->paydate =~ /^(\d{4})-(\d{1,2})-\d{1,2}$/ ) { #Pg date format
6261 } elsif ( $self->paydate =~ /^(\d{1,2})-(\d{1,2}-)?(\d{4}$)/ ) {
6268 =item invoicing_list [ ARRAYREF ]
6270 If an arguement is given, sets these email addresses as invoice recipients
6271 (see L<FS::cust_main_invoice>). Errors are not fatal and are not reported
6272 (except as warnings), so use check_invoicing_list first.
6274 Returns a list of email addresses (with svcnum entries expanded).
6276 Note: You can clear the invoicing list by passing an empty ARRAYREF. You can
6277 check it without disturbing anything by passing nothing.
6279 This interface may change in the future.
6283 sub invoicing_list {
6284 my( $self, $arrayref ) = @_;
6287 my @cust_main_invoice;
6288 if ( $self->custnum ) {
6289 @cust_main_invoice =
6290 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
6292 @cust_main_invoice = ();
6294 foreach my $cust_main_invoice ( @cust_main_invoice ) {
6295 #warn $cust_main_invoice->destnum;
6296 unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
6297 #warn $cust_main_invoice->destnum;
6298 my $error = $cust_main_invoice->delete;
6299 warn $error if $error;
6302 if ( $self->custnum ) {
6303 @cust_main_invoice =
6304 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
6306 @cust_main_invoice = ();
6308 my %seen = map { $_->address => 1 } @cust_main_invoice;
6309 foreach my $address ( @{$arrayref} ) {
6310 next if exists $seen{$address} && $seen{$address};
6311 $seen{$address} = 1;
6312 my $cust_main_invoice = new FS::cust_main_invoice ( {
6313 'custnum' => $self->custnum,
6316 my $error = $cust_main_invoice->insert;
6317 warn $error if $error;
6321 if ( $self->custnum ) {
6323 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
6330 =item check_invoicing_list ARRAYREF
6332 Checks these arguements as valid input for the invoicing_list method. If there
6333 is an error, returns the error, otherwise returns false.
6337 sub check_invoicing_list {
6338 my( $self, $arrayref ) = @_;
6340 foreach my $address ( @$arrayref ) {
6342 if ($address eq 'FAX' and $self->getfield('fax') eq '') {
6343 return 'Can\'t add FAX invoice destination with a blank FAX number.';
6346 my $cust_main_invoice = new FS::cust_main_invoice ( {
6347 'custnum' => $self->custnum,
6350 my $error = $self->custnum
6351 ? $cust_main_invoice->check
6352 : $cust_main_invoice->checkdest
6354 return $error if $error;
6358 return "Email address required"
6359 if $conf->exists('cust_main-require_invoicing_list_email')
6360 && ! grep { $_ !~ /^([A-Z]+)$/ } @$arrayref;
6365 =item set_default_invoicing_list
6367 Sets the invoicing list to all accounts associated with this customer,
6368 overwriting any previous invoicing list.
6372 sub set_default_invoicing_list {
6374 $self->invoicing_list($self->all_emails);
6379 Returns the email addresses of all accounts provisioned for this customer.
6386 foreach my $cust_pkg ( $self->all_pkgs ) {
6387 my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
6389 map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
6390 grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
6392 $list{$_}=1 foreach map { $_->email } @svc_acct;
6397 =item invoicing_list_addpost
6399 Adds postal invoicing to this customer. If this customer is already configured
6400 to receive postal invoices, does nothing.
6404 sub invoicing_list_addpost {
6406 return if grep { $_ eq 'POST' } $self->invoicing_list;
6407 my @invoicing_list = $self->invoicing_list;
6408 push @invoicing_list, 'POST';
6409 $self->invoicing_list(\@invoicing_list);
6412 =item invoicing_list_emailonly
6414 Returns the list of email invoice recipients (invoicing_list without non-email
6415 destinations such as POST and FAX).
6419 sub invoicing_list_emailonly {
6421 warn "$me invoicing_list_emailonly called"
6423 grep { $_ !~ /^([A-Z]+)$/ } $self->invoicing_list;
6426 =item invoicing_list_emailonly_scalar
6428 Returns the list of email invoice recipients (invoicing_list without non-email
6429 destinations such as POST and FAX) as a comma-separated scalar.
6433 sub invoicing_list_emailonly_scalar {
6435 warn "$me invoicing_list_emailonly_scalar called"
6437 join(', ', $self->invoicing_list_emailonly);
6440 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
6442 Returns an array of customers referred by this customer (referral_custnum set
6443 to this custnum). If DEPTH is given, recurses up to the given depth, returning
6444 customers referred by customers referred by this customer and so on, inclusive.
6445 The default behavior is DEPTH 1 (no recursion).
6449 sub referral_cust_main {
6451 my $depth = @_ ? shift : 1;
6452 my $exclude = @_ ? shift : {};
6455 map { $exclude->{$_->custnum}++; $_; }
6456 grep { ! $exclude->{ $_->custnum } }
6457 qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
6461 map { $_->referral_cust_main($depth-1, $exclude) }
6468 =item referral_cust_main_ncancelled
6470 Same as referral_cust_main, except only returns customers with uncancelled
6475 sub referral_cust_main_ncancelled {
6477 grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
6480 =item referral_cust_pkg [ DEPTH ]
6482 Like referral_cust_main, except returns a flat list of all unsuspended (and
6483 uncancelled) packages for each customer. The number of items in this list may
6484 be useful for comission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
6488 sub referral_cust_pkg {
6490 my $depth = @_ ? shift : 1;
6492 map { $_->unsuspended_pkgs }
6493 grep { $_->unsuspended_pkgs }
6494 $self->referral_cust_main($depth);
6497 =item referring_cust_main
6499 Returns the single cust_main record for the customer who referred this customer
6500 (referral_custnum), or false.
6504 sub referring_cust_main {
6506 return '' unless $self->referral_custnum;
6507 qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
6510 =item credit AMOUNT, REASON [ , OPTION => VALUE ... ]
6512 Applies a credit to this customer. If there is an error, returns the error,
6513 otherwise returns false.
6515 REASON can be a text string, an FS::reason object, or a scalar reference to
6516 a reasonnum. If a text string, it will be automatically inserted as a new
6517 reason, and a 'reason_type' option must be passed to indicate the
6518 FS::reason_type for the new reason.
6520 An I<addlinfo> option may be passed to set the credit's I<addlinfo> field.
6522 Any other options are passed to FS::cust_credit::insert.
6527 my( $self, $amount, $reason, %options ) = @_;
6529 my $cust_credit = new FS::cust_credit {
6530 'custnum' => $self->custnum,
6531 'amount' => $amount,
6534 if ( ref($reason) ) {
6536 if ( ref($reason) eq 'SCALAR' ) {
6537 $cust_credit->reasonnum( $$reason );
6539 $cust_credit->reasonnum( $reason->reasonnum );
6543 $cust_credit->set('reason', $reason)
6546 $cust_credit->addlinfo( delete $options{'addlinfo'} )
6547 if exists($options{'addlinfo'});
6549 $cust_credit->insert(%options);
6553 =item charge AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
6555 Creates a one-time charge for this customer. If there is an error, returns
6556 the error, otherwise returns false.
6562 my ( $amount, $quantity, $pkg, $comment, $classnum, $additional );
6563 my ( $setuptax, $taxclass ); #internal taxes
6564 my ( $taxproduct, $override ); #vendor (CCH) taxes
6565 if ( ref( $_[0] ) ) {
6566 $amount = $_[0]->{amount};
6567 $quantity = exists($_[0]->{quantity}) ? $_[0]->{quantity} : 1;
6568 $pkg = exists($_[0]->{pkg}) ? $_[0]->{pkg} : 'One-time charge';
6569 $comment = exists($_[0]->{comment}) ? $_[0]->{comment}
6570 : '$'. sprintf("%.2f",$amount);
6571 $setuptax = exists($_[0]->{setuptax}) ? $_[0]->{setuptax} : '';
6572 $taxclass = exists($_[0]->{taxclass}) ? $_[0]->{taxclass} : '';
6573 $classnum = exists($_[0]->{classnum}) ? $_[0]->{classnum} : '';
6574 $additional = $_[0]->{additional};
6575 $taxproduct = $_[0]->{taxproductnum};
6576 $override = { '' => $_[0]->{tax_override} };
6580 $pkg = @_ ? shift : 'One-time charge';
6581 $comment = @_ ? shift : '$'. sprintf("%.2f",$amount);
6583 $taxclass = @_ ? shift : '';
6587 local $SIG{HUP} = 'IGNORE';
6588 local $SIG{INT} = 'IGNORE';
6589 local $SIG{QUIT} = 'IGNORE';
6590 local $SIG{TERM} = 'IGNORE';
6591 local $SIG{TSTP} = 'IGNORE';
6592 local $SIG{PIPE} = 'IGNORE';
6594 my $oldAutoCommit = $FS::UID::AutoCommit;
6595 local $FS::UID::AutoCommit = 0;
6598 my $part_pkg = new FS::part_pkg ( {
6600 'comment' => $comment,
6604 'classnum' => $classnum ? $classnum : '',
6605 'setuptax' => $setuptax,
6606 'taxclass' => $taxclass,
6607 'taxproductnum' => $taxproduct,
6610 my %options = ( ( map { ("additional_info$_" => $additional->[$_] ) }
6611 ( 0 .. @$additional - 1 )
6613 'additional_count' => scalar(@$additional),
6614 'setup_fee' => $amount,
6617 my $error = $part_pkg->insert( options => \%options,
6618 tax_overrides => $override,
6621 $dbh->rollback if $oldAutoCommit;
6625 my $pkgpart = $part_pkg->pkgpart;
6626 my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
6627 unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
6628 my $type_pkgs = new FS::type_pkgs \%type_pkgs;
6629 $error = $type_pkgs->insert;
6631 $dbh->rollback if $oldAutoCommit;
6636 my $cust_pkg = new FS::cust_pkg ( {
6637 'custnum' => $self->custnum,
6638 'pkgpart' => $pkgpart,
6639 'quantity' => $quantity,
6642 $error = $cust_pkg->insert;
6644 $dbh->rollback if $oldAutoCommit;
6648 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
6653 #=item charge_postal_fee
6655 #Applies a one time charge this customer. If there is an error,
6656 #returns the error, returns the cust_pkg charge object or false
6657 #if there was no charge.
6661 # This should be a customer event. For that to work requires that bill
6662 # also be a customer event.
6664 sub charge_postal_fee {
6667 my $pkgpart = $conf->config('postal_invoice-fee_pkgpart');
6668 return '' unless ($pkgpart && grep { $_ eq 'POST' } $self->invoicing_list);
6670 my $cust_pkg = new FS::cust_pkg ( {
6671 'custnum' => $self->custnum,
6672 'pkgpart' => $pkgpart,
6676 my $error = $cust_pkg->insert;
6677 $error ? $error : $cust_pkg;
6682 Returns all the invoices (see L<FS::cust_bill>) for this customer.
6688 sort { $a->_date <=> $b->_date }
6689 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
6692 =item open_cust_bill
6694 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
6699 sub open_cust_bill {
6701 grep { $_->owed > 0 } $self->cust_bill;
6706 Returns all the credits (see L<FS::cust_credit>) for this customer.
6712 sort { $a->_date <=> $b->_date }
6713 qsearch( 'cust_credit', { 'custnum' => $self->custnum } )
6718 Returns all the payments (see L<FS::cust_pay>) for this customer.
6724 sort { $a->_date <=> $b->_date }
6725 qsearch( 'cust_pay', { 'custnum' => $self->custnum } )
6730 Returns all voided payments (see L<FS::cust_pay_void>) for this customer.
6736 sort { $a->_date <=> $b->_date }
6737 qsearch( 'cust_pay_void', { 'custnum' => $self->custnum } )
6740 =item cust_pay_batch
6742 Returns all batched payments (see L<FS::cust_pay_void>) for this customer.
6746 sub cust_pay_batch {
6748 sort { $a->_date <=> $b->_date }
6749 qsearch( 'cust_pay_batch', { 'custnum' => $self->custnum } )
6752 =item cust_pay_pending
6754 Returns all pending payments (see L<FS::cust_pay_pending>) for this customer
6755 (without status "done").
6759 sub cust_pay_pending {
6761 return $self->num_cust_pay_pending unless wantarray;
6762 sort { $a->_date <=> $b->_date }
6763 qsearch( 'cust_pay_pending', {
6764 'custnum' => $self->custnum,
6765 'status' => { op=>'!=', value=>'done' },
6770 =item num_cust_pay_pending
6772 Returns the number of pending payments (see L<FS::cust_pay_pending>) for this
6773 customer (without status "done"). Also called automatically when the
6774 cust_pay_pending method is used in a scalar context.
6778 sub num_cust_pay_pending {
6780 my $sql = " SELECT COUNT(*) FROM cust_pay_pending ".
6781 " WHERE custnum = ? AND status != 'done' ";
6782 my $sth = dbh->prepare($sql) or die dbh->errstr;
6783 $sth->execute($self->custnum) or die $sth->errstr;
6784 $sth->fetchrow_arrayref->[0];
6789 Returns all the refunds (see L<FS::cust_refund>) for this customer.
6795 sort { $a->_date <=> $b->_date }
6796 qsearch( 'cust_refund', { 'custnum' => $self->custnum } )
6799 =item display_custnum
6801 Returns the displayed customer number for this customer: agent_custid if
6802 cust_main-default_agent_custid is set and it has a value, custnum otherwise.
6806 sub display_custnum {
6808 if ( $conf->exists('cust_main-default_agent_custid') && $self->agent_custid ){
6809 return $self->agent_custid;
6811 return $self->custnum;
6817 Returns a name string for this customer, either "Company (Last, First)" or
6824 my $name = $self->contact;
6825 $name = $self->company. " ($name)" if $self->company;
6831 Returns a name string for this (service/shipping) contact, either
6832 "Company (Last, First)" or "Last, First".
6838 if ( $self->get('ship_last') ) {
6839 my $name = $self->ship_contact;
6840 $name = $self->ship_company. " ($name)" if $self->ship_company;
6849 Returns a name string for this customer, either "Company" or "First Last".
6855 $self->company !~ /^\s*$/ ? $self->company : $self->contact_firstlast;
6858 =item ship_name_short
6860 Returns a name string for this (service/shipping) contact, either "Company"
6865 sub ship_name_short {
6867 if ( $self->get('ship_last') ) {
6868 $self->ship_company !~ /^\s*$/
6869 ? $self->ship_company
6870 : $self->ship_contact_firstlast;
6872 $self->name_company_or_firstlast;
6878 Returns this customer's full (billing) contact name only, "Last, First"
6884 $self->get('last'). ', '. $self->first;
6889 Returns this customer's full (shipping) contact name only, "Last, First"
6895 $self->get('ship_last')
6896 ? $self->get('ship_last'). ', '. $self->ship_first
6900 =item contact_firstlast
6902 Returns this customers full (billing) contact name only, "First Last".
6906 sub contact_firstlast {
6908 $self->first. ' '. $self->get('last');
6911 =item ship_contact_firstlast
6913 Returns this customer's full (shipping) contact name only, "First Last".
6917 sub ship_contact_firstlast {
6919 $self->get('ship_last')
6920 ? $self->first. ' '. $self->get('ship_last')
6921 : $self->contact_firstlast;
6926 Returns this customer's full country name
6932 code2country($self->country);
6935 =item geocode DATA_VENDOR
6937 Returns a value for the customer location as encoded by DATA_VENDOR.
6938 Currently this only makes sense for "CCH" as DATA_VENDOR.
6943 my ($self, $data_vendor) = (shift, shift); #always cch for now
6945 my $geocode = $self->get('geocode'); #XXX only one data_vendor for geocode
6946 return $geocode if $geocode;
6948 my $prefix = ( $conf->exists('tax-ship_address') && length($self->ship_last) )
6952 my ($zip,$plus4) = split /-/, $self->get("${prefix}zip")
6953 if $self->country eq 'US';
6955 #CCH specific location stuff
6956 my $extra_sql = "AND plus4lo <= '$plus4' AND plus4hi >= '$plus4'";
6958 my @cust_tax_location =
6960 'table' => 'cust_tax_location',
6961 'hashref' => { 'zip' => $zip, 'data_vendor' => $data_vendor },
6962 'extra_sql' => $extra_sql,
6963 'order_by' => 'ORDER BY plus4hi',#overlapping with distinct ends
6966 $geocode = $cust_tax_location[0]->geocode
6967 if scalar(@cust_tax_location);
6976 Returns a status string for this customer, currently:
6980 =item prospect - No packages have ever been ordered
6982 =item active - One or more recurring packages is active
6984 =item inactive - No active recurring packages, but otherwise unsuspended/uncancelled (the inactive status is new - previously inactive customers were mis-identified as cancelled)
6986 =item suspended - All non-cancelled recurring packages are suspended
6988 =item cancelled - All recurring packages are cancelled
6994 sub status { shift->cust_status(@_); }
6998 for my $status (qw( prospect active inactive suspended cancelled )) {
6999 my $method = $status.'_sql';
7000 my $numnum = ( my $sql = $self->$method() ) =~ s/cust_main\.custnum/?/g;
7001 my $sth = dbh->prepare("SELECT $sql") or die dbh->errstr;
7002 $sth->execute( ($self->custnum) x $numnum )
7003 or die "Error executing 'SELECT $sql': ". $sth->errstr;
7004 return $status if $sth->fetchrow_arrayref->[0];
7008 =item ucfirst_cust_status
7010 =item ucfirst_status
7012 Returns the status with the first character capitalized.
7016 sub ucfirst_status { shift->ucfirst_cust_status(@_); }
7018 sub ucfirst_cust_status {
7020 ucfirst($self->cust_status);
7025 Returns a hex triplet color string for this customer's status.
7029 use vars qw(%statuscolor);
7030 tie %statuscolor, 'Tie::IxHash',
7031 'prospect' => '7e0079', #'000000', #black? naw, purple
7032 'active' => '00CC00', #green
7033 'inactive' => '0000CC', #blue
7034 'suspended' => 'FF9900', #yellow
7035 'cancelled' => 'FF0000', #red
7038 sub statuscolor { shift->cust_statuscolor(@_); }
7040 sub cust_statuscolor {
7042 $statuscolor{$self->cust_status};
7047 Returns an array of hashes representing the customer's RT tickets.
7054 my $num = $conf->config('cust_main-max_tickets') || 10;
7057 if ( $conf->config('ticket_system') ) {
7058 unless ( $conf->config('ticket_system-custom_priority_field') ) {
7060 @tickets = @{ FS::TicketSystem->customer_tickets($self->custnum, $num) };
7064 foreach my $priority (
7065 $conf->config('ticket_system-custom_priority_field-values'), ''
7067 last if scalar(@tickets) >= $num;
7069 @{ FS::TicketSystem->customer_tickets( $self->custnum,
7070 $num - scalar(@tickets),
7080 # Return services representing svc_accts in customer support packages
7081 sub support_services {
7083 my %packages = map { $_ => 1 } $conf->config('support_packages');
7085 grep { $_->pkg_svc && $_->pkg_svc->primary_svc eq 'Y' }
7086 grep { $_->part_svc->svcdb eq 'svc_acct' }
7087 map { $_->cust_svc }
7088 grep { exists $packages{ $_->pkgpart } }
7089 $self->ncancelled_pkgs;
7095 =head1 CLASS METHODS
7101 Class method that returns the list of possible status strings for customers
7102 (see L<the status method|/status>). For example:
7104 @statuses = FS::cust_main->statuses();
7109 #my $self = shift; #could be class...
7115 Returns an SQL expression identifying prospective cust_main records (customers
7116 with no packages ever ordered)
7120 use vars qw($select_count_pkgs);
7121 $select_count_pkgs =
7122 "SELECT COUNT(*) FROM cust_pkg
7123 WHERE cust_pkg.custnum = cust_main.custnum";
7125 sub select_count_pkgs_sql {
7129 sub prospect_sql { "
7130 0 = ( $select_count_pkgs )
7135 Returns an SQL expression identifying active cust_main records (customers with
7136 active recurring packages).
7141 0 < ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. "
7147 Returns an SQL expression identifying inactive cust_main records (customers with
7148 no active recurring packages, but otherwise unsuspended/uncancelled).
7152 sub inactive_sql { "
7153 0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " )
7155 0 < ( $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " )
7161 Returns an SQL expression identifying suspended cust_main records.
7166 sub suspended_sql { susp_sql(@_); }
7168 0 < ( $select_count_pkgs AND ". FS::cust_pkg->suspended_sql. " )
7170 0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " )
7176 Returns an SQL expression identifying cancelled cust_main records.
7180 sub cancelled_sql { cancel_sql(@_); }
7183 my $recurring_sql = FS::cust_pkg->recurring_sql;
7184 my $cancelled_sql = FS::cust_pkg->cancelled_sql;
7187 0 < ( $select_count_pkgs )
7188 AND 0 < ( $select_count_pkgs AND $recurring_sql AND $cancelled_sql )
7189 AND 0 = ( $select_count_pkgs AND $recurring_sql
7190 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
7192 AND 0 = ( $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " )
7198 =item uncancelled_sql
7200 Returns an SQL expression identifying un-cancelled cust_main records.
7204 sub uncancelled_sql { uncancel_sql(@_); }
7205 sub uncancel_sql { "
7206 ( 0 < ( $select_count_pkgs
7207 AND ( cust_pkg.cancel IS NULL
7208 OR cust_pkg.cancel = 0
7211 OR 0 = ( $select_count_pkgs )
7217 Returns an SQL fragment to retreive the balance.
7222 ( SELECT COALESCE( SUM(charged), 0 ) FROM cust_bill
7223 WHERE cust_bill.custnum = cust_main.custnum )
7224 - ( SELECT COALESCE( SUM(paid), 0 ) FROM cust_pay
7225 WHERE cust_pay.custnum = cust_main.custnum )
7226 - ( SELECT COALESCE( SUM(amount), 0 ) FROM cust_credit
7227 WHERE cust_credit.custnum = cust_main.custnum )
7228 + ( SELECT COALESCE( SUM(refund), 0 ) FROM cust_refund
7229 WHERE cust_refund.custnum = cust_main.custnum )
7232 =item balance_date_sql START_TIME [ END_TIME [ OPTION => VALUE ... ] ]
7234 Returns an SQL fragment to retreive the balance for this customer, only
7235 considering invoices with date earlier than START_TIME, and optionally not
7236 later than END_TIME (total_owed_date minus total_unapplied_credits minus
7237 total_unapplied_payments).
7239 Times are specified as SQL fragments or numeric
7240 UNIX timestamps; see L<perlfunc/"time">). Also see L<Time::Local> and
7241 L<Date::Parse> for conversion functions. The empty string can be passed
7242 to disable that time constraint completely.
7244 Available options are:
7248 =item unapplied_date
7250 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)
7255 set to true to remove all customer comparison clauses, for totals
7260 WHERE clause hashref (elements "AND"ed together) (typically used with the total option)
7265 JOIN clause (typically used with the total option)
7271 sub balance_date_sql {
7272 my( $class, $start, $end, %opt ) = @_;
7274 my $owed = FS::cust_bill->owed_sql;
7275 my $unapp_refund = FS::cust_refund->unapplied_sql;
7276 my $unapp_credit = FS::cust_credit->unapplied_sql;
7277 my $unapp_pay = FS::cust_pay->unapplied_sql;
7279 my $j = $opt{'join'} || '';
7281 my $owed_wh = $class->_money_table_where( 'cust_bill', $start,$end,%opt );
7282 my $refund_wh = $class->_money_table_where( 'cust_refund', $start,$end,%opt );
7283 my $credit_wh = $class->_money_table_where( 'cust_credit', $start,$end,%opt );
7284 my $pay_wh = $class->_money_table_where( 'cust_pay', $start,$end,%opt );
7286 " ( SELECT COALESCE(SUM($owed), 0) FROM cust_bill $j $owed_wh )
7287 + ( SELECT COALESCE(SUM($unapp_refund), 0) FROM cust_refund $j $refund_wh )
7288 - ( SELECT COALESCE(SUM($unapp_credit), 0) FROM cust_credit $j $credit_wh )
7289 - ( SELECT COALESCE(SUM($unapp_pay), 0) FROM cust_pay $j $pay_wh )
7294 =item _money_table_where TABLE START_TIME [ END_TIME [ OPTION => VALUE ... ] ]
7296 Helper method for balance_date_sql; name (and usage) subject to change
7297 (suggestions welcome).
7299 Returns a WHERE clause for the specified monetary TABLE (cust_bill,
7300 cust_refund, cust_credit or cust_pay).
7302 If TABLE is "cust_bill" or the unapplied_date option is true, only
7303 considers records with date earlier than START_TIME, and optionally not
7304 later than END_TIME .
7308 sub _money_table_where {
7309 my( $class, $table, $start, $end, %opt ) = @_;
7312 push @where, "cust_main.custnum = $table.custnum" unless $opt{'total'};
7313 if ( $table eq 'cust_bill' || $opt{'unapplied_date'} ) {
7314 push @where, "$table._date <= $start" if defined($start) && length($start);
7315 push @where, "$table._date > $end" if defined($end) && length($end);
7317 push @where, @{$opt{'where'}} if $opt{'where'};
7318 my $where = scalar(@where) ? 'WHERE '. join(' AND ', @where ) : '';
7324 =item search_sql HASHREF
7328 Returns a qsearch hash expression to search for parameters specified in HREF.
7329 Valid parameters are
7337 =item cancelled_pkgs
7343 listref of start date, end date
7349 =item current_balance
7351 listref (list returned by FS::UI::Web::parse_lt_gt($cgi, 'current_balance'))
7355 =item flattened_pkgs
7364 my ($class, $params) = @_;
7375 if ( $params->{'agentnum'} =~ /^(\d+)$/ and $1 ) {
7377 "cust_main.agentnum = $1";
7384 #prospect active inactive suspended cancelled
7385 if ( grep { $params->{'status'} eq $_ } FS::cust_main->statuses() ) {
7386 my $method = $params->{'status'}. '_sql';
7387 #push @where, $class->$method();
7388 push @where, FS::cust_main->$method();
7392 # parse cancelled package checkbox
7397 $pkgwhere .= "AND (cancel = 0 or cancel is null)"
7398 unless $params->{'cancelled_pkgs'};
7404 foreach my $field (qw( signupdate )) {
7406 next unless exists($params->{$field});
7408 my($beginning, $ending) = @{$params->{$field}};
7411 "cust_main.$field IS NOT NULL",
7412 "cust_main.$field >= $beginning",
7413 "cust_main.$field <= $ending";
7415 $orderby ||= "ORDER BY cust_main.$field";
7423 my @payby = grep /^([A-Z]{4})$/, @{ $params->{'payby'} };
7425 push @where, '( '. join(' OR ', map "cust_main.payby = '$_'", @payby). ' )';
7432 #my $balance_sql = $class->balance_sql();
7433 my $balance_sql = FS::cust_main->balance_sql();
7435 push @where, map { s/current_balance/$balance_sql/; $_ }
7436 @{ $params->{'current_balance'} };
7442 if ( $params->{'custbatch'} =~ /^([\w\/\-\:\.]+)$/ and $1 ) {
7444 "cust_main.custbatch = '$1'";
7448 # setup queries, subs, etc. for the search
7451 $orderby ||= 'ORDER BY custnum';
7453 # here is the agent virtualization
7454 push @where, $FS::CurrentUser::CurrentUser->agentnums_sql;
7456 my $extra_sql = scalar(@where) ? ' WHERE '. join(' AND ', @where) : '';
7458 my $addl_from = 'LEFT JOIN cust_pkg USING ( custnum ) ';
7460 my $count_query = "SELECT COUNT(*) FROM cust_main $extra_sql";
7462 my $select = join(', ',
7463 'cust_main.custnum',
7464 FS::UI::Web::cust_sql_fields($params->{'cust_fields'}),
7467 my(@extra_headers) = ();
7468 my(@extra_fields) = ();
7470 if ($params->{'flattened_pkgs'}) {
7472 if ($dbh->{Driver}->{Name} eq 'Pg') {
7474 $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";
7476 }elsif ($dbh->{Driver}->{Name} =~ /^mysql/i) {
7477 $select .= ", GROUP_CONCAT(pkg SEPARATOR '|') as magic";
7478 $addl_from .= " LEFT JOIN part_pkg using ( pkgpart )";
7480 warn "warning: unknown database type ". $dbh->{Driver}->{Name}.
7481 "omitting packing information from report.";
7484 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";
7486 my $sth = dbh->prepare($header_query) or die dbh->errstr;
7487 $sth->execute() or die $sth->errstr;
7488 my $headerrow = $sth->fetchrow_arrayref;
7489 my $headercount = $headerrow ? $headerrow->[0] : 0;
7490 while($headercount) {
7491 unshift @extra_headers, "Package ". $headercount;
7492 unshift @extra_fields, eval q!sub {my $c = shift;
7493 my @a = split '\|', $c->magic;
7494 my $p = $a[!.--$headercount. q!];
7502 'table' => 'cust_main',
7503 'select' => $select,
7505 'extra_sql' => $extra_sql,
7506 'order_by' => $orderby,
7507 'count_query' => $count_query,
7508 'extra_headers' => \@extra_headers,
7509 'extra_fields' => \@extra_fields,
7514 =item email_search_sql HASHREF
7518 Emails a notice to the specified customers.
7520 Valid parameters are those of the L<search_sql> method, plus the following:
7542 Optional job queue job for status updates.
7546 Returns an error message, or false for success.
7548 If an error occurs during any email, stops the enture send and returns that
7549 error. Presumably if you're getting SMTP errors aborting is better than
7550 retrying everything.
7554 sub email_search_sql {
7555 my($class, $params) = @_;
7557 my $from = delete $params->{from};
7558 my $subject = delete $params->{subject};
7559 my $html_body = delete $params->{html_body};
7560 my $text_body = delete $params->{text_body};
7562 my $job = delete $params->{'job'};
7564 my $sql_query = $class->search_sql($params);
7566 my $count_query = delete($sql_query->{'count_query'});
7567 my $count_sth = dbh->prepare($count_query)
7568 or die "Error preparing $count_query: ". dbh->errstr;
7570 or die "Error executing $count_query: ". $count_sth->errstr;
7571 my $count_arrayref = $count_sth->fetchrow_arrayref;
7572 my $num_cust = $count_arrayref->[0];
7574 #my @extra_headers = @{ delete($sql_query->{'extra_headers'}) };
7575 #my @extra_fields = @{ delete($sql_query->{'extra_fields'}) };
7578 my( $num, $last, $min_sec ) = (0, time, 5); #progresbar foo
7580 #eventually order+limit magic to reduce memory use?
7581 foreach my $cust_main ( qsearch($sql_query) ) {
7583 my $to = $cust_main->invoicing_list_emailonly_scalar;
7586 my $error = send_email(
7590 'subject' => $subject,
7591 'html_body' => $html_body,
7592 'text_body' => $text_body,
7595 return $error if $error;
7597 if ( $job ) { #progressbar foo
7599 if ( time - $min_sec > $last ) {
7600 my $error = $job->update_statustext(
7601 int( 100 * $num / $num_cust )
7603 die $error if $error;
7613 use Storable qw(thaw);
7616 sub process_email_search_sql {
7618 #warn "$me process_re_X $method for job $job\n" if $DEBUG;
7620 my $param = thaw(decode_base64(shift));
7621 warn Dumper($param) if $DEBUG;
7623 $param->{'job'} = $job;
7625 my $error = FS::cust_main->email_search_sql( $param );
7626 die $error if $error;
7630 =item fuzzy_search FUZZY_HASHREF [ HASHREF, SELECT, EXTRA_SQL, CACHE_OBJ ]
7632 Performs a fuzzy (approximate) search and returns the matching FS::cust_main
7633 records. Currently, I<first>, I<last> and/or I<company> may be specified (the
7634 appropriate ship_ field is also searched).
7636 Additional options are the same as FS::Record::qsearch
7641 my( $self, $fuzzy, $hash, @opt) = @_;
7646 check_and_rebuild_fuzzyfiles();
7647 foreach my $field ( keys %$fuzzy ) {
7649 my $all = $self->all_X($field);
7650 next unless scalar(@$all);
7653 $match{$_}=1 foreach ( amatch( $fuzzy->{$field}, ['i'], @$all ) );
7656 foreach ( keys %match ) {
7657 push @fcust, qsearch('cust_main', { %$hash, $field=>$_}, @opt);
7658 push @fcust, qsearch('cust_main', { %$hash, "ship_$field"=>$_}, @opt);
7661 push @cust_main, grep { ! $fsaw{$_->custnum}++ } @fcust;
7664 # we want the components of $fuzzy ANDed, not ORed, but still don't want dupes
7666 @cust_main = grep { ++$saw{$_->custnum} == scalar(keys %$fuzzy) } @cust_main;
7674 Returns a masked version of the named field
7679 my ($self,$field) = @_;
7683 'x'x(length($self->getfield($field))-4).
7684 substr($self->getfield($field), (length($self->getfield($field))-4));
7694 =item smart_search OPTION => VALUE ...
7696 Accepts the following options: I<search>, the string to search for. The string
7697 will be searched for as a customer number, phone number, name or company name,
7698 as an exact, or, in some cases, a substring or fuzzy match (see the source code
7699 for the exact heuristics used); I<no_fuzzy_on_exact>, causes smart_search to
7700 skip fuzzy matching when an exact match is found.
7702 Any additional options are treated as an additional qualifier on the search
7705 Returns a (possibly empty) array of FS::cust_main objects.
7712 #here is the agent virtualization
7713 my $agentnums_sql = $FS::CurrentUser::CurrentUser->agentnums_sql;
7717 my $skip_fuzzy = delete $options{'no_fuzzy_on_exact'};
7718 my $search = delete $options{'search'};
7719 ( my $alphanum_search = $search ) =~ s/\W//g;
7721 if ( $alphanum_search =~ /^1?(\d{3})(\d{3})(\d{4})(\d*)$/ ) { #phone# search
7723 #false laziness w/Record::ut_phone
7724 my $phonen = "$1-$2-$3";
7725 $phonen .= " x$4" if $4;
7727 push @cust_main, qsearch( {
7728 'table' => 'cust_main',
7729 'hashref' => { %options },
7730 'extra_sql' => ( scalar(keys %options) ? ' AND ' : ' WHERE ' ).
7732 join(' OR ', map "$_ = '$phonen'",
7733 qw( daytime night fax
7734 ship_daytime ship_night ship_fax )
7737 " AND $agentnums_sql", #agent virtualization
7740 unless ( @cust_main || $phonen =~ /x\d+$/ ) { #no exact match
7741 #try looking for matches with extensions unless one was specified
7743 push @cust_main, qsearch( {
7744 'table' => 'cust_main',
7745 'hashref' => { %options },
7746 'extra_sql' => ( scalar(keys %options) ? ' AND ' : ' WHERE ' ).
7748 join(' OR ', map "$_ LIKE '$phonen\%'",
7750 ship_daytime ship_night )
7753 " AND $agentnums_sql", #agent virtualization
7758 # custnum search (also try agent_custid), with some tweaking options if your
7759 # legacy cust "numbers" have letters
7762 if ( $search =~ /^\s*(\d+)\s*$/
7763 || ( $conf->config('cust_main-agent_custid-format') eq 'ww?d+'
7764 && $search =~ /^\s*(\w\w?\d+)\s*$/
7771 if ( $num <= 2147483647 ) { #need a bigint custnum? wow.
7772 push @cust_main, qsearch( {
7773 'table' => 'cust_main',
7774 'hashref' => { 'custnum' => $num, %options },
7775 'extra_sql' => " AND $agentnums_sql", #agent virtualization
7779 push @cust_main, qsearch( {
7780 'table' => 'cust_main',
7781 'hashref' => { 'agent_custid' => $num, %options },
7782 'extra_sql' => " AND $agentnums_sql", #agent virtualization
7785 } elsif ( $search =~ /^\s*(\S.*\S)\s+\((.+), ([^,]+)\)\s*$/ ) {
7787 my($company, $last, $first) = ( $1, $2, $3 );
7789 # "Company (Last, First)"
7790 #this is probably something a browser remembered,
7791 #so just do an exact search
7793 foreach my $prefix ( '', 'ship_' ) {
7794 push @cust_main, qsearch( {
7795 'table' => 'cust_main',
7796 'hashref' => { $prefix.'first' => $first,
7797 $prefix.'last' => $last,
7798 $prefix.'company' => $company,
7801 'extra_sql' => " AND $agentnums_sql",
7805 } elsif ( $search =~ /^\s*(\S.*\S)\s*$/ ) { # value search
7806 # try (ship_){last,company}
7810 # # remove "(Last, First)" in "Company (Last, First)", otherwise the
7811 # # full strings the browser remembers won't work
7812 # $value =~ s/\([\w \,\.\-\']*\)$//; #false laziness w/Record::ut_name
7814 use Lingua::EN::NameParse;
7815 my $NameParse = new Lingua::EN::NameParse(
7817 allow_reversed => 1,
7820 my($last, $first) = ( '', '' );
7821 #maybe disable this too and just rely on NameParse?
7822 if ( $value =~ /^(.+),\s*([^,]+)$/ ) { # Last, First
7824 ($last, $first) = ( $1, $2 );
7826 #} elsif ( $value =~ /^(.+)\s+(.+)$/ ) {
7827 } elsif ( ! $NameParse->parse($value) ) {
7829 my %name = $NameParse->components;
7830 $first = $name{'given_name_1'};
7831 $last = $name{'surname_1'};
7835 if ( $first && $last ) {
7837 my($q_last, $q_first) = ( dbh->quote($last), dbh->quote($first) );
7840 my $sql = scalar(keys %options) ? ' AND ' : ' WHERE ';
7842 ( ( LOWER(last) = $q_last AND LOWER(first) = $q_first )
7843 OR ( LOWER(ship_last) = $q_last AND LOWER(ship_first) = $q_first )
7846 push @cust_main, qsearch( {
7847 'table' => 'cust_main',
7848 'hashref' => \%options,
7849 'extra_sql' => "$sql AND $agentnums_sql", #agent virtualization
7852 # or it just be something that was typed in... (try that in a sec)
7856 my $q_value = dbh->quote($value);
7859 my $sql = scalar(keys %options) ? ' AND ' : ' WHERE ';
7860 $sql .= " ( LOWER(last) = $q_value
7861 OR LOWER(company) = $q_value
7862 OR LOWER(ship_last) = $q_value
7863 OR LOWER(ship_company) = $q_value
7866 push @cust_main, qsearch( {
7867 'table' => 'cust_main',
7868 'hashref' => \%options,
7869 'extra_sql' => "$sql AND $agentnums_sql", #agent virtualization
7872 #no exact match, trying substring/fuzzy
7873 #always do substring & fuzzy (unless they're explicity config'ed off)
7874 #getting complaints searches are not returning enough
7875 unless ( @cust_main && $skip_fuzzy || $conf->exists('disable-fuzzy') ) {
7877 #still some false laziness w/search_sql (was search/cust_main.cgi)
7882 { 'company' => { op=>'ILIKE', value=>"%$value%" }, },
7883 { 'ship_company' => { op=>'ILIKE', value=>"%$value%" }, },
7886 if ( $first && $last ) {
7889 { 'first' => { op=>'ILIKE', value=>"%$first%" },
7890 'last' => { op=>'ILIKE', value=>"%$last%" },
7892 { 'ship_first' => { op=>'ILIKE', value=>"%$first%" },
7893 'ship_last' => { op=>'ILIKE', value=>"%$last%" },
7900 { 'last' => { op=>'ILIKE', value=>"%$value%" }, },
7901 { 'ship_last' => { op=>'ILIKE', value=>"%$value%" }, },
7905 foreach my $hashref ( @hashrefs ) {
7907 push @cust_main, qsearch( {
7908 'table' => 'cust_main',
7909 'hashref' => { %$hashref,
7912 'extra_sql' => " AND $agentnums_sql", #agent virtualizaiton
7921 " AND $agentnums_sql", #extra_sql #agent virtualization
7924 if ( $first && $last ) {
7925 push @cust_main, FS::cust_main->fuzzy_search(
7926 { 'last' => $last, #fuzzy hashref
7927 'first' => $first }, #
7931 foreach my $field ( 'last', 'company' ) {
7933 FS::cust_main->fuzzy_search( { $field => $value }, @fuzopts );
7938 #eliminate duplicates
7940 @cust_main = grep { !$saw{$_->custnum}++ } @cust_main;
7950 Accepts the following options: I<email>, the email address to search for. The
7951 email address will be searched for as an email invoice destination and as an
7954 #Any additional options are treated as an additional qualifier on the search
7955 #(i.e. I<agentnum>).
7957 Returns a (possibly empty) array of FS::cust_main objects (but usually just
7967 my $email = delete $options{'email'};
7969 #we're only being used by RT at the moment... no agent virtualization yet
7970 #my $agentnums_sql = $FS::CurrentUser::CurrentUser->agentnums_sql;
7974 if ( $email =~ /([^@]+)\@([^@]+)/ ) {
7976 my ( $user, $domain ) = ( $1, $2 );
7978 warn "$me smart_search: searching for $user in domain $domain"
7984 'table' => 'cust_main_invoice',
7985 'hashref' => { 'dest' => $email },
7992 map $_->cust_svc->cust_pkg,
7994 'table' => 'svc_acct',
7995 'hashref' => { 'username' => $user, },
7997 'AND ( SELECT domain FROM svc_domain
7998 WHERE svc_acct.domsvc = svc_domain.svcnum
7999 ) = '. dbh->quote($domain),
8005 @cust_main = grep { !$saw{$_->custnum}++ } @cust_main;
8007 warn "$me smart_search: found ". scalar(@cust_main). " unique customers"
8014 =item check_and_rebuild_fuzzyfiles
8018 use vars qw(@fuzzyfields);
8019 @fuzzyfields = ( 'last', 'first', 'company' );
8021 sub check_and_rebuild_fuzzyfiles {
8022 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
8023 rebuild_fuzzyfiles() if grep { ! -e "$dir/cust_main.$_" } @fuzzyfields
8026 =item rebuild_fuzzyfiles
8030 sub rebuild_fuzzyfiles {
8032 use Fcntl qw(:flock);
8034 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
8035 mkdir $dir, 0700 unless -d $dir;
8037 foreach my $fuzzy ( @fuzzyfields ) {
8039 open(LOCK,">>$dir/cust_main.$fuzzy")
8040 or die "can't open $dir/cust_main.$fuzzy: $!";
8042 or die "can't lock $dir/cust_main.$fuzzy: $!";
8044 open (CACHE,">$dir/cust_main.$fuzzy.tmp")
8045 or die "can't open $dir/cust_main.$fuzzy.tmp: $!";
8047 foreach my $field ( $fuzzy, "ship_$fuzzy" ) {
8048 my $sth = dbh->prepare("SELECT $field FROM cust_main".
8049 " WHERE $field != '' AND $field IS NOT NULL");
8050 $sth->execute or die $sth->errstr;
8052 while ( my $row = $sth->fetchrow_arrayref ) {
8053 print CACHE $row->[0]. "\n";
8058 close CACHE or die "can't close $dir/cust_main.$fuzzy.tmp: $!";
8060 rename "$dir/cust_main.$fuzzy.tmp", "$dir/cust_main.$fuzzy";
8071 my( $self, $field ) = @_;
8072 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
8073 open(CACHE,"<$dir/cust_main.$field")
8074 or die "can't open $dir/cust_main.$field: $!";
8075 my @array = map { chomp; $_; } <CACHE>;
8080 =item append_fuzzyfiles LASTNAME COMPANY
8084 sub append_fuzzyfiles {
8085 #my( $first, $last, $company ) = @_;
8087 &check_and_rebuild_fuzzyfiles;
8089 use Fcntl qw(:flock);
8091 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
8093 foreach my $field (qw( first last company )) {
8098 open(CACHE,">>$dir/cust_main.$field")
8099 or die "can't open $dir/cust_main.$field: $!";
8100 flock(CACHE,LOCK_EX)
8101 or die "can't lock $dir/cust_main.$field: $!";
8103 print CACHE "$value\n";
8105 flock(CACHE,LOCK_UN)
8106 or die "can't unlock $dir/cust_main.$field: $!";
8121 #warn join('-',keys %$param);
8122 my $fh = $param->{filehandle};
8123 my @fields = @{$param->{fields}};
8125 eval "use Text::CSV_XS;";
8128 my $csv = new Text::CSV_XS;
8135 local $SIG{HUP} = 'IGNORE';
8136 local $SIG{INT} = 'IGNORE';
8137 local $SIG{QUIT} = 'IGNORE';
8138 local $SIG{TERM} = 'IGNORE';
8139 local $SIG{TSTP} = 'IGNORE';
8140 local $SIG{PIPE} = 'IGNORE';
8142 my $oldAutoCommit = $FS::UID::AutoCommit;
8143 local $FS::UID::AutoCommit = 0;
8146 #while ( $columns = $csv->getline($fh) ) {
8148 while ( defined($line=<$fh>) ) {
8150 $csv->parse($line) or do {
8151 $dbh->rollback if $oldAutoCommit;
8152 return "can't parse: ". $csv->error_input();
8155 my @columns = $csv->fields();
8156 #warn join('-',@columns);
8159 foreach my $field ( @fields ) {
8160 $row{$field} = shift @columns;
8163 my $cust_main = qsearchs('cust_main', { 'custnum' => $row{'custnum'} } );
8164 unless ( $cust_main ) {
8165 $dbh->rollback if $oldAutoCommit;
8166 return "unknown custnum $row{'custnum'}";
8169 if ( $row{'amount'} > 0 ) {
8170 my $error = $cust_main->charge($row{'amount'}, $row{'pkg'});
8172 $dbh->rollback if $oldAutoCommit;
8176 } elsif ( $row{'amount'} < 0 ) {
8177 my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ),
8180 $dbh->rollback if $oldAutoCommit;
8190 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
8192 return "Empty file!" unless $imported;
8198 =item notify CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
8200 Sends a templated email notification to the customer (see L<Text::Template>).
8202 OPTIONS is a hash and may include
8204 I<from> - the email sender (default is invoice_from)
8206 I<to> - comma-separated scalar or arrayref of recipients
8207 (default is invoicing_list)
8209 I<subject> - The subject line of the sent email notification
8210 (default is "Notice from company_name")
8212 I<extra_fields> - a hashref of name/value pairs which will be substituted
8215 The following variables are vavailable in the template.
8217 I<$first> - the customer first name
8218 I<$last> - the customer last name
8219 I<$company> - the customer company
8220 I<$payby> - a description of the method of payment for the customer
8221 # would be nice to use FS::payby::shortname
8222 I<$payinfo> - the account information used to collect for this customer
8223 I<$expdate> - the expiration of the customer payment in seconds from epoch
8228 my ($self, $template, %options) = @_;
8230 return unless $conf->exists($template);
8232 my $from = $conf->config('invoice_from', $self->agentnum)
8233 if $conf->exists('invoice_from', $self->agentnum);
8234 $from = $options{from} if exists($options{from});
8236 my $to = join(',', $self->invoicing_list_emailonly);
8237 $to = $options{to} if exists($options{to});
8239 my $subject = "Notice from " . $conf->config('company_name', $self->agentnum)
8240 if $conf->exists('company_name', $self->agentnum);
8241 $subject = $options{subject} if exists($options{subject});
8243 my $notify_template = new Text::Template (TYPE => 'ARRAY',
8244 SOURCE => [ map "$_\n",
8245 $conf->config($template)]
8247 or die "can't create new Text::Template object: Text::Template::ERROR";
8248 $notify_template->compile()
8249 or die "can't compile template: Text::Template::ERROR";
8251 $FS::notify_template::_template::company_name =
8252 $conf->config('company_name', $self->agentnum);
8253 $FS::notify_template::_template::company_address =
8254 join("\n", $conf->config('company_address', $self->agentnum) ). "\n";
8256 my $paydate = $self->paydate || '2037-12-31';
8257 $FS::notify_template::_template::first = $self->first;
8258 $FS::notify_template::_template::last = $self->last;
8259 $FS::notify_template::_template::company = $self->company;
8260 $FS::notify_template::_template::payinfo = $self->mask_payinfo;
8261 my $payby = $self->payby;
8262 my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
8263 my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
8265 #credit cards expire at the end of the month/year of their exp date
8266 if ($payby eq 'CARD' || $payby eq 'DCRD') {
8267 $FS::notify_template::_template::payby = 'credit card';
8268 ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
8269 $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
8271 }elsif ($payby eq 'COMP') {
8272 $FS::notify_template::_template::payby = 'complimentary account';
8274 $FS::notify_template::_template::payby = 'current method';
8276 $FS::notify_template::_template::expdate = $expire_time;
8278 for (keys %{$options{extra_fields}}){
8280 ${"FS::notify_template::_template::$_"} = $options{extra_fields}->{$_};
8283 send_email(from => $from,
8285 subject => $subject,
8286 body => $notify_template->fill_in( PACKAGE =>
8287 'FS::notify_template::_template' ),
8292 =item generate_letter CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
8294 Generates a templated notification to the customer (see L<Text::Template>).
8296 OPTIONS is a hash and may include
8298 I<extra_fields> - a hashref of name/value pairs which will be substituted
8299 into the template. These values may override values mentioned below
8300 and those from the customer record.
8302 The following variables are available in the template instead of or in addition
8303 to the fields of the customer record.
8305 I<$payby> - a description of the method of payment for the customer
8306 # would be nice to use FS::payby::shortname
8307 I<$payinfo> - the masked account information used to collect for this customer
8308 I<$expdate> - the expiration of the customer payment method in seconds from epoch
8309 I<$returnaddress> - the return address defaults to invoice_latexreturnaddress or company_address
8313 sub generate_letter {
8314 my ($self, $template, %options) = @_;
8316 return unless $conf->exists($template);
8318 my $letter_template = new Text::Template
8320 SOURCE => [ map "$_\n", $conf->config($template)],
8321 DELIMITERS => [ '[@--', '--@]' ],
8323 or die "can't create new Text::Template object: Text::Template::ERROR";
8325 $letter_template->compile()
8326 or die "can't compile template: Text::Template::ERROR";
8328 my %letter_data = map { $_ => $self->$_ } $self->fields;
8329 $letter_data{payinfo} = $self->mask_payinfo;
8331 #my $paydate = $self->paydate || '2037-12-31';
8332 my $paydate = $self->paydate =~ /^\S+$/ ? $self->paydate : '2037-12-31';
8334 my $payby = $self->payby;
8335 my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
8336 my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
8338 #credit cards expire at the end of the month/year of their exp date
8339 if ($payby eq 'CARD' || $payby eq 'DCRD') {
8340 $letter_data{payby} = 'credit card';
8341 ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
8342 $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
8344 }elsif ($payby eq 'COMP') {
8345 $letter_data{payby} = 'complimentary account';
8347 $letter_data{payby} = 'current method';
8349 $letter_data{expdate} = $expire_time;
8351 for (keys %{$options{extra_fields}}){
8352 $letter_data{$_} = $options{extra_fields}->{$_};
8355 unless(exists($letter_data{returnaddress})){
8356 my $retadd = join("\n", $conf->config_orbase( 'invoice_latexreturnaddress',
8357 $self->agent_template)
8359 if ( length($retadd) ) {
8360 $letter_data{returnaddress} = $retadd;
8361 } elsif ( grep /\S/, $conf->config('company_address', $self->agentnum) ) {
8362 $letter_data{returnaddress} =
8363 join( '\\*'."\n", map s/( {2,})/'~' x length($1)/eg,
8364 $conf->config('company_address', $self->agentnum)
8367 $letter_data{returnaddress} = '~';
8371 $letter_data{conf_dir} = "$FS::UID::conf_dir/conf.$FS::UID::datasrc";
8373 $letter_data{company_name} = $conf->config('company_name', $self->agentnum);
8375 my $dir = $FS::UID::conf_dir."/cache.". $FS::UID::datasrc;
8376 my $fh = new File::Temp( TEMPLATE => 'letter.'. $self->custnum. '.XXXXXXXX',
8380 ) or die "can't open temp file: $!\n";
8382 $letter_template->fill_in( OUTPUT => $fh, HASH => \%letter_data );
8384 $fh->filename =~ /^(.*).tex$/ or die "unparsable filename: ". $fh->filename;
8388 =item print_ps TEMPLATE
8390 Returns an postscript letter filled in from TEMPLATE, as a scalar.
8396 my $file = $self->generate_letter(@_);
8397 FS::Misc::generate_ps($file);
8400 =item print TEMPLATE
8402 Prints the filled in template.
8404 TEMPLATE is the name of a L<Text::Template> to fill in and print.
8408 sub queueable_print {
8411 my $self = qsearchs('cust_main', { 'custnum' => $opt{custnum} } )
8412 or die "invalid customer number: " . $opt{custvnum};
8414 my $error = $self->print( $opt{template} );
8415 die $error if $error;
8419 my ($self, $template) = (shift, shift);
8420 do_print [ $self->print_ps($template) ];
8423 #these three subs should just go away once agent stuff is all config overrides
8425 sub agent_template {
8427 $self->_agent_plandata('agent_templatename');
8430 sub agent_invoice_from {
8432 $self->_agent_plandata('agent_invoice_from');
8435 sub _agent_plandata {
8436 my( $self, $option ) = @_;
8438 #yuck. this whole thing needs to be reconciled better with 1.9's idea of
8439 #agent-specific Conf
8441 use FS::part_event::Condition;
8443 my $agentnum = $self->agentnum;
8446 if ( driver_name =~ /^Pg/i ) {
8448 } elsif ( driver_name =~ /^mysql/i ) {
8451 die "don't know how to use regular expressions in ". driver_name. " databases";
8454 my $part_event_option =
8456 'select' => 'part_event_option.*',
8457 'table' => 'part_event_option',
8459 LEFT JOIN part_event USING ( eventpart )
8460 LEFT JOIN part_event_option AS peo_agentnum
8461 ON ( part_event.eventpart = peo_agentnum.eventpart
8462 AND peo_agentnum.optionname = 'agentnum'
8463 AND peo_agentnum.optionvalue }. $regexp. q{ '(^|,)}. $agentnum. q{(,|$)'
8465 LEFT JOIN part_event_condition
8466 ON ( part_event.eventpart = part_event_condition.eventpart
8467 AND part_event_condition.conditionname = 'cust_bill_age'
8469 LEFT JOIN part_event_condition_option
8470 ON ( part_event_condition.eventconditionnum = part_event_condition_option.eventconditionnum
8471 AND part_event_condition_option.optionname = 'age'
8474 #'hashref' => { 'optionname' => $option },
8475 #'hashref' => { 'part_event_option.optionname' => $option },
8477 " WHERE part_event_option.optionname = ". dbh->quote($option).
8478 " AND action = 'cust_bill_send_agent' ".
8479 " AND ( disabled IS NULL OR disabled != 'Y' ) ".
8480 " AND peo_agentnum.optionname = 'agentnum' ".
8481 " AND ( agentnum IS NULL OR agentnum = $agentnum ) ".
8483 CASE WHEN part_event_condition_option.optionname IS NULL
8485 ELSE ". FS::part_event::Condition->age2seconds_sql('part_event_condition_option.optionvalue').
8487 , part_event.weight".
8491 unless ( $part_event_option ) {
8492 return $self->agent->invoice_template || ''
8493 if $option eq 'agent_templatename';
8497 $part_event_option->optionvalue;
8502 ## actual sub, not a method, designed to be called from the queue.
8503 ## sets up the customer, and calls the bill_and_collect
8504 my (%args) = @_; #, ($time, $invoice_time, $check_freq, $resetup) = @_;
8505 my $cust_main = qsearchs( 'cust_main', { custnum => $args{'custnum'} } );
8506 $cust_main->bill_and_collect(
8511 sub _upgrade_data { #class method
8512 my ($class, %opts) = @_;
8514 my $sql = 'UPDATE h_cust_main SET paycvv = NULL WHERE paycvv IS NOT NULL';
8515 my $sth = dbh->prepare($sql) or die dbh->errstr;
8516 $sth->execute or die $sth->errstr;
8526 The delete method should possibly take an FS::cust_main object reference
8527 instead of a scalar customer number.
8529 Bill and collect options should probably be passed as references instead of a
8532 There should probably be a configuration file with a list of allowed credit
8535 No multiple currency support (probably a larger project than just this module).
8537 payinfo_masked false laziness with cust_pay.pm and cust_refund.pm
8539 Birthdates rely on negative epoch values.
8541 The payby for card/check batches is broken. With mixed batching, bad
8544 B<collect> I<invoice_time> should be renamed I<time>, like B<bill>.
8548 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
8549 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
8550 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.