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;
43 use FS::cust_main_exemption;
45 use FS::tax_rate_location;
46 use FS::cust_tax_location;
47 use FS::part_pkg_taxrate;
49 use FS::cust_main_invoice;
50 use FS::cust_credit_bill;
51 use FS::cust_bill_pay;
52 use FS::prepay_credit;
56 use FS::part_event_condition;
59 use FS::payment_gateway;
60 use FS::agent_payment_gateway;
62 use FS::payinfo_Mixin;
65 @ISA = qw( FS::payinfo_Mixin FS::Record );
67 @EXPORT_OK = qw( smart_search );
69 $realtime_bop_decline_quiet = 0;
71 # 1 is mostly method/subroutine entry and options
72 # 2 traces progress of some operations
73 # 3 is even more information including possibly sensitive data
75 $me = '[FS::cust_main]';
79 $ignore_expired_card = 0;
81 @encrypted_fields = ('payinfo', 'paycvv');
82 sub nohistory_fields { ('paycvv'); }
84 @paytypes = ('', 'Personal checking', 'Personal savings', 'Business checking', 'Business savings');
86 #ask FS::UID to run this stuff for us later
87 #$FS::UID::callback{'FS::cust_main'} = sub {
88 install_callback FS::UID sub {
90 #yes, need it for stuff below (prolly should be cached)
95 my ( $hashref, $cache ) = @_;
96 if ( exists $hashref->{'pkgnum'} ) {
97 #@{ $self->{'_pkgnum'} } = ();
98 my $subcache = $cache->subcache( 'pkgnum', 'cust_pkg', $hashref->{custnum});
99 $self->{'_pkgnum'} = $subcache;
100 #push @{ $self->{'_pkgnum'} },
101 FS::cust_pkg->new_or_cached($hashref, $subcache) if $hashref->{pkgnum};
107 FS::cust_main - Object methods for cust_main records
113 $record = new FS::cust_main \%hash;
114 $record = new FS::cust_main { 'column' => 'value' };
116 $error = $record->insert;
118 $error = $new_record->replace($old_record);
120 $error = $record->delete;
122 $error = $record->check;
124 @cust_pkg = $record->all_pkgs;
126 @cust_pkg = $record->ncancelled_pkgs;
128 @cust_pkg = $record->suspended_pkgs;
130 $error = $record->bill;
131 $error = $record->bill %options;
132 $error = $record->bill 'time' => $time;
134 $error = $record->collect;
135 $error = $record->collect %options;
136 $error = $record->collect 'invoice_time' => $time,
141 An FS::cust_main object represents a customer. FS::cust_main inherits from
142 FS::Record. The following fields are currently supported:
148 Primary key (assigned automatically for new customers)
152 Agent (see L<FS::agent>)
156 Advertising source (see L<FS::part_referral>)
168 Cocial security number (optional)
184 (optional, see L<FS::cust_main_county>)
188 (see L<FS::cust_main_county>)
194 (see L<FS::cust_main_county>)
230 (optional, see L<FS::cust_main_county>)
234 (see L<FS::cust_main_county>)
240 (see L<FS::cust_main_county>)
256 Payment Type (See L<FS::payinfo_Mixin> for valid payby values)
260 Payment Information (See L<FS::payinfo_Mixin> for data format)
264 Masked payinfo (See L<FS::payinfo_Mixin> for how this works)
268 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
272 Expiration date, mm/yyyy, m/yyyy, mm/yy or m/yy
276 Start date month (maestro/solo cards only)
280 Start date year (maestro/solo cards only)
284 Issue number (maestro/solo cards only)
288 Name on card or billing name
292 IP address from which payment information was received
296 Tax exempt, empty or `Y'
300 Order taker (assigned automatically, see L<FS::UID>)
306 =item referral_custnum
308 Referring customer number
312 Enable individual CDR spooling, empty or `Y'
316 A suggestion to events (see L<FS::part_bill_event">) to delay until this unix timestamp
320 Discourage individual CDR printing, empty or `Y'
330 Creates a new customer. To add the customer to the database, see L<"insert">.
332 Note that this stores the hash reference, not a distinct copy of the hash it
333 points to. You can ask the object for a copy with the I<hash> method.
337 sub table { 'cust_main'; }
339 =item insert [ CUST_PKG_HASHREF [ , INVOICING_LIST_ARYREF ] [ , OPTION => VALUE ... ] ]
341 Adds this customer to the database. If there is an error, returns the error,
342 otherwise returns false.
344 CUST_PKG_HASHREF: If you pass a Tie::RefHash data structure to the insert
345 method containing FS::cust_pkg and FS::svc_I<tablename> objects, all records
346 are inserted atomicly, or the transaction is rolled back. Passing an empty
347 hash reference is equivalent to not supplying this parameter. There should be
348 a better explanation of this, but until then, here's an example:
351 tie %hash, 'Tie::RefHash'; #this part is important
353 $cust_pkg => [ $svc_acct ],
356 $cust_main->insert( \%hash );
358 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
359 be set as the invoicing list (see L<"invoicing_list">). Errors return as
360 expected and rollback the entire transaction; it is not necessary to call
361 check_invoicing_list first. The invoicing_list is set after the records in the
362 CUST_PKG_HASHREF above are inserted, so it is now possible to set an
363 invoicing_list destination to the newly-created svc_acct. Here's an example:
365 $cust_main->insert( {}, [ $email, 'POST' ] );
367 Currently available options are: I<depend_jobnum>, I<noexport> and I<tax_exemption>.
369 If I<depend_jobnum> is set, all provisioning jobs will have a dependancy
370 on the supplied jobnum (they will not run until the specific job completes).
371 This can be used to defer provisioning until some action completes (such
372 as running the customer's credit card successfully).
374 The I<noexport> option is deprecated. If I<noexport> is set true, no
375 provisioning jobs (exports) are scheduled. (You can schedule them later with
376 the B<reexport> method.)
378 The I<tax_exemption> option can be set to an arrayref of tax names.
379 FS::cust_main_exemption records will be created and inserted.
385 my $cust_pkgs = @_ ? shift : {};
386 my $invoicing_list = @_ ? shift : '';
388 warn "$me insert called with options ".
389 join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
392 local $SIG{HUP} = 'IGNORE';
393 local $SIG{INT} = 'IGNORE';
394 local $SIG{QUIT} = 'IGNORE';
395 local $SIG{TERM} = 'IGNORE';
396 local $SIG{TSTP} = 'IGNORE';
397 local $SIG{PIPE} = 'IGNORE';
399 my $oldAutoCommit = $FS::UID::AutoCommit;
400 local $FS::UID::AutoCommit = 0;
403 my $prepay_identifier = '';
404 my( $amount, $seconds, $upbytes, $downbytes, $totalbytes ) = (0, 0, 0, 0, 0);
406 if ( $self->payby eq 'PREPAY' ) {
408 $self->payby('BILL');
409 $prepay_identifier = $self->payinfo;
412 warn " looking up prepaid card $prepay_identifier\n"
415 my $error = $self->get_prepay( $prepay_identifier,
416 'amount_ref' => \$amount,
417 'seconds_ref' => \$seconds,
418 'upbytes_ref' => \$upbytes,
419 'downbytes_ref' => \$downbytes,
420 'totalbytes_ref' => \$totalbytes,
423 $dbh->rollback if $oldAutoCommit;
424 #return "error applying prepaid card (transaction rolled back): $error";
428 $payby = 'PREP' if $amount;
430 } elsif ( $self->payby =~ /^(CASH|WEST|MCRD)$/ ) {
433 $self->payby('BILL');
434 $amount = $self->paid;
438 warn " inserting $self\n"
441 $self->signupdate(time) unless $self->signupdate;
443 $self->auto_agent_custid()
444 if $conf->config('cust_main-auto_agent_custid') && ! $self->agent_custid;
446 my $error = $self->SUPER::insert;
448 $dbh->rollback if $oldAutoCommit;
449 #return "inserting cust_main record (transaction rolled back): $error";
453 warn " setting invoicing list\n"
456 if ( $invoicing_list ) {
457 $error = $self->check_invoicing_list( $invoicing_list );
459 $dbh->rollback if $oldAutoCommit;
460 #return "checking invoicing_list (transaction rolled back): $error";
463 $self->invoicing_list( $invoicing_list );
466 warn " setting cust_main_exemption\n"
469 my $tax_exemption = delete $options{'tax_exemption'};
470 if ( $tax_exemption ) {
471 foreach my $taxname ( @$tax_exemption ) {
472 my $cust_main_exemption = new FS::cust_main_exemption {
473 'custnum' => $self->custnum,
474 'taxname' => $taxname,
476 my $error = $cust_main_exemption->insert;
478 $dbh->rollback if $oldAutoCommit;
479 return "inserting cust_main_exemption (transaction rolled back): $error";
484 if ( $conf->config('cust_main-skeleton_tables')
485 && $conf->config('cust_main-skeleton_custnum') ) {
487 warn " inserting skeleton records\n"
490 my $error = $self->start_copy_skel;
492 $dbh->rollback if $oldAutoCommit;
498 warn " ordering packages\n"
501 $error = $self->order_pkgs( $cust_pkgs,
503 'seconds_ref' => \$seconds,
504 'upbytes_ref' => \$upbytes,
505 'downbytes_ref' => \$downbytes,
506 'totalbytes_ref' => \$totalbytes,
509 $dbh->rollback if $oldAutoCommit;
514 $dbh->rollback if $oldAutoCommit;
515 return "No svc_acct record to apply pre-paid time";
517 if ( $upbytes || $downbytes || $totalbytes ) {
518 $dbh->rollback if $oldAutoCommit;
519 return "No svc_acct record to apply pre-paid data";
523 warn " inserting initial $payby payment of $amount\n"
525 $error = $self->insert_cust_pay($payby, $amount, $prepay_identifier);
527 $dbh->rollback if $oldAutoCommit;
528 return "inserting payment (transaction rolled back): $error";
532 unless ( $import || $skip_fuzzyfiles ) {
533 warn " queueing fuzzyfiles update\n"
535 $error = $self->queue_fuzzyfiles_update;
537 $dbh->rollback if $oldAutoCommit;
538 return "updating fuzzy search cache: $error";
542 warn " insert complete; committing transaction\n"
545 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
550 use File::CounterFile;
551 sub auto_agent_custid {
554 my $format = $conf->config('cust_main-auto_agent_custid');
556 if ( $format eq '1YMMXXXXXXXX' ) {
558 my $counter = new File::CounterFile 'cust_main.agent_custid';
561 my $ym = 100000000000 + time2str('%y%m00000000', time);
562 if ( $ym > $counter->value ) {
563 $counter->{'value'} = $agent_custid = $ym;
564 $counter->{'updated'} = 1;
566 $agent_custid = $counter->inc;
572 die "Unknown cust_main-auto_agent_custid format: $format";
575 $self->agent_custid($agent_custid);
579 sub start_copy_skel {
582 #'mg_user_preference' => {},
583 #'mg_user_indicator_profile.user_indicator_profile_id' => { 'mg_profile_indicator.profile_indicator_id' => { 'mg_profile_details.profile_detail_id' }, },
584 #'mg_watchlist_header.watchlist_header_id' => { 'mg_watchlist_details.watchlist_details_id' },
585 #'mg_user_grid_header.grid_header_id' => { 'mg_user_grid_details.user_grid_details_id' },
586 #'mg_portfolio_header.portfolio_header_id' => { 'mg_portfolio_trades.portfolio_trades_id' => { 'mg_portfolio_trades_positions.portfolio_trades_positions_id' } },
587 my @tables = eval(join('\n',$conf->config('cust_main-skeleton_tables')));
590 _copy_skel( 'cust_main', #tablename
591 $conf->config('cust_main-skeleton_custnum'), #sourceid
592 $self->custnum, #destid
593 @tables, #child tables
597 #recursive subroutine, not a method
599 my( $table, $sourceid, $destid, %child_tables ) = @_;
602 if ( $table =~ /^(\w+)\.(\w+)$/ ) {
603 ( $table, $primary_key ) = ( $1, $2 );
605 my $dbdef_table = dbdef->table($table);
606 $primary_key = $dbdef_table->primary_key
607 or return "$table has no primary key".
608 " (or do you need to run dbdef-create?)";
611 warn " _copy_skel: $table.$primary_key $sourceid to $destid for ".
612 join (', ', keys %child_tables). "\n"
615 foreach my $child_table_def ( keys %child_tables ) {
619 if ( $child_table_def =~ /^(\w+)\.(\w+)$/ ) {
620 ( $child_table, $child_pkey ) = ( $1, $2 );
622 $child_table = $child_table_def;
624 $child_pkey = dbdef->table($child_table)->primary_key;
625 # or return "$table has no primary key".
626 # " (or do you need to run dbdef-create?)\n";
630 if ( keys %{ $child_tables{$child_table_def} } ) {
632 return "$child_table has no primary key".
633 " (run dbdef-create or try specifying it?)\n"
636 #false laziness w/Record::insert and only works on Pg
637 #refactor the proper last-inserted-id stuff out of Record::insert if this
638 # ever gets use for anything besides a quick kludge for one customer
639 my $default = dbdef->table($child_table)->column($child_pkey)->default;
640 $default =~ /^nextval\(\(?'"?([\w\.]+)"?'/i
641 or return "can't parse $child_table.$child_pkey default value ".
642 " for sequence name: $default";
647 my @sel_columns = grep { $_ ne $primary_key }
648 dbdef->table($child_table)->columns;
649 my $sel_columns = join(', ', @sel_columns );
651 my @ins_columns = grep { $_ ne $child_pkey } @sel_columns;
652 my $ins_columns = ' ( '. join(', ', $primary_key, @ins_columns ). ' ) ';
653 my $placeholders = ' ( ?, '. join(', ', map '?', @ins_columns ). ' ) ';
655 my $sel_st = "SELECT $sel_columns FROM $child_table".
656 " WHERE $primary_key = $sourceid";
659 my $sel_sth = dbh->prepare( $sel_st )
660 or return dbh->errstr;
662 $sel_sth->execute or return $sel_sth->errstr;
664 while ( my $row = $sel_sth->fetchrow_hashref ) {
666 warn " selected row: ".
667 join(', ', map { "$_=".$row->{$_} } keys %$row ). "\n"
671 "INSERT INTO $child_table $ins_columns VALUES $placeholders";
672 my $ins_sth =dbh->prepare($statement)
673 or return dbh->errstr;
674 my @param = ( $destid, map $row->{$_}, @ins_columns );
675 warn " $statement: [ ". join(', ', @param). " ]\n"
677 $ins_sth->execute( @param )
678 or return $ins_sth->errstr;
680 #next unless keys %{ $child_tables{$child_table} };
681 next unless $sequence;
683 #another section of that laziness
684 my $seq_sql = "SELECT currval('$sequence')";
685 my $seq_sth = dbh->prepare($seq_sql) or return dbh->errstr;
686 $seq_sth->execute or return $seq_sth->errstr;
687 my $insertid = $seq_sth->fetchrow_arrayref->[0];
689 # don't drink soap! recurse! recurse! okay!
691 _copy_skel( $child_table_def,
692 $row->{$child_pkey}, #sourceid
694 %{ $child_tables{$child_table_def} },
696 return $error if $error;
706 =item order_pkg HASHREF | OPTION => VALUE ...
708 Orders a single package.
710 Options may be passed as a list of key/value pairs or as a hash reference.
721 Optional FS::cust_location object
725 Optional arryaref of FS::svc_* service objects.
729 If this option is set to a job queue jobnum (see L<FS::queue>), all provisioning
730 jobs will have a dependancy on the supplied job (they will not run until the
731 specific job completes). This can be used to defer provisioning until some
732 action completes (such as running the customer's credit card successfully).
736 Optional subject for a ticket created and attached to this customer
740 Optional queue name for ticket additions
748 my $opt = ref($_[0]) ? shift : { @_ };
750 warn "$me order_pkg called with options ".
751 join(', ', map { "$_: $opt->{$_}" } keys %$opt ). "\n"
754 my $cust_pkg = $opt->{'cust_pkg'};
755 my $svcs = $opt->{'svcs'} || [];
757 my %svc_options = ();
758 $svc_options{'depend_jobnum'} = $opt->{'depend_jobnum'}
759 if exists($opt->{'depend_jobnum'}) && $opt->{'depend_jobnum'};
761 my %insert_params = map { $opt->{$_} ? ( $_ => $opt->{$_} ) : () }
762 qw( ticket_subject ticket_queue );
764 local $SIG{HUP} = 'IGNORE';
765 local $SIG{INT} = 'IGNORE';
766 local $SIG{QUIT} = 'IGNORE';
767 local $SIG{TERM} = 'IGNORE';
768 local $SIG{TSTP} = 'IGNORE';
769 local $SIG{PIPE} = 'IGNORE';
771 my $oldAutoCommit = $FS::UID::AutoCommit;
772 local $FS::UID::AutoCommit = 0;
775 if ( $opt->{'cust_location'} &&
776 ( ! $cust_pkg->locationnum || $cust_pkg->locationnum == -1 ) ) {
777 my $error = $opt->{'cust_location'}->insert;
779 $dbh->rollback if $oldAutoCommit;
780 return "inserting cust_location (transaction rolled back): $error";
782 $cust_pkg->locationnum($opt->{'cust_location'}->locationnum);
785 $cust_pkg->custnum( $self->custnum );
787 my $error = $cust_pkg->insert( %insert_params );
789 $dbh->rollback if $oldAutoCommit;
790 return "inserting cust_pkg (transaction rolled back): $error";
793 foreach my $svc_something ( @{ $opt->{'svcs'} } ) {
794 if ( $svc_something->svcnum ) {
795 my $old_cust_svc = $svc_something->cust_svc;
796 my $new_cust_svc = new FS::cust_svc { $old_cust_svc->hash };
797 $new_cust_svc->pkgnum( $cust_pkg->pkgnum);
798 $error = $new_cust_svc->replace($old_cust_svc);
800 $svc_something->pkgnum( $cust_pkg->pkgnum );
801 if ( $svc_something->isa('FS::svc_acct') ) {
802 foreach ( grep { $opt->{$_.'_ref'} && ${ $opt->{$_.'_ref'} } }
803 qw( seconds upbytes downbytes totalbytes ) ) {
804 $svc_something->$_( $svc_something->$_() + ${ $opt->{$_.'_ref'} } );
805 ${ $opt->{$_.'_ref'} } = 0;
808 $error = $svc_something->insert(%svc_options);
811 $dbh->rollback if $oldAutoCommit;
812 return "inserting svc_ (transaction rolled back): $error";
816 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
821 #deprecated #=item order_pkgs HASHREF [ , SECONDSREF ] [ , OPTION => VALUE ... ]
822 =item order_pkgs HASHREF [ , OPTION => VALUE ... ]
824 Like the insert method on an existing record, this method orders multiple
825 packages and included services atomicaly. Pass a Tie::RefHash data structure
826 to this method containing FS::cust_pkg and FS::svc_I<tablename> objects.
827 There should be a better explanation of this, but until then, here's an
831 tie %hash, 'Tie::RefHash'; #this part is important
833 $cust_pkg => [ $svc_acct ],
836 $cust_main->order_pkgs( \%hash, 'noexport'=>1 );
838 Services can be new, in which case they are inserted, or existing unaudited
839 services, in which case they are linked to the newly-created package.
841 Currently available options are: I<depend_jobnum>, I<noexport>, I<seconds_ref>,
842 I<upbytes_ref>, I<downbytes_ref>, and I<totalbytes_ref>.
844 If I<depend_jobnum> is set, all provisioning jobs will have a dependancy
845 on the supplied jobnum (they will not run until the specific job completes).
846 This can be used to defer provisioning until some action completes (such
847 as running the customer's credit card successfully).
849 The I<noexport> option is deprecated. If I<noexport> is set true, no
850 provisioning jobs (exports) are scheduled. (You can schedule them later with
851 the B<reexport> method for each cust_pkg object. Using the B<reexport> method
852 on the cust_main object is not recommended, as existing services will also be
855 If I<seconds_ref>, I<upbytes_ref>, I<downbytes_ref>, or I<totalbytes_ref> is
856 provided, the scalars (provided by references) will be incremented by the
857 values of the prepaid card.`
863 my $cust_pkgs = shift;
864 my $seconds_ref = ref($_[0]) ? shift : ''; #deprecated
866 $seconds_ref ||= $options{'seconds_ref'};
868 warn "$me order_pkgs called with options ".
869 join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
872 local $SIG{HUP} = 'IGNORE';
873 local $SIG{INT} = 'IGNORE';
874 local $SIG{QUIT} = 'IGNORE';
875 local $SIG{TERM} = 'IGNORE';
876 local $SIG{TSTP} = 'IGNORE';
877 local $SIG{PIPE} = 'IGNORE';
879 my $oldAutoCommit = $FS::UID::AutoCommit;
880 local $FS::UID::AutoCommit = 0;
883 local $FS::svc_Common::noexport_hack = 1 if $options{'noexport'};
885 foreach my $cust_pkg ( keys %$cust_pkgs ) {
887 my $error = $self->order_pkg(
888 'cust_pkg' => $cust_pkg,
889 'svcs' => $cust_pkgs->{$cust_pkg},
890 'seconds_ref' => $seconds_ref,
891 map { $_ => $options{$_} } qw( upbytes_ref downbytes_ref totalbytes_ref
896 $dbh->rollback if $oldAutoCommit;
902 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
906 =item recharge_prepay IDENTIFIER | PREPAY_CREDIT_OBJ [ , AMOUNTREF, SECONDSREF, UPBYTEREF, DOWNBYTEREF ]
908 Recharges this (existing) customer with the specified prepaid card (see
909 L<FS::prepay_credit>), specified either by I<identifier> or as an
910 FS::prepay_credit object. If there is an error, returns the error, otherwise
913 Optionally, five scalar references can be passed as well. They will have their
914 values filled in with the amount, number of seconds, and number of upload,
915 download, and total bytes applied by this prepaid card.
919 #the ref bullshit here should be refactored like get_prepay. MyAccount.pm is
920 #the only place that uses these args
921 sub recharge_prepay {
922 my( $self, $prepay_credit, $amountref, $secondsref,
923 $upbytesref, $downbytesref, $totalbytesref ) = @_;
925 local $SIG{HUP} = 'IGNORE';
926 local $SIG{INT} = 'IGNORE';
927 local $SIG{QUIT} = 'IGNORE';
928 local $SIG{TERM} = 'IGNORE';
929 local $SIG{TSTP} = 'IGNORE';
930 local $SIG{PIPE} = 'IGNORE';
932 my $oldAutoCommit = $FS::UID::AutoCommit;
933 local $FS::UID::AutoCommit = 0;
936 my( $amount, $seconds, $upbytes, $downbytes, $totalbytes) = ( 0, 0, 0, 0, 0 );
938 my $error = $self->get_prepay( $prepay_credit,
939 'amount_ref' => \$amount,
940 'seconds_ref' => \$seconds,
941 'upbytes_ref' => \$upbytes,
942 'downbytes_ref' => \$downbytes,
943 'totalbytes_ref' => \$totalbytes,
945 || $self->increment_seconds($seconds)
946 || $self->increment_upbytes($upbytes)
947 || $self->increment_downbytes($downbytes)
948 || $self->increment_totalbytes($totalbytes)
949 || $self->insert_cust_pay_prepay( $amount,
951 ? $prepay_credit->identifier
956 $dbh->rollback if $oldAutoCommit;
960 if ( defined($amountref) ) { $$amountref = $amount; }
961 if ( defined($secondsref) ) { $$secondsref = $seconds; }
962 if ( defined($upbytesref) ) { $$upbytesref = $upbytes; }
963 if ( defined($downbytesref) ) { $$downbytesref = $downbytes; }
964 if ( defined($totalbytesref) ) { $$totalbytesref = $totalbytes; }
966 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
971 =item get_prepay IDENTIFIER | PREPAY_CREDIT_OBJ [ , OPTION => VALUE ... ]
973 Looks up and deletes a prepaid card (see L<FS::prepay_credit>),
974 specified either by I<identifier> or as an FS::prepay_credit object.
976 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
977 incremented by the values of the prepaid card.
979 If the prepaid card specifies an I<agentnum> (see L<FS::agent>), it is used to
980 check or set this customer's I<agentnum>.
982 If there is an error, returns the error, otherwise returns false.
988 my( $self, $prepay_credit, %opt ) = @_;
990 local $SIG{HUP} = 'IGNORE';
991 local $SIG{INT} = 'IGNORE';
992 local $SIG{QUIT} = 'IGNORE';
993 local $SIG{TERM} = 'IGNORE';
994 local $SIG{TSTP} = 'IGNORE';
995 local $SIG{PIPE} = 'IGNORE';
997 my $oldAutoCommit = $FS::UID::AutoCommit;
998 local $FS::UID::AutoCommit = 0;
1001 unless ( ref($prepay_credit) ) {
1003 my $identifier = $prepay_credit;
1005 $prepay_credit = qsearchs(
1007 { 'identifier' => $prepay_credit },
1012 unless ( $prepay_credit ) {
1013 $dbh->rollback if $oldAutoCommit;
1014 return "Invalid prepaid card: ". $identifier;
1019 if ( $prepay_credit->agentnum ) {
1020 if ( $self->agentnum && $self->agentnum != $prepay_credit->agentnum ) {
1021 $dbh->rollback if $oldAutoCommit;
1022 return "prepaid card not valid for agent ". $self->agentnum;
1024 $self->agentnum($prepay_credit->agentnum);
1027 my $error = $prepay_credit->delete;
1029 $dbh->rollback if $oldAutoCommit;
1030 return "removing prepay_credit (transaction rolled back): $error";
1033 ${ $opt{$_.'_ref'} } += $prepay_credit->$_()
1034 for grep $opt{$_.'_ref'}, qw( amount seconds upbytes downbytes totalbytes );
1036 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1041 =item increment_upbytes SECONDS
1043 Updates this customer's single or primary account (see L<FS::svc_acct>) by
1044 the specified number of upbytes. If there is an error, returns the error,
1045 otherwise returns false.
1049 sub increment_upbytes {
1050 _increment_column( shift, 'upbytes', @_);
1053 =item increment_downbytes SECONDS
1055 Updates this customer's single or primary account (see L<FS::svc_acct>) by
1056 the specified number of downbytes. If there is an error, returns the error,
1057 otherwise returns false.
1061 sub increment_downbytes {
1062 _increment_column( shift, 'downbytes', @_);
1065 =item increment_totalbytes SECONDS
1067 Updates this customer's single or primary account (see L<FS::svc_acct>) by
1068 the specified number of totalbytes. If there is an error, returns the error,
1069 otherwise returns false.
1073 sub increment_totalbytes {
1074 _increment_column( shift, 'totalbytes', @_);
1077 =item increment_seconds SECONDS
1079 Updates this customer's single or primary account (see L<FS::svc_acct>) by
1080 the specified number of seconds. If there is an error, returns the error,
1081 otherwise returns false.
1085 sub increment_seconds {
1086 _increment_column( shift, 'seconds', @_);
1089 =item _increment_column AMOUNT
1091 Updates this customer's single or primary account (see L<FS::svc_acct>) by
1092 the specified number of seconds or bytes. If there is an error, returns
1093 the error, otherwise returns false.
1097 sub _increment_column {
1098 my( $self, $column, $amount ) = @_;
1099 warn "$me increment_column called: $column, $amount\n"
1102 return '' unless $amount;
1104 my @cust_pkg = grep { $_->part_pkg->svcpart('svc_acct') }
1105 $self->ncancelled_pkgs;
1107 if ( ! @cust_pkg ) {
1108 return 'No packages with primary or single services found'.
1109 ' to apply pre-paid time';
1110 } elsif ( scalar(@cust_pkg) > 1 ) {
1111 #maybe have a way to specify the package/account?
1112 return 'Multiple packages found to apply pre-paid time';
1115 my $cust_pkg = $cust_pkg[0];
1116 warn " found package pkgnum ". $cust_pkg->pkgnum. "\n"
1120 $cust_pkg->cust_svc( $cust_pkg->part_pkg->svcpart('svc_acct') );
1122 if ( ! @cust_svc ) {
1123 return 'No account found to apply pre-paid time';
1124 } elsif ( scalar(@cust_svc) > 1 ) {
1125 return 'Multiple accounts found to apply pre-paid time';
1128 my $svc_acct = $cust_svc[0]->svc_x;
1129 warn " found service svcnum ". $svc_acct->pkgnum.
1130 ' ('. $svc_acct->email. ")\n"
1133 $column = "increment_$column";
1134 $svc_acct->$column($amount);
1138 =item insert_cust_pay_prepay AMOUNT [ PAYINFO ]
1140 Inserts a prepayment in the specified amount for this customer. An optional
1141 second argument can specify the prepayment identifier for tracking purposes.
1142 If there is an error, returns the error, otherwise returns false.
1146 sub insert_cust_pay_prepay {
1147 shift->insert_cust_pay('PREP', @_);
1150 =item insert_cust_pay_cash AMOUNT [ PAYINFO ]
1152 Inserts a cash payment in the specified amount for this customer. An optional
1153 second argument can specify the payment identifier for tracking purposes.
1154 If there is an error, returns the error, otherwise returns false.
1158 sub insert_cust_pay_cash {
1159 shift->insert_cust_pay('CASH', @_);
1162 =item insert_cust_pay_west AMOUNT [ PAYINFO ]
1164 Inserts a Western Union payment in the specified amount for this customer. An
1165 optional second argument can specify the prepayment identifier for tracking
1166 purposes. If there is an error, returns the error, otherwise returns false.
1170 sub insert_cust_pay_west {
1171 shift->insert_cust_pay('WEST', @_);
1174 sub insert_cust_pay {
1175 my( $self, $payby, $amount ) = splice(@_, 0, 3);
1176 my $payinfo = scalar(@_) ? shift : '';
1178 my $cust_pay = new FS::cust_pay {
1179 'custnum' => $self->custnum,
1180 'paid' => sprintf('%.2f', $amount),
1181 #'_date' => #date the prepaid card was purchased???
1183 'payinfo' => $payinfo,
1191 This method is deprecated. See the I<depend_jobnum> option to the insert and
1192 order_pkgs methods for a better way to defer provisioning.
1194 Re-schedules all exports by calling the B<reexport> method of all associated
1195 packages (see L<FS::cust_pkg>). If there is an error, returns the error;
1196 otherwise returns false.
1203 carp "WARNING: FS::cust_main::reexport is deprectated; ".
1204 "use the depend_jobnum option to insert or order_pkgs to delay export";
1206 local $SIG{HUP} = 'IGNORE';
1207 local $SIG{INT} = 'IGNORE';
1208 local $SIG{QUIT} = 'IGNORE';
1209 local $SIG{TERM} = 'IGNORE';
1210 local $SIG{TSTP} = 'IGNORE';
1211 local $SIG{PIPE} = 'IGNORE';
1213 my $oldAutoCommit = $FS::UID::AutoCommit;
1214 local $FS::UID::AutoCommit = 0;
1217 foreach my $cust_pkg ( $self->ncancelled_pkgs ) {
1218 my $error = $cust_pkg->reexport;
1220 $dbh->rollback if $oldAutoCommit;
1225 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1230 =item delete NEW_CUSTNUM
1232 This deletes the customer. If there is an error, returns the error, otherwise
1235 This will completely remove all traces of the customer record. This is not
1236 what you want when a customer cancels service; for that, cancel all of the
1237 customer's packages (see L</cancel>).
1239 If the customer has any uncancelled packages, you need to pass a new (valid)
1240 customer number for those packages to be transferred to. Cancelled packages
1241 will be deleted. Did I mention that this is NOT what you want when a customer
1242 cancels service and that you really should be looking see L<FS::cust_pkg/cancel>?
1244 You can't delete a customer with invoices (see L<FS::cust_bill>),
1245 or credits (see L<FS::cust_credit>), payments (see L<FS::cust_pay>) or
1246 refunds (see L<FS::cust_refund>).
1253 local $SIG{HUP} = 'IGNORE';
1254 local $SIG{INT} = 'IGNORE';
1255 local $SIG{QUIT} = 'IGNORE';
1256 local $SIG{TERM} = 'IGNORE';
1257 local $SIG{TSTP} = 'IGNORE';
1258 local $SIG{PIPE} = 'IGNORE';
1260 my $oldAutoCommit = $FS::UID::AutoCommit;
1261 local $FS::UID::AutoCommit = 0;
1264 if ( $self->cust_bill ) {
1265 $dbh->rollback if $oldAutoCommit;
1266 return "Can't delete a customer with invoices";
1268 if ( $self->cust_credit ) {
1269 $dbh->rollback if $oldAutoCommit;
1270 return "Can't delete a customer with credits";
1272 if ( $self->cust_pay ) {
1273 $dbh->rollback if $oldAutoCommit;
1274 return "Can't delete a customer with payments";
1276 if ( $self->cust_refund ) {
1277 $dbh->rollback if $oldAutoCommit;
1278 return "Can't delete a customer with refunds";
1281 my @cust_pkg = $self->ncancelled_pkgs;
1283 my $new_custnum = shift;
1284 unless ( qsearchs( 'cust_main', { 'custnum' => $new_custnum } ) ) {
1285 $dbh->rollback if $oldAutoCommit;
1286 return "Invalid new customer number: $new_custnum";
1288 foreach my $cust_pkg ( @cust_pkg ) {
1289 my %hash = $cust_pkg->hash;
1290 $hash{'custnum'} = $new_custnum;
1291 my $new_cust_pkg = new FS::cust_pkg ( \%hash );
1292 my $error = $new_cust_pkg->replace($cust_pkg,
1293 options => { $cust_pkg->options },
1296 $dbh->rollback if $oldAutoCommit;
1301 my @cancelled_cust_pkg = $self->all_pkgs;
1302 foreach my $cust_pkg ( @cancelled_cust_pkg ) {
1303 my $error = $cust_pkg->delete;
1305 $dbh->rollback if $oldAutoCommit;
1310 foreach my $cust_main_invoice ( #(email invoice destinations, not invoices)
1311 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } )
1313 my $error = $cust_main_invoice->delete;
1315 $dbh->rollback if $oldAutoCommit;
1320 foreach my $cust_main_exemption (
1321 qsearch( 'cust_main_exemption', { 'custnum' => $self->custnum } )
1323 my $error = $cust_main_exemption->delete;
1325 $dbh->rollback if $oldAutoCommit;
1330 my $error = $self->SUPER::delete;
1332 $dbh->rollback if $oldAutoCommit;
1336 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1341 =item replace [ OLD_RECORD ] [ INVOICING_LIST_ARYREF ] [ , OPTION => VALUE ... ] ]
1344 Replaces the OLD_RECORD with this one in the database. If there is an error,
1345 returns the error, otherwise returns false.
1347 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
1348 be set as the invoicing list (see L<"invoicing_list">). Errors return as
1349 expected and rollback the entire transaction; it is not necessary to call
1350 check_invoicing_list first. Here's an example:
1352 $new_cust_main->replace( $old_cust_main, [ $email, 'POST' ] );
1354 Currently available options are: I<tax_exemption>.
1356 The I<tax_exemption> option can be set to an arrayref of tax names.
1357 FS::cust_main_exemption records will be deleted and inserted as appropriate.
1364 my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
1366 : $self->replace_old;
1370 warn "$me replace called\n"
1373 my $curuser = $FS::CurrentUser::CurrentUser;
1374 if ( $self->payby eq 'COMP'
1375 && $self->payby ne $old->payby
1376 && ! $curuser->access_right('Complimentary customer')
1379 return "You are not permitted to create complimentary accounts.";
1382 local($ignore_expired_card) = 1
1383 if $old->payby =~ /^(CARD|DCRD)$/
1384 && $self->payby =~ /^(CARD|DCRD)$/
1385 && ( $old->payinfo eq $self->payinfo || $old->paymask eq $self->paymask );
1387 local $SIG{HUP} = 'IGNORE';
1388 local $SIG{INT} = 'IGNORE';
1389 local $SIG{QUIT} = 'IGNORE';
1390 local $SIG{TERM} = 'IGNORE';
1391 local $SIG{TSTP} = 'IGNORE';
1392 local $SIG{PIPE} = 'IGNORE';
1394 my $oldAutoCommit = $FS::UID::AutoCommit;
1395 local $FS::UID::AutoCommit = 0;
1398 my $error = $self->SUPER::replace($old);
1401 $dbh->rollback if $oldAutoCommit;
1405 if ( @param && ref($param[0]) eq 'ARRAY' ) { # INVOICING_LIST_ARYREF
1406 my $invoicing_list = shift @param;
1407 $error = $self->check_invoicing_list( $invoicing_list );
1409 $dbh->rollback if $oldAutoCommit;
1412 $self->invoicing_list( $invoicing_list );
1415 my %options = @param;
1417 my $tax_exemption = delete $options{'tax_exemption'};
1418 if ( $tax_exemption ) {
1420 my %cust_main_exemption =
1421 map { $_->taxname => $_ }
1422 qsearch('cust_main_exemption', { 'custnum' => $old->custnum } );
1424 foreach my $taxname ( @$tax_exemption ) {
1426 next if delete $cust_main_exemption{$taxname};
1428 my $cust_main_exemption = new FS::cust_main_exemption {
1429 'custnum' => $self->custnum,
1430 'taxname' => $taxname,
1432 my $error = $cust_main_exemption->insert;
1434 $dbh->rollback if $oldAutoCommit;
1435 return "inserting cust_main_exemption (transaction rolled back): $error";
1439 foreach my $cust_main_exemption ( values %cust_main_exemption ) {
1440 my $error = $cust_main_exemption->delete;
1442 $dbh->rollback if $oldAutoCommit;
1443 return "deleting cust_main_exemption (transaction rolled back): $error";
1449 if ( $self->payby =~ /^(CARD|CHEK|LECB)$/ &&
1450 grep { $self->get($_) ne $old->get($_) } qw(payinfo paydate payname) ) {
1451 # card/check/lec info has changed, want to retry realtime_ invoice events
1452 my $error = $self->retry_realtime;
1454 $dbh->rollback if $oldAutoCommit;
1459 unless ( $import || $skip_fuzzyfiles ) {
1460 $error = $self->queue_fuzzyfiles_update;
1462 $dbh->rollback if $oldAutoCommit;
1463 return "updating fuzzy search cache: $error";
1467 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1472 =item queue_fuzzyfiles_update
1474 Used by insert & replace to update the fuzzy search cache
1478 sub queue_fuzzyfiles_update {
1481 local $SIG{HUP} = 'IGNORE';
1482 local $SIG{INT} = 'IGNORE';
1483 local $SIG{QUIT} = 'IGNORE';
1484 local $SIG{TERM} = 'IGNORE';
1485 local $SIG{TSTP} = 'IGNORE';
1486 local $SIG{PIPE} = 'IGNORE';
1488 my $oldAutoCommit = $FS::UID::AutoCommit;
1489 local $FS::UID::AutoCommit = 0;
1492 my $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
1493 my $error = $queue->insert( map $self->getfield($_),
1494 qw(first last company)
1497 $dbh->rollback if $oldAutoCommit;
1498 return "queueing job (transaction rolled back): $error";
1501 if ( $self->ship_last ) {
1502 $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
1503 $error = $queue->insert( map $self->getfield("ship_$_"),
1504 qw(first last company)
1507 $dbh->rollback if $oldAutoCommit;
1508 return "queueing job (transaction rolled back): $error";
1512 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1519 Checks all fields to make sure this is a valid customer record. If there is
1520 an error, returns the error, otherwise returns false. Called by the insert
1521 and replace methods.
1528 warn "$me check BEFORE: \n". $self->_dump
1532 $self->ut_numbern('custnum')
1533 || $self->ut_number('agentnum')
1534 || $self->ut_textn('agent_custid')
1535 || $self->ut_number('refnum')
1536 || $self->ut_textn('custbatch')
1537 || $self->ut_name('last')
1538 || $self->ut_name('first')
1539 || $self->ut_snumbern('birthdate')
1540 || $self->ut_snumbern('signupdate')
1541 || $self->ut_textn('company')
1542 || $self->ut_text('address1')
1543 || $self->ut_textn('address2')
1544 || $self->ut_text('city')
1545 || $self->ut_textn('county')
1546 || $self->ut_textn('state')
1547 || $self->ut_country('country')
1548 || $self->ut_anything('comments')
1549 || $self->ut_numbern('referral_custnum')
1550 || $self->ut_textn('stateid')
1551 || $self->ut_textn('stateid_state')
1552 || $self->ut_textn('invoice_terms')
1553 || $self->ut_alphan('geocode')
1556 #barf. need message catalogs. i18n. etc.
1557 $error .= "Please select an advertising source."
1558 if $error =~ /^Illegal or empty \(numeric\) refnum: /;
1559 return $error if $error;
1561 return "Unknown agent"
1562 unless qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
1564 return "Unknown refnum"
1565 unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } );
1567 return "Unknown referring custnum: ". $self->referral_custnum
1568 unless ! $self->referral_custnum
1569 || qsearchs( 'cust_main', { 'custnum' => $self->referral_custnum } );
1571 if ( $self->ss eq '' ) {
1576 $ss =~ /^(\d{3})(\d{2})(\d{4})$/
1577 or return "Illegal social security number: ". $self->ss;
1578 $self->ss("$1-$2-$3");
1582 # bad idea to disable, causes billing to fail because of no tax rates later
1583 # unless ( $import ) {
1584 unless ( qsearch('cust_main_county', {
1585 'country' => $self->country,
1588 return "Unknown state/county/country: ".
1589 $self->state. "/". $self->county. "/". $self->country
1590 unless qsearch('cust_main_county',{
1591 'state' => $self->state,
1592 'county' => $self->county,
1593 'country' => $self->country,
1599 $self->ut_phonen('daytime', $self->country)
1600 || $self->ut_phonen('night', $self->country)
1601 || $self->ut_phonen('fax', $self->country)
1602 || $self->ut_zip('zip', $self->country)
1604 return $error if $error;
1606 if ( $conf->exists('cust_main-require_phone')
1607 && ! length($self->daytime) && ! length($self->night)
1610 my $daytime_label = FS::Msgcat::_gettext('daytime') =~ /^(daytime)?$/
1612 : FS::Msgcat::_gettext('daytime');
1613 my $night_label = FS::Msgcat::_gettext('night') =~ /^(night)?$/
1615 : FS::Msgcat::_gettext('night');
1617 return "$daytime_label or $night_label is required"
1621 if ( $self->has_ship_address
1622 && scalar ( grep { $self->getfield($_) ne $self->getfield("ship_$_") }
1623 $self->addr_fields )
1627 $self->ut_name('ship_last')
1628 || $self->ut_name('ship_first')
1629 || $self->ut_textn('ship_company')
1630 || $self->ut_text('ship_address1')
1631 || $self->ut_textn('ship_address2')
1632 || $self->ut_text('ship_city')
1633 || $self->ut_textn('ship_county')
1634 || $self->ut_textn('ship_state')
1635 || $self->ut_country('ship_country')
1637 return $error if $error;
1639 #false laziness with above
1640 unless ( qsearchs('cust_main_county', {
1641 'country' => $self->ship_country,
1644 return "Unknown ship_state/ship_county/ship_country: ".
1645 $self->ship_state. "/". $self->ship_county. "/". $self->ship_country
1646 unless qsearch('cust_main_county',{
1647 'state' => $self->ship_state,
1648 'county' => $self->ship_county,
1649 'country' => $self->ship_country,
1655 $self->ut_phonen('ship_daytime', $self->ship_country)
1656 || $self->ut_phonen('ship_night', $self->ship_country)
1657 || $self->ut_phonen('ship_fax', $self->ship_country)
1658 || $self->ut_zip('ship_zip', $self->ship_country)
1660 return $error if $error;
1662 return "Unit # is required."
1663 if $self->ship_address2 =~ /^\s*$/
1664 && $conf->exists('cust_main-require_address2');
1666 } else { # ship_ info eq billing info, so don't store dup info in database
1668 $self->setfield("ship_$_", '')
1669 foreach $self->addr_fields;
1671 return "Unit # is required."
1672 if $self->address2 =~ /^\s*$/
1673 && $conf->exists('cust_main-require_address2');
1677 #$self->payby =~ /^(CARD|DCRD|CHEK|DCHK|LECB|BILL|COMP|PREPAY|CASH|WEST|MCRD)$/
1678 # or return "Illegal payby: ". $self->payby;
1680 FS::payby->can_payby($self->table, $self->payby)
1681 or return "Illegal payby: ". $self->payby;
1683 $error = $self->ut_numbern('paystart_month')
1684 || $self->ut_numbern('paystart_year')
1685 || $self->ut_numbern('payissue')
1686 || $self->ut_textn('paytype')
1688 return $error if $error;
1690 if ( $self->payip eq '' ) {
1693 $error = $self->ut_ip('payip');
1694 return $error if $error;
1697 # If it is encrypted and the private key is not availaible then we can't
1698 # check the credit card.
1700 my $check_payinfo = 1;
1702 if ($self->is_encrypted($self->payinfo)) {
1706 if ( $check_payinfo && $self->payby =~ /^(CARD|DCRD)$/ ) {
1708 my $payinfo = $self->payinfo;
1709 $payinfo =~ s/\D//g;
1710 $payinfo =~ /^(\d{13,16})$/
1711 or return gettext('invalid_card'); # . ": ". $self->payinfo;
1713 $self->payinfo($payinfo);
1715 or return gettext('invalid_card'); # . ": ". $self->payinfo;
1717 return gettext('unknown_card_type')
1718 if cardtype($self->payinfo) eq "Unknown";
1720 my $ban = qsearchs('banned_pay', $self->_banned_pay_hashref);
1722 return 'Banned credit card: banned on '.
1723 time2str('%a %h %o at %r', $ban->_date).
1724 ' by '. $ban->otaker.
1725 ' (ban# '. $ban->bannum. ')';
1728 if (length($self->paycvv) && !$self->is_encrypted($self->paycvv)) {
1729 if ( cardtype($self->payinfo) eq 'American Express card' ) {
1730 $self->paycvv =~ /^(\d{4})$/
1731 or return "CVV2 (CID) for American Express cards is four digits.";
1734 $self->paycvv =~ /^(\d{3})$/
1735 or return "CVV2 (CVC2/CID) is three digits.";
1742 my $cardtype = cardtype($payinfo);
1743 if ( $cardtype =~ /^(Switch|Solo)$/i ) {
1745 return "Start date or issue number is required for $cardtype cards"
1746 unless $self->paystart_month && $self->paystart_year or $self->payissue;
1748 return "Start month must be between 1 and 12"
1749 if $self->paystart_month
1750 and $self->paystart_month < 1 || $self->paystart_month > 12;
1752 return "Start year must be 1990 or later"
1753 if $self->paystart_year
1754 and $self->paystart_year < 1990;
1756 return "Issue number must be beween 1 and 99"
1758 and $self->payissue < 1 || $self->payissue > 99;
1761 $self->paystart_month('');
1762 $self->paystart_year('');
1763 $self->payissue('');
1766 } elsif ( $check_payinfo && $self->payby =~ /^(CHEK|DCHK)$/ ) {
1768 my $payinfo = $self->payinfo;
1769 $payinfo =~ s/[^\d\@]//g;
1770 if ( $conf->exists('echeck-nonus') ) {
1771 $payinfo =~ /^(\d+)\@(\d+)$/ or return 'invalid echeck account@aba';
1772 $payinfo = "$1\@$2";
1774 $payinfo =~ /^(\d+)\@(\d{9})$/ or return 'invalid echeck account@aba';
1775 $payinfo = "$1\@$2";
1777 $self->payinfo($payinfo);
1780 my $ban = qsearchs('banned_pay', $self->_banned_pay_hashref);
1782 return 'Banned ACH account: banned on '.
1783 time2str('%a %h %o at %r', $ban->_date).
1784 ' by '. $ban->otaker.
1785 ' (ban# '. $ban->bannum. ')';
1788 } elsif ( $self->payby eq 'LECB' ) {
1790 my $payinfo = $self->payinfo;
1791 $payinfo =~ s/\D//g;
1792 $payinfo =~ /^1?(\d{10})$/ or return 'invalid btn billing telephone number';
1794 $self->payinfo($payinfo);
1797 } elsif ( $self->payby eq 'BILL' ) {
1799 $error = $self->ut_textn('payinfo');
1800 return "Illegal P.O. number: ". $self->payinfo if $error;
1803 } elsif ( $self->payby eq 'COMP' ) {
1805 my $curuser = $FS::CurrentUser::CurrentUser;
1806 if ( ! $self->custnum
1807 && ! $curuser->access_right('Complimentary customer')
1810 return "You are not permitted to create complimentary accounts."
1813 $error = $self->ut_textn('payinfo');
1814 return "Illegal comp account issuer: ". $self->payinfo if $error;
1817 } elsif ( $self->payby eq 'PREPAY' ) {
1819 my $payinfo = $self->payinfo;
1820 $payinfo =~ s/\W//g; #anything else would just confuse things
1821 $self->payinfo($payinfo);
1822 $error = $self->ut_alpha('payinfo');
1823 return "Illegal prepayment identifier: ". $self->payinfo if $error;
1824 return "Unknown prepayment identifier"
1825 unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } );
1830 if ( $self->paydate eq '' || $self->paydate eq '-' ) {
1831 return "Expiration date required"
1832 unless $self->payby =~ /^(BILL|PREPAY|CHEK|DCHK|LECB|CASH|WEST|MCRD)$/;
1836 if ( $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/ ) {
1837 ( $m, $y ) = ( $1, length($2) == 4 ? $2 : "20$2" );
1838 } elsif ( $self->paydate =~ /^(20)?(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) {
1839 ( $m, $y ) = ( $3, "20$2" );
1841 return "Illegal expiration date: ". $self->paydate;
1843 $self->paydate("$y-$m-01");
1844 my($nowm,$nowy)=(localtime(time))[4,5]; $nowm++; $nowy+=1900;
1845 return gettext('expired_card')
1847 && !$ignore_expired_card
1848 && ( $y<$nowy || ( $y==$nowy && $1<$nowm ) );
1851 if ( $self->payname eq '' && $self->payby !~ /^(CHEK|DCHK)$/ &&
1852 ( ! $conf->exists('require_cardname')
1853 || $self->payby !~ /^(CARD|DCRD)$/ )
1855 $self->payname( $self->first. " ". $self->getfield('last') );
1857 $self->payname =~ /^([\w \,\.\-\'\&]+)$/
1858 or return gettext('illegal_name'). " payname: ". $self->payname;
1862 foreach my $flag (qw( tax spool_cdr squelch_cdr archived )) {
1863 $self->$flag() =~ /^(Y?)$/ or return "Illegal $flag: ". $self->$flag();
1867 $self->otaker(getotaker) unless $self->otaker;
1869 warn "$me check AFTER: \n". $self->_dump
1872 $self->SUPER::check;
1877 Returns a list of fields which have ship_ duplicates.
1882 qw( last first company
1883 address1 address2 city county state zip country
1888 =item has_ship_address
1890 Returns true if this customer record has a separate shipping address.
1894 sub has_ship_address {
1896 scalar( grep { $self->getfield("ship_$_") ne '' } $self->addr_fields );
1899 =item all_pkgs [ EXTRA_QSEARCH_PARAMS_HASHREF ]
1901 Returns all packages (see L<FS::cust_pkg>) for this customer.
1907 my $extra_qsearch = ref($_[0]) ? shift : {};
1909 return $self->num_pkgs unless wantarray || keys(%$extra_qsearch);
1912 if ( $self->{'_pkgnum'} ) {
1913 @cust_pkg = values %{ $self->{'_pkgnum'}->cache };
1915 @cust_pkg = $self->_cust_pkg($extra_qsearch);
1918 sort sort_packages @cust_pkg;
1923 Synonym for B<all_pkgs>.
1928 shift->all_pkgs(@_);
1933 Returns all locations (see L<FS::cust_location>) for this customer.
1939 qsearch('cust_location', { 'custnum' => $self->custnum } );
1942 =item ncancelled_pkgs [ EXTRA_QSEARCH_PARAMS_HASHREF ]
1944 Returns all non-cancelled packages (see L<FS::cust_pkg>) for this customer.
1948 sub ncancelled_pkgs {
1950 my $extra_qsearch = ref($_[0]) ? shift : {};
1952 return $self->num_ncancelled_pkgs unless wantarray;
1955 if ( $self->{'_pkgnum'} ) {
1957 warn "$me ncancelled_pkgs: returning cached objects"
1960 @cust_pkg = grep { ! $_->getfield('cancel') }
1961 values %{ $self->{'_pkgnum'}->cache };
1965 warn "$me ncancelled_pkgs: searching for packages with custnum ".
1966 $self->custnum. "\n"
1969 $extra_qsearch->{'extra_sql'} .= ' AND ( cancel IS NULL OR cancel = 0 ) ';
1971 @cust_pkg = $self->_cust_pkg($extra_qsearch);
1975 sort sort_packages @cust_pkg;
1981 my $extra_qsearch = ref($_[0]) ? shift : {};
1983 $extra_qsearch->{'select'} ||= '*';
1984 $extra_qsearch->{'select'} .=
1985 ',( SELECT COUNT(*) FROM cust_svc WHERE cust_pkg.pkgnum = cust_svc.pkgnum )
1989 $_->{'_num_cust_svc'} = $_->get('_num_cust_svc');
1994 'table' => 'cust_pkg',
1995 'hashref' => { 'custnum' => $self->custnum },
2000 # This should be generalized to use config options to determine order.
2003 if ( $a->get('cancel') xor $b->get('cancel') ) {
2004 return -1 if $b->get('cancel');
2005 return 1 if $a->get('cancel');
2006 #shouldn't get here...
2009 my $a_num_cust_svc = $a->num_cust_svc;
2010 my $b_num_cust_svc = $b->num_cust_svc;
2011 return 0 if !$a_num_cust_svc && !$b_num_cust_svc;
2012 return -1 if $a_num_cust_svc && !$b_num_cust_svc;
2013 return 1 if !$a_num_cust_svc && $b_num_cust_svc;
2014 my @a_cust_svc = $a->cust_svc;
2015 my @b_cust_svc = $b->cust_svc;
2016 $a_cust_svc[0]->svc_x->label cmp $b_cust_svc[0]->svc_x->label;
2021 =item suspended_pkgs
2023 Returns all suspended packages (see L<FS::cust_pkg>) for this customer.
2027 sub suspended_pkgs {
2029 grep { $_->susp } $self->ncancelled_pkgs;
2032 =item unflagged_suspended_pkgs
2034 Returns all unflagged suspended packages (see L<FS::cust_pkg>) for this
2035 customer (thouse packages without the `manual_flag' set).
2039 sub unflagged_suspended_pkgs {
2041 return $self->suspended_pkgs
2042 unless dbdef->table('cust_pkg')->column('manual_flag');
2043 grep { ! $_->manual_flag } $self->suspended_pkgs;
2046 =item unsuspended_pkgs
2048 Returns all unsuspended (and uncancelled) packages (see L<FS::cust_pkg>) for
2053 sub unsuspended_pkgs {
2055 grep { ! $_->susp } $self->ncancelled_pkgs;
2058 =item num_cancelled_pkgs
2060 Returns the number of cancelled packages (see L<FS::cust_pkg>) for this
2065 sub num_cancelled_pkgs {
2066 shift->num_pkgs("cust_pkg.cancel IS NOT NULL AND cust_pkg.cancel != 0");
2069 sub num_ncancelled_pkgs {
2070 shift->num_pkgs("( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )");
2074 my( $self ) = shift;
2075 my $sql = scalar(@_) ? shift : '';
2076 $sql = "AND $sql" if $sql && $sql !~ /^\s*$/ && $sql !~ /^\s*AND/i;
2077 my $sth = dbh->prepare(
2078 "SELECT COUNT(*) FROM cust_pkg WHERE custnum = ? $sql"
2079 ) or die dbh->errstr;
2080 $sth->execute($self->custnum) or die $sth->errstr;
2081 $sth->fetchrow_arrayref->[0];
2086 Unsuspends all unflagged suspended packages (see L</unflagged_suspended_pkgs>
2087 and L<FS::cust_pkg>) for this customer. Always returns a list: an empty list
2088 on success or a list of errors.
2094 grep { $_->unsuspend } $self->suspended_pkgs;
2099 Suspends all unsuspended packages (see L<FS::cust_pkg>) for this customer.
2101 Returns a list: an empty list on success or a list of errors.
2107 grep { $_->suspend(@_) } $self->unsuspended_pkgs;
2110 =item suspend_if_pkgpart HASHREF | PKGPART [ , PKGPART ... ]
2112 Suspends all unsuspended packages (see L<FS::cust_pkg>) matching the listed
2113 PKGPARTs (see L<FS::part_pkg>). Preferred usage is to pass a hashref instead
2114 of a list of pkgparts; the hashref has the following keys:
2118 =item pkgparts - listref of pkgparts
2120 =item (other options are passed to the suspend method)
2125 Returns a list: an empty list on success or a list of errors.
2129 sub suspend_if_pkgpart {
2131 my (@pkgparts, %opt);
2132 if (ref($_[0]) eq 'HASH'){
2133 @pkgparts = @{$_[0]{pkgparts}};
2138 grep { $_->suspend(%opt) }
2139 grep { my $pkgpart = $_->pkgpart; grep { $pkgpart eq $_ } @pkgparts }
2140 $self->unsuspended_pkgs;
2143 =item suspend_unless_pkgpart HASHREF | PKGPART [ , PKGPART ... ]
2145 Suspends all unsuspended packages (see L<FS::cust_pkg>) unless they match the
2146 given PKGPARTs (see L<FS::part_pkg>). Preferred usage is to pass a hashref
2147 instead of a list of pkgparts; the hashref has the following keys:
2151 =item pkgparts - listref of pkgparts
2153 =item (other options are passed to the suspend method)
2157 Returns a list: an empty list on success or a list of errors.
2161 sub suspend_unless_pkgpart {
2163 my (@pkgparts, %opt);
2164 if (ref($_[0]) eq 'HASH'){
2165 @pkgparts = @{$_[0]{pkgparts}};
2170 grep { $_->suspend(%opt) }
2171 grep { my $pkgpart = $_->pkgpart; ! grep { $pkgpart eq $_ } @pkgparts }
2172 $self->unsuspended_pkgs;
2175 =item cancel [ OPTION => VALUE ... ]
2177 Cancels all uncancelled packages (see L<FS::cust_pkg>) for this customer.
2179 Available options are:
2183 =item quiet - can be set true to supress email cancellation notices.
2185 =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.
2187 =item ban - can be set true to ban this customer's credit card or ACH information, if present.
2191 Always returns a list: an empty list on success or a list of errors.
2196 my( $self, %opt ) = @_;
2198 warn "$me cancel called on customer ". $self->custnum. " with options ".
2199 join(', ', map { "$_: $opt{$_}" } keys %opt ). "\n"
2202 return ( 'access denied' )
2203 unless $FS::CurrentUser::CurrentUser->access_right('Cancel customer');
2205 if ( $opt{'ban'} && $self->payby =~ /^(CARD|DCRD|CHEK|DCHK)$/ ) {
2207 #should try decryption (we might have the private key)
2208 # and if not maybe queue a job for the server that does?
2209 return ( "Can't (yet) ban encrypted credit cards" )
2210 if $self->is_encrypted($self->payinfo);
2212 my $ban = new FS::banned_pay $self->_banned_pay_hashref;
2213 my $error = $ban->insert;
2214 return ( $error ) if $error;
2218 my @pkgs = $self->ncancelled_pkgs;
2220 warn "$me cancelling ". scalar($self->ncancelled_pkgs). "/".
2221 scalar(@pkgs). " packages for customer ". $self->custnum. "\n"
2224 grep { $_ } map { $_->cancel(%opt) } $self->ncancelled_pkgs;
2227 sub _banned_pay_hashref {
2238 'payby' => $payby2ban{$self->payby},
2239 'payinfo' => md5_base64($self->payinfo),
2240 #don't ever *search* on reason! #'reason' =>
2246 Returns all notes (see L<FS::cust_main_note>) for this customer.
2253 qsearch( 'cust_main_note',
2254 { 'custnum' => $self->custnum },
2256 'ORDER BY _DATE DESC'
2262 Returns the agent (see L<FS::agent>) for this customer.
2268 qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
2271 =item bill_and_collect
2273 Cancels and suspends any packages due, generates bills, applies payments and
2276 Warns on errors (Does not currently: If there is an error, returns the error, otherwise returns false.)
2278 Options are passed as name-value pairs. Currently available options are:
2284 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:
2288 $cust_main->bill( 'time' => str2time('April 20th, 2001') );
2292 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.
2296 "1d" for the traditional, daily events (the default), or "1m" for the new monthly events (part_event.check_freq)
2300 If set true, re-charges setup fees.
2304 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)
2310 sub bill_and_collect {
2311 my( $self, %options ) = @_;
2313 #$options{actual_time} not $options{time} because freeside-daily -d is for
2314 #pre-printing invoices
2315 $self->cancel_expired_pkgs( $options{actual_time} );
2316 $self->suspend_adjourned_pkgs( $options{actual_time} );
2318 my $error = $self->bill( %options );
2319 warn "Error billing, custnum ". $self->custnum. ": $error" if $error;
2321 $self->apply_payments_and_credits;
2323 unless ( $conf->exists('cancelled_cust-noevents')
2324 && ! $self->num_ncancelled_pkgs
2327 $error = $self->collect( %options );
2328 warn "Error collecting, custnum". $self->custnum. ": $error" if $error;
2334 sub cancel_expired_pkgs {
2335 my ( $self, $time ) = @_;
2337 my @cancel_pkgs = $self->ncancelled_pkgs( {
2338 'extra_sql' => " AND expire IS NOT NULL AND expire > 0 AND expire <= $time "
2341 foreach my $cust_pkg ( @cancel_pkgs ) {
2342 my $cpr = $cust_pkg->last_cust_pkg_reason('expire');
2343 my $error = $cust_pkg->cancel($cpr ? ( 'reason' => $cpr->reasonnum,
2344 'reason_otaker' => $cpr->otaker
2348 warn "Error cancelling expired pkg ". $cust_pkg->pkgnum.
2349 " for custnum ". $self->custnum. ": $error"
2355 sub suspend_adjourned_pkgs {
2356 my ( $self, $time ) = @_;
2358 my @susp_pkgs = $self->ncancelled_pkgs( {
2360 " AND ( susp IS NULL OR susp = 0 )
2361 AND ( ( bill IS NOT NULL AND bill != 0 AND bill < $time )
2362 OR ( adjourn IS NOT NULL AND adjourn != 0 AND adjourn <= $time )
2367 #only because there's no SQL test for is_prepaid :/
2369 grep { ( $_->part_pkg->is_prepaid
2374 && $_->adjourn <= $time
2380 foreach my $cust_pkg ( @susp_pkgs ) {
2381 my $cpr = $cust_pkg->last_cust_pkg_reason('adjourn')
2382 if ($cust_pkg->adjourn && $cust_pkg->adjourn < $^T);
2383 my $error = $cust_pkg->suspend($cpr ? ( 'reason' => $cpr->reasonnum,
2384 'reason_otaker' => $cpr->otaker
2389 warn "Error suspending package ". $cust_pkg->pkgnum.
2390 " for custnum ". $self->custnum. ": $error"
2398 Generates invoices (see L<FS::cust_bill>) for this customer. Usually used in
2399 conjunction with the collect method by calling B<bill_and_collect>.
2401 If there is an error, returns the error, otherwise returns false.
2403 Options are passed as name-value pairs. Currently available options are:
2409 If set true, re-charges setup fees.
2413 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:
2417 $cust_main->bill( 'time' => str2time('April 20th, 2001') );
2421 An array ref of specific packages (objects) to attempt billing, instead trying all of them.
2423 $cust_main->bill( pkg_list => [$pkg1, $pkg2] );
2427 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.
2434 my( $self, %options ) = @_;
2435 return '' if $self->payby eq 'COMP';
2436 warn "$me bill customer ". $self->custnum. "\n"
2439 my $time = $options{'time'} || time;
2440 my $invoice_time = $options{'invoice_time'} || $time;
2443 local $SIG{HUP} = 'IGNORE';
2444 local $SIG{INT} = 'IGNORE';
2445 local $SIG{QUIT} = 'IGNORE';
2446 local $SIG{TERM} = 'IGNORE';
2447 local $SIG{TSTP} = 'IGNORE';
2448 local $SIG{PIPE} = 'IGNORE';
2450 my $oldAutoCommit = $FS::UID::AutoCommit;
2451 local $FS::UID::AutoCommit = 0;
2454 $self->select_for_update; #mutex
2456 my @cust_bill_pkg = ();
2459 # find the packages which are due for billing, find out how much they are
2460 # & generate invoice database.
2463 my( $total_setup, $total_recur, $postal_charge ) = ( 0, 0, 0 );
2465 my @precommit_hooks = ();
2467 foreach my $cust_pkg ( $self->ncancelled_pkgs ) {
2469 warn " bill package ". $cust_pkg->pkgnum. "\n" if $DEBUG > 1;
2471 #? to avoid use of uninitialized value errors... ?
2472 $cust_pkg->setfield('bill', '')
2473 unless defined($cust_pkg->bill);
2475 #my $part_pkg = $cust_pkg->part_pkg;
2477 my $real_pkgpart = $cust_pkg->pkgpart;
2478 my %hash = $cust_pkg->hash;
2480 foreach my $part_pkg ( $cust_pkg->part_pkg->self_and_bill_linked ) {
2482 $cust_pkg->set($_, $hash{$_}) foreach qw ( setup last_bill bill );
2485 $self->_make_lines( 'part_pkg' => $part_pkg,
2486 'cust_pkg' => $cust_pkg,
2487 'precommit_hooks' => \@precommit_hooks,
2488 'line_items' => \@cust_bill_pkg,
2489 'setup' => \$total_setup,
2490 'recur' => \$total_recur,
2491 'tax_matrix' => \%taxlisthash,
2493 'options' => \%options,
2496 $dbh->rollback if $oldAutoCommit;
2500 } #foreach my $part_pkg
2502 } #foreach my $cust_pkg
2504 unless ( @cust_bill_pkg ) { #don't create an invoice w/o line items
2505 #but do commit any package date cycling that happened
2506 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2510 if ( scalar( grep { $_->recur && $_->recur > 0 } @cust_bill_pkg) ||
2511 !$conf->exists('postal_invoice-recurring_only')
2515 my $postal_pkg = $self->charge_postal_fee();
2516 if ( $postal_pkg && !ref( $postal_pkg ) ) {
2518 $dbh->rollback if $oldAutoCommit;
2519 return "can't charge postal invoice fee for customer ".
2520 $self->custnum. ": $postal_pkg";
2522 } elsif ( $postal_pkg ) {
2524 foreach my $part_pkg ( $postal_pkg->part_pkg->self_and_bill_linked ) {
2526 $self->_make_lines( 'part_pkg' => $part_pkg,
2527 'cust_pkg' => $postal_pkg,
2528 'precommit_hooks' => \@precommit_hooks,
2529 'line_items' => \@cust_bill_pkg,
2530 'setup' => \$total_setup,
2531 'recur' => \$total_recur,
2532 'tax_matrix' => \%taxlisthash,
2534 'options' => \%options,
2537 $dbh->rollback if $oldAutoCommit;
2546 warn "having a look at the taxes we found...\n" if $DEBUG > 2;
2548 # keys are tax names (as printed on invoices / itemdesc )
2549 # values are listrefs of taxlisthash keys (internal identifiers)
2552 # keys are taxlisthash keys (internal identifiers)
2553 # values are (cumulative) amounts
2556 # keys are taxlisthash keys (internal identifiers)
2557 # values are listrefs of cust_bill_pkg_tax_location hashrefs
2558 my %tax_location = ();
2560 # keys are taxlisthash keys (internal identifiers)
2561 # values are listrefs of cust_bill_pkg_tax_rate_location hashrefs
2562 my %tax_rate_location = ();
2564 foreach my $tax ( keys %taxlisthash ) {
2565 my $tax_object = shift @{ $taxlisthash{$tax} };
2566 warn "found ". $tax_object->taxname. " as $tax\n" if $DEBUG > 2;
2567 warn " ". join('/', @{ $taxlisthash{$tax} } ). "\n" if $DEBUG > 2;
2568 my $hashref_or_error =
2569 $tax_object->taxline( $taxlisthash{$tax},
2570 'custnum' => $self->custnum,
2571 'invoice_time' => $invoice_time
2573 unless ( ref($hashref_or_error) ) {
2574 $dbh->rollback if $oldAutoCommit;
2575 return $hashref_or_error;
2577 unshift @{ $taxlisthash{$tax} }, $tax_object;
2579 my $name = $hashref_or_error->{'name'};
2580 my $amount = $hashref_or_error->{'amount'};
2582 #warn "adding $amount as $name\n";
2583 $taxname{ $name } ||= [];
2584 push @{ $taxname{ $name } }, $tax;
2586 $tax{ $tax } += $amount;
2588 $tax_location{ $tax } ||= [];
2589 if ( $tax_object->get('pkgnum') || $tax_object->get('locationnum') ) {
2590 push @{ $tax_location{ $tax } },
2592 'taxnum' => $tax_object->taxnum,
2593 'taxtype' => ref($tax_object),
2594 'pkgnum' => $tax_object->get('pkgnum'),
2595 'locationnum' => $tax_object->get('locationnum'),
2596 'amount' => sprintf('%.2f', $amount ),
2600 $tax_rate_location{ $tax } ||= [];
2601 if ( ref($tax_object) eq 'FS::tax_rate' ) {
2602 my $taxratelocationnum =
2603 $tax_object->tax_rate_location->taxratelocationnum;
2604 push @{ $tax_rate_location{ $tax } },
2606 'taxnum' => $tax_object->taxnum,
2607 'taxtype' => ref($tax_object),
2608 'amount' => sprintf('%.2f', $amount ),
2609 'locationtaxid' => $tax_object->location,
2610 'taxratelocationnum' => $taxratelocationnum,
2616 #move the cust_tax_exempt_pkg records to the cust_bill_pkgs we will commit
2617 my %packagemap = map { $_->pkgnum => $_ } @cust_bill_pkg;
2618 foreach my $tax ( keys %taxlisthash ) {
2619 foreach ( @{ $taxlisthash{$tax} }[1 ... scalar(@{ $taxlisthash{$tax} })] ) {
2620 next unless ref($_) eq 'FS::cust_bill_pkg';
2622 push @{ $packagemap{$_->pkgnum}->_cust_tax_exempt_pkg },
2623 splice( @{ $_->_cust_tax_exempt_pkg } );
2627 #consolidate and create tax line items
2628 warn "consolidating and generating...\n" if $DEBUG > 2;
2629 foreach my $taxname ( keys %taxname ) {
2632 my @cust_bill_pkg_tax_location = ();
2633 my @cust_bill_pkg_tax_rate_location = ();
2634 warn "adding $taxname\n" if $DEBUG > 1;
2635 foreach my $taxitem ( @{ $taxname{$taxname} } ) {
2636 next if $seen{$taxitem}++;
2637 warn "adding $tax{$taxitem}\n" if $DEBUG > 1;
2638 $tax += $tax{$taxitem};
2639 push @cust_bill_pkg_tax_location,
2640 map { new FS::cust_bill_pkg_tax_location $_ }
2641 @{ $tax_location{ $taxitem } };
2642 push @cust_bill_pkg_tax_rate_location,
2643 map { new FS::cust_bill_pkg_tax_rate_location $_ }
2644 @{ $tax_rate_location{ $taxitem } };
2648 $tax = sprintf('%.2f', $tax );
2649 $total_setup = sprintf('%.2f', $total_setup+$tax );
2651 push @cust_bill_pkg, new FS::cust_bill_pkg {
2657 'itemdesc' => $taxname,
2658 'cust_bill_pkg_tax_location' => \@cust_bill_pkg_tax_location,
2659 'cust_bill_pkg_tax_rate_location' => \@cust_bill_pkg_tax_rate_location,
2664 my $charged = sprintf('%.2f', $total_setup + $total_recur );
2666 #create the new invoice
2667 my $cust_bill = new FS::cust_bill ( {
2668 'custnum' => $self->custnum,
2669 '_date' => ( $invoice_time ),
2670 'charged' => $charged,
2672 my $error = $cust_bill->insert;
2674 $dbh->rollback if $oldAutoCommit;
2675 return "can't create invoice for customer #". $self->custnum. ": $error";
2678 foreach my $cust_bill_pkg ( @cust_bill_pkg ) {
2679 $cust_bill_pkg->invnum($cust_bill->invnum);
2680 my $error = $cust_bill_pkg->insert;
2682 $dbh->rollback if $oldAutoCommit;
2683 return "can't create invoice line item: $error";
2688 foreach my $hook ( @precommit_hooks ) {
2690 &{$hook}; #($self) ?
2693 $dbh->rollback if $oldAutoCommit;
2694 return "$@ running precommit hook $hook\n";
2698 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2704 my ($self, %params) = @_;
2706 my $part_pkg = $params{part_pkg} or die "no part_pkg specified";
2707 my $cust_pkg = $params{cust_pkg} or die "no cust_pkg specified";
2708 my $precommit_hooks = $params{precommit_hooks} or die "no package specified";
2709 my $cust_bill_pkgs = $params{line_items} or die "no line buffer specified";
2710 my $total_setup = $params{setup} or die "no setup accumulator specified";
2711 my $total_recur = $params{recur} or die "no recur accumulator specified";
2712 my $taxlisthash = $params{tax_matrix} or die "no tax accumulator specified";
2713 my $time = $params{'time'} or die "no time specified";
2714 my (%options) = %{$params{options}};
2717 my $real_pkgpart = $cust_pkg->pkgpart;
2718 my %hash = $cust_pkg->hash;
2719 my $old_cust_pkg = new FS::cust_pkg \%hash;
2725 $cust_pkg->pkgpart($part_pkg->pkgpart);
2733 if ( ! $cust_pkg->setup &&
2735 ( $conf->exists('disable_setup_suspended_pkgs') &&
2736 ! $cust_pkg->getfield('susp')
2737 ) || ! $conf->exists('disable_setup_suspended_pkgs')
2739 || $options{'resetup'}
2742 warn " bill setup\n" if $DEBUG > 1;
2745 $setup = eval { $cust_pkg->calc_setup( $time, \@details ) };
2746 return "$@ running calc_setup for $cust_pkg\n"
2749 $unitsetup = $cust_pkg->part_pkg->unit_setup || $setup; #XXX uuh
2751 $cust_pkg->setfield('setup', $time)
2752 unless $cust_pkg->setup;
2753 #do need it, but it won't get written to the db
2754 #|| $cust_pkg->pkgpart != $real_pkgpart;
2759 # bill recurring fee
2762 #XXX unit stuff here too
2766 if ( ! $cust_pkg->getfield('susp') and
2767 ( $part_pkg->getfield('freq') ne '0' &&
2768 ( $cust_pkg->getfield('bill') || 0 ) <= $time
2770 || ( $part_pkg->plan eq 'voip_cdr'
2771 && $part_pkg->option('bill_every_call')
2775 # XXX should this be a package event? probably. events are called
2776 # at collection time at the moment, though...
2777 $part_pkg->reset_usage($cust_pkg, 'debug'=>$DEBUG)
2778 if $part_pkg->can('reset_usage');
2779 #don't want to reset usage just cause we want a line item??
2780 #&& $part_pkg->pkgpart == $real_pkgpart;
2782 warn " bill recur\n" if $DEBUG > 1;
2785 # XXX shared with $recur_prog
2786 $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
2788 #over two params! lets at least switch to a hashref for the rest...
2789 my $increment_next_bill = ( $part_pkg->freq ne '0'
2790 && ( $cust_pkg->getfield('bill') || 0 ) <= $time
2792 my %param = ( 'precommit_hooks' => $precommit_hooks,
2793 'increment_next_bill' => $increment_next_bill,
2796 $recur = eval { $cust_pkg->calc_recur( \$sdate, \@details, \%param ) };
2797 return "$@ running calc_recur for $cust_pkg\n"
2800 if ( $increment_next_bill ) {
2802 my $next_bill = $part_pkg->add_freq($sdate);
2803 return "unparsable frequency: ". $part_pkg->freq
2804 if $next_bill == -1;
2806 #pro-rating magic - if $recur_prog fiddled $sdate, want to use that
2807 # only for figuring next bill date, nothing else, so, reset $sdate again
2809 $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
2810 #no need, its in $hash{last_bill}# my $last_bill = $cust_pkg->last_bill;
2811 $cust_pkg->last_bill($sdate);
2813 $cust_pkg->setfield('bill', $next_bill );
2819 warn "\$setup is undefined" unless defined($setup);
2820 warn "\$recur is undefined" unless defined($recur);
2821 warn "\$cust_pkg->bill is undefined" unless defined($cust_pkg->bill);
2824 # If there's line items, create em cust_bill_pkg records
2825 # If $cust_pkg has been modified, update it (if we're a real pkgpart)
2830 if ( $cust_pkg->modified && $cust_pkg->pkgpart == $real_pkgpart ) {
2831 # hmm.. and if just the options are modified in some weird price plan?
2833 warn " package ". $cust_pkg->pkgnum. " modified; updating\n"
2836 my $error = $cust_pkg->replace( $old_cust_pkg,
2837 'options' => { $cust_pkg->options },
2839 return "Error modifying pkgnum ". $cust_pkg->pkgnum. ": $error"
2840 if $error; #just in case
2843 $setup = sprintf( "%.2f", $setup );
2844 $recur = sprintf( "%.2f", $recur );
2845 if ( $setup < 0 && ! $conf->exists('allow_negative_charges') ) {
2846 return "negative setup $setup for pkgnum ". $cust_pkg->pkgnum;
2848 if ( $recur < 0 && ! $conf->exists('allow_negative_charges') ) {
2849 return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum;
2852 if ( $setup != 0 || $recur != 0 ) {
2854 warn " charges (setup=$setup, recur=$recur); adding line items\n"
2857 my @cust_pkg_detail = map { $_->detail } $cust_pkg->cust_pkg_detail('I');
2859 warn " adding customer package invoice detail: $_\n"
2860 foreach @cust_pkg_detail;
2862 push @details, @cust_pkg_detail;
2864 my $cust_bill_pkg = new FS::cust_bill_pkg {
2865 'pkgnum' => $cust_pkg->pkgnum,
2867 'unitsetup' => $unitsetup,
2869 'unitrecur' => $unitrecur,
2870 'quantity' => $cust_pkg->quantity,
2871 'details' => \@details,
2874 if ( $part_pkg->option('recur_temporality', 1) eq 'preceding' ) {
2875 $cust_bill_pkg->sdate( $hash{last_bill} );
2876 $cust_bill_pkg->edate( $sdate - 86399 ); #60s*60m*24h-1
2877 } else { #if ( $part_pkg->option('recur_temporality', 1) eq 'upcoming' ) {
2878 $cust_bill_pkg->sdate( $sdate );
2879 $cust_bill_pkg->edate( $cust_pkg->bill );
2882 $cust_bill_pkg->pkgpart_override($part_pkg->pkgpart)
2883 unless $part_pkg->pkgpart == $real_pkgpart;
2885 $$total_setup += $setup;
2886 $$total_recur += $recur;
2893 $self->_handle_taxes($part_pkg, $taxlisthash, $cust_bill_pkg, $cust_pkg, $options{invoice_time});
2894 return $error if $error;
2896 push @$cust_bill_pkgs, $cust_bill_pkg;
2898 } #if $setup != 0 || $recur != 0
2908 my $part_pkg = shift;
2909 my $taxlisthash = shift;
2910 my $cust_bill_pkg = shift;
2911 my $cust_pkg = shift;
2912 my $invoice_time = shift;
2914 my %cust_bill_pkg = ();
2918 #push @classes, $cust_bill_pkg->usage_classes if $cust_bill_pkg->type eq 'U';
2919 push @classes, $cust_bill_pkg->usage_classes if $cust_bill_pkg->usage;
2920 push @classes, 'setup' if $cust_bill_pkg->setup;
2921 push @classes, 'recur' if $cust_bill_pkg->recur;
2923 if ( $self->tax !~ /Y/i && $self->payby ne 'COMP' ) {
2925 if ( $conf->exists('enable_taxproducts')
2926 && ( scalar($part_pkg->part_pkg_taxoverride)
2927 || $part_pkg->has_taxproduct
2932 if ( $conf->exists('tax-pkg_address') && $cust_pkg->locationnum ) {
2933 return "fatal: Can't (yet) use tax-pkg_address with taxproducts";
2936 foreach my $class (@classes) {
2937 my $err_or_ref = $self->_gather_taxes( $part_pkg, $class );
2938 return $err_or_ref unless ref($err_or_ref);
2939 $taxes{$class} = $err_or_ref;
2942 unless (exists $taxes{''}) {
2943 my $err_or_ref = $self->_gather_taxes( $part_pkg, '' );
2944 return $err_or_ref unless ref($err_or_ref);
2945 $taxes{''} = $err_or_ref;
2950 my @loc_keys = qw( state county country );
2952 if ( $conf->exists('tax-pkg_address') && $cust_pkg->locationnum ) {
2953 my $cust_location = $cust_pkg->cust_location;
2954 %taxhash = map { $_ => $cust_location->$_() } @loc_keys;
2957 ( $conf->exists('tax-ship_address') && length($self->ship_last) )
2960 %taxhash = map { $_ => $self->get("$prefix$_") } @loc_keys;
2963 $taxhash{'taxclass'} = $part_pkg->taxclass;
2965 my @taxes = qsearch( 'cust_main_county', \%taxhash );
2967 my %taxhash_elim = %taxhash;
2969 my @elim = qw( taxclass county state );
2970 while ( !scalar(@taxes) && scalar(@elim) ) {
2971 $taxhash_elim{ shift(@elim) } = '';
2972 @taxes = qsearch( 'cust_main_county', \%taxhash_elim );
2975 if ( $conf->exists('tax-pkg_address') && $cust_pkg->locationnum ) {
2977 $_->set('pkgnum', $cust_pkg->pkgnum );
2978 $_->set('locationnum', $cust_pkg->locationnum );
2982 $taxes{''} = [ @taxes ];
2983 $taxes{'setup'} = [ @taxes ];
2984 $taxes{'recur'} = [ @taxes ];
2985 $taxes{$_} = [ @taxes ] foreach (@classes);
2987 # maybe eliminate this entirely, along with all the 0% records
2990 "fatal: can't find tax rate for state/county/country/taxclass ".
2991 join('/', map $taxhash{$_}, qw(state county country taxclass) );
2994 } #if $conf->exists('enable_taxproducts') ...
2999 if ( $conf->exists('separate_usage') ) {
3000 my $section = $cust_pkg->part_pkg->option('usage_section', 'Hush!');
3001 my $summary = $cust_pkg->part_pkg->option('summarize_usage', 'Hush!');
3002 push @display, new FS::cust_bill_pkg_display { type => 'S' };
3003 push @display, new FS::cust_bill_pkg_display { type => 'R' };
3004 push @display, new FS::cust_bill_pkg_display { type => 'U',
3007 if ($section && $summary) {
3008 $display[2]->post_total('Y');
3009 push @display, new FS::cust_bill_pkg_display { type => 'U',
3014 $cust_bill_pkg->set('display', \@display);
3016 my %tax_cust_bill_pkg = $cust_bill_pkg->disintegrate;
3017 foreach my $key (keys %tax_cust_bill_pkg) {
3018 my @taxes = @{ $taxes{$key} || [] };
3019 my $tax_cust_bill_pkg = $tax_cust_bill_pkg{$key};
3021 my %localtaxlisthash = ();
3022 foreach my $tax ( @taxes ) {
3024 my $taxname = ref( $tax ). ' '. $tax->taxnum;
3025 # $taxname .= ' pkgnum'. $cust_pkg->pkgnum.
3026 # ' locationnum'. $cust_pkg->locationnum
3027 # if $conf->exists('tax-pkg_address') && $cust_pkg->locationnum;
3029 $taxlisthash->{ $taxname } ||= [ $tax ];
3030 push @{ $taxlisthash->{ $taxname } }, $tax_cust_bill_pkg;
3032 $localtaxlisthash{ $taxname } ||= [ $tax ];
3033 push @{ $localtaxlisthash{ $taxname } }, $tax_cust_bill_pkg;
3037 warn "finding taxed taxes...\n" if $DEBUG > 2;
3038 foreach my $tax ( keys %localtaxlisthash ) {
3039 my $tax_object = shift @{ $localtaxlisthash{$tax} };
3040 warn "found possible taxed tax ". $tax_object->taxname. " we call $tax\n"
3042 next unless $tax_object->can('tax_on_tax');
3044 foreach my $tot ( $tax_object->tax_on_tax( $self ) ) {
3045 my $totname = ref( $tot ). ' '. $tot->taxnum;
3047 warn "checking $totname which we call ". $tot->taxname. " as applicable\n"
3049 next unless exists( $localtaxlisthash{ $totname } ); # only increase
3051 warn "adding $totname to taxed taxes\n" if $DEBUG > 2;
3052 my $hashref_or_error =
3053 $tax_object->taxline( $localtaxlisthash{$tax},
3054 'custnum' => $self->custnum,
3055 'invoice_time' => $invoice_time,
3057 return $hashref_or_error
3058 unless ref($hashref_or_error);
3060 $taxlisthash->{ $totname } ||= [ $tot ];
3061 push @{ $taxlisthash->{ $totname } }, $hashref_or_error->{amount};
3073 my $part_pkg = shift;
3077 my $geocode = $self->geocode('cch');
3079 my @taxclassnums = map { $_->taxclassnum }
3080 $part_pkg->part_pkg_taxoverride($class);
3082 unless (@taxclassnums) {
3083 @taxclassnums = map { $_->taxclassnum }
3084 $part_pkg->part_pkg_taxrate('cch', $geocode, $class);
3086 warn "Found taxclassnum values of ". join(',', @taxclassnums)
3091 join(' OR ', map { "taxclassnum = $_" } @taxclassnums ). ")";
3093 @taxes = qsearch({ 'table' => 'tax_rate',
3094 'hashref' => { 'geocode' => $geocode, },
3095 'extra_sql' => $extra_sql,
3097 if scalar(@taxclassnums);
3099 warn "Found taxes ".
3100 join(',', map{ ref($_). " ". $_->get($_->primary_key) } @taxes). "\n"
3107 =item collect OPTIONS
3109 (Attempt to) collect money for this customer's outstanding invoices (see
3110 L<FS::cust_bill>). Usually used after the bill method.
3112 Actions are now triggered by billing events; see L<FS::part_event> and the
3113 billing events web interface. Old-style invoice events (see
3114 L<FS::part_bill_event>) have been deprecated.
3116 If there is an error, returns the error, otherwise returns false.
3118 Options are passed as name-value pairs.
3120 Currently available options are:
3126 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.
3130 Retry card/echeck/LEC transactions even when not scheduled by invoice events.
3134 set true to surpress email card/ACH decline notices.
3138 "1d" for the traditional, daily events (the default), or "1m" for the new monthly events (part_event.check_freq)
3142 allows for one time override of normal customer billing method
3146 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)
3154 my( $self, %options ) = @_;
3155 my $invoice_time = $options{'invoice_time'} || time;
3158 local $SIG{HUP} = 'IGNORE';
3159 local $SIG{INT} = 'IGNORE';
3160 local $SIG{QUIT} = 'IGNORE';
3161 local $SIG{TERM} = 'IGNORE';
3162 local $SIG{TSTP} = 'IGNORE';
3163 local $SIG{PIPE} = 'IGNORE';
3165 my $oldAutoCommit = $FS::UID::AutoCommit;
3166 local $FS::UID::AutoCommit = 0;
3169 $self->select_for_update; #mutex
3172 my $balance = $self->balance;
3173 warn "$me collect customer ". $self->custnum. ": balance $balance\n"
3176 if ( exists($options{'retry_card'}) ) {
3177 carp 'retry_card option passed to collect is deprecated; use retry';
3178 $options{'retry'} ||= $options{'retry_card'};
3180 if ( exists($options{'retry'}) && $options{'retry'} ) {
3181 my $error = $self->retry_realtime;
3183 $dbh->rollback if $oldAutoCommit;
3188 # false laziness w/pay_batch::import_results
3190 my $due_cust_event = $self->due_cust_event(
3191 'debug' => ( $options{'debug'} || 0 ),
3192 'time' => $invoice_time,
3193 'check_freq' => $options{'check_freq'},
3195 unless( ref($due_cust_event) ) {
3196 $dbh->rollback if $oldAutoCommit;
3197 return $due_cust_event;
3200 foreach my $cust_event ( @$due_cust_event ) {
3204 #re-eval event conditions (a previous event could have changed things)
3205 unless ( $cust_event->test_conditions( 'time' => $invoice_time ) ) {
3206 #don't leave stray "new/locked" records around
3207 my $error = $cust_event->delete;
3209 #gah, even with transactions
3210 $dbh->commit if $oldAutoCommit; #well.
3217 local $realtime_bop_decline_quiet = 1 if $options{'quiet'};
3218 warn " running cust_event ". $cust_event->eventnum. "\n"
3222 #if ( my $error = $cust_event->do_event(%options) ) { #XXX %options?
3223 if ( my $error = $cust_event->do_event() ) {
3224 #XXX wtf is this? figure out a proper dealio with return value
3226 # gah, even with transactions.
3227 $dbh->commit if $oldAutoCommit; #well.
3234 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3239 =item due_cust_event [ HASHREF | OPTION => VALUE ... ]
3241 Inserts database records for and returns an ordered listref of new events due
3242 for this customer, as FS::cust_event objects (see L<FS::cust_event>). If no
3243 events are due, an empty listref is returned. If there is an error, returns a
3244 scalar error message.
3246 To actually run the events, call each event's test_condition method, and if
3247 still true, call the event's do_event method.
3249 Options are passed as a hashref or as a list of name-value pairs. Available
3256 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.
3260 "Current time" for the events.
3264 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)
3268 Only return events for the specified eventtable (by default, events of all eventtables are returned)
3272 Explicitly pass the objects to be tested (typically used with eventtable).
3276 Set to true to return the objects, but not actually insert them into the
3283 sub due_cust_event {
3285 my %opt = ref($_[0]) ? %{ $_[0] } : @_;
3288 #my $DEBUG = $opt{'debug'}
3289 local($DEBUG) = $opt{'debug'}
3290 if defined($opt{'debug'}) && $opt{'debug'} > $DEBUG;
3292 warn "$me due_cust_event called with options ".
3293 join(', ', map { "$_: $opt{$_}" } keys %opt). "\n"
3296 $opt{'time'} ||= time;
3298 local $SIG{HUP} = 'IGNORE';
3299 local $SIG{INT} = 'IGNORE';
3300 local $SIG{QUIT} = 'IGNORE';
3301 local $SIG{TERM} = 'IGNORE';
3302 local $SIG{TSTP} = 'IGNORE';
3303 local $SIG{PIPE} = 'IGNORE';
3305 my $oldAutoCommit = $FS::UID::AutoCommit;
3306 local $FS::UID::AutoCommit = 0;
3309 $self->select_for_update #mutex
3310 unless $opt{testonly};
3313 # 1: find possible events (initial search)
3316 my @cust_event = ();
3318 my @eventtable = $opt{'eventtable'}
3319 ? ( $opt{'eventtable'} )
3320 : FS::part_event->eventtables_runorder;
3322 foreach my $eventtable ( @eventtable ) {
3325 if ( $opt{'objects'} ) {
3327 @objects = @{ $opt{'objects'} };
3331 #my @objects = $self->eventtable(); # sub cust_main { @{ [ $self ] }; }
3332 @objects = ( $eventtable eq 'cust_main' )
3334 : ( $self->$eventtable() );
3338 my @e_cust_event = ();
3340 my $cross = "CROSS JOIN $eventtable";
3341 $cross .= ' LEFT JOIN cust_main USING ( custnum )'
3342 unless $eventtable eq 'cust_main';
3344 foreach my $object ( @objects ) {
3346 #this first search uses the condition_sql magic for optimization.
3347 #the more possible events we can eliminate in this step the better
3349 my $cross_where = '';
3350 my $pkey = $object->primary_key;
3351 $cross_where = "$eventtable.$pkey = ". $object->$pkey();
3353 my $join = FS::part_event_condition->join_conditions_sql( $eventtable );
3355 FS::part_event_condition->where_conditions_sql( $eventtable,
3356 'time'=>$opt{'time'}
3358 my $order = FS::part_event_condition->order_conditions_sql( $eventtable );
3360 $extra_sql = "AND $extra_sql" if $extra_sql;
3362 #here is the agent virtualization
3363 $extra_sql .= " AND ( part_event.agentnum IS NULL
3364 OR part_event.agentnum = ". $self->agentnum. ' )';
3366 $extra_sql .= " $order";
3368 warn "searching for events for $eventtable ". $object->$pkey. "\n"
3369 if $opt{'debug'} > 2;
3370 my @part_event = qsearch( {
3371 'debug' => ( $opt{'debug'} > 3 ? 1 : 0 ),
3372 'select' => 'part_event.*',
3373 'table' => 'part_event',
3374 'addl_from' => "$cross $join",
3375 'hashref' => { 'check_freq' => ( $opt{'check_freq'} || '1d' ),
3376 'eventtable' => $eventtable,
3379 'extra_sql' => "AND $cross_where $extra_sql",
3383 my $pkey = $object->primary_key;
3384 warn " ". scalar(@part_event).
3385 " possible events found for $eventtable ". $object->$pkey(). "\n";
3388 push @e_cust_event, map { $_->new_cust_event($object) } @part_event;
3392 warn " ". scalar(@e_cust_event).
3393 " subtotal possible cust events found for $eventtable\n"
3396 push @cust_event, @e_cust_event;
3400 warn " ". scalar(@cust_event).
3401 " total possible cust events found in initial search\n"
3405 # 2: test conditions
3410 @cust_event = grep $_->test_conditions( 'time' => $opt{'time'},
3411 'stats_hashref' => \%unsat ),
3414 warn " ". scalar(@cust_event). " cust events left satisfying conditions\n"
3417 warn " invalid conditions not eliminated with condition_sql:\n".
3418 join('', map " $_: ".$unsat{$_}."\n", keys %unsat )
3425 unless( $opt{testonly} ) {
3426 foreach my $cust_event ( @cust_event ) {
3428 my $error = $cust_event->insert();
3430 $dbh->rollback if $oldAutoCommit;
3437 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3443 warn " returning events: ". Dumper(@cust_event). "\n"
3450 =item retry_realtime
3452 Schedules realtime / batch credit card / electronic check / LEC billing
3453 events for for retry. Useful if card information has changed or manual
3454 retry is desired. The 'collect' method must be called to actually retry
3457 Implementation details: For either this customer, or for each of this
3458 customer's open invoices, changes the status of the first "done" (with
3459 statustext error) realtime processing event to "failed".
3463 sub retry_realtime {
3466 local $SIG{HUP} = 'IGNORE';
3467 local $SIG{INT} = 'IGNORE';
3468 local $SIG{QUIT} = 'IGNORE';
3469 local $SIG{TERM} = 'IGNORE';
3470 local $SIG{TSTP} = 'IGNORE';
3471 local $SIG{PIPE} = 'IGNORE';
3473 my $oldAutoCommit = $FS::UID::AutoCommit;
3474 local $FS::UID::AutoCommit = 0;
3477 #a little false laziness w/due_cust_event (not too bad, really)
3479 my $join = FS::part_event_condition->join_conditions_sql;
3480 my $order = FS::part_event_condition->order_conditions_sql;
3483 . join ( ' OR ' , map {
3484 "( part_event.eventtable = " . dbh->quote($_)
3485 . " AND tablenum IN( SELECT " . dbdef->table($_)->primary_key . " from $_ where custnum = " . dbh->quote( $self->custnum ) . "))" ;
3486 } FS::part_event->eventtables)
3489 #here is the agent virtualization
3490 my $agent_virt = " ( part_event.agentnum IS NULL
3491 OR part_event.agentnum = ". $self->agentnum. ' )';
3493 #XXX this shouldn't be hardcoded, actions should declare it...
3494 my @realtime_events = qw(
3495 cust_bill_realtime_card
3496 cust_bill_realtime_check
3497 cust_bill_realtime_lec
3501 my $is_realtime_event = ' ( '. join(' OR ', map "part_event.action = '$_'",
3506 my @cust_event = qsearchs({
3507 'table' => 'cust_event',
3508 'select' => 'cust_event.*',
3509 'addl_from' => "LEFT JOIN part_event USING ( eventpart ) $join",
3510 'hashref' => { 'status' => 'done' },
3511 'extra_sql' => " AND statustext IS NOT NULL AND statustext != '' ".
3512 " AND $mine AND $is_realtime_event AND $agent_virt $order" # LIMIT 1"
3515 my %seen_invnum = ();
3516 foreach my $cust_event (@cust_event) {
3518 #max one for the customer, one for each open invoice
3519 my $cust_X = $cust_event->cust_X;
3520 next if $seen_invnum{ $cust_event->part_event->eventtable eq 'cust_bill'
3524 or $cust_event->part_event->eventtable eq 'cust_bill'
3527 my $error = $cust_event->retry;
3529 $dbh->rollback if $oldAutoCommit;
3530 return "error scheduling event for retry: $error";
3535 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3540 # some horrid false laziness here to avoid refactor fallout
3541 # eventually realtime realtime_bop and realtime_refund_bop should go
3542 # away and be replaced by _new_realtime_bop and _new_realtime_refund_bop
3544 =item realtime_bop METHOD AMOUNT [ OPTION => VALUE ... ]
3546 Runs a realtime credit card, ACH (electronic check) or phone bill transaction
3547 via a Business::OnlinePayment realtime gateway. See
3548 L<http://420.am/business-onlinepayment> for supported gateways.
3550 Available methods are: I<CC>, I<ECHECK> and I<LEC>
3552 Available options are: I<description>, I<invnum>, I<quiet>, I<paynum_ref>, I<payunique>
3554 The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
3555 I<zip>, I<payinfo> and I<paydate> are also available. Any of these options,
3556 if set, will override the value from the customer record.
3558 I<description> is a free-text field passed to the gateway. It defaults to
3559 "Internet services".
3561 If an I<invnum> is specified, this payment (if successful) is applied to the
3562 specified invoice. If you don't specify an I<invnum> you might want to
3563 call the B<apply_payments> method.
3565 I<quiet> can be set true to surpress email decline notices.
3567 I<paynum_ref> can be set to a scalar reference. It will be filled in with the
3568 resulting paynum, if any.
3570 I<payunique> is a unique identifier for this payment.
3572 (moved from cust_bill) (probably should get realtime_{card,ach,lec} here too)
3579 return $self->_new_realtime_bop(@_)
3580 if $self->_new_bop_required();
3582 my( $method, $amount, %options ) = @_;
3584 warn "$me realtime_bop: $method $amount\n";
3585 warn " $_ => $options{$_}\n" foreach keys %options;
3588 $options{'description'} ||= 'Internet services';
3590 return $self->fake_bop($method, $amount, %options) if $options{'fake'};
3592 eval "use Business::OnlinePayment";
3595 my $payinfo = exists($options{'payinfo'})
3596 ? $options{'payinfo'}
3599 my %method2payby = (
3606 # check for banned credit card/ACH
3609 my $ban = qsearchs('banned_pay', {
3610 'payby' => $method2payby{$method},
3611 'payinfo' => md5_base64($payinfo),
3613 return "Banned credit card" if $ban;
3616 # set taxclass and trans_is_recur based on invnum if there is one
3620 my $trans_is_recur = 0;
3621 if ( $options{'invnum'} ) {
3623 my $cust_bill = qsearchs('cust_bill', { 'invnum' => $options{'invnum'} } );
3624 die "invnum ". $options{'invnum'}. " not found" unless $cust_bill;
3627 map { $_->part_pkg }
3629 map { $_->cust_pkg }
3630 $cust_bill->cust_bill_pkg;
3632 my @taxclasses = map $_->taxclass, @part_pkg;
3633 $taxclass = $taxclasses[0]
3634 unless grep { $taxclasses[0] ne $_ } @taxclasses; #unless there are
3635 #different taxclasses
3637 if grep { $_->freq ne '0' } @part_pkg;
3645 #look for an agent gateway override first
3647 if ( $method eq 'CC' ) {
3648 $cardtype = cardtype($payinfo);
3649 } elsif ( $method eq 'ECHECK' ) {
3652 $cardtype = $method;
3656 qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
3657 cardtype => $cardtype,
3658 taxclass => $taxclass, } )
3659 || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
3661 taxclass => $taxclass, } )
3662 || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
3663 cardtype => $cardtype,
3665 || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
3667 taxclass => '', } );
3669 my $payment_gateway = '';
3670 my( $processor, $login, $password, $action, @bop_options );
3671 if ( $override ) { #use a payment gateway override
3673 $payment_gateway = $override->payment_gateway;
3675 $processor = $payment_gateway->gateway_module;
3676 $login = $payment_gateway->gateway_username;
3677 $password = $payment_gateway->gateway_password;
3678 $action = $payment_gateway->gateway_action;
3679 @bop_options = $payment_gateway->options;
3681 } else { #use the standard settings from the config
3683 ( $processor, $login, $password, $action, @bop_options ) =
3684 $self->default_payment_gateway($method);
3692 my $address = exists($options{'address1'})
3693 ? $options{'address1'}
3695 my $address2 = exists($options{'address2'})
3696 ? $options{'address2'}
3698 $address .= ", ". $address2 if length($address2);
3700 my $o_payname = exists($options{'payname'})
3701 ? $options{'payname'}
3703 my($payname, $payfirst, $paylast);
3704 if ( $o_payname && $method ne 'ECHECK' ) {
3705 ($payname = $o_payname) =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
3706 or return "Illegal payname $payname";
3707 ($payfirst, $paylast) = ($1, $2);
3709 $payfirst = $self->getfield('first');
3710 $paylast = $self->getfield('last');
3711 $payname = "$payfirst $paylast";
3714 my @invoicing_list = $self->invoicing_list_emailonly;
3715 if ( $conf->exists('emailinvoiceautoalways')
3716 || $conf->exists('emailinvoiceauto') && ! @invoicing_list
3717 || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
3718 push @invoicing_list, $self->all_emails;
3721 my $email = ($conf->exists('business-onlinepayment-email-override'))
3722 ? $conf->config('business-onlinepayment-email-override')
3723 : $invoicing_list[0];
3727 my $payip = exists($options{'payip'})
3730 $content{customer_ip} = $payip
3733 $content{invoice_number} = $options{'invnum'}
3734 if exists($options{'invnum'}) && length($options{'invnum'});
3736 $content{email_customer} =
3737 ( $conf->exists('business-onlinepayment-email_customer')
3738 || $conf->exists('business-onlinepayment-email-override') );
3741 if ( $method eq 'CC' ) {
3743 $content{card_number} = $payinfo;
3744 $paydate = exists($options{'paydate'})
3745 ? $options{'paydate'}
3747 $paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
3748 $content{expiration} = "$2/$1";
3750 my $paycvv = exists($options{'paycvv'})
3751 ? $options{'paycvv'}
3753 $content{cvv2} = $paycvv
3756 my $paystart_month = exists($options{'paystart_month'})
3757 ? $options{'paystart_month'}
3758 : $self->paystart_month;
3760 my $paystart_year = exists($options{'paystart_year'})
3761 ? $options{'paystart_year'}
3762 : $self->paystart_year;
3764 $content{card_start} = "$paystart_month/$paystart_year"
3765 if $paystart_month && $paystart_year;
3767 my $payissue = exists($options{'payissue'})
3768 ? $options{'payissue'}
3770 $content{issue_number} = $payissue if $payissue;
3772 if ( $self->_bop_recurring_billing( 'payinfo' => $payinfo,
3773 'trans_is_recur' => $trans_is_recur,
3777 $content{recurring_billing} = 'YES';
3778 $content{acct_code} = 'rebill'
3779 if $conf->exists('credit_card-recurring_billing_acct_code');
3782 } elsif ( $method eq 'ECHECK' ) {
3783 ( $content{account_number}, $content{routing_code} ) =
3784 split('@', $payinfo);
3785 $content{bank_name} = $o_payname;
3786 $content{bank_state} = exists($options{'paystate'})
3787 ? $options{'paystate'}
3788 : $self->getfield('paystate');
3789 $content{account_type} = exists($options{'paytype'})
3790 ? uc($options{'paytype'}) || 'CHECKING'
3791 : uc($self->getfield('paytype')) || 'CHECKING';
3792 $content{account_name} = $payname;
3793 $content{customer_org} = $self->company ? 'B' : 'I';
3794 $content{state_id} = exists($options{'stateid'})
3795 ? $options{'stateid'}
3796 : $self->getfield('stateid');
3797 $content{state_id_state} = exists($options{'stateid_state'})
3798 ? $options{'stateid_state'}
3799 : $self->getfield('stateid_state');
3800 $content{customer_ssn} = exists($options{'ss'})
3803 } elsif ( $method eq 'LEC' ) {
3804 $content{phone} = $payinfo;
3808 # run transaction(s)
3811 my $balance = exists( $options{'balance'} )
3812 ? $options{'balance'}
3815 $self->select_for_update; #mutex ... just until we get our pending record in
3817 #the checks here are intended to catch concurrent payments
3818 #double-form-submission prevention is taken care of in cust_pay_pending::check
3821 return "The customer's balance has changed; $method transaction aborted."
3822 if $self->balance < $balance;
3823 #&& $self->balance < $amount; #might as well anyway?
3825 #also check and make sure there aren't *other* pending payments for this cust
3827 my @pending = qsearch('cust_pay_pending', {
3828 'custnum' => $self->custnum,
3829 'status' => { op=>'!=', value=>'done' }
3831 return "A payment is already being processed for this customer (".
3832 join(', ', map 'paypendingnum '. $_->paypendingnum, @pending ).
3833 "); $method transaction aborted."
3834 if scalar(@pending);
3836 #okay, good to go, if we're a duplicate, cust_pay_pending will kick us out
3838 my $cust_pay_pending = new FS::cust_pay_pending {
3839 'custnum' => $self->custnum,
3840 #'invnum' => $options{'invnum'},
3843 'payby' => $method2payby{$method},
3844 'payinfo' => $payinfo,
3845 'paydate' => $paydate,
3846 'recurring_billing' => $content{recurring_billing},
3848 'gatewaynum' => ( $payment_gateway ? $payment_gateway->gatewaynum : '' ),
3850 $cust_pay_pending->payunique( $options{payunique} )
3851 if defined($options{payunique}) && length($options{payunique});
3852 my $cpp_new_err = $cust_pay_pending->insert; #mutex lost when this is inserted
3853 return $cpp_new_err if $cpp_new_err;
3855 my( $action1, $action2 ) = split(/\s*\,\s*/, $action );
3857 my $transaction = new Business::OnlinePayment( $processor, @bop_options );
3858 $transaction->content(
3861 'password' => $password,
3862 'action' => $action1,
3863 'description' => $options{'description'},
3864 'amount' => $amount,
3865 #'invoice_number' => $options{'invnum'},
3866 'customer_id' => $self->custnum,
3867 'last_name' => $paylast,
3868 'first_name' => $payfirst,
3870 'address' => $address,
3871 'city' => ( exists($options{'city'})
3874 'state' => ( exists($options{'state'})
3877 'zip' => ( exists($options{'zip'})
3880 'country' => ( exists($options{'country'})
3881 ? $options{'country'}
3883 'referer' => 'http://cleanwhisker.420.am/', #XXX fix referer :/
3885 'phone' => $self->daytime || $self->night,
3889 $cust_pay_pending->status('pending');
3890 my $cpp_pending_err = $cust_pay_pending->replace;
3891 return $cpp_pending_err if $cpp_pending_err;
3894 my $BOP_TESTING = 0;
3895 my $BOP_TESTING_SUCCESS = 1;
3897 unless ( $BOP_TESTING ) {
3898 $transaction->submit();
3900 if ( $BOP_TESTING_SUCCESS ) {
3901 $transaction->is_success(1);
3902 $transaction->authorization('fake auth');
3904 $transaction->is_success(0);
3905 $transaction->error_message('fake failure');
3909 if ( $transaction->is_success() && $action2 ) {
3911 $cust_pay_pending->status('authorized');
3912 my $cpp_authorized_err = $cust_pay_pending->replace;
3913 return $cpp_authorized_err if $cpp_authorized_err;
3915 my $auth = $transaction->authorization;
3916 my $ordernum = $transaction->can('order_number')
3917 ? $transaction->order_number
3921 new Business::OnlinePayment( $processor, @bop_options );
3928 password => $password,
3929 order_number => $ordernum,
3931 authorization => $auth,
3932 description => $options{'description'},
3935 foreach my $field (qw( authorization_source_code returned_ACI
3936 transaction_identifier validation_code
3937 transaction_sequence_num local_transaction_date
3938 local_transaction_time AVS_result_code )) {
3939 $capture{$field} = $transaction->$field() if $transaction->can($field);
3942 $capture->content( %capture );
3946 unless ( $capture->is_success ) {
3947 my $e = "Authorization successful but capture failed, custnum #".
3948 $self->custnum. ': '. $capture->result_code.
3949 ": ". $capture->error_message;
3956 $cust_pay_pending->status($transaction->is_success() ? 'captured' : 'declined');
3957 my $cpp_captured_err = $cust_pay_pending->replace;
3958 return $cpp_captured_err if $cpp_captured_err;
3961 # remove paycvv after initial transaction
3964 #false laziness w/misc/process/payment.cgi - check both to make sure working
3966 if ( defined $self->dbdef_table->column('paycvv')
3967 && length($self->paycvv)
3968 && ! grep { $_ eq cardtype($payinfo) } $conf->config('cvv-save')
3970 my $error = $self->remove_cvv;
3972 warn "WARNING: error removing cvv: $error\n";
3980 if ( $transaction->is_success() ) {
3983 if ( $payment_gateway ) { # agent override
3984 $paybatch = $payment_gateway->gatewaynum. '-';
3987 $paybatch .= "$processor:". $transaction->authorization;
3989 $paybatch .= ':'. $transaction->order_number
3990 if $transaction->can('order_number')
3991 && length($transaction->order_number);
3993 my $cust_pay = new FS::cust_pay ( {
3994 'custnum' => $self->custnum,
3995 'invnum' => $options{'invnum'},
3998 'payby' => $method2payby{$method},
3999 'payinfo' => $payinfo,
4000 'paybatch' => $paybatch,
4001 'paydate' => $paydate,
4003 #doesn't hurt to know, even though the dup check is in cust_pay_pending now
4004 $cust_pay->payunique( $options{payunique} )
4005 if defined($options{payunique}) && length($options{payunique});
4007 my $oldAutoCommit = $FS::UID::AutoCommit;
4008 local $FS::UID::AutoCommit = 0;
4011 #start a transaction, insert the cust_pay and set cust_pay_pending.status to done in a single transction
4013 my $error = $cust_pay->insert($options{'manual'} ? ( 'manual' => 1 ) : () );
4016 $cust_pay->invnum(''); #try again with no specific invnum
4017 my $error2 = $cust_pay->insert( $options{'manual'} ?
4018 ( 'manual' => 1 ) : ()
4021 # gah. but at least we have a record of the state we had to abort in
4022 # from cust_pay_pending now.
4023 my $e = "WARNING: $method captured but payment not recorded - ".
4024 "error inserting payment ($processor): $error2".
4025 " (previously tried insert with invnum #$options{'invnum'}" .
4026 ": $error ) - pending payment saved as paypendingnum ".
4027 $cust_pay_pending->paypendingnum. "\n";
4033 if ( $options{'paynum_ref'} ) {
4034 ${ $options{'paynum_ref'} } = $cust_pay->paynum;
4037 $cust_pay_pending->status('done');
4038 $cust_pay_pending->statustext('captured');
4039 $cust_pay_pending->paynum($cust_pay->paynum);
4040 my $cpp_done_err = $cust_pay_pending->replace;
4042 if ( $cpp_done_err ) {
4044 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
4045 my $e = "WARNING: $method captured but payment not recorded - ".
4046 "error updating status for paypendingnum ".
4047 $cust_pay_pending->paypendingnum. ": $cpp_done_err \n";
4053 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4054 return ''; #no error
4060 my $perror = "$processor error: ". $transaction->error_message;
4062 unless ( $transaction->error_message ) {
4065 if ( $transaction->can('response_page') ) {
4067 'page' => ( $transaction->can('response_page')
4068 ? $transaction->response_page
4071 'code' => ( $transaction->can('response_code')
4072 ? $transaction->response_code
4075 'headers' => ( $transaction->can('response_headers')
4076 ? $transaction->response_headers
4082 "No additional debugging information available for $processor";
4085 $perror .= "No error_message returned from $processor -- ".
4086 ( ref($t_response) ? Dumper($t_response) : $t_response );
4090 if ( !$options{'quiet'} && !$realtime_bop_decline_quiet
4091 && $conf->exists('emaildecline')
4092 && grep { $_ ne 'POST' } $self->invoicing_list
4093 && ! grep { $transaction->error_message =~ /$_/ }
4094 $conf->config('emaildecline-exclude')
4096 my @templ = $conf->config('declinetemplate');
4097 my $template = new Text::Template (
4099 SOURCE => [ map "$_\n", @templ ],
4100 ) or return "($perror) can't create template: $Text::Template::ERROR";
4101 $template->compile()
4102 or return "($perror) can't compile template: $Text::Template::ERROR";
4104 my $templ_hash = { error => $transaction->error_message };
4106 my $error = send_email(
4107 'from' => $conf->config('invoice_from', $self->agentnum ),
4108 'to' => [ grep { $_ ne 'POST' } $self->invoicing_list ],
4109 'subject' => 'Your payment could not be processed',
4110 'body' => [ $template->fill_in(HASH => $templ_hash) ],
4113 $perror .= " (also received error sending decline notification: $error)"
4118 $cust_pay_pending->status('done');
4119 $cust_pay_pending->statustext("declined: $perror");
4120 my $cpp_done_err = $cust_pay_pending->replace;
4121 if ( $cpp_done_err ) {
4122 my $e = "WARNING: $method declined but pending payment not resolved - ".
4123 "error updating status for paypendingnum ".
4124 $cust_pay_pending->paypendingnum. ": $cpp_done_err \n";
4126 $perror = "$e ($perror)";
4134 sub _bop_recurring_billing {
4135 my( $self, %opt ) = @_;
4137 my $method = $conf->config('credit_card-recurring_billing_flag');
4139 if ( $method eq 'transaction_is_recur' ) {
4141 return 1 if $opt{'trans_is_recur'};
4145 my %hash = ( 'custnum' => $self->custnum,
4150 if qsearch('cust_pay', { %hash, 'payinfo' => $opt{'payinfo'} } )
4151 || qsearch('cust_pay', { %hash, 'paymask' => $self->mask_payinfo('CARD',
4162 =item realtime_refund_bop METHOD [ OPTION => VALUE ... ]
4164 Refunds a realtime credit card, ACH (electronic check) or phone bill transaction
4165 via a Business::OnlinePayment realtime gateway. See
4166 L<http://420.am/business-onlinepayment> for supported gateways.
4168 Available methods are: I<CC>, I<ECHECK> and I<LEC>
4170 Available options are: I<amount>, I<reason>, I<paynum>, I<paydate>
4172 Most gateways require a reference to an original payment transaction to refund,
4173 so you probably need to specify a I<paynum>.
4175 I<amount> defaults to the original amount of the payment if not specified.
4177 I<reason> specifies a reason for the refund.
4179 I<paydate> specifies the expiration date for a credit card overriding the
4180 value from the customer record or the payment record. Specified as yyyy-mm-dd
4182 Implementation note: If I<amount> is unspecified or equal to the amount of the
4183 orignal payment, first an attempt is made to "void" the transaction via
4184 the gateway (to cancel a not-yet settled transaction) and then if that fails,
4185 the normal attempt is made to "refund" ("credit") the transaction via the
4186 gateway is attempted.
4188 #The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
4189 #I<zip>, I<payinfo> and I<paydate> are also available. Any of these options,
4190 #if set, will override the value from the customer record.
4192 #If an I<invnum> is specified, this payment (if successful) is applied to the
4193 #specified invoice. If you don't specify an I<invnum> you might want to
4194 #call the B<apply_payments> method.
4198 #some false laziness w/realtime_bop, not enough to make it worth merging
4199 #but some useful small subs should be pulled out
4200 sub realtime_refund_bop {
4203 return $self->_new_realtime_refund_bop(@_)
4204 if $self->_new_bop_required();
4206 my( $method, %options ) = @_;
4208 warn "$me realtime_refund_bop: $method refund\n";
4209 warn " $_ => $options{$_}\n" foreach keys %options;
4212 eval "use Business::OnlinePayment";
4216 # look up the original payment and optionally a gateway for that payment
4220 my $amount = $options{'amount'};
4222 my( $processor, $login, $password, @bop_options ) ;
4223 my( $auth, $order_number ) = ( '', '', '' );
4225 if ( $options{'paynum'} ) {
4227 warn " paynum: $options{paynum}\n" if $DEBUG > 1;
4228 $cust_pay = qsearchs('cust_pay', { paynum=>$options{'paynum'} } )
4229 or return "Unknown paynum $options{'paynum'}";
4230 $amount ||= $cust_pay->paid;
4232 $cust_pay->paybatch =~ /^((\d+)\-)?(\w+):\s*([\w\-\/ ]*)(:([\w\-]+))?$/
4233 or return "Can't parse paybatch for paynum $options{'paynum'}: ".
4234 $cust_pay->paybatch;
4235 my $gatewaynum = '';
4236 ( $gatewaynum, $processor, $auth, $order_number ) = ( $2, $3, $4, $6 );
4238 if ( $gatewaynum ) { #gateway for the payment to be refunded
4240 my $payment_gateway =
4241 qsearchs('payment_gateway', { 'gatewaynum' => $gatewaynum } );
4242 die "payment gateway $gatewaynum not found"
4243 unless $payment_gateway;
4245 $processor = $payment_gateway->gateway_module;
4246 $login = $payment_gateway->gateway_username;
4247 $password = $payment_gateway->gateway_password;
4248 @bop_options = $payment_gateway->options;
4250 } else { #try the default gateway
4252 my( $conf_processor, $unused_action );
4253 ( $conf_processor, $login, $password, $unused_action, @bop_options ) =
4254 $self->default_payment_gateway($method);
4256 return "processor of payment $options{'paynum'} $processor does not".
4257 " match default processor $conf_processor"
4258 unless $processor eq $conf_processor;
4263 } else { # didn't specify a paynum, so look for agent gateway overrides
4264 # like a normal transaction
4267 if ( $method eq 'CC' ) {
4268 $cardtype = cardtype($self->payinfo);
4269 } elsif ( $method eq 'ECHECK' ) {
4272 $cardtype = $method;
4275 qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
4276 cardtype => $cardtype,
4278 || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
4280 taxclass => '', } );
4282 if ( $override ) { #use a payment gateway override
4284 my $payment_gateway = $override->payment_gateway;
4286 $processor = $payment_gateway->gateway_module;
4287 $login = $payment_gateway->gateway_username;
4288 $password = $payment_gateway->gateway_password;
4289 #$action = $payment_gateway->gateway_action;
4290 @bop_options = $payment_gateway->options;
4292 } else { #use the standard settings from the config
4295 ( $processor, $login, $password, $unused_action, @bop_options ) =
4296 $self->default_payment_gateway($method);
4301 return "neither amount nor paynum specified" unless $amount;
4306 'password' => $password,
4307 'order_number' => $order_number,
4308 'amount' => $amount,
4309 'referer' => 'http://cleanwhisker.420.am/', #XXX fix referer :/
4311 $content{authorization} = $auth
4312 if length($auth); #echeck/ACH transactions have an order # but no auth
4313 #(at least with authorize.net)
4315 my $disable_void_after;
4316 if ($conf->exists('disable_void_after')
4317 && $conf->config('disable_void_after') =~ /^(\d+)$/) {
4318 $disable_void_after = $1;
4321 #first try void if applicable
4322 if ( $cust_pay && $cust_pay->paid == $amount
4324 ( not defined($disable_void_after) )
4325 || ( time < ($cust_pay->_date + $disable_void_after ) )
4328 warn " attempting void\n" if $DEBUG > 1;
4329 my $void = new Business::OnlinePayment( $processor, @bop_options );
4330 $void->content( 'action' => 'void', %content );
4332 if ( $void->is_success ) {
4333 my $error = $cust_pay->void($options{'reason'});
4335 # gah, even with transactions.
4336 my $e = 'WARNING: Card/ACH voided but database not updated - '.
4337 "error voiding payment: $error";
4341 warn " void successful\n" if $DEBUG > 1;
4346 warn " void unsuccessful, trying refund\n"
4350 my $address = $self->address1;
4351 $address .= ", ". $self->address2 if $self->address2;
4353 my($payname, $payfirst, $paylast);
4354 if ( $self->payname && $method ne 'ECHECK' ) {
4355 $payname = $self->payname;
4356 $payname =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
4357 or return "Illegal payname $payname";
4358 ($payfirst, $paylast) = ($1, $2);
4360 $payfirst = $self->getfield('first');
4361 $paylast = $self->getfield('last');
4362 $payname = "$payfirst $paylast";
4365 my @invoicing_list = $self->invoicing_list_emailonly;
4366 if ( $conf->exists('emailinvoiceautoalways')
4367 || $conf->exists('emailinvoiceauto') && ! @invoicing_list
4368 || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
4369 push @invoicing_list, $self->all_emails;
4372 my $email = ($conf->exists('business-onlinepayment-email-override'))
4373 ? $conf->config('business-onlinepayment-email-override')
4374 : $invoicing_list[0];
4376 my $payip = exists($options{'payip'})
4379 $content{customer_ip} = $payip
4383 if ( $method eq 'CC' ) {
4386 $content{card_number} = $payinfo = $cust_pay->payinfo;
4387 (exists($options{'paydate'}) ? $options{'paydate'} : $cust_pay->paydate)
4388 =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/ &&
4389 ($content{expiration} = "$2/$1"); # where available
4391 $content{card_number} = $payinfo = $self->payinfo;
4392 (exists($options{'paydate'}) ? $options{'paydate'} : $self->paydate)
4393 =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
4394 $content{expiration} = "$2/$1";
4397 } elsif ( $method eq 'ECHECK' ) {
4400 $payinfo = $cust_pay->payinfo;
4402 $payinfo = $self->payinfo;
4404 ( $content{account_number}, $content{routing_code} )= split('@', $payinfo );
4405 $content{bank_name} = $self->payname;
4406 $content{account_type} = 'CHECKING';
4407 $content{account_name} = $payname;
4408 $content{customer_org} = $self->company ? 'B' : 'I';
4409 $content{customer_ssn} = $self->ss;
4410 } elsif ( $method eq 'LEC' ) {
4411 $content{phone} = $payinfo = $self->payinfo;
4415 my $refund = new Business::OnlinePayment( $processor, @bop_options );
4416 my %sub_content = $refund->content(
4417 'action' => 'credit',
4418 'customer_id' => $self->custnum,
4419 'last_name' => $paylast,
4420 'first_name' => $payfirst,
4422 'address' => $address,
4423 'city' => $self->city,
4424 'state' => $self->state,
4425 'zip' => $self->zip,
4426 'country' => $self->country,
4428 'phone' => $self->daytime || $self->night,
4431 warn join('', map { " $_ => $sub_content{$_}\n" } keys %sub_content )
4435 return "$processor error: ". $refund->error_message
4436 unless $refund->is_success();
4438 my %method2payby = (
4444 my $paybatch = "$processor:". $refund->authorization;
4445 $paybatch .= ':'. $refund->order_number
4446 if $refund->can('order_number') && $refund->order_number;
4448 while ( $cust_pay && $cust_pay->unapplied < $amount ) {
4449 my @cust_bill_pay = $cust_pay->cust_bill_pay;
4450 last unless @cust_bill_pay;
4451 my $cust_bill_pay = pop @cust_bill_pay;
4452 my $error = $cust_bill_pay->delete;
4456 my $cust_refund = new FS::cust_refund ( {
4457 'custnum' => $self->custnum,
4458 'paynum' => $options{'paynum'},
4459 'refund' => $amount,
4461 'payby' => $method2payby{$method},
4462 'payinfo' => $payinfo,
4463 'paybatch' => $paybatch,
4464 'reason' => $options{'reason'} || 'card or ACH refund',
4466 my $error = $cust_refund->insert;
4468 $cust_refund->paynum(''); #try again with no specific paynum
4469 my $error2 = $cust_refund->insert;
4471 # gah, even with transactions.
4472 my $e = 'WARNING: Card/ACH refunded but database not updated - '.
4473 "error inserting refund ($processor): $error2".
4474 " (previously tried insert with paynum #$options{'paynum'}" .
4485 # does the configuration indicate the new bop routines are required?
4487 sub _new_bop_required {
4490 my $botpp = 'Business::OnlineThirdPartyPayment';
4493 if ( $conf->config('business-onlinepayment-namespace') eq $botpp ||
4494 scalar( grep { $_->gateway_namespace eq $botpp }
4495 qsearch( 'payment_gateway', { 'disabled' => '' } )
4504 =item realtime_collect [ OPTION => VALUE ... ]
4506 Runs a realtime credit card, ACH (electronic check) or phone bill transaction
4507 via a Business::OnlinePayment or Business::OnlineThirdPartyPayment realtime
4508 gateway. See L<http://420.am/business-onlinepayment> and
4509 L<http://420.am/business-onlinethirdpartypayment> for supported gateways.
4511 On failure returns an error message.
4513 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.
4515 Available options are: I<method>, I<amount>, I<description>, I<invnum>, I<quiet>, I<paynum_ref>, I<payunique>, I<session_id>
4517 I<method> is one of: I<CC>, I<ECHECK> and I<LEC>. If none is specified
4518 then it is deduced from the customer record.
4520 If no I<amount> is specified, then the customer balance is used.
4522 The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
4523 I<zip>, I<payinfo> and I<paydate> are also available. Any of these options,
4524 if set, will override the value from the customer record.
4526 I<description> is a free-text field passed to the gateway. It defaults to
4527 "Internet services".
4529 If an I<invnum> is specified, this payment (if successful) is applied to the
4530 specified invoice. If you don't specify an I<invnum> you might want to
4531 call the B<apply_payments> method.
4533 I<quiet> can be set true to surpress email decline notices.
4535 I<paynum_ref> can be set to a scalar reference. It will be filled in with the
4536 resulting paynum, if any.
4538 I<payunique> is a unique identifier for this payment.
4540 I<session_id> is a session identifier associated with this payment.
4542 I<depend_jobnum> allows payment capture to unlock export jobs
4546 sub realtime_collect {
4547 my( $self, %options ) = @_;
4550 warn "$me realtime_collect:\n";
4551 warn " $_ => $options{$_}\n" foreach keys %options;
4554 $options{amount} = $self->balance unless exists( $options{amount} );
4555 $options{method} = FS::payby->payby2bop($self->payby)
4556 unless exists( $options{method} );
4558 return $self->realtime_bop({%options});
4562 =item _realtime_bop { [ ARG => VALUE ... ] }
4564 Runs a realtime credit card, ACH (electronic check) or phone bill transaction
4565 via a Business::OnlinePayment realtime gateway. See
4566 L<http://420.am/business-onlinepayment> for supported gateways.
4568 Required arguments in the hashref are I<method>, and I<amount>
4570 Available methods are: I<CC>, I<ECHECK> and I<LEC>
4572 Available optional arguments are: I<description>, I<invnum>, I<quiet>, I<paynum_ref>, I<payunique>, I<session_id>
4574 The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
4575 I<zip>, I<payinfo> and I<paydate> are also available. Any of these options,
4576 if set, will override the value from the customer record.
4578 I<description> is a free-text field passed to the gateway. It defaults to
4579 "Internet services".
4581 If an I<invnum> is specified, this payment (if successful) is applied to the
4582 specified invoice. If you don't specify an I<invnum> you might want to
4583 call the B<apply_payments> method.
4585 I<quiet> can be set true to surpress email decline notices.
4587 I<paynum_ref> can be set to a scalar reference. It will be filled in with the
4588 resulting paynum, if any.
4590 I<payunique> is a unique identifier for this payment.
4592 I<session_id> is a session identifier associated with this payment.
4594 I<depend_jobnum> allows payment capture to unlock export jobs
4596 (moved from cust_bill) (probably should get realtime_{card,ach,lec} here too)
4600 # some helper routines
4601 sub _payment_gateway {
4602 my ($self, $options) = @_;
4604 $options->{payment_gateway} = $self->agent->payment_gateway( %$options )
4605 unless exists($options->{payment_gateway});
4607 $options->{payment_gateway};
4611 my ($self, $options) = @_;
4614 'login' => $options->{payment_gateway}->gateway_username,
4615 'password' => $options->{payment_gateway}->gateway_password,
4620 my ($self, $options) = @_;
4622 $options->{payment_gateway}->gatewaynum
4623 ? $options->{payment_gateway}->options
4624 : @{ $options->{payment_gateway}->get('options') };
4628 my ($self, $options) = @_;
4630 $options->{description} ||= 'Internet services';
4631 $options->{payinfo} = $self->payinfo unless exists( $options->{payinfo} );
4632 $options->{invnum} ||= '';
4633 $options->{payname} = $self->payname unless exists( $options->{payname} );
4637 my ($self, $options) = @_;
4640 $content{address} = exists($options->{'address1'})
4641 ? $options->{'address1'}
4643 my $address2 = exists($options->{'address2'})
4644 ? $options->{'address2'}
4646 $content{address} .= ", ". $address2 if length($address2);
4648 my $payip = exists($options->{'payip'}) ? $options->{'payip'} : $self->payip;
4649 $content{customer_ip} = $payip if length($payip);
4651 $content{invoice_number} = $options->{'invnum'}
4652 if exists($options->{'invnum'}) && length($options->{'invnum'});
4654 $content{email_customer} =
4655 ( $conf->exists('business-onlinepayment-email_customer')
4656 || $conf->exists('business-onlinepayment-email-override') );
4658 $content{payfirst} = $self->getfield('first');
4659 $content{paylast} = $self->getfield('last');
4661 $content{account_name} = "$content{payfirst} $content{paylast}"
4662 if $options->{method} eq 'ECHECK';
4664 $content{name} = $options->{payname};
4665 $content{name} = $content{account_name} if exists($content{account_name});
4667 $content{city} = exists($options->{city})
4670 $content{state} = exists($options->{state})
4673 $content{zip} = exists($options->{zip})
4676 $content{country} = exists($options->{country})
4677 ? $options->{country}
4679 $content{referer} = 'http://cleanwhisker.420.am/'; #XXX fix referer :/
4680 $content{phone} = $self->daytime || $self->night;
4685 my %bop_method2payby = (
4691 sub _new_realtime_bop {
4695 if (ref($_[0]) eq 'HASH') {
4696 %options = %{$_[0]};
4698 my ( $method, $amount ) = ( shift, shift );
4700 $options{method} = $method;
4701 $options{amount} = $amount;
4705 warn "$me realtime_bop (new): $options{method} $options{amount}\n";
4706 warn " $_ => $options{$_}\n" foreach keys %options;
4709 return $self->fake_bop(%options) if $options{'fake'};
4711 $self->_bop_defaults(\%options);
4714 # set trans_is_recur based on invnum if there is one
4717 my $trans_is_recur = 0;
4718 if ( $options{'invnum'} ) {
4720 my $cust_bill = qsearchs('cust_bill', { 'invnum' => $options{'invnum'} } );
4721 die "invnum ". $options{'invnum'}. " not found" unless $cust_bill;
4724 map { $_->part_pkg }
4726 map { $_->cust_pkg }
4727 $cust_bill->cust_bill_pkg;
4730 if grep { $_->freq ne '0' } @part_pkg;
4738 my $payment_gateway = $self->_payment_gateway( \%options );
4739 my $namespace = $payment_gateway->gateway_namespace;
4741 eval "use $namespace";
4745 # check for banned credit card/ACH
4748 my $ban = qsearchs('banned_pay', {
4749 'payby' => $bop_method2payby{$options{method}},
4750 'payinfo' => md5_base64($options{payinfo}),
4752 return "Banned credit card" if $ban;
4758 my (%bop_content) = $self->_bop_content(\%options);
4760 if ( $options{method} ne 'ECHECK' ) {
4761 $options{payname} =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
4762 or return "Illegal payname $options{payname}";
4763 ($bop_content{payfirst}, $bop_content{paylast}) = ($1, $2);
4766 my @invoicing_list = $self->invoicing_list_emailonly;
4767 if ( $conf->exists('emailinvoiceautoalways')
4768 || $conf->exists('emailinvoiceauto') && ! @invoicing_list
4769 || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
4770 push @invoicing_list, $self->all_emails;
4773 my $email = ($conf->exists('business-onlinepayment-email-override'))
4774 ? $conf->config('business-onlinepayment-email-override')
4775 : $invoicing_list[0];
4779 if ( $namespace eq 'Business::OnlinePayment' && $options{method} eq 'CC' ) {
4781 $content{card_number} = $options{payinfo};
4782 $paydate = exists($options{'paydate'})
4783 ? $options{'paydate'}
4785 $paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
4786 $content{expiration} = "$2/$1";
4788 my $paycvv = exists($options{'paycvv'})
4789 ? $options{'paycvv'}
4791 $content{cvv2} = $paycvv
4794 my $paystart_month = exists($options{'paystart_month'})
4795 ? $options{'paystart_month'}
4796 : $self->paystart_month;
4798 my $paystart_year = exists($options{'paystart_year'})
4799 ? $options{'paystart_year'}
4800 : $self->paystart_year;
4802 $content{card_start} = "$paystart_month/$paystart_year"
4803 if $paystart_month && $paystart_year;
4805 my $payissue = exists($options{'payissue'})
4806 ? $options{'payissue'}
4808 $content{issue_number} = $payissue if $payissue;
4810 if ( $self->_bop_recurring_billing( 'payinfo' => $options{'payinfo'},
4811 'trans_is_recur' => $trans_is_recur,
4815 $content{recurring_billing} = 'YES';
4816 $content{acct_code} = 'rebill'
4817 if $conf->exists('credit_card-recurring_billing_acct_code');
4820 } elsif ( $namespace eq 'Business::OnlinePayment' && $options{method} eq 'ECHECK' ){
4821 ( $content{account_number}, $content{routing_code} ) =
4822 split('@', $options{payinfo});
4823 $content{bank_name} = $options{payname};
4824 $content{bank_state} = exists($options{'paystate'})
4825 ? $options{'paystate'}
4826 : $self->getfield('paystate');
4827 $content{account_type} = exists($options{'paytype'})
4828 ? uc($options{'paytype'}) || 'CHECKING'
4829 : uc($self->getfield('paytype')) || 'CHECKING';
4830 $content{customer_org} = $self->company ? 'B' : 'I';
4831 $content{state_id} = exists($options{'stateid'})
4832 ? $options{'stateid'}
4833 : $self->getfield('stateid');
4834 $content{state_id_state} = exists($options{'stateid_state'})
4835 ? $options{'stateid_state'}
4836 : $self->getfield('stateid_state');
4837 $content{customer_ssn} = exists($options{'ss'})
4840 } elsif ( $namespace eq 'Business::OnlinePayment' && $options{method} eq 'LEC' ) {
4841 $content{phone} = $options{payinfo};
4842 } elsif ( $namespace eq 'Business::OnlineThirdPartyPayment' ) {
4849 # run transaction(s)
4852 my $balance = exists( $options{'balance'} )
4853 ? $options{'balance'}
4856 $self->select_for_update; #mutex ... just until we get our pending record in
4858 #the checks here are intended to catch concurrent payments
4859 #double-form-submission prevention is taken care of in cust_pay_pending::check
4862 return "The customer's balance has changed; $options{method} transaction aborted."
4863 if $self->balance < $balance;
4864 #&& $self->balance < $options{amount}; #might as well anyway?
4866 #also check and make sure there aren't *other* pending payments for this cust
4868 my @pending = qsearch('cust_pay_pending', {
4869 'custnum' => $self->custnum,
4870 'status' => { op=>'!=', value=>'done' }
4872 return "A payment is already being processed for this customer (".
4873 join(', ', map 'paypendingnum '. $_->paypendingnum, @pending ).
4874 "); $options{method} transaction aborted."
4875 if scalar(@pending);
4877 #okay, good to go, if we're a duplicate, cust_pay_pending will kick us out
4879 my $cust_pay_pending = new FS::cust_pay_pending {
4880 'custnum' => $self->custnum,
4881 #'invnum' => $options{'invnum'},
4882 'paid' => $options{amount},
4884 'payby' => $bop_method2payby{$options{method}},
4885 'payinfo' => $options{payinfo},
4886 'paydate' => $paydate,
4887 'recurring_billing' => $content{recurring_billing},
4889 'gatewaynum' => $payment_gateway->gatewaynum || '',
4890 'session_id' => $options{session_id} || '',
4891 'jobnum' => $options{depend_jobnum} || '',
4893 $cust_pay_pending->payunique( $options{payunique} )
4894 if defined($options{payunique}) && length($options{payunique});
4895 my $cpp_new_err = $cust_pay_pending->insert; #mutex lost when this is inserted
4896 return $cpp_new_err if $cpp_new_err;
4898 my( $action1, $action2 ) =
4899 split( /\s*\,\s*/, $payment_gateway->gateway_action );
4901 my $transaction = new $namespace( $payment_gateway->gateway_module,
4902 $self->_bop_options(\%options),
4905 $transaction->content(
4906 'type' => $options{method},
4907 $self->_bop_auth(\%options),
4908 'action' => $action1,
4909 'description' => $options{'description'},
4910 'amount' => $options{amount},
4911 #'invoice_number' => $options{'invnum'},
4912 'customer_id' => $self->custnum,
4914 'reference' => $cust_pay_pending->paypendingnum, #for now
4919 $cust_pay_pending->status('pending');
4920 my $cpp_pending_err = $cust_pay_pending->replace;
4921 return $cpp_pending_err if $cpp_pending_err;
4924 my $BOP_TESTING = 0;
4925 my $BOP_TESTING_SUCCESS = 1;
4927 unless ( $BOP_TESTING ) {
4928 $transaction->submit();
4930 if ( $BOP_TESTING_SUCCESS ) {
4931 $transaction->is_success(1);
4932 $transaction->authorization('fake auth');
4934 $transaction->is_success(0);
4935 $transaction->error_message('fake failure');
4939 if ( $transaction->is_success() && $namespace eq 'Business::OnlineThirdPartyPayment' ) {
4941 return { reference => $cust_pay_pending->paypendingnum,
4942 map { $_ => $transaction->$_ } qw ( popup_url collectitems ) };
4944 } elsif ( $transaction->is_success() && $action2 ) {
4946 $cust_pay_pending->status('authorized');
4947 my $cpp_authorized_err = $cust_pay_pending->replace;
4948 return $cpp_authorized_err if $cpp_authorized_err;
4950 my $auth = $transaction->authorization;
4951 my $ordernum = $transaction->can('order_number')
4952 ? $transaction->order_number
4956 new Business::OnlinePayment( $payment_gateway->gateway_module,
4957 $self->_bop_options(\%options),
4962 type => $options{method},
4964 $self->_bop_auth(\%options),
4965 order_number => $ordernum,
4966 amount => $options{amount},
4967 authorization => $auth,
4968 description => $options{'description'},
4971 foreach my $field (qw( authorization_source_code returned_ACI
4972 transaction_identifier validation_code
4973 transaction_sequence_num local_transaction_date
4974 local_transaction_time AVS_result_code )) {
4975 $capture{$field} = $transaction->$field() if $transaction->can($field);
4978 $capture->content( %capture );
4982 unless ( $capture->is_success ) {
4983 my $e = "Authorization successful but capture failed, custnum #".
4984 $self->custnum. ': '. $capture->result_code.
4985 ": ". $capture->error_message;
4993 # remove paycvv after initial transaction
4996 #false laziness w/misc/process/payment.cgi - check both to make sure working
4998 if ( defined $self->dbdef_table->column('paycvv')
4999 && length($self->paycvv)
5000 && ! grep { $_ eq cardtype($options{payinfo}) } $conf->config('cvv-save')
5002 my $error = $self->remove_cvv;
5004 warn "WARNING: error removing cvv: $error\n";
5012 $self->_realtime_bop_result( $cust_pay_pending, $transaction, %options );
5024 if (ref($_[0]) eq 'HASH') {
5025 %options = %{$_[0]};
5027 my ( $method, $amount ) = ( shift, shift );
5029 $options{method} = $method;
5030 $options{amount} = $amount;
5033 if ( $options{'fake_failure'} ) {
5034 return "Error: No error; test failure requested with fake_failure";
5038 #if ( $payment_gateway->gatewaynum ) { # agent override
5039 # $paybatch = $payment_gateway->gatewaynum. '-';
5042 #$paybatch .= "$processor:". $transaction->authorization;
5044 #$paybatch .= ':'. $transaction->order_number
5045 # if $transaction->can('order_number')
5046 # && length($transaction->order_number);
5048 my $paybatch = 'FakeProcessor:54:32';
5050 my $cust_pay = new FS::cust_pay ( {
5051 'custnum' => $self->custnum,
5052 'invnum' => $options{'invnum'},
5053 'paid' => $options{amount},
5055 'payby' => $bop_method2payby{$options{method}},
5056 #'payinfo' => $payinfo,
5057 'payinfo' => '4111111111111111',
5058 'paybatch' => $paybatch,
5059 #'paydate' => $paydate,
5060 'paydate' => '2012-05-01',
5062 $cust_pay->payunique( $options{payunique} ) if length($options{payunique});
5064 my $error = $cust_pay->insert($options{'manual'} ? ( 'manual' => 1 ) : () );
5067 $cust_pay->invnum(''); #try again with no specific invnum
5068 my $error2 = $cust_pay->insert( $options{'manual'} ?
5069 ( 'manual' => 1 ) : ()
5072 # gah, even with transactions.
5073 my $e = 'WARNING: Card/ACH debited but database not updated - '.
5074 "error inserting (fake!) payment: $error2".
5075 " (previously tried insert with invnum #$options{'invnum'}" .
5082 if ( $options{'paynum_ref'} ) {
5083 ${ $options{'paynum_ref'} } = $cust_pay->paynum;
5086 return ''; #no error
5091 # item _realtime_bop_result CUST_PAY_PENDING, BOP_OBJECT [ OPTION => VALUE ... ]
5093 # Wraps up processing of a realtime credit card, ACH (electronic check) or
5094 # phone bill transaction.
5096 sub _realtime_bop_result {
5097 my( $self, $cust_pay_pending, $transaction, %options ) = @_;
5099 warn "$me _realtime_bop_result: pending transaction ".
5100 $cust_pay_pending->paypendingnum. "\n";
5101 warn " $_ => $options{$_}\n" foreach keys %options;
5104 my $payment_gateway = $options{payment_gateway}
5105 or return "no payment gateway in arguments to _realtime_bop_result";
5107 $cust_pay_pending->status($transaction->is_success() ? 'captured' : 'declined');
5108 my $cpp_captured_err = $cust_pay_pending->replace;
5109 return $cpp_captured_err if $cpp_captured_err;
5111 if ( $transaction->is_success() ) {
5114 if ( $payment_gateway->gatewaynum ) { # agent override
5115 $paybatch = $payment_gateway->gatewaynum. '-';
5118 $paybatch .= $payment_gateway->gateway_module. ":".
5119 $transaction->authorization;
5121 $paybatch .= ':'. $transaction->order_number
5122 if $transaction->can('order_number')
5123 && length($transaction->order_number);
5125 my $cust_pay = new FS::cust_pay ( {
5126 'custnum' => $self->custnum,
5127 'invnum' => $options{'invnum'},
5128 'paid' => $cust_pay_pending->paid,
5130 'payby' => $cust_pay_pending->payby,
5131 #'payinfo' => $payinfo,
5132 'paybatch' => $paybatch,
5133 'paydate' => $cust_pay_pending->paydate,
5135 #doesn't hurt to know, even though the dup check is in cust_pay_pending now
5136 $cust_pay->payunique( $options{payunique} )
5137 if defined($options{payunique}) && length($options{payunique});
5139 my $oldAutoCommit = $FS::UID::AutoCommit;
5140 local $FS::UID::AutoCommit = 0;
5143 #start a transaction, insert the cust_pay and set cust_pay_pending.status to done in a single transction
5145 my $error = $cust_pay->insert($options{'manual'} ? ( 'manual' => 1 ) : () );
5148 $cust_pay->invnum(''); #try again with no specific invnum
5149 my $error2 = $cust_pay->insert( $options{'manual'} ?
5150 ( 'manual' => 1 ) : ()
5153 # gah. but at least we have a record of the state we had to abort in
5154 # from cust_pay_pending now.
5155 my $e = "WARNING: $options{method} captured but payment not recorded -".
5156 " error inserting payment (". $payment_gateway->gateway_module.
5158 " (previously tried insert with invnum #$options{'invnum'}" .
5159 ": $error ) - pending payment saved as paypendingnum ".
5160 $cust_pay_pending->paypendingnum. "\n";
5166 my $jobnum = $cust_pay_pending->jobnum;
5168 my $placeholder = qsearchs( 'queue', { 'jobnum' => $jobnum } );
5170 unless ( $placeholder ) {
5171 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
5172 my $e = "WARNING: $options{method} captured but job $jobnum not ".
5173 "found for paypendingnum ". $cust_pay_pending->paypendingnum. "\n";
5178 $error = $placeholder->delete;
5181 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
5182 my $e = "WARNING: $options{method} captured but could not delete ".
5183 "job $jobnum for paypendingnum ".
5184 $cust_pay_pending->paypendingnum. ": $error\n";
5191 if ( $options{'paynum_ref'} ) {
5192 ${ $options{'paynum_ref'} } = $cust_pay->paynum;
5195 $cust_pay_pending->status('done');
5196 $cust_pay_pending->statustext('captured');
5197 $cust_pay_pending->paynum($cust_pay->paynum);
5198 my $cpp_done_err = $cust_pay_pending->replace;
5200 if ( $cpp_done_err ) {
5202 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
5203 my $e = "WARNING: $options{method} captured but payment not recorded - ".
5204 "error updating status for paypendingnum ".
5205 $cust_pay_pending->paypendingnum. ": $cpp_done_err \n";
5211 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
5212 return ''; #no error
5218 my $perror = $payment_gateway->gateway_module. " error: ".
5219 $transaction->error_message;
5221 my $jobnum = $cust_pay_pending->jobnum;
5223 my $placeholder = qsearchs( 'queue', { 'jobnum' => $jobnum } );
5225 if ( $placeholder ) {
5226 my $error = $placeholder->depended_delete;
5227 $error ||= $placeholder->delete;
5228 warn "error removing provisioning jobs after declined paypendingnum ".
5229 $cust_pay_pending->paypendingnum. "\n";
5231 my $e = "error finding job $jobnum for declined paypendingnum ".
5232 $cust_pay_pending->paypendingnum. "\n";
5238 unless ( $transaction->error_message ) {
5241 if ( $transaction->can('response_page') ) {
5243 'page' => ( $transaction->can('response_page')
5244 ? $transaction->response_page
5247 'code' => ( $transaction->can('response_code')
5248 ? $transaction->response_code
5251 'headers' => ( $transaction->can('response_headers')
5252 ? $transaction->response_headers
5258 "No additional debugging information available for ".
5259 $payment_gateway->gateway_module;
5262 $perror .= "No error_message returned from ".
5263 $payment_gateway->gateway_module. " -- ".
5264 ( ref($t_response) ? Dumper($t_response) : $t_response );
5268 if ( !$options{'quiet'} && !$realtime_bop_decline_quiet
5269 && $conf->exists('emaildecline')
5270 && grep { $_ ne 'POST' } $self->invoicing_list
5271 && ! grep { $transaction->error_message =~ /$_/ }
5272 $conf->config('emaildecline-exclude')
5274 my @templ = $conf->config('declinetemplate');
5275 my $template = new Text::Template (
5277 SOURCE => [ map "$_\n", @templ ],
5278 ) or return "($perror) can't create template: $Text::Template::ERROR";
5279 $template->compile()
5280 or return "($perror) can't compile template: $Text::Template::ERROR";
5282 my $templ_hash = { error => $transaction->error_message };
5284 my $error = send_email(
5285 'from' => $conf->config('invoice_from', $self->agentnum ),
5286 'to' => [ grep { $_ ne 'POST' } $self->invoicing_list ],
5287 'subject' => 'Your payment could not be processed',
5288 'body' => [ $template->fill_in(HASH => $templ_hash) ],
5291 $perror .= " (also received error sending decline notification: $error)"
5296 $cust_pay_pending->status('done');
5297 $cust_pay_pending->statustext("declined: $perror");
5298 my $cpp_done_err = $cust_pay_pending->replace;
5299 if ( $cpp_done_err ) {
5300 my $e = "WARNING: $options{method} declined but pending payment not ".
5301 "resolved - error updating status for paypendingnum ".
5302 $cust_pay_pending->paypendingnum. ": $cpp_done_err \n";
5304 $perror = "$e ($perror)";
5312 =item realtime_botpp_capture CUST_PAY_PENDING [ OPTION => VALUE ... ]
5314 Verifies successful third party processing of a realtime credit card,
5315 ACH (electronic check) or phone bill transaction via a
5316 Business::OnlineThirdPartyPayment realtime gateway. See
5317 L<http://420.am/business-onlinethirdpartypayment> for supported gateways.
5319 Available options are: I<description>, I<invnum>, I<quiet>, I<paynum_ref>, I<payunique>
5321 The additional options I<payname>, I<city>, I<state>,
5322 I<zip>, I<payinfo> and I<paydate> are also available. Any of these options,
5323 if set, will override the value from the customer record.
5325 I<description> is a free-text field passed to the gateway. It defaults to
5326 "Internet services".
5328 If an I<invnum> is specified, this payment (if successful) is applied to the
5329 specified invoice. If you don't specify an I<invnum> you might want to
5330 call the B<apply_payments> method.
5332 I<quiet> can be set true to surpress email decline notices.
5334 I<paynum_ref> can be set to a scalar reference. It will be filled in with the
5335 resulting paynum, if any.
5337 I<payunique> is a unique identifier for this payment.
5339 Returns a hashref containing elements bill_error (which will be undefined
5340 upon success) and session_id of any associated session.
5344 sub realtime_botpp_capture {
5345 my( $self, $cust_pay_pending, %options ) = @_;
5347 warn "$me realtime_botpp_capture: pending transaction $cust_pay_pending\n";
5348 warn " $_ => $options{$_}\n" foreach keys %options;
5351 eval "use Business::OnlineThirdPartyPayment";
5355 # select the gateway
5358 my $method = FS::payby->payby2bop($cust_pay_pending->payby);
5360 my $payment_gateway = $cust_pay_pending->gatewaynum
5361 ? qsearchs( 'payment_gateway',
5362 { gatewaynum => $cust_pay_pending->gatewaynum }
5364 : $self->agent->payment_gateway( 'method' => $method,
5365 # 'invnum' => $cust_pay_pending->invnum,
5366 # 'payinfo' => $cust_pay_pending->payinfo,
5369 $options{payment_gateway} = $payment_gateway; # for the helper subs
5375 my @invoicing_list = $self->invoicing_list_emailonly;
5376 if ( $conf->exists('emailinvoiceautoalways')
5377 || $conf->exists('emailinvoiceauto') && ! @invoicing_list
5378 || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
5379 push @invoicing_list, $self->all_emails;
5382 my $email = ($conf->exists('business-onlinepayment-email-override'))
5383 ? $conf->config('business-onlinepayment-email-override')
5384 : $invoicing_list[0];
5388 $content{email_customer} =
5389 ( $conf->exists('business-onlinepayment-email_customer')
5390 || $conf->exists('business-onlinepayment-email-override') );
5393 # run transaction(s)
5397 new Business::OnlineThirdPartyPayment( $payment_gateway->gateway_module,
5398 $self->_bop_options(\%options),
5401 $transaction->reference({ %options });
5403 $transaction->content(
5405 $self->_bop_auth(\%options),
5406 'action' => 'Post Authorization',
5407 'description' => $options{'description'},
5408 'amount' => $cust_pay_pending->paid,
5409 #'invoice_number' => $options{'invnum'},
5410 'customer_id' => $self->custnum,
5411 'referer' => 'http://cleanwhisker.420.am/',
5412 'reference' => $cust_pay_pending->paypendingnum,
5414 'phone' => $self->daytime || $self->night,
5416 # plus whatever is required for bogus capture avoidance
5419 $transaction->submit();
5422 $self->_realtime_bop_result( $cust_pay_pending, $transaction, %options );
5425 bill_error => $error,
5426 session_id => $cust_pay_pending->session_id,
5431 =item default_payment_gateway DEPRECATED -- use agent->payment_gateway
5435 sub default_payment_gateway {
5436 my( $self, $method ) = @_;
5438 die "Real-time processing not enabled\n"
5439 unless $conf->exists('business-onlinepayment');
5441 #warn "default_payment_gateway deprecated -- use agent->payment_gateway\n";
5444 my $bop_config = 'business-onlinepayment';
5445 $bop_config .= '-ach'
5446 if $method =~ /^(ECHECK|CHEK)$/ && $conf->exists($bop_config. '-ach');
5447 my ( $processor, $login, $password, $action, @bop_options ) =
5448 $conf->config($bop_config);
5449 $action ||= 'normal authorization';
5450 pop @bop_options if scalar(@bop_options) % 2 && $bop_options[-1] =~ /^\s*$/;
5451 die "No real-time processor is enabled - ".
5452 "did you set the business-onlinepayment configuration value?\n"
5455 ( $processor, $login, $password, $action, @bop_options )
5460 Removes the I<paycvv> field from the database directly.
5462 If there is an error, returns the error, otherwise returns false.
5468 my $sth = dbh->prepare("UPDATE cust_main SET paycvv = '' WHERE custnum = ?")
5469 or return dbh->errstr;
5470 $sth->execute($self->custnum)
5471 or return $sth->errstr;
5476 =item _new_realtime_refund_bop METHOD [ OPTION => VALUE ... ]
5478 Refunds a realtime credit card, ACH (electronic check) or phone bill transaction
5479 via a Business::OnlinePayment realtime gateway. See
5480 L<http://420.am/business-onlinepayment> for supported gateways.
5482 Available methods are: I<CC>, I<ECHECK> and I<LEC>
5484 Available options are: I<amount>, I<reason>, I<paynum>, I<paydate>
5486 Most gateways require a reference to an original payment transaction to refund,
5487 so you probably need to specify a I<paynum>.
5489 I<amount> defaults to the original amount of the payment if not specified.
5491 I<reason> specifies a reason for the refund.
5493 I<paydate> specifies the expiration date for a credit card overriding the
5494 value from the customer record or the payment record. Specified as yyyy-mm-dd
5496 Implementation note: If I<amount> is unspecified or equal to the amount of the
5497 orignal payment, first an attempt is made to "void" the transaction via
5498 the gateway (to cancel a not-yet settled transaction) and then if that fails,
5499 the normal attempt is made to "refund" ("credit") the transaction via the
5500 gateway is attempted.
5502 #The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
5503 #I<zip>, I<payinfo> and I<paydate> are also available. Any of these options,
5504 #if set, will override the value from the customer record.
5506 #If an I<invnum> is specified, this payment (if successful) is applied to the
5507 #specified invoice. If you don't specify an I<invnum> you might want to
5508 #call the B<apply_payments> method.
5512 #some false laziness w/realtime_bop, not enough to make it worth merging
5513 #but some useful small subs should be pulled out
5514 sub _new_realtime_refund_bop {
5518 if (ref($_[0]) ne 'HASH') {
5519 %options = %{$_[0]};
5523 $options{method} = $method;
5527 warn "$me realtime_refund_bop (new): $options{method} refund\n";
5528 warn " $_ => $options{$_}\n" foreach keys %options;
5532 # look up the original payment and optionally a gateway for that payment
5536 my $amount = $options{'amount'};
5538 my( $processor, $login, $password, @bop_options, $namespace ) ;
5539 my( $auth, $order_number ) = ( '', '', '' );
5541 if ( $options{'paynum'} ) {
5543 warn " paynum: $options{paynum}\n" if $DEBUG > 1;
5544 $cust_pay = qsearchs('cust_pay', { paynum=>$options{'paynum'} } )
5545 or return "Unknown paynum $options{'paynum'}";
5546 $amount ||= $cust_pay->paid;
5548 $cust_pay->paybatch =~ /^((\d+)\-)?(\w+):\s*([\w\-\/ ]*)(:([\w\-]+))?$/
5549 or return "Can't parse paybatch for paynum $options{'paynum'}: ".
5550 $cust_pay->paybatch;
5551 my $gatewaynum = '';
5552 ( $gatewaynum, $processor, $auth, $order_number ) = ( $2, $3, $4, $6 );
5554 if ( $gatewaynum ) { #gateway for the payment to be refunded
5556 my $payment_gateway =
5557 qsearchs('payment_gateway', { 'gatewaynum' => $gatewaynum } );
5558 die "payment gateway $gatewaynum not found"
5559 unless $payment_gateway;
5561 $processor = $payment_gateway->gateway_module;
5562 $login = $payment_gateway->gateway_username;
5563 $password = $payment_gateway->gateway_password;
5564 $namespace = $payment_gateway->gateway_namespace;
5565 @bop_options = $payment_gateway->options;
5567 } else { #try the default gateway
5570 my $payment_gateway =
5571 $self->agent->payment_gateway('method' => $options{method});
5573 ( $conf_processor, $login, $password, $namespace ) =
5574 map { my $method = "gateway_$_"; $payment_gateway->$method }
5575 qw( module username password namespace );
5577 @bop_options = $payment_gateway->gatewaynum
5578 ? $payment_gateway->options
5579 : @{ $payment_gateway->get('options') };
5581 return "processor of payment $options{'paynum'} $processor does not".
5582 " match default processor $conf_processor"
5583 unless $processor eq $conf_processor;
5588 } else { # didn't specify a paynum, so look for agent gateway overrides
5589 # like a normal transaction
5591 my $payment_gateway =
5592 $self->agent->payment_gateway( 'method' => $options{method},
5593 #'payinfo' => $payinfo,
5595 my( $processor, $login, $password, $namespace ) =
5596 map { my $method = "gateway_$_"; $payment_gateway->$method }
5597 qw( module username password namespace );
5599 my @bop_options = $payment_gateway->gatewaynum
5600 ? $payment_gateway->options
5601 : @{ $payment_gateway->get('options') };
5604 return "neither amount nor paynum specified" unless $amount;
5606 eval "use $namespace";
5610 'type' => $options{method},
5612 'password' => $password,
5613 'order_number' => $order_number,
5614 'amount' => $amount,
5615 'referer' => 'http://cleanwhisker.420.am/', #XXX fix referer :/
5617 $content{authorization} = $auth
5618 if length($auth); #echeck/ACH transactions have an order # but no auth
5619 #(at least with authorize.net)
5621 my $disable_void_after;
5622 if ($conf->exists('disable_void_after')
5623 && $conf->config('disable_void_after') =~ /^(\d+)$/) {
5624 $disable_void_after = $1;
5627 #first try void if applicable
5628 if ( $cust_pay && $cust_pay->paid == $amount
5630 ( not defined($disable_void_after) )
5631 || ( time < ($cust_pay->_date + $disable_void_after ) )
5634 warn " attempting void\n" if $DEBUG > 1;
5635 my $void = new Business::OnlinePayment( $processor, @bop_options );
5636 $void->content( 'action' => 'void', %content );
5638 if ( $void->is_success ) {
5639 my $error = $cust_pay->void($options{'reason'});
5641 # gah, even with transactions.
5642 my $e = 'WARNING: Card/ACH voided but database not updated - '.
5643 "error voiding payment: $error";
5647 warn " void successful\n" if $DEBUG > 1;
5652 warn " void unsuccessful, trying refund\n"
5656 my $address = $self->address1;
5657 $address .= ", ". $self->address2 if $self->address2;
5659 my($payname, $payfirst, $paylast);
5660 if ( $self->payname && $options{method} ne 'ECHECK' ) {
5661 $payname = $self->payname;
5662 $payname =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
5663 or return "Illegal payname $payname";
5664 ($payfirst, $paylast) = ($1, $2);
5666 $payfirst = $self->getfield('first');
5667 $paylast = $self->getfield('last');
5668 $payname = "$payfirst $paylast";
5671 my @invoicing_list = $self->invoicing_list_emailonly;
5672 if ( $conf->exists('emailinvoiceautoalways')
5673 || $conf->exists('emailinvoiceauto') && ! @invoicing_list
5674 || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
5675 push @invoicing_list, $self->all_emails;
5678 my $email = ($conf->exists('business-onlinepayment-email-override'))
5679 ? $conf->config('business-onlinepayment-email-override')
5680 : $invoicing_list[0];
5682 my $payip = exists($options{'payip'})
5685 $content{customer_ip} = $payip
5689 if ( $options{method} eq 'CC' ) {
5692 $content{card_number} = $payinfo = $cust_pay->payinfo;
5693 (exists($options{'paydate'}) ? $options{'paydate'} : $cust_pay->paydate)
5694 =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/ &&
5695 ($content{expiration} = "$2/$1"); # where available
5697 $content{card_number} = $payinfo = $self->payinfo;
5698 (exists($options{'paydate'}) ? $options{'paydate'} : $self->paydate)
5699 =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
5700 $content{expiration} = "$2/$1";
5703 } elsif ( $options{method} eq 'ECHECK' ) {
5706 $payinfo = $cust_pay->payinfo;
5708 $payinfo = $self->payinfo;
5710 ( $content{account_number}, $content{routing_code} )= split('@', $payinfo );
5711 $content{bank_name} = $self->payname;
5712 $content{account_type} = 'CHECKING';
5713 $content{account_name} = $payname;
5714 $content{customer_org} = $self->company ? 'B' : 'I';
5715 $content{customer_ssn} = $self->ss;
5716 } elsif ( $options{method} eq 'LEC' ) {
5717 $content{phone} = $payinfo = $self->payinfo;
5721 my $refund = new Business::OnlinePayment( $processor, @bop_options );
5722 my %sub_content = $refund->content(
5723 'action' => 'credit',
5724 'customer_id' => $self->custnum,
5725 'last_name' => $paylast,
5726 'first_name' => $payfirst,
5728 'address' => $address,
5729 'city' => $self->city,
5730 'state' => $self->state,
5731 'zip' => $self->zip,
5732 'country' => $self->country,
5734 'phone' => $self->daytime || $self->night,
5737 warn join('', map { " $_ => $sub_content{$_}\n" } keys %sub_content )
5741 return "$processor error: ". $refund->error_message
5742 unless $refund->is_success();
5744 my $paybatch = "$processor:". $refund->authorization;
5745 $paybatch .= ':'. $refund->order_number
5746 if $refund->can('order_number') && $refund->order_number;
5748 while ( $cust_pay && $cust_pay->unapplied < $amount ) {
5749 my @cust_bill_pay = $cust_pay->cust_bill_pay;
5750 last unless @cust_bill_pay;
5751 my $cust_bill_pay = pop @cust_bill_pay;
5752 my $error = $cust_bill_pay->delete;
5756 my $cust_refund = new FS::cust_refund ( {
5757 'custnum' => $self->custnum,
5758 'paynum' => $options{'paynum'},
5759 'refund' => $amount,
5761 'payby' => $bop_method2payby{$options{method}},
5762 'payinfo' => $payinfo,
5763 'paybatch' => $paybatch,
5764 'reason' => $options{'reason'} || 'card or ACH refund',
5766 my $error = $cust_refund->insert;
5768 $cust_refund->paynum(''); #try again with no specific paynum
5769 my $error2 = $cust_refund->insert;
5771 # gah, even with transactions.
5772 my $e = 'WARNING: Card/ACH refunded but database not updated - '.
5773 "error inserting refund ($processor): $error2".
5774 " (previously tried insert with paynum #$options{'paynum'}" .
5785 =item batch_card OPTION => VALUE...
5787 Adds a payment for this invoice to the pending credit card batch (see
5788 L<FS::cust_pay_batch>), or, if the B<realtime> option is set to a true value,
5789 runs the payment using a realtime gateway.
5794 my ($self, %options) = @_;
5797 if (exists($options{amount})) {
5798 $amount = $options{amount};
5800 $amount = sprintf("%.2f", $self->balance - $self->in_transit_payments);
5802 return '' unless $amount > 0;
5804 my $invnum = delete $options{invnum};
5805 my $payby = $options{invnum} || $self->payby; #dubious
5807 if ($options{'realtime'}) {
5808 return $self->realtime_bop( FS::payby->payby2bop($self->payby),
5814 my $oldAutoCommit = $FS::UID::AutoCommit;
5815 local $FS::UID::AutoCommit = 0;
5818 #this needs to handle mysql as well as Pg, like svc_acct.pm
5819 #(make it into a common function if folks need to do batching with mysql)
5820 $dbh->do("LOCK TABLE pay_batch IN SHARE ROW EXCLUSIVE MODE")
5821 or return "Cannot lock pay_batch: " . $dbh->errstr;
5825 'payby' => FS::payby->payby2payment($payby),
5828 my $pay_batch = qsearchs( 'pay_batch', \%pay_batch );
5830 unless ( $pay_batch ) {
5831 $pay_batch = new FS::pay_batch \%pay_batch;
5832 my $error = $pay_batch->insert;
5834 $dbh->rollback if $oldAutoCommit;
5835 die "error creating new batch: $error\n";
5839 my $old_cust_pay_batch = qsearchs('cust_pay_batch', {
5840 'batchnum' => $pay_batch->batchnum,
5841 'custnum' => $self->custnum,
5844 foreach (qw( address1 address2 city state zip country payby payinfo paydate
5846 $options{$_} = '' unless exists($options{$_});
5849 my $cust_pay_batch = new FS::cust_pay_batch ( {
5850 'batchnum' => $pay_batch->batchnum,
5851 'invnum' => $invnum || 0, # is there a better value?
5852 # this field should be
5854 # cust_bill_pay_batch now
5855 'custnum' => $self->custnum,
5856 'last' => $self->getfield('last'),
5857 'first' => $self->getfield('first'),
5858 'address1' => $options{address1} || $self->address1,
5859 'address2' => $options{address2} || $self->address2,
5860 'city' => $options{city} || $self->city,
5861 'state' => $options{state} || $self->state,
5862 'zip' => $options{zip} || $self->zip,
5863 'country' => $options{country} || $self->country,
5864 'payby' => $options{payby} || $self->payby,
5865 'payinfo' => $options{payinfo} || $self->payinfo,
5866 'exp' => $options{paydate} || $self->paydate,
5867 'payname' => $options{payname} || $self->payname,
5868 'amount' => $amount, # consolidating
5871 $cust_pay_batch->paybatchnum($old_cust_pay_batch->paybatchnum)
5872 if $old_cust_pay_batch;
5875 if ($old_cust_pay_batch) {
5876 $error = $cust_pay_batch->replace($old_cust_pay_batch)
5878 $error = $cust_pay_batch->insert;
5882 $dbh->rollback if $oldAutoCommit;
5886 my $unapplied = $self->total_unapplied_credits
5887 + $self->total_unapplied_payments
5888 + $self->in_transit_payments;
5889 foreach my $cust_bill ($self->open_cust_bill) {
5890 #$dbh->commit or die $dbh->errstr if $oldAutoCommit;
5891 my $cust_bill_pay_batch = new FS::cust_bill_pay_batch {
5892 'invnum' => $cust_bill->invnum,
5893 'paybatchnum' => $cust_pay_batch->paybatchnum,
5894 'amount' => $cust_bill->owed,
5897 if ($unapplied >= $cust_bill_pay_batch->amount){
5898 $unapplied -= $cust_bill_pay_batch->amount;
5901 $cust_bill_pay_batch->amount(sprintf ( "%.2f",
5902 $cust_bill_pay_batch->amount - $unapplied )); $unapplied = 0;
5904 $error = $cust_bill_pay_batch->insert;
5906 $dbh->rollback if $oldAutoCommit;
5911 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
5915 =item apply_payments_and_credits
5917 Applies unapplied payments and credits.
5919 In most cases, this new method should be used in place of sequential
5920 apply_payments and apply_credits methods.
5922 If there is an error, returns the error, otherwise returns false.
5926 sub apply_payments_and_credits {
5929 local $SIG{HUP} = 'IGNORE';
5930 local $SIG{INT} = 'IGNORE';
5931 local $SIG{QUIT} = 'IGNORE';
5932 local $SIG{TERM} = 'IGNORE';
5933 local $SIG{TSTP} = 'IGNORE';
5934 local $SIG{PIPE} = 'IGNORE';
5936 my $oldAutoCommit = $FS::UID::AutoCommit;
5937 local $FS::UID::AutoCommit = 0;
5940 $self->select_for_update; #mutex
5942 foreach my $cust_bill ( $self->open_cust_bill ) {
5943 my $error = $cust_bill->apply_payments_and_credits;
5945 $dbh->rollback if $oldAutoCommit;
5946 return "Error applying: $error";
5950 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
5955 =item apply_credits OPTION => VALUE ...
5957 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
5958 to outstanding invoice balances in chronological order (or reverse
5959 chronological order if the I<order> option is set to B<newest>) and returns the
5960 value of any remaining unapplied credits available for refund (see
5961 L<FS::cust_refund>).
5963 Dies if there is an error.
5971 local $SIG{HUP} = 'IGNORE';
5972 local $SIG{INT} = 'IGNORE';
5973 local $SIG{QUIT} = 'IGNORE';
5974 local $SIG{TERM} = 'IGNORE';
5975 local $SIG{TSTP} = 'IGNORE';
5976 local $SIG{PIPE} = 'IGNORE';
5978 my $oldAutoCommit = $FS::UID::AutoCommit;
5979 local $FS::UID::AutoCommit = 0;
5982 $self->select_for_update; #mutex
5984 unless ( $self->total_unapplied_credits ) {
5985 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
5989 my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
5990 qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
5992 my @invoices = $self->open_cust_bill;
5993 @invoices = sort { $b->_date <=> $a->_date } @invoices
5994 if defined($opt{'order'}) && $opt{'order'} eq 'newest';
5997 foreach my $cust_bill ( @invoices ) {
6000 if ( !defined($credit) || $credit->credited == 0) {
6001 $credit = pop @credits or last;
6004 if ($cust_bill->owed >= $credit->credited) {
6005 $amount=$credit->credited;
6007 $amount=$cust_bill->owed;
6010 my $cust_credit_bill = new FS::cust_credit_bill ( {
6011 'crednum' => $credit->crednum,
6012 'invnum' => $cust_bill->invnum,
6013 'amount' => $amount,
6015 my $error = $cust_credit_bill->insert;
6017 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
6021 redo if ($cust_bill->owed > 0);
6025 my $total_unapplied_credits = $self->total_unapplied_credits;
6027 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
6029 return $total_unapplied_credits;
6032 =item apply_payments
6034 Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
6035 to outstanding invoice balances in chronological order.
6037 #and returns the value of any remaining unapplied payments.
6039 Dies if there is an error.
6043 sub apply_payments {
6046 local $SIG{HUP} = 'IGNORE';
6047 local $SIG{INT} = 'IGNORE';
6048 local $SIG{QUIT} = 'IGNORE';
6049 local $SIG{TERM} = 'IGNORE';
6050 local $SIG{TSTP} = 'IGNORE';
6051 local $SIG{PIPE} = 'IGNORE';
6053 my $oldAutoCommit = $FS::UID::AutoCommit;
6054 local $FS::UID::AutoCommit = 0;
6057 $self->select_for_update; #mutex
6061 my @payments = sort { $b->_date <=> $a->_date }
6062 grep { $_->unapplied > 0 }
6065 my @invoices = sort { $a->_date <=> $b->_date}
6066 grep { $_->owed > 0 }
6071 foreach my $cust_bill ( @invoices ) {
6074 if ( !defined($payment) || $payment->unapplied == 0 ) {
6075 $payment = pop @payments or last;
6078 if ( $cust_bill->owed >= $payment->unapplied ) {
6079 $amount = $payment->unapplied;
6081 $amount = $cust_bill->owed;
6084 my $cust_bill_pay = new FS::cust_bill_pay ( {
6085 'paynum' => $payment->paynum,
6086 'invnum' => $cust_bill->invnum,
6087 'amount' => $amount,
6089 my $error = $cust_bill_pay->insert;
6091 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
6095 redo if ( $cust_bill->owed > 0);
6099 my $total_unapplied_payments = $self->total_unapplied_payments;
6101 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
6103 return $total_unapplied_payments;
6108 Returns the total owed for this customer on all invoices
6109 (see L<FS::cust_bill/owed>).
6115 $self->total_owed_date(2145859200); #12/31/2037
6118 =item total_owed_date TIME
6120 Returns the total owed for this customer on all invoices with date earlier than
6121 TIME. TIME is specified as a UNIX timestamp; see L<perlfunc/"time">). Also
6122 see L<Time::Local> and L<Date::Parse> for conversion functions.
6126 sub total_owed_date {
6130 # my $custnum = $self->custnum;
6132 # my $owed_sql = FS::cust_bill->owed_sql;
6135 # SELECT SUM($owed_sql) FROM cust_bill
6136 # WHERE custnum = $custnum
6137 # AND _date <= $time
6140 # my $sth = dbh->prepare($sql) or die dbh->errstr;
6141 # $sth->execute() or die $sth->errstr;
6143 # return sprintf( '%.2f', $sth->fetchrow_arrayref->[0] );
6146 foreach my $cust_bill (
6147 grep { $_->_date <= $time }
6148 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
6150 $total_bill += $cust_bill->owed;
6152 sprintf( "%.2f", $total_bill );
6158 Returns the total amount of all payments.
6165 $total += $_->paid foreach $self->cust_pay;
6166 sprintf( "%.2f", $total );
6169 =item total_unapplied_credits
6171 Returns the total outstanding credit (see L<FS::cust_credit>) for this
6172 customer. See L<FS::cust_credit/credited>.
6174 =item total_credited
6176 Old name for total_unapplied_credits. Don't use.
6180 sub total_credited {
6181 #carp "total_credited deprecated, use total_unapplied_credits";
6182 shift->total_unapplied_credits(@_);
6185 sub total_unapplied_credits {
6187 my $total_credit = 0;
6188 $total_credit += $_->credited foreach $self->cust_credit;
6189 sprintf( "%.2f", $total_credit );
6192 =item total_unapplied_payments
6194 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
6195 See L<FS::cust_pay/unapplied>.
6199 sub total_unapplied_payments {
6201 my $total_unapplied = 0;
6202 $total_unapplied += $_->unapplied foreach $self->cust_pay;
6203 sprintf( "%.2f", $total_unapplied );
6206 =item total_unapplied_refunds
6208 Returns the total unrefunded refunds (see L<FS::cust_refund>) for this
6209 customer. See L<FS::cust_refund/unapplied>.
6213 sub total_unapplied_refunds {
6215 my $total_unapplied = 0;
6216 $total_unapplied += $_->unapplied foreach $self->cust_refund;
6217 sprintf( "%.2f", $total_unapplied );
6222 Returns the balance for this customer (total_owed plus total_unrefunded, minus
6223 total_unapplied_credits minus total_unapplied_payments).
6231 + $self->total_unapplied_refunds
6232 - $self->total_unapplied_credits
6233 - $self->total_unapplied_payments
6237 =item balance_date TIME
6239 Returns the balance for this customer, only considering invoices with date
6240 earlier than TIME (total_owed_date minus total_credited minus
6241 total_unapplied_payments). TIME is specified as a UNIX timestamp; see
6242 L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion
6251 $self->total_owed_date($time)
6252 + $self->total_unapplied_refunds
6253 - $self->total_unapplied_credits
6254 - $self->total_unapplied_payments
6258 =item in_transit_payments
6260 Returns the total of requests for payments for this customer pending in
6261 batches in transit to the bank. See L<FS::pay_batch> and L<FS::cust_pay_batch>
6265 sub in_transit_payments {
6267 my $in_transit_payments = 0;
6268 foreach my $pay_batch ( qsearch('pay_batch', {
6271 foreach my $cust_pay_batch ( qsearch('cust_pay_batch', {
6272 'batchnum' => $pay_batch->batchnum,
6273 'custnum' => $self->custnum,
6275 $in_transit_payments += $cust_pay_batch->amount;
6278 sprintf( "%.2f", $in_transit_payments );
6283 Returns a hash of useful information for making a payment.
6293 'CARD' (credit card - automatic), 'DCRD' (credit card - on-demand),
6294 'CHEK' (electronic check - automatic), 'DCHK' (electronic check - on-demand),
6295 'LECB' (Phone bill billing), 'BILL' (billing), or 'COMP' (free).
6299 For credit card transactions:
6311 For electronic check transactions:
6326 $return{balance} = $self->balance;
6328 $return{payname} = $self->payname
6329 || ( $self->first. ' '. $self->get('last') );
6331 $return{$_} = $self->get($_) for qw(address1 address2 city state zip);
6333 $return{payby} = $self->payby;
6334 $return{stateid_state} = $self->stateid_state;
6336 if ( $self->payby =~ /^(CARD|DCRD)$/ ) {
6337 $return{card_type} = cardtype($self->payinfo);
6338 $return{payinfo} = $self->paymask;
6340 @return{'month', 'year'} = $self->paydate_monthyear;
6344 if ( $self->payby =~ /^(CHEK|DCHK)$/ ) {
6345 my ($payinfo1, $payinfo2) = split '@', $self->paymask;
6346 $return{payinfo1} = $payinfo1;
6347 $return{payinfo2} = $payinfo2;
6348 $return{paytype} = $self->paytype;
6349 $return{paystate} = $self->paystate;
6353 #doubleclick protection
6355 $return{paybatch} = "webui-MyAccount-$_date-$$-". rand() * 2**32;
6361 =item paydate_monthyear
6363 Returns a two-element list consisting of the month and year of this customer's
6364 paydate (credit card expiration date for CARD customers)
6368 sub paydate_monthyear {
6370 if ( $self->paydate =~ /^(\d{4})-(\d{1,2})-\d{1,2}$/ ) { #Pg date format
6372 } elsif ( $self->paydate =~ /^(\d{1,2})-(\d{1,2}-)?(\d{4}$)/ ) {
6379 =item tax_exemption TAXNAME
6384 my( $self, $taxname ) = @_;
6386 qsearchs( 'cust_main_exemption', { 'custnum' => $self->custnum,
6387 'taxname' => { 'op' => 'LIKE',
6388 'value' => $taxname.'%' },
6393 =item invoicing_list [ ARRAYREF ]
6395 If an arguement is given, sets these email addresses as invoice recipients
6396 (see L<FS::cust_main_invoice>). Errors are not fatal and are not reported
6397 (except as warnings), so use check_invoicing_list first.
6399 Returns a list of email addresses (with svcnum entries expanded).
6401 Note: You can clear the invoicing list by passing an empty ARRAYREF. You can
6402 check it without disturbing anything by passing nothing.
6404 This interface may change in the future.
6408 sub invoicing_list {
6409 my( $self, $arrayref ) = @_;
6412 my @cust_main_invoice;
6413 if ( $self->custnum ) {
6414 @cust_main_invoice =
6415 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
6417 @cust_main_invoice = ();
6419 foreach my $cust_main_invoice ( @cust_main_invoice ) {
6420 #warn $cust_main_invoice->destnum;
6421 unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
6422 #warn $cust_main_invoice->destnum;
6423 my $error = $cust_main_invoice->delete;
6424 warn $error if $error;
6427 if ( $self->custnum ) {
6428 @cust_main_invoice =
6429 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
6431 @cust_main_invoice = ();
6433 my %seen = map { $_->address => 1 } @cust_main_invoice;
6434 foreach my $address ( @{$arrayref} ) {
6435 next if exists $seen{$address} && $seen{$address};
6436 $seen{$address} = 1;
6437 my $cust_main_invoice = new FS::cust_main_invoice ( {
6438 'custnum' => $self->custnum,
6441 my $error = $cust_main_invoice->insert;
6442 warn $error if $error;
6446 if ( $self->custnum ) {
6448 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
6455 =item check_invoicing_list ARRAYREF
6457 Checks these arguements as valid input for the invoicing_list method. If there
6458 is an error, returns the error, otherwise returns false.
6462 sub check_invoicing_list {
6463 my( $self, $arrayref ) = @_;
6465 foreach my $address ( @$arrayref ) {
6467 if ($address eq 'FAX' and $self->getfield('fax') eq '') {
6468 return 'Can\'t add FAX invoice destination with a blank FAX number.';
6471 my $cust_main_invoice = new FS::cust_main_invoice ( {
6472 'custnum' => $self->custnum,
6475 my $error = $self->custnum
6476 ? $cust_main_invoice->check
6477 : $cust_main_invoice->checkdest
6479 return $error if $error;
6483 return "Email address required"
6484 if $conf->exists('cust_main-require_invoicing_list_email')
6485 && ! grep { $_ !~ /^([A-Z]+)$/ } @$arrayref;
6490 =item set_default_invoicing_list
6492 Sets the invoicing list to all accounts associated with this customer,
6493 overwriting any previous invoicing list.
6497 sub set_default_invoicing_list {
6499 $self->invoicing_list($self->all_emails);
6504 Returns the email addresses of all accounts provisioned for this customer.
6511 foreach my $cust_pkg ( $self->all_pkgs ) {
6512 my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
6514 map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
6515 grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
6517 $list{$_}=1 foreach map { $_->email } @svc_acct;
6522 =item invoicing_list_addpost
6524 Adds postal invoicing to this customer. If this customer is already configured
6525 to receive postal invoices, does nothing.
6529 sub invoicing_list_addpost {
6531 return if grep { $_ eq 'POST' } $self->invoicing_list;
6532 my @invoicing_list = $self->invoicing_list;
6533 push @invoicing_list, 'POST';
6534 $self->invoicing_list(\@invoicing_list);
6537 =item invoicing_list_emailonly
6539 Returns the list of email invoice recipients (invoicing_list without non-email
6540 destinations such as POST and FAX).
6544 sub invoicing_list_emailonly {
6546 warn "$me invoicing_list_emailonly called"
6548 grep { $_ !~ /^([A-Z]+)$/ } $self->invoicing_list;
6551 =item invoicing_list_emailonly_scalar
6553 Returns the list of email invoice recipients (invoicing_list without non-email
6554 destinations such as POST and FAX) as a comma-separated scalar.
6558 sub invoicing_list_emailonly_scalar {
6560 warn "$me invoicing_list_emailonly_scalar called"
6562 join(', ', $self->invoicing_list_emailonly);
6565 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
6567 Returns an array of customers referred by this customer (referral_custnum set
6568 to this custnum). If DEPTH is given, recurses up to the given depth, returning
6569 customers referred by customers referred by this customer and so on, inclusive.
6570 The default behavior is DEPTH 1 (no recursion).
6574 sub referral_cust_main {
6576 my $depth = @_ ? shift : 1;
6577 my $exclude = @_ ? shift : {};
6580 map { $exclude->{$_->custnum}++; $_; }
6581 grep { ! $exclude->{ $_->custnum } }
6582 qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
6586 map { $_->referral_cust_main($depth-1, $exclude) }
6593 =item referral_cust_main_ncancelled
6595 Same as referral_cust_main, except only returns customers with uncancelled
6600 sub referral_cust_main_ncancelled {
6602 grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
6605 =item referral_cust_pkg [ DEPTH ]
6607 Like referral_cust_main, except returns a flat list of all unsuspended (and
6608 uncancelled) packages for each customer. The number of items in this list may
6609 be useful for comission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
6613 sub referral_cust_pkg {
6615 my $depth = @_ ? shift : 1;
6617 map { $_->unsuspended_pkgs }
6618 grep { $_->unsuspended_pkgs }
6619 $self->referral_cust_main($depth);
6622 =item referring_cust_main
6624 Returns the single cust_main record for the customer who referred this customer
6625 (referral_custnum), or false.
6629 sub referring_cust_main {
6631 return '' unless $self->referral_custnum;
6632 qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
6635 =item credit AMOUNT, REASON [ , OPTION => VALUE ... ]
6637 Applies a credit to this customer. If there is an error, returns the error,
6638 otherwise returns false.
6640 REASON can be a text string, an FS::reason object, or a scalar reference to
6641 a reasonnum. If a text string, it will be automatically inserted as a new
6642 reason, and a 'reason_type' option must be passed to indicate the
6643 FS::reason_type for the new reason.
6645 An I<addlinfo> option may be passed to set the credit's I<addlinfo> field.
6647 Any other options are passed to FS::cust_credit::insert.
6652 my( $self, $amount, $reason, %options ) = @_;
6654 my $cust_credit = new FS::cust_credit {
6655 'custnum' => $self->custnum,
6656 'amount' => $amount,
6659 if ( ref($reason) ) {
6661 if ( ref($reason) eq 'SCALAR' ) {
6662 $cust_credit->reasonnum( $$reason );
6664 $cust_credit->reasonnum( $reason->reasonnum );
6668 $cust_credit->set('reason', $reason)
6671 $cust_credit->addlinfo( delete $options{'addlinfo'} )
6672 if exists($options{'addlinfo'});
6674 $cust_credit->insert(%options);
6678 =item charge AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
6680 Creates a one-time charge for this customer. If there is an error, returns
6681 the error, otherwise returns false.
6687 my ( $amount, $quantity, $pkg, $comment, $classnum, $additional );
6688 my ( $setuptax, $taxclass ); #internal taxes
6689 my ( $taxproduct, $override ); #vendor (CCH) taxes
6690 if ( ref( $_[0] ) ) {
6691 $amount = $_[0]->{amount};
6692 $quantity = exists($_[0]->{quantity}) ? $_[0]->{quantity} : 1;
6693 $pkg = exists($_[0]->{pkg}) ? $_[0]->{pkg} : 'One-time charge';
6694 $comment = exists($_[0]->{comment}) ? $_[0]->{comment}
6695 : '$'. sprintf("%.2f",$amount);
6696 $setuptax = exists($_[0]->{setuptax}) ? $_[0]->{setuptax} : '';
6697 $taxclass = exists($_[0]->{taxclass}) ? $_[0]->{taxclass} : '';
6698 $classnum = exists($_[0]->{classnum}) ? $_[0]->{classnum} : '';
6699 $additional = $_[0]->{additional};
6700 $taxproduct = $_[0]->{taxproductnum};
6701 $override = { '' => $_[0]->{tax_override} };
6705 $pkg = @_ ? shift : 'One-time charge';
6706 $comment = @_ ? shift : '$'. sprintf("%.2f",$amount);
6708 $taxclass = @_ ? shift : '';
6712 local $SIG{HUP} = 'IGNORE';
6713 local $SIG{INT} = 'IGNORE';
6714 local $SIG{QUIT} = 'IGNORE';
6715 local $SIG{TERM} = 'IGNORE';
6716 local $SIG{TSTP} = 'IGNORE';
6717 local $SIG{PIPE} = 'IGNORE';
6719 my $oldAutoCommit = $FS::UID::AutoCommit;
6720 local $FS::UID::AutoCommit = 0;
6723 my $part_pkg = new FS::part_pkg ( {
6725 'comment' => $comment,
6729 'classnum' => $classnum ? $classnum : '',
6730 'setuptax' => $setuptax,
6731 'taxclass' => $taxclass,
6732 'taxproductnum' => $taxproduct,
6735 my %options = ( ( map { ("additional_info$_" => $additional->[$_] ) }
6736 ( 0 .. @$additional - 1 )
6738 'additional_count' => scalar(@$additional),
6739 'setup_fee' => $amount,
6742 my $error = $part_pkg->insert( options => \%options,
6743 tax_overrides => $override,
6746 $dbh->rollback if $oldAutoCommit;
6750 my $pkgpart = $part_pkg->pkgpart;
6751 my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
6752 unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
6753 my $type_pkgs = new FS::type_pkgs \%type_pkgs;
6754 $error = $type_pkgs->insert;
6756 $dbh->rollback if $oldAutoCommit;
6761 my $cust_pkg = new FS::cust_pkg ( {
6762 'custnum' => $self->custnum,
6763 'pkgpart' => $pkgpart,
6764 'quantity' => $quantity,
6767 $error = $cust_pkg->insert;
6769 $dbh->rollback if $oldAutoCommit;
6773 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
6778 #=item charge_postal_fee
6780 #Applies a one time charge this customer. If there is an error,
6781 #returns the error, returns the cust_pkg charge object or false
6782 #if there was no charge.
6786 # This should be a customer event. For that to work requires that bill
6787 # also be a customer event.
6789 sub charge_postal_fee {
6792 my $pkgpart = $conf->config('postal_invoice-fee_pkgpart');
6793 return '' unless ($pkgpart && grep { $_ eq 'POST' } $self->invoicing_list);
6795 my $cust_pkg = new FS::cust_pkg ( {
6796 'custnum' => $self->custnum,
6797 'pkgpart' => $pkgpart,
6801 my $error = $cust_pkg->insert;
6802 $error ? $error : $cust_pkg;
6807 Returns all the invoices (see L<FS::cust_bill>) for this customer.
6813 sort { $a->_date <=> $b->_date }
6814 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
6817 =item open_cust_bill
6819 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
6824 sub open_cust_bill {
6828 'table' => 'cust_bill',
6829 'hashref' => { 'custnum' => $self->custnum, },
6830 'extra_sql' => ' AND '. FS::cust_bill->owed_sql. ' > 0',
6831 'order_by' => 'ORDER BY _date ASC',
6838 Returns all the credits (see L<FS::cust_credit>) for this customer.
6844 sort { $a->_date <=> $b->_date }
6845 qsearch( 'cust_credit', { 'custnum' => $self->custnum } )
6850 Returns all the payments (see L<FS::cust_pay>) for this customer.
6856 sort { $a->_date <=> $b->_date }
6857 qsearch( 'cust_pay', { 'custnum' => $self->custnum } )
6862 Returns all voided payments (see L<FS::cust_pay_void>) for this customer.
6868 sort { $a->_date <=> $b->_date }
6869 qsearch( 'cust_pay_void', { 'custnum' => $self->custnum } )
6872 =item cust_pay_batch
6874 Returns all batched payments (see L<FS::cust_pay_void>) for this customer.
6878 sub cust_pay_batch {
6880 sort { $a->paybatchnum <=> $b->paybatchnum }
6881 qsearch( 'cust_pay_batch', { 'custnum' => $self->custnum } )
6884 =item cust_pay_pending
6886 Returns all pending payments (see L<FS::cust_pay_pending>) for this customer
6887 (without status "done").
6891 sub cust_pay_pending {
6893 return $self->num_cust_pay_pending unless wantarray;
6894 sort { $a->_date <=> $b->_date }
6895 qsearch( 'cust_pay_pending', {
6896 'custnum' => $self->custnum,
6897 'status' => { op=>'!=', value=>'done' },
6902 =item num_cust_pay_pending
6904 Returns the number of pending payments (see L<FS::cust_pay_pending>) for this
6905 customer (without status "done"). Also called automatically when the
6906 cust_pay_pending method is used in a scalar context.
6910 sub num_cust_pay_pending {
6912 my $sql = " SELECT COUNT(*) FROM cust_pay_pending ".
6913 " WHERE custnum = ? AND status != 'done' ";
6914 my $sth = dbh->prepare($sql) or die dbh->errstr;
6915 $sth->execute($self->custnum) or die $sth->errstr;
6916 $sth->fetchrow_arrayref->[0];
6921 Returns all the refunds (see L<FS::cust_refund>) for this customer.
6927 sort { $a->_date <=> $b->_date }
6928 qsearch( 'cust_refund', { 'custnum' => $self->custnum } )
6931 =item display_custnum
6933 Returns the displayed customer number for this customer: agent_custid if
6934 cust_main-default_agent_custid is set and it has a value, custnum otherwise.
6938 sub display_custnum {
6940 if ( $conf->exists('cust_main-default_agent_custid') && $self->agent_custid ){
6941 return $self->agent_custid;
6943 return $self->custnum;
6949 Returns a name string for this customer, either "Company (Last, First)" or
6956 my $name = $self->contact;
6957 $name = $self->company. " ($name)" if $self->company;
6963 Returns a name string for this (service/shipping) contact, either
6964 "Company (Last, First)" or "Last, First".
6970 if ( $self->get('ship_last') ) {
6971 my $name = $self->ship_contact;
6972 $name = $self->ship_company. " ($name)" if $self->ship_company;
6981 Returns a name string for this customer, either "Company" or "First Last".
6987 $self->company !~ /^\s*$/ ? $self->company : $self->contact_firstlast;
6990 =item ship_name_short
6992 Returns a name string for this (service/shipping) contact, either "Company"
6997 sub ship_name_short {
6999 if ( $self->get('ship_last') ) {
7000 $self->ship_company !~ /^\s*$/
7001 ? $self->ship_company
7002 : $self->ship_contact_firstlast;
7004 $self->name_company_or_firstlast;
7010 Returns this customer's full (billing) contact name only, "Last, First"
7016 $self->get('last'). ', '. $self->first;
7021 Returns this customer's full (shipping) contact name only, "Last, First"
7027 $self->get('ship_last')
7028 ? $self->get('ship_last'). ', '. $self->ship_first
7032 =item contact_firstlast
7034 Returns this customers full (billing) contact name only, "First Last".
7038 sub contact_firstlast {
7040 $self->first. ' '. $self->get('last');
7043 =item ship_contact_firstlast
7045 Returns this customer's full (shipping) contact name only, "First Last".
7049 sub ship_contact_firstlast {
7051 $self->get('ship_last')
7052 ? $self->first. ' '. $self->get('ship_last')
7053 : $self->contact_firstlast;
7058 Returns this customer's full country name
7064 code2country($self->country);
7067 =item geocode DATA_VENDOR
7069 Returns a value for the customer location as encoded by DATA_VENDOR.
7070 Currently this only makes sense for "CCH" as DATA_VENDOR.
7075 my ($self, $data_vendor) = (shift, shift); #always cch for now
7077 my $geocode = $self->get('geocode'); #XXX only one data_vendor for geocode
7078 return $geocode if $geocode;
7080 my $prefix = ( $conf->exists('tax-ship_address') && length($self->ship_last) )
7084 my ($zip,$plus4) = split /-/, $self->get("${prefix}zip")
7085 if $self->country eq 'US';
7087 #CCH specific location stuff
7088 my $extra_sql = "AND plus4lo <= '$plus4' AND plus4hi >= '$plus4'";
7090 my @cust_tax_location =
7092 'table' => 'cust_tax_location',
7093 'hashref' => { 'zip' => $zip, 'data_vendor' => $data_vendor },
7094 'extra_sql' => $extra_sql,
7095 'order_by' => 'ORDER BY plus4hi',#overlapping with distinct ends
7098 $geocode = $cust_tax_location[0]->geocode
7099 if scalar(@cust_tax_location);
7108 Returns a status string for this customer, currently:
7112 =item prospect - No packages have ever been ordered
7114 =item active - One or more recurring packages is active
7116 =item inactive - No active recurring packages, but otherwise unsuspended/uncancelled (the inactive status is new - previously inactive customers were mis-identified as cancelled)
7118 =item suspended - All non-cancelled recurring packages are suspended
7120 =item cancelled - All recurring packages are cancelled
7126 sub status { shift->cust_status(@_); }
7130 for my $status (qw( prospect active inactive suspended cancelled )) {
7131 my $method = $status.'_sql';
7132 my $numnum = ( my $sql = $self->$method() ) =~ s/cust_main\.custnum/?/g;
7133 my $sth = dbh->prepare("SELECT $sql") or die dbh->errstr;
7134 $sth->execute( ($self->custnum) x $numnum )
7135 or die "Error executing 'SELECT $sql': ". $sth->errstr;
7136 return $status if $sth->fetchrow_arrayref->[0];
7140 =item ucfirst_cust_status
7142 =item ucfirst_status
7144 Returns the status with the first character capitalized.
7148 sub ucfirst_status { shift->ucfirst_cust_status(@_); }
7150 sub ucfirst_cust_status {
7152 ucfirst($self->cust_status);
7157 Returns a hex triplet color string for this customer's status.
7161 use vars qw(%statuscolor);
7162 tie %statuscolor, 'Tie::IxHash',
7163 'prospect' => '7e0079', #'000000', #black? naw, purple
7164 'active' => '00CC00', #green
7165 'inactive' => '0000CC', #blue
7166 'suspended' => 'FF9900', #yellow
7167 'cancelled' => 'FF0000', #red
7170 sub statuscolor { shift->cust_statuscolor(@_); }
7172 sub cust_statuscolor {
7174 $statuscolor{$self->cust_status};
7179 Returns an array of hashes representing the customer's RT tickets.
7186 my $num = $conf->config('cust_main-max_tickets') || 10;
7189 if ( $conf->config('ticket_system') ) {
7190 unless ( $conf->config('ticket_system-custom_priority_field') ) {
7192 @tickets = @{ FS::TicketSystem->customer_tickets($self->custnum, $num) };
7196 foreach my $priority (
7197 $conf->config('ticket_system-custom_priority_field-values'), ''
7199 last if scalar(@tickets) >= $num;
7201 @{ FS::TicketSystem->customer_tickets( $self->custnum,
7202 $num - scalar(@tickets),
7212 # Return services representing svc_accts in customer support packages
7213 sub support_services {
7215 my %packages = map { $_ => 1 } $conf->config('support_packages');
7217 grep { $_->pkg_svc && $_->pkg_svc->primary_svc eq 'Y' }
7218 grep { $_->part_svc->svcdb eq 'svc_acct' }
7219 map { $_->cust_svc }
7220 grep { exists $packages{ $_->pkgpart } }
7221 $self->ncancelled_pkgs;
7227 =head1 CLASS METHODS
7233 Class method that returns the list of possible status strings for customers
7234 (see L<the status method|/status>). For example:
7236 @statuses = FS::cust_main->statuses();
7241 #my $self = shift; #could be class...
7247 Returns an SQL expression identifying prospective cust_main records (customers
7248 with no packages ever ordered)
7252 use vars qw($select_count_pkgs);
7253 $select_count_pkgs =
7254 "SELECT COUNT(*) FROM cust_pkg
7255 WHERE cust_pkg.custnum = cust_main.custnum";
7257 sub select_count_pkgs_sql {
7261 sub prospect_sql { "
7262 0 = ( $select_count_pkgs )
7267 Returns an SQL expression identifying active cust_main records (customers with
7268 active recurring packages).
7273 0 < ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. "
7279 Returns an SQL expression identifying inactive cust_main records (customers with
7280 no active recurring packages, but otherwise unsuspended/uncancelled).
7284 sub inactive_sql { "
7285 0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " )
7287 0 < ( $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " )
7293 Returns an SQL expression identifying suspended cust_main records.
7298 sub suspended_sql { susp_sql(@_); }
7300 0 < ( $select_count_pkgs AND ". FS::cust_pkg->suspended_sql. " )
7302 0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " )
7308 Returns an SQL expression identifying cancelled cust_main records.
7312 sub cancelled_sql { cancel_sql(@_); }
7315 my $recurring_sql = FS::cust_pkg->recurring_sql;
7316 my $cancelled_sql = FS::cust_pkg->cancelled_sql;
7319 0 < ( $select_count_pkgs )
7320 AND 0 < ( $select_count_pkgs AND $recurring_sql AND $cancelled_sql )
7321 AND 0 = ( $select_count_pkgs AND $recurring_sql
7322 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
7324 AND 0 = ( $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " )
7330 =item uncancelled_sql
7332 Returns an SQL expression identifying un-cancelled cust_main records.
7336 sub uncancelled_sql { uncancel_sql(@_); }
7337 sub uncancel_sql { "
7338 ( 0 < ( $select_count_pkgs
7339 AND ( cust_pkg.cancel IS NULL
7340 OR cust_pkg.cancel = 0
7343 OR 0 = ( $select_count_pkgs )
7349 Returns an SQL fragment to retreive the balance.
7354 ( SELECT COALESCE( SUM(charged), 0 ) FROM cust_bill
7355 WHERE cust_bill.custnum = cust_main.custnum )
7356 - ( SELECT COALESCE( SUM(paid), 0 ) FROM cust_pay
7357 WHERE cust_pay.custnum = cust_main.custnum )
7358 - ( SELECT COALESCE( SUM(amount), 0 ) FROM cust_credit
7359 WHERE cust_credit.custnum = cust_main.custnum )
7360 + ( SELECT COALESCE( SUM(refund), 0 ) FROM cust_refund
7361 WHERE cust_refund.custnum = cust_main.custnum )
7364 =item balance_date_sql START_TIME [ END_TIME [ OPTION => VALUE ... ] ]
7366 Returns an SQL fragment to retreive the balance for this customer, only
7367 considering invoices with date earlier than START_TIME, and optionally not
7368 later than END_TIME (total_owed_date minus total_unapplied_credits minus
7369 total_unapplied_payments).
7371 Times are specified as SQL fragments or numeric
7372 UNIX timestamps; see L<perlfunc/"time">). Also see L<Time::Local> and
7373 L<Date::Parse> for conversion functions. The empty string can be passed
7374 to disable that time constraint completely.
7376 Available options are:
7380 =item unapplied_date
7382 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)
7387 set to true to remove all customer comparison clauses, for totals
7392 WHERE clause hashref (elements "AND"ed together) (typically used with the total option)
7397 JOIN clause (typically used with the total option)
7403 sub balance_date_sql {
7404 my( $class, $start, $end, %opt ) = @_;
7406 my $owed = FS::cust_bill->owed_sql;
7407 my $unapp_refund = FS::cust_refund->unapplied_sql;
7408 my $unapp_credit = FS::cust_credit->unapplied_sql;
7409 my $unapp_pay = FS::cust_pay->unapplied_sql;
7411 my $j = $opt{'join'} || '';
7413 my $owed_wh = $class->_money_table_where( 'cust_bill', $start,$end,%opt );
7414 my $refund_wh = $class->_money_table_where( 'cust_refund', $start,$end,%opt );
7415 my $credit_wh = $class->_money_table_where( 'cust_credit', $start,$end,%opt );
7416 my $pay_wh = $class->_money_table_where( 'cust_pay', $start,$end,%opt );
7418 " ( SELECT COALESCE(SUM($owed), 0) FROM cust_bill $j $owed_wh )
7419 + ( SELECT COALESCE(SUM($unapp_refund), 0) FROM cust_refund $j $refund_wh )
7420 - ( SELECT COALESCE(SUM($unapp_credit), 0) FROM cust_credit $j $credit_wh )
7421 - ( SELECT COALESCE(SUM($unapp_pay), 0) FROM cust_pay $j $pay_wh )
7426 =item _money_table_where TABLE START_TIME [ END_TIME [ OPTION => VALUE ... ] ]
7428 Helper method for balance_date_sql; name (and usage) subject to change
7429 (suggestions welcome).
7431 Returns a WHERE clause for the specified monetary TABLE (cust_bill,
7432 cust_refund, cust_credit or cust_pay).
7434 If TABLE is "cust_bill" or the unapplied_date option is true, only
7435 considers records with date earlier than START_TIME, and optionally not
7436 later than END_TIME .
7440 sub _money_table_where {
7441 my( $class, $table, $start, $end, %opt ) = @_;
7444 push @where, "cust_main.custnum = $table.custnum" unless $opt{'total'};
7445 if ( $table eq 'cust_bill' || $opt{'unapplied_date'} ) {
7446 push @where, "$table._date <= $start" if defined($start) && length($start);
7447 push @where, "$table._date > $end" if defined($end) && length($end);
7449 push @where, @{$opt{'where'}} if $opt{'where'};
7450 my $where = scalar(@where) ? 'WHERE '. join(' AND ', @where ) : '';
7456 =item search_sql HASHREF
7460 Returns a qsearch hash expression to search for parameters specified in HREF.
7461 Valid parameters are
7469 =item cancelled_pkgs
7475 listref of start date, end date
7481 =item current_balance
7483 listref (list returned by FS::UI::Web::parse_lt_gt($cgi, 'current_balance'))
7487 =item flattened_pkgs
7496 my ($class, $params) = @_;
7507 if ( $params->{'agentnum'} =~ /^(\d+)$/ and $1 ) {
7509 "cust_main.agentnum = $1";
7516 #prospect active inactive suspended cancelled
7517 if ( grep { $params->{'status'} eq $_ } FS::cust_main->statuses() ) {
7518 my $method = $params->{'status'}. '_sql';
7519 #push @where, $class->$method();
7520 push @where, FS::cust_main->$method();
7524 # parse cancelled package checkbox
7529 $pkgwhere .= "AND (cancel = 0 or cancel is null)"
7530 unless $params->{'cancelled_pkgs'};
7536 foreach my $field (qw( signupdate )) {
7538 next unless exists($params->{$field});
7540 my($beginning, $ending) = @{$params->{$field}};
7543 "cust_main.$field IS NOT NULL",
7544 "cust_main.$field >= $beginning",
7545 "cust_main.$field <= $ending";
7547 $orderby ||= "ORDER BY cust_main.$field";
7555 my @payby = grep /^([A-Z]{4})$/, @{ $params->{'payby'} };
7557 push @where, '( '. join(' OR ', map "cust_main.payby = '$_'", @payby). ' )';
7564 #my $balance_sql = $class->balance_sql();
7565 my $balance_sql = FS::cust_main->balance_sql();
7567 push @where, map { s/current_balance/$balance_sql/; $_ }
7568 @{ $params->{'current_balance'} };
7574 if ( $params->{'custbatch'} =~ /^([\w\/\-\:\.]+)$/ and $1 ) {
7576 "cust_main.custbatch = '$1'";
7580 # setup queries, subs, etc. for the search
7583 $orderby ||= 'ORDER BY custnum';
7585 # here is the agent virtualization
7586 push @where, $FS::CurrentUser::CurrentUser->agentnums_sql;
7588 my $extra_sql = scalar(@where) ? ' WHERE '. join(' AND ', @where) : '';
7590 my $addl_from = 'LEFT JOIN cust_pkg USING ( custnum ) ';
7592 my $count_query = "SELECT COUNT(*) FROM cust_main $extra_sql";
7594 my $select = join(', ',
7595 'cust_main.custnum',
7596 FS::UI::Web::cust_sql_fields($params->{'cust_fields'}),
7599 my(@extra_headers) = ();
7600 my(@extra_fields) = ();
7602 if ($params->{'flattened_pkgs'}) {
7604 if ($dbh->{Driver}->{Name} eq 'Pg') {
7606 $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";
7608 }elsif ($dbh->{Driver}->{Name} =~ /^mysql/i) {
7609 $select .= ", GROUP_CONCAT(pkg SEPARATOR '|') as magic";
7610 $addl_from .= " LEFT JOIN part_pkg using ( pkgpart )";
7612 warn "warning: unknown database type ". $dbh->{Driver}->{Name}.
7613 "omitting packing information from report.";
7616 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";
7618 my $sth = dbh->prepare($header_query) or die dbh->errstr;
7619 $sth->execute() or die $sth->errstr;
7620 my $headerrow = $sth->fetchrow_arrayref;
7621 my $headercount = $headerrow ? $headerrow->[0] : 0;
7622 while($headercount) {
7623 unshift @extra_headers, "Package ". $headercount;
7624 unshift @extra_fields, eval q!sub {my $c = shift;
7625 my @a = split '\|', $c->magic;
7626 my $p = $a[!.--$headercount. q!];
7634 'table' => 'cust_main',
7635 'select' => $select,
7637 'extra_sql' => $extra_sql,
7638 'order_by' => $orderby,
7639 'count_query' => $count_query,
7640 'extra_headers' => \@extra_headers,
7641 'extra_fields' => \@extra_fields,
7646 =item email_search_sql HASHREF
7650 Emails a notice to the specified customers.
7652 Valid parameters are those of the L<search_sql> method, plus the following:
7674 Optional job queue job for status updates.
7678 Returns an error message, or false for success.
7680 If an error occurs during any email, stops the enture send and returns that
7681 error. Presumably if you're getting SMTP errors aborting is better than
7682 retrying everything.
7686 sub email_search_sql {
7687 my($class, $params) = @_;
7689 my $from = delete $params->{from};
7690 my $subject = delete $params->{subject};
7691 my $html_body = delete $params->{html_body};
7692 my $text_body = delete $params->{text_body};
7694 my $job = delete $params->{'job'};
7696 my $sql_query = $class->search_sql($params);
7698 my $count_query = delete($sql_query->{'count_query'});
7699 my $count_sth = dbh->prepare($count_query)
7700 or die "Error preparing $count_query: ". dbh->errstr;
7702 or die "Error executing $count_query: ". $count_sth->errstr;
7703 my $count_arrayref = $count_sth->fetchrow_arrayref;
7704 my $num_cust = $count_arrayref->[0];
7706 #my @extra_headers = @{ delete($sql_query->{'extra_headers'}) };
7707 #my @extra_fields = @{ delete($sql_query->{'extra_fields'}) };
7710 my( $num, $last, $min_sec ) = (0, time, 5); #progresbar foo
7712 #eventually order+limit magic to reduce memory use?
7713 foreach my $cust_main ( qsearch($sql_query) ) {
7715 my $to = $cust_main->invoicing_list_emailonly_scalar;
7718 my $error = send_email(
7722 'subject' => $subject,
7723 'html_body' => $html_body,
7724 'text_body' => $text_body,
7727 return $error if $error;
7729 if ( $job ) { #progressbar foo
7731 if ( time - $min_sec > $last ) {
7732 my $error = $job->update_statustext(
7733 int( 100 * $num / $num_cust )
7735 die $error if $error;
7745 use Storable qw(thaw);
7748 sub process_email_search_sql {
7750 #warn "$me process_re_X $method for job $job\n" if $DEBUG;
7752 my $param = thaw(decode_base64(shift));
7753 warn Dumper($param) if $DEBUG;
7755 $param->{'job'} = $job;
7757 my $error = FS::cust_main->email_search_sql( $param );
7758 die $error if $error;
7762 =item fuzzy_search FUZZY_HASHREF [ HASHREF, SELECT, EXTRA_SQL, CACHE_OBJ ]
7764 Performs a fuzzy (approximate) search and returns the matching FS::cust_main
7765 records. Currently, I<first>, I<last> and/or I<company> may be specified (the
7766 appropriate ship_ field is also searched).
7768 Additional options are the same as FS::Record::qsearch
7773 my( $self, $fuzzy, $hash, @opt) = @_;
7778 check_and_rebuild_fuzzyfiles();
7779 foreach my $field ( keys %$fuzzy ) {
7781 my $all = $self->all_X($field);
7782 next unless scalar(@$all);
7785 $match{$_}=1 foreach ( amatch( $fuzzy->{$field}, ['i'], @$all ) );
7788 foreach ( keys %match ) {
7789 push @fcust, qsearch('cust_main', { %$hash, $field=>$_}, @opt);
7790 push @fcust, qsearch('cust_main', { %$hash, "ship_$field"=>$_}, @opt);
7793 push @cust_main, grep { ! $fsaw{$_->custnum}++ } @fcust;
7796 # we want the components of $fuzzy ANDed, not ORed, but still don't want dupes
7798 @cust_main = grep { ++$saw{$_->custnum} == scalar(keys %$fuzzy) } @cust_main;
7806 Returns a masked version of the named field
7811 my ($self,$field) = @_;
7815 'x'x(length($self->getfield($field))-4).
7816 substr($self->getfield($field), (length($self->getfield($field))-4));
7826 =item smart_search OPTION => VALUE ...
7828 Accepts the following options: I<search>, the string to search for. The string
7829 will be searched for as a customer number, phone number, name or company name,
7830 as an exact, or, in some cases, a substring or fuzzy match (see the source code
7831 for the exact heuristics used); I<no_fuzzy_on_exact>, causes smart_search to
7832 skip fuzzy matching when an exact match is found.
7834 Any additional options are treated as an additional qualifier on the search
7837 Returns a (possibly empty) array of FS::cust_main objects.
7844 #here is the agent virtualization
7845 my $agentnums_sql = $FS::CurrentUser::CurrentUser->agentnums_sql;
7849 my $skip_fuzzy = delete $options{'no_fuzzy_on_exact'};
7850 my $search = delete $options{'search'};
7851 ( my $alphanum_search = $search ) =~ s/\W//g;
7853 if ( $alphanum_search =~ /^1?(\d{3})(\d{3})(\d{4})(\d*)$/ ) { #phone# search
7855 #false laziness w/Record::ut_phone
7856 my $phonen = "$1-$2-$3";
7857 $phonen .= " x$4" if $4;
7859 push @cust_main, qsearch( {
7860 'table' => 'cust_main',
7861 'hashref' => { %options },
7862 'extra_sql' => ( scalar(keys %options) ? ' AND ' : ' WHERE ' ).
7864 join(' OR ', map "$_ = '$phonen'",
7865 qw( daytime night fax
7866 ship_daytime ship_night ship_fax )
7869 " AND $agentnums_sql", #agent virtualization
7872 unless ( @cust_main || $phonen =~ /x\d+$/ ) { #no exact match
7873 #try looking for matches with extensions unless one was specified
7875 push @cust_main, qsearch( {
7876 'table' => 'cust_main',
7877 'hashref' => { %options },
7878 'extra_sql' => ( scalar(keys %options) ? ' AND ' : ' WHERE ' ).
7880 join(' OR ', map "$_ LIKE '$phonen\%'",
7882 ship_daytime ship_night )
7885 " AND $agentnums_sql", #agent virtualization
7890 # custnum search (also try agent_custid), with some tweaking options if your
7891 # legacy cust "numbers" have letters
7894 if ( $search =~ /^\s*(\d+)\s*$/
7895 || ( $conf->config('cust_main-agent_custid-format') eq 'ww?d+'
7896 && $search =~ /^\s*(\w\w?\d+)\s*$/
7903 if ( $num <= 2147483647 ) { #need a bigint custnum? wow.
7904 push @cust_main, qsearch( {
7905 'table' => 'cust_main',
7906 'hashref' => { 'custnum' => $num, %options },
7907 'extra_sql' => " AND $agentnums_sql", #agent virtualization
7911 push @cust_main, qsearch( {
7912 'table' => 'cust_main',
7913 'hashref' => { 'agent_custid' => $num, %options },
7914 'extra_sql' => " AND $agentnums_sql", #agent virtualization
7917 } elsif ( $search =~ /^\s*(\S.*\S)\s+\((.+), ([^,]+)\)\s*$/ ) {
7919 my($company, $last, $first) = ( $1, $2, $3 );
7921 # "Company (Last, First)"
7922 #this is probably something a browser remembered,
7923 #so just do an exact search
7925 foreach my $prefix ( '', 'ship_' ) {
7926 push @cust_main, qsearch( {
7927 'table' => 'cust_main',
7928 'hashref' => { $prefix.'first' => $first,
7929 $prefix.'last' => $last,
7930 $prefix.'company' => $company,
7933 'extra_sql' => " AND $agentnums_sql",
7937 } elsif ( $search =~ /^\s*(\S.*\S)\s*$/ ) { # value search
7938 # try (ship_){last,company}
7942 # # remove "(Last, First)" in "Company (Last, First)", otherwise the
7943 # # full strings the browser remembers won't work
7944 # $value =~ s/\([\w \,\.\-\']*\)$//; #false laziness w/Record::ut_name
7946 use Lingua::EN::NameParse;
7947 my $NameParse = new Lingua::EN::NameParse(
7949 allow_reversed => 1,
7952 my($last, $first) = ( '', '' );
7953 #maybe disable this too and just rely on NameParse?
7954 if ( $value =~ /^(.+),\s*([^,]+)$/ ) { # Last, First
7956 ($last, $first) = ( $1, $2 );
7958 #} elsif ( $value =~ /^(.+)\s+(.+)$/ ) {
7959 } elsif ( ! $NameParse->parse($value) ) {
7961 my %name = $NameParse->components;
7962 $first = $name{'given_name_1'};
7963 $last = $name{'surname_1'};
7967 if ( $first && $last ) {
7969 my($q_last, $q_first) = ( dbh->quote($last), dbh->quote($first) );
7972 my $sql = scalar(keys %options) ? ' AND ' : ' WHERE ';
7974 ( ( LOWER(last) = $q_last AND LOWER(first) = $q_first )
7975 OR ( LOWER(ship_last) = $q_last AND LOWER(ship_first) = $q_first )
7978 push @cust_main, qsearch( {
7979 'table' => 'cust_main',
7980 'hashref' => \%options,
7981 'extra_sql' => "$sql AND $agentnums_sql", #agent virtualization
7984 # or it just be something that was typed in... (try that in a sec)
7988 my $q_value = dbh->quote($value);
7991 my $sql = scalar(keys %options) ? ' AND ' : ' WHERE ';
7992 $sql .= " ( LOWER(last) = $q_value
7993 OR LOWER(company) = $q_value
7994 OR LOWER(ship_last) = $q_value
7995 OR LOWER(ship_company) = $q_value
7998 push @cust_main, qsearch( {
7999 'table' => 'cust_main',
8000 'hashref' => \%options,
8001 'extra_sql' => "$sql AND $agentnums_sql", #agent virtualization
8004 #no exact match, trying substring/fuzzy
8005 #always do substring & fuzzy (unless they're explicity config'ed off)
8006 #getting complaints searches are not returning enough
8007 unless ( @cust_main && $skip_fuzzy || $conf->exists('disable-fuzzy') ) {
8009 #still some false laziness w/search_sql (was search/cust_main.cgi)
8014 { 'company' => { op=>'ILIKE', value=>"%$value%" }, },
8015 { 'ship_company' => { op=>'ILIKE', value=>"%$value%" }, },
8018 if ( $first && $last ) {
8021 { 'first' => { op=>'ILIKE', value=>"%$first%" },
8022 'last' => { op=>'ILIKE', value=>"%$last%" },
8024 { 'ship_first' => { op=>'ILIKE', value=>"%$first%" },
8025 'ship_last' => { op=>'ILIKE', value=>"%$last%" },
8032 { 'last' => { op=>'ILIKE', value=>"%$value%" }, },
8033 { 'ship_last' => { op=>'ILIKE', value=>"%$value%" }, },
8037 foreach my $hashref ( @hashrefs ) {
8039 push @cust_main, qsearch( {
8040 'table' => 'cust_main',
8041 'hashref' => { %$hashref,
8044 'extra_sql' => " AND $agentnums_sql", #agent virtualizaiton
8053 " AND $agentnums_sql", #extra_sql #agent virtualization
8056 if ( $first && $last ) {
8057 push @cust_main, FS::cust_main->fuzzy_search(
8058 { 'last' => $last, #fuzzy hashref
8059 'first' => $first }, #
8063 foreach my $field ( 'last', 'company' ) {
8065 FS::cust_main->fuzzy_search( { $field => $value }, @fuzopts );
8070 #eliminate duplicates
8072 @cust_main = grep { !$saw{$_->custnum}++ } @cust_main;
8082 Accepts the following options: I<email>, the email address to search for. The
8083 email address will be searched for as an email invoice destination and as an
8086 #Any additional options are treated as an additional qualifier on the search
8087 #(i.e. I<agentnum>).
8089 Returns a (possibly empty) array of FS::cust_main objects (but usually just
8099 my $email = delete $options{'email'};
8101 #we're only being used by RT at the moment... no agent virtualization yet
8102 #my $agentnums_sql = $FS::CurrentUser::CurrentUser->agentnums_sql;
8106 if ( $email =~ /([^@]+)\@([^@]+)/ ) {
8108 my ( $user, $domain ) = ( $1, $2 );
8110 warn "$me smart_search: searching for $user in domain $domain"
8116 'table' => 'cust_main_invoice',
8117 'hashref' => { 'dest' => $email },
8124 map $_->cust_svc->cust_pkg,
8126 'table' => 'svc_acct',
8127 'hashref' => { 'username' => $user, },
8129 'AND ( SELECT domain FROM svc_domain
8130 WHERE svc_acct.domsvc = svc_domain.svcnum
8131 ) = '. dbh->quote($domain),
8137 @cust_main = grep { !$saw{$_->custnum}++ } @cust_main;
8139 warn "$me smart_search: found ". scalar(@cust_main). " unique customers"
8146 =item check_and_rebuild_fuzzyfiles
8150 use vars qw(@fuzzyfields);
8151 @fuzzyfields = ( 'last', 'first', 'company' );
8153 sub check_and_rebuild_fuzzyfiles {
8154 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
8155 rebuild_fuzzyfiles() if grep { ! -e "$dir/cust_main.$_" } @fuzzyfields
8158 =item rebuild_fuzzyfiles
8162 sub rebuild_fuzzyfiles {
8164 use Fcntl qw(:flock);
8166 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
8167 mkdir $dir, 0700 unless -d $dir;
8169 foreach my $fuzzy ( @fuzzyfields ) {
8171 open(LOCK,">>$dir/cust_main.$fuzzy")
8172 or die "can't open $dir/cust_main.$fuzzy: $!";
8174 or die "can't lock $dir/cust_main.$fuzzy: $!";
8176 open (CACHE,">$dir/cust_main.$fuzzy.tmp")
8177 or die "can't open $dir/cust_main.$fuzzy.tmp: $!";
8179 foreach my $field ( $fuzzy, "ship_$fuzzy" ) {
8180 my $sth = dbh->prepare("SELECT $field FROM cust_main".
8181 " WHERE $field != '' AND $field IS NOT NULL");
8182 $sth->execute or die $sth->errstr;
8184 while ( my $row = $sth->fetchrow_arrayref ) {
8185 print CACHE $row->[0]. "\n";
8190 close CACHE or die "can't close $dir/cust_main.$fuzzy.tmp: $!";
8192 rename "$dir/cust_main.$fuzzy.tmp", "$dir/cust_main.$fuzzy";
8203 my( $self, $field ) = @_;
8204 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
8205 open(CACHE,"<$dir/cust_main.$field")
8206 or die "can't open $dir/cust_main.$field: $!";
8207 my @array = map { chomp; $_; } <CACHE>;
8212 =item append_fuzzyfiles LASTNAME COMPANY
8216 sub append_fuzzyfiles {
8217 #my( $first, $last, $company ) = @_;
8219 &check_and_rebuild_fuzzyfiles;
8221 use Fcntl qw(:flock);
8223 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
8225 foreach my $field (qw( first last company )) {
8230 open(CACHE,">>$dir/cust_main.$field")
8231 or die "can't open $dir/cust_main.$field: $!";
8232 flock(CACHE,LOCK_EX)
8233 or die "can't lock $dir/cust_main.$field: $!";
8235 print CACHE "$value\n";
8237 flock(CACHE,LOCK_UN)
8238 or die "can't unlock $dir/cust_main.$field: $!";
8253 #warn join('-',keys %$param);
8254 my $fh = $param->{filehandle};
8255 my @fields = @{$param->{fields}};
8257 eval "use Text::CSV_XS;";
8260 my $csv = new Text::CSV_XS;
8267 local $SIG{HUP} = 'IGNORE';
8268 local $SIG{INT} = 'IGNORE';
8269 local $SIG{QUIT} = 'IGNORE';
8270 local $SIG{TERM} = 'IGNORE';
8271 local $SIG{TSTP} = 'IGNORE';
8272 local $SIG{PIPE} = 'IGNORE';
8274 my $oldAutoCommit = $FS::UID::AutoCommit;
8275 local $FS::UID::AutoCommit = 0;
8278 #while ( $columns = $csv->getline($fh) ) {
8280 while ( defined($line=<$fh>) ) {
8282 $csv->parse($line) or do {
8283 $dbh->rollback if $oldAutoCommit;
8284 return "can't parse: ". $csv->error_input();
8287 my @columns = $csv->fields();
8288 #warn join('-',@columns);
8291 foreach my $field ( @fields ) {
8292 $row{$field} = shift @columns;
8295 my $cust_main = qsearchs('cust_main', { 'custnum' => $row{'custnum'} } );
8296 unless ( $cust_main ) {
8297 $dbh->rollback if $oldAutoCommit;
8298 return "unknown custnum $row{'custnum'}";
8301 if ( $row{'amount'} > 0 ) {
8302 my $error = $cust_main->charge($row{'amount'}, $row{'pkg'});
8304 $dbh->rollback if $oldAutoCommit;
8308 } elsif ( $row{'amount'} < 0 ) {
8309 my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ),
8312 $dbh->rollback if $oldAutoCommit;
8322 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
8324 return "Empty file!" unless $imported;
8330 =item notify CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
8332 Sends a templated email notification to the customer (see L<Text::Template>).
8334 OPTIONS is a hash and may include
8336 I<from> - the email sender (default is invoice_from)
8338 I<to> - comma-separated scalar or arrayref of recipients
8339 (default is invoicing_list)
8341 I<subject> - The subject line of the sent email notification
8342 (default is "Notice from company_name")
8344 I<extra_fields> - a hashref of name/value pairs which will be substituted
8347 The following variables are vavailable in the template.
8349 I<$first> - the customer first name
8350 I<$last> - the customer last name
8351 I<$company> - the customer company
8352 I<$payby> - a description of the method of payment for the customer
8353 # would be nice to use FS::payby::shortname
8354 I<$payinfo> - the account information used to collect for this customer
8355 I<$expdate> - the expiration of the customer payment in seconds from epoch
8360 my ($self, $template, %options) = @_;
8362 return unless $conf->exists($template);
8364 my $from = $conf->config('invoice_from', $self->agentnum)
8365 if $conf->exists('invoice_from', $self->agentnum);
8366 $from = $options{from} if exists($options{from});
8368 my $to = join(',', $self->invoicing_list_emailonly);
8369 $to = $options{to} if exists($options{to});
8371 my $subject = "Notice from " . $conf->config('company_name', $self->agentnum)
8372 if $conf->exists('company_name', $self->agentnum);
8373 $subject = $options{subject} if exists($options{subject});
8375 my $notify_template = new Text::Template (TYPE => 'ARRAY',
8376 SOURCE => [ map "$_\n",
8377 $conf->config($template)]
8379 or die "can't create new Text::Template object: Text::Template::ERROR";
8380 $notify_template->compile()
8381 or die "can't compile template: Text::Template::ERROR";
8383 $FS::notify_template::_template::company_name =
8384 $conf->config('company_name', $self->agentnum);
8385 $FS::notify_template::_template::company_address =
8386 join("\n", $conf->config('company_address', $self->agentnum) ). "\n";
8388 my $paydate = $self->paydate || '2037-12-31';
8389 $FS::notify_template::_template::first = $self->first;
8390 $FS::notify_template::_template::last = $self->last;
8391 $FS::notify_template::_template::company = $self->company;
8392 $FS::notify_template::_template::payinfo = $self->mask_payinfo;
8393 my $payby = $self->payby;
8394 my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
8395 my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
8397 #credit cards expire at the end of the month/year of their exp date
8398 if ($payby eq 'CARD' || $payby eq 'DCRD') {
8399 $FS::notify_template::_template::payby = 'credit card';
8400 ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
8401 $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
8403 }elsif ($payby eq 'COMP') {
8404 $FS::notify_template::_template::payby = 'complimentary account';
8406 $FS::notify_template::_template::payby = 'current method';
8408 $FS::notify_template::_template::expdate = $expire_time;
8410 for (keys %{$options{extra_fields}}){
8412 ${"FS::notify_template::_template::$_"} = $options{extra_fields}->{$_};
8415 send_email(from => $from,
8417 subject => $subject,
8418 body => $notify_template->fill_in( PACKAGE =>
8419 'FS::notify_template::_template' ),
8424 =item generate_letter CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
8426 Generates a templated notification to the customer (see L<Text::Template>).
8428 OPTIONS is a hash and may include
8430 I<extra_fields> - a hashref of name/value pairs which will be substituted
8431 into the template. These values may override values mentioned below
8432 and those from the customer record.
8434 The following variables are available in the template instead of or in addition
8435 to the fields of the customer record.
8437 I<$payby> - a description of the method of payment for the customer
8438 # would be nice to use FS::payby::shortname
8439 I<$payinfo> - the masked account information used to collect for this customer
8440 I<$expdate> - the expiration of the customer payment method in seconds from epoch
8441 I<$returnaddress> - the return address defaults to invoice_latexreturnaddress or company_address
8445 sub generate_letter {
8446 my ($self, $template, %options) = @_;
8448 return unless $conf->exists($template);
8450 my $letter_template = new Text::Template
8452 SOURCE => [ map "$_\n", $conf->config($template)],
8453 DELIMITERS => [ '[@--', '--@]' ],
8455 or die "can't create new Text::Template object: Text::Template::ERROR";
8457 $letter_template->compile()
8458 or die "can't compile template: Text::Template::ERROR";
8460 my %letter_data = map { $_ => $self->$_ } $self->fields;
8461 $letter_data{payinfo} = $self->mask_payinfo;
8463 #my $paydate = $self->paydate || '2037-12-31';
8464 my $paydate = $self->paydate =~ /^\S+$/ ? $self->paydate : '2037-12-31';
8466 my $payby = $self->payby;
8467 my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
8468 my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
8470 #credit cards expire at the end of the month/year of their exp date
8471 if ($payby eq 'CARD' || $payby eq 'DCRD') {
8472 $letter_data{payby} = 'credit card';
8473 ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
8474 $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
8476 }elsif ($payby eq 'COMP') {
8477 $letter_data{payby} = 'complimentary account';
8479 $letter_data{payby} = 'current method';
8481 $letter_data{expdate} = $expire_time;
8483 for (keys %{$options{extra_fields}}){
8484 $letter_data{$_} = $options{extra_fields}->{$_};
8487 unless(exists($letter_data{returnaddress})){
8488 my $retadd = join("\n", $conf->config_orbase( 'invoice_latexreturnaddress',
8489 $self->agent_template)
8491 if ( length($retadd) ) {
8492 $letter_data{returnaddress} = $retadd;
8493 } elsif ( grep /\S/, $conf->config('company_address', $self->agentnum) ) {
8494 $letter_data{returnaddress} =
8495 join( '\\*'."\n", map s/( {2,})/'~' x length($1)/eg,
8496 $conf->config('company_address', $self->agentnum)
8499 $letter_data{returnaddress} = '~';
8503 $letter_data{conf_dir} = "$FS::UID::conf_dir/conf.$FS::UID::datasrc";
8505 $letter_data{company_name} = $conf->config('company_name', $self->agentnum);
8507 my $dir = $FS::UID::conf_dir."/cache.". $FS::UID::datasrc;
8508 my $fh = new File::Temp( TEMPLATE => 'letter.'. $self->custnum. '.XXXXXXXX',
8512 ) or die "can't open temp file: $!\n";
8514 $letter_template->fill_in( OUTPUT => $fh, HASH => \%letter_data );
8516 $fh->filename =~ /^(.*).tex$/ or die "unparsable filename: ". $fh->filename;
8520 =item print_ps TEMPLATE
8522 Returns an postscript letter filled in from TEMPLATE, as a scalar.
8528 my $file = $self->generate_letter(@_);
8529 FS::Misc::generate_ps($file);
8532 =item print TEMPLATE
8534 Prints the filled in template.
8536 TEMPLATE is the name of a L<Text::Template> to fill in and print.
8540 sub queueable_print {
8543 my $self = qsearchs('cust_main', { 'custnum' => $opt{custnum} } )
8544 or die "invalid customer number: " . $opt{custvnum};
8546 my $error = $self->print( $opt{template} );
8547 die $error if $error;
8551 my ($self, $template) = (shift, shift);
8552 do_print [ $self->print_ps($template) ];
8555 #these three subs should just go away once agent stuff is all config overrides
8557 sub agent_template {
8559 $self->_agent_plandata('agent_templatename');
8562 sub agent_invoice_from {
8564 $self->_agent_plandata('agent_invoice_from');
8567 sub _agent_plandata {
8568 my( $self, $option ) = @_;
8570 #yuck. this whole thing needs to be reconciled better with 1.9's idea of
8571 #agent-specific Conf
8573 use FS::part_event::Condition;
8575 my $agentnum = $self->agentnum;
8578 if ( driver_name =~ /^Pg/i ) {
8580 } elsif ( driver_name =~ /^mysql/i ) {
8583 die "don't know how to use regular expressions in ". driver_name. " databases";
8586 my $part_event_option =
8588 'select' => 'part_event_option.*',
8589 'table' => 'part_event_option',
8591 LEFT JOIN part_event USING ( eventpart )
8592 LEFT JOIN part_event_option AS peo_agentnum
8593 ON ( part_event.eventpart = peo_agentnum.eventpart
8594 AND peo_agentnum.optionname = 'agentnum'
8595 AND peo_agentnum.optionvalue }. $regexp. q{ '(^|,)}. $agentnum. q{(,|$)'
8597 LEFT JOIN part_event_condition
8598 ON ( part_event.eventpart = part_event_condition.eventpart
8599 AND part_event_condition.conditionname = 'cust_bill_age'
8601 LEFT JOIN part_event_condition_option
8602 ON ( part_event_condition.eventconditionnum = part_event_condition_option.eventconditionnum
8603 AND part_event_condition_option.optionname = 'age'
8606 #'hashref' => { 'optionname' => $option },
8607 #'hashref' => { 'part_event_option.optionname' => $option },
8609 " WHERE part_event_option.optionname = ". dbh->quote($option).
8610 " AND action = 'cust_bill_send_agent' ".
8611 " AND ( disabled IS NULL OR disabled != 'Y' ) ".
8612 " AND peo_agentnum.optionname = 'agentnum' ".
8613 " AND ( agentnum IS NULL OR agentnum = $agentnum ) ".
8615 CASE WHEN part_event_condition_option.optionname IS NULL
8617 ELSE ". FS::part_event::Condition->age2seconds_sql('part_event_condition_option.optionvalue').
8619 , part_event.weight".
8623 unless ( $part_event_option ) {
8624 return $self->agent->invoice_template || ''
8625 if $option eq 'agent_templatename';
8629 $part_event_option->optionvalue;
8634 ## actual sub, not a method, designed to be called from the queue.
8635 ## sets up the customer, and calls the bill_and_collect
8636 my (%args) = @_; #, ($time, $invoice_time, $check_freq, $resetup) = @_;
8637 my $cust_main = qsearchs( 'cust_main', { custnum => $args{'custnum'} } );
8638 $cust_main->bill_and_collect(
8643 sub _upgrade_data { #class method
8644 my ($class, %opts) = @_;
8646 my $sql = 'UPDATE h_cust_main SET paycvv = NULL WHERE paycvv IS NOT NULL';
8647 my $sth = dbh->prepare($sql) or die dbh->errstr;
8648 $sth->execute or die $sth->errstr;
8658 The delete method should possibly take an FS::cust_main object reference
8659 instead of a scalar customer number.
8661 Bill and collect options should probably be passed as references instead of a
8664 There should probably be a configuration file with a list of allowed credit
8667 No multiple currency support (probably a larger project than just this module).
8669 payinfo_masked false laziness with cust_pay.pm and cust_refund.pm
8671 Birthdates rely on negative epoch values.
8673 The payby for card/check batches is broken. With mixed batching, bad
8676 B<collect> I<invoice_time> should be renamed I<time>, like B<bill>.
8680 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
8681 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
8682 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.