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 @taxes = grep { ! $_->taxname or ! $self->tax_exemption($_->taxname) }
2977 if $self->cust_main_exemption; #just to be safe
2979 if ( $conf->exists('tax-pkg_address') && $cust_pkg->locationnum ) {
2981 $_->set('pkgnum', $cust_pkg->pkgnum );
2982 $_->set('locationnum', $cust_pkg->locationnum );
2986 $taxes{''} = [ @taxes ];
2987 $taxes{'setup'} = [ @taxes ];
2988 $taxes{'recur'} = [ @taxes ];
2989 $taxes{$_} = [ @taxes ] foreach (@classes);
2991 # # maybe eliminate this entirely, along with all the 0% records
2992 # unless ( @taxes ) {
2994 # "fatal: can't find tax rate for state/county/country/taxclass ".
2995 # join('/', map $taxhash{$_}, qw(state county country taxclass) );
2998 } #if $conf->exists('enable_taxproducts') ...
3003 if ( $conf->exists('separate_usage') ) {
3004 my $section = $cust_pkg->part_pkg->option('usage_section', 'Hush!');
3005 my $summary = $cust_pkg->part_pkg->option('summarize_usage', 'Hush!');
3006 push @display, new FS::cust_bill_pkg_display { type => 'S' };
3007 push @display, new FS::cust_bill_pkg_display { type => 'R' };
3008 push @display, new FS::cust_bill_pkg_display { type => 'U',
3011 if ($section && $summary) {
3012 $display[2]->post_total('Y');
3013 push @display, new FS::cust_bill_pkg_display { type => 'U',
3018 $cust_bill_pkg->set('display', \@display);
3020 my %tax_cust_bill_pkg = $cust_bill_pkg->disintegrate;
3021 foreach my $key (keys %tax_cust_bill_pkg) {
3022 my @taxes = @{ $taxes{$key} || [] };
3023 my $tax_cust_bill_pkg = $tax_cust_bill_pkg{$key};
3025 my %localtaxlisthash = ();
3026 foreach my $tax ( @taxes ) {
3028 my $taxname = ref( $tax ). ' '. $tax->taxnum;
3029 # $taxname .= ' pkgnum'. $cust_pkg->pkgnum.
3030 # ' locationnum'. $cust_pkg->locationnum
3031 # if $conf->exists('tax-pkg_address') && $cust_pkg->locationnum;
3033 $taxlisthash->{ $taxname } ||= [ $tax ];
3034 push @{ $taxlisthash->{ $taxname } }, $tax_cust_bill_pkg;
3036 $localtaxlisthash{ $taxname } ||= [ $tax ];
3037 push @{ $localtaxlisthash{ $taxname } }, $tax_cust_bill_pkg;
3041 warn "finding taxed taxes...\n" if $DEBUG > 2;
3042 foreach my $tax ( keys %localtaxlisthash ) {
3043 my $tax_object = shift @{ $localtaxlisthash{$tax} };
3044 warn "found possible taxed tax ". $tax_object->taxname. " we call $tax\n"
3046 next unless $tax_object->can('tax_on_tax');
3048 foreach my $tot ( $tax_object->tax_on_tax( $self ) ) {
3049 my $totname = ref( $tot ). ' '. $tot->taxnum;
3051 warn "checking $totname which we call ". $tot->taxname. " as applicable\n"
3053 next unless exists( $localtaxlisthash{ $totname } ); # only increase
3055 warn "adding $totname to taxed taxes\n" if $DEBUG > 2;
3056 my $hashref_or_error =
3057 $tax_object->taxline( $localtaxlisthash{$tax},
3058 'custnum' => $self->custnum,
3059 'invoice_time' => $invoice_time,
3061 return $hashref_or_error
3062 unless ref($hashref_or_error);
3064 $taxlisthash->{ $totname } ||= [ $tot ];
3065 push @{ $taxlisthash->{ $totname } }, $hashref_or_error->{amount};
3077 my $part_pkg = shift;
3081 my $geocode = $self->geocode('cch');
3083 my @taxclassnums = map { $_->taxclassnum }
3084 $part_pkg->part_pkg_taxoverride($class);
3086 unless (@taxclassnums) {
3087 @taxclassnums = map { $_->taxclassnum }
3088 $part_pkg->part_pkg_taxrate('cch', $geocode, $class);
3090 warn "Found taxclassnum values of ". join(',', @taxclassnums)
3095 join(' OR ', map { "taxclassnum = $_" } @taxclassnums ). ")";
3097 @taxes = qsearch({ 'table' => 'tax_rate',
3098 'hashref' => { 'geocode' => $geocode, },
3099 'extra_sql' => $extra_sql,
3101 if scalar(@taxclassnums);
3103 warn "Found taxes ".
3104 join(',', map{ ref($_). " ". $_->get($_->primary_key) } @taxes). "\n"
3111 =item collect OPTIONS
3113 (Attempt to) collect money for this customer's outstanding invoices (see
3114 L<FS::cust_bill>). Usually used after the bill method.
3116 Actions are now triggered by billing events; see L<FS::part_event> and the
3117 billing events web interface. Old-style invoice events (see
3118 L<FS::part_bill_event>) have been deprecated.
3120 If there is an error, returns the error, otherwise returns false.
3122 Options are passed as name-value pairs.
3124 Currently available options are:
3130 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.
3134 Retry card/echeck/LEC transactions even when not scheduled by invoice events.
3138 set true to surpress email card/ACH decline notices.
3142 "1d" for the traditional, daily events (the default), or "1m" for the new monthly events (part_event.check_freq)
3146 allows for one time override of normal customer billing method
3150 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)
3158 my( $self, %options ) = @_;
3159 my $invoice_time = $options{'invoice_time'} || time;
3162 local $SIG{HUP} = 'IGNORE';
3163 local $SIG{INT} = 'IGNORE';
3164 local $SIG{QUIT} = 'IGNORE';
3165 local $SIG{TERM} = 'IGNORE';
3166 local $SIG{TSTP} = 'IGNORE';
3167 local $SIG{PIPE} = 'IGNORE';
3169 my $oldAutoCommit = $FS::UID::AutoCommit;
3170 local $FS::UID::AutoCommit = 0;
3173 $self->select_for_update; #mutex
3176 my $balance = $self->balance;
3177 warn "$me collect customer ". $self->custnum. ": balance $balance\n"
3180 if ( exists($options{'retry_card'}) ) {
3181 carp 'retry_card option passed to collect is deprecated; use retry';
3182 $options{'retry'} ||= $options{'retry_card'};
3184 if ( exists($options{'retry'}) && $options{'retry'} ) {
3185 my $error = $self->retry_realtime;
3187 $dbh->rollback if $oldAutoCommit;
3192 # false laziness w/pay_batch::import_results
3194 my $due_cust_event = $self->due_cust_event(
3195 'debug' => ( $options{'debug'} || 0 ),
3196 'time' => $invoice_time,
3197 'check_freq' => $options{'check_freq'},
3199 unless( ref($due_cust_event) ) {
3200 $dbh->rollback if $oldAutoCommit;
3201 return $due_cust_event;
3204 foreach my $cust_event ( @$due_cust_event ) {
3208 #re-eval event conditions (a previous event could have changed things)
3209 unless ( $cust_event->test_conditions( 'time' => $invoice_time ) ) {
3210 #don't leave stray "new/locked" records around
3211 my $error = $cust_event->delete;
3213 #gah, even with transactions
3214 $dbh->commit if $oldAutoCommit; #well.
3221 local $realtime_bop_decline_quiet = 1 if $options{'quiet'};
3222 warn " running cust_event ". $cust_event->eventnum. "\n"
3226 #if ( my $error = $cust_event->do_event(%options) ) { #XXX %options?
3227 if ( my $error = $cust_event->do_event() ) {
3228 #XXX wtf is this? figure out a proper dealio with return value
3230 # gah, even with transactions.
3231 $dbh->commit if $oldAutoCommit; #well.
3238 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3243 =item due_cust_event [ HASHREF | OPTION => VALUE ... ]
3245 Inserts database records for and returns an ordered listref of new events due
3246 for this customer, as FS::cust_event objects (see L<FS::cust_event>). If no
3247 events are due, an empty listref is returned. If there is an error, returns a
3248 scalar error message.
3250 To actually run the events, call each event's test_condition method, and if
3251 still true, call the event's do_event method.
3253 Options are passed as a hashref or as a list of name-value pairs. Available
3260 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.
3264 "Current time" for the events.
3268 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)
3272 Only return events for the specified eventtable (by default, events of all eventtables are returned)
3276 Explicitly pass the objects to be tested (typically used with eventtable).
3280 Set to true to return the objects, but not actually insert them into the
3287 sub due_cust_event {
3289 my %opt = ref($_[0]) ? %{ $_[0] } : @_;
3292 #my $DEBUG = $opt{'debug'}
3293 local($DEBUG) = $opt{'debug'}
3294 if defined($opt{'debug'}) && $opt{'debug'} > $DEBUG;
3296 warn "$me due_cust_event called with options ".
3297 join(', ', map { "$_: $opt{$_}" } keys %opt). "\n"
3300 $opt{'time'} ||= time;
3302 local $SIG{HUP} = 'IGNORE';
3303 local $SIG{INT} = 'IGNORE';
3304 local $SIG{QUIT} = 'IGNORE';
3305 local $SIG{TERM} = 'IGNORE';
3306 local $SIG{TSTP} = 'IGNORE';
3307 local $SIG{PIPE} = 'IGNORE';
3309 my $oldAutoCommit = $FS::UID::AutoCommit;
3310 local $FS::UID::AutoCommit = 0;
3313 $self->select_for_update #mutex
3314 unless $opt{testonly};
3317 # 1: find possible events (initial search)
3320 my @cust_event = ();
3322 my @eventtable = $opt{'eventtable'}
3323 ? ( $opt{'eventtable'} )
3324 : FS::part_event->eventtables_runorder;
3326 foreach my $eventtable ( @eventtable ) {
3329 if ( $opt{'objects'} ) {
3331 @objects = @{ $opt{'objects'} };
3335 #my @objects = $self->eventtable(); # sub cust_main { @{ [ $self ] }; }
3336 @objects = ( $eventtable eq 'cust_main' )
3338 : ( $self->$eventtable() );
3342 my @e_cust_event = ();
3344 my $cross = "CROSS JOIN $eventtable";
3345 $cross .= ' LEFT JOIN cust_main USING ( custnum )'
3346 unless $eventtable eq 'cust_main';
3348 foreach my $object ( @objects ) {
3350 #this first search uses the condition_sql magic for optimization.
3351 #the more possible events we can eliminate in this step the better
3353 my $cross_where = '';
3354 my $pkey = $object->primary_key;
3355 $cross_where = "$eventtable.$pkey = ". $object->$pkey();
3357 my $join = FS::part_event_condition->join_conditions_sql( $eventtable );
3359 FS::part_event_condition->where_conditions_sql( $eventtable,
3360 'time'=>$opt{'time'}
3362 my $order = FS::part_event_condition->order_conditions_sql( $eventtable );
3364 $extra_sql = "AND $extra_sql" if $extra_sql;
3366 #here is the agent virtualization
3367 $extra_sql .= " AND ( part_event.agentnum IS NULL
3368 OR part_event.agentnum = ". $self->agentnum. ' )';
3370 $extra_sql .= " $order";
3372 warn "searching for events for $eventtable ". $object->$pkey. "\n"
3373 if $opt{'debug'} > 2;
3374 my @part_event = qsearch( {
3375 'debug' => ( $opt{'debug'} > 3 ? 1 : 0 ),
3376 'select' => 'part_event.*',
3377 'table' => 'part_event',
3378 'addl_from' => "$cross $join",
3379 'hashref' => { 'check_freq' => ( $opt{'check_freq'} || '1d' ),
3380 'eventtable' => $eventtable,
3383 'extra_sql' => "AND $cross_where $extra_sql",
3387 my $pkey = $object->primary_key;
3388 warn " ". scalar(@part_event).
3389 " possible events found for $eventtable ". $object->$pkey(). "\n";
3392 push @e_cust_event, map { $_->new_cust_event($object) } @part_event;
3396 warn " ". scalar(@e_cust_event).
3397 " subtotal possible cust events found for $eventtable\n"
3400 push @cust_event, @e_cust_event;
3404 warn " ". scalar(@cust_event).
3405 " total possible cust events found in initial search\n"
3409 # 2: test conditions
3414 @cust_event = grep $_->test_conditions( 'time' => $opt{'time'},
3415 'stats_hashref' => \%unsat ),
3418 warn " ". scalar(@cust_event). " cust events left satisfying conditions\n"
3421 warn " invalid conditions not eliminated with condition_sql:\n".
3422 join('', map " $_: ".$unsat{$_}."\n", keys %unsat )
3429 unless( $opt{testonly} ) {
3430 foreach my $cust_event ( @cust_event ) {
3432 my $error = $cust_event->insert();
3434 $dbh->rollback if $oldAutoCommit;
3441 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3447 warn " returning events: ". Dumper(@cust_event). "\n"
3454 =item retry_realtime
3456 Schedules realtime / batch credit card / electronic check / LEC billing
3457 events for for retry. Useful if card information has changed or manual
3458 retry is desired. The 'collect' method must be called to actually retry
3461 Implementation details: For either this customer, or for each of this
3462 customer's open invoices, changes the status of the first "done" (with
3463 statustext error) realtime processing event to "failed".
3467 sub retry_realtime {
3470 local $SIG{HUP} = 'IGNORE';
3471 local $SIG{INT} = 'IGNORE';
3472 local $SIG{QUIT} = 'IGNORE';
3473 local $SIG{TERM} = 'IGNORE';
3474 local $SIG{TSTP} = 'IGNORE';
3475 local $SIG{PIPE} = 'IGNORE';
3477 my $oldAutoCommit = $FS::UID::AutoCommit;
3478 local $FS::UID::AutoCommit = 0;
3481 #a little false laziness w/due_cust_event (not too bad, really)
3483 my $join = FS::part_event_condition->join_conditions_sql;
3484 my $order = FS::part_event_condition->order_conditions_sql;
3487 . join ( ' OR ' , map {
3488 "( part_event.eventtable = " . dbh->quote($_)
3489 . " AND tablenum IN( SELECT " . dbdef->table($_)->primary_key . " from $_ where custnum = " . dbh->quote( $self->custnum ) . "))" ;
3490 } FS::part_event->eventtables)
3493 #here is the agent virtualization
3494 my $agent_virt = " ( part_event.agentnum IS NULL
3495 OR part_event.agentnum = ". $self->agentnum. ' )';
3497 #XXX this shouldn't be hardcoded, actions should declare it...
3498 my @realtime_events = qw(
3499 cust_bill_realtime_card
3500 cust_bill_realtime_check
3501 cust_bill_realtime_lec
3505 my $is_realtime_event = ' ( '. join(' OR ', map "part_event.action = '$_'",
3510 my @cust_event = qsearchs({
3511 'table' => 'cust_event',
3512 'select' => 'cust_event.*',
3513 'addl_from' => "LEFT JOIN part_event USING ( eventpart ) $join",
3514 'hashref' => { 'status' => 'done' },
3515 'extra_sql' => " AND statustext IS NOT NULL AND statustext != '' ".
3516 " AND $mine AND $is_realtime_event AND $agent_virt $order" # LIMIT 1"
3519 my %seen_invnum = ();
3520 foreach my $cust_event (@cust_event) {
3522 #max one for the customer, one for each open invoice
3523 my $cust_X = $cust_event->cust_X;
3524 next if $seen_invnum{ $cust_event->part_event->eventtable eq 'cust_bill'
3528 or $cust_event->part_event->eventtable eq 'cust_bill'
3531 my $error = $cust_event->retry;
3533 $dbh->rollback if $oldAutoCommit;
3534 return "error scheduling event for retry: $error";
3539 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3544 # some horrid false laziness here to avoid refactor fallout
3545 # eventually realtime realtime_bop and realtime_refund_bop should go
3546 # away and be replaced by _new_realtime_bop and _new_realtime_refund_bop
3548 =item realtime_bop METHOD AMOUNT [ OPTION => VALUE ... ]
3550 Runs a realtime credit card, ACH (electronic check) or phone bill transaction
3551 via a Business::OnlinePayment realtime gateway. See
3552 L<http://420.am/business-onlinepayment> for supported gateways.
3554 Available methods are: I<CC>, I<ECHECK> and I<LEC>
3556 Available options are: I<description>, I<invnum>, I<quiet>, I<paynum_ref>, I<payunique>
3558 The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
3559 I<zip>, I<payinfo> and I<paydate> are also available. Any of these options,
3560 if set, will override the value from the customer record.
3562 I<description> is a free-text field passed to the gateway. It defaults to
3563 "Internet services".
3565 If an I<invnum> is specified, this payment (if successful) is applied to the
3566 specified invoice. If you don't specify an I<invnum> you might want to
3567 call the B<apply_payments> method.
3569 I<quiet> can be set true to surpress email decline notices.
3571 I<paynum_ref> can be set to a scalar reference. It will be filled in with the
3572 resulting paynum, if any.
3574 I<payunique> is a unique identifier for this payment.
3576 (moved from cust_bill) (probably should get realtime_{card,ach,lec} here too)
3583 return $self->_new_realtime_bop(@_)
3584 if $self->_new_bop_required();
3586 my( $method, $amount, %options ) = @_;
3588 warn "$me realtime_bop: $method $amount\n";
3589 warn " $_ => $options{$_}\n" foreach keys %options;
3592 $options{'description'} ||= 'Internet services';
3594 return $self->fake_bop($method, $amount, %options) if $options{'fake'};
3596 eval "use Business::OnlinePayment";
3599 my $payinfo = exists($options{'payinfo'})
3600 ? $options{'payinfo'}
3603 my %method2payby = (
3610 # check for banned credit card/ACH
3613 my $ban = qsearchs('banned_pay', {
3614 'payby' => $method2payby{$method},
3615 'payinfo' => md5_base64($payinfo),
3617 return "Banned credit card" if $ban;
3620 # set taxclass and trans_is_recur based on invnum if there is one
3624 my $trans_is_recur = 0;
3625 if ( $options{'invnum'} ) {
3627 my $cust_bill = qsearchs('cust_bill', { 'invnum' => $options{'invnum'} } );
3628 die "invnum ". $options{'invnum'}. " not found" unless $cust_bill;
3631 map { $_->part_pkg }
3633 map { $_->cust_pkg }
3634 $cust_bill->cust_bill_pkg;
3636 my @taxclasses = map $_->taxclass, @part_pkg;
3637 $taxclass = $taxclasses[0]
3638 unless grep { $taxclasses[0] ne $_ } @taxclasses; #unless there are
3639 #different taxclasses
3641 if grep { $_->freq ne '0' } @part_pkg;
3649 #look for an agent gateway override first
3651 if ( $method eq 'CC' ) {
3652 $cardtype = cardtype($payinfo);
3653 } elsif ( $method eq 'ECHECK' ) {
3656 $cardtype = $method;
3660 qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
3661 cardtype => $cardtype,
3662 taxclass => $taxclass, } )
3663 || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
3665 taxclass => $taxclass, } )
3666 || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
3667 cardtype => $cardtype,
3669 || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
3671 taxclass => '', } );
3673 my $payment_gateway = '';
3674 my( $processor, $login, $password, $action, @bop_options );
3675 if ( $override ) { #use a payment gateway override
3677 $payment_gateway = $override->payment_gateway;
3679 $processor = $payment_gateway->gateway_module;
3680 $login = $payment_gateway->gateway_username;
3681 $password = $payment_gateway->gateway_password;
3682 $action = $payment_gateway->gateway_action;
3683 @bop_options = $payment_gateway->options;
3685 } else { #use the standard settings from the config
3687 ( $processor, $login, $password, $action, @bop_options ) =
3688 $self->default_payment_gateway($method);
3696 my $address = exists($options{'address1'})
3697 ? $options{'address1'}
3699 my $address2 = exists($options{'address2'})
3700 ? $options{'address2'}
3702 $address .= ", ". $address2 if length($address2);
3704 my $o_payname = exists($options{'payname'})
3705 ? $options{'payname'}
3707 my($payname, $payfirst, $paylast);
3708 if ( $o_payname && $method ne 'ECHECK' ) {
3709 ($payname = $o_payname) =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
3710 or return "Illegal payname $payname";
3711 ($payfirst, $paylast) = ($1, $2);
3713 $payfirst = $self->getfield('first');
3714 $paylast = $self->getfield('last');
3715 $payname = "$payfirst $paylast";
3718 my @invoicing_list = $self->invoicing_list_emailonly;
3719 if ( $conf->exists('emailinvoiceautoalways')
3720 || $conf->exists('emailinvoiceauto') && ! @invoicing_list
3721 || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
3722 push @invoicing_list, $self->all_emails;
3725 my $email = ($conf->exists('business-onlinepayment-email-override'))
3726 ? $conf->config('business-onlinepayment-email-override')
3727 : $invoicing_list[0];
3731 my $payip = exists($options{'payip'})
3734 $content{customer_ip} = $payip
3737 $content{invoice_number} = $options{'invnum'}
3738 if exists($options{'invnum'}) && length($options{'invnum'});
3740 $content{email_customer} =
3741 ( $conf->exists('business-onlinepayment-email_customer')
3742 || $conf->exists('business-onlinepayment-email-override') );
3745 if ( $method eq 'CC' ) {
3747 $content{card_number} = $payinfo;
3748 $paydate = exists($options{'paydate'})
3749 ? $options{'paydate'}
3751 $paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
3752 $content{expiration} = "$2/$1";
3754 my $paycvv = exists($options{'paycvv'})
3755 ? $options{'paycvv'}
3757 $content{cvv2} = $paycvv
3760 my $paystart_month = exists($options{'paystart_month'})
3761 ? $options{'paystart_month'}
3762 : $self->paystart_month;
3764 my $paystart_year = exists($options{'paystart_year'})
3765 ? $options{'paystart_year'}
3766 : $self->paystart_year;
3768 $content{card_start} = "$paystart_month/$paystart_year"
3769 if $paystart_month && $paystart_year;
3771 my $payissue = exists($options{'payissue'})
3772 ? $options{'payissue'}
3774 $content{issue_number} = $payissue if $payissue;
3776 if ( $self->_bop_recurring_billing( 'payinfo' => $payinfo,
3777 'trans_is_recur' => $trans_is_recur,
3781 $content{recurring_billing} = 'YES';
3782 $content{acct_code} = 'rebill'
3783 if $conf->exists('credit_card-recurring_billing_acct_code');
3786 } elsif ( $method eq 'ECHECK' ) {
3787 ( $content{account_number}, $content{routing_code} ) =
3788 split('@', $payinfo);
3789 $content{bank_name} = $o_payname;
3790 $content{bank_state} = exists($options{'paystate'})
3791 ? $options{'paystate'}
3792 : $self->getfield('paystate');
3793 $content{account_type} = exists($options{'paytype'})
3794 ? uc($options{'paytype'}) || 'CHECKING'
3795 : uc($self->getfield('paytype')) || 'CHECKING';
3796 $content{account_name} = $payname;
3797 $content{customer_org} = $self->company ? 'B' : 'I';
3798 $content{state_id} = exists($options{'stateid'})
3799 ? $options{'stateid'}
3800 : $self->getfield('stateid');
3801 $content{state_id_state} = exists($options{'stateid_state'})
3802 ? $options{'stateid_state'}
3803 : $self->getfield('stateid_state');
3804 $content{customer_ssn} = exists($options{'ss'})
3807 } elsif ( $method eq 'LEC' ) {
3808 $content{phone} = $payinfo;
3812 # run transaction(s)
3815 my $balance = exists( $options{'balance'} )
3816 ? $options{'balance'}
3819 $self->select_for_update; #mutex ... just until we get our pending record in
3821 #the checks here are intended to catch concurrent payments
3822 #double-form-submission prevention is taken care of in cust_pay_pending::check
3825 return "The customer's balance has changed; $method transaction aborted."
3826 if $self->balance < $balance;
3827 #&& $self->balance < $amount; #might as well anyway?
3829 #also check and make sure there aren't *other* pending payments for this cust
3831 my @pending = qsearch('cust_pay_pending', {
3832 'custnum' => $self->custnum,
3833 'status' => { op=>'!=', value=>'done' }
3835 return "A payment is already being processed for this customer (".
3836 join(', ', map 'paypendingnum '. $_->paypendingnum, @pending ).
3837 "); $method transaction aborted."
3838 if scalar(@pending);
3840 #okay, good to go, if we're a duplicate, cust_pay_pending will kick us out
3842 my $cust_pay_pending = new FS::cust_pay_pending {
3843 'custnum' => $self->custnum,
3844 #'invnum' => $options{'invnum'},
3847 'payby' => $method2payby{$method},
3848 'payinfo' => $payinfo,
3849 'paydate' => $paydate,
3850 'recurring_billing' => $content{recurring_billing},
3852 'gatewaynum' => ( $payment_gateway ? $payment_gateway->gatewaynum : '' ),
3854 $cust_pay_pending->payunique( $options{payunique} )
3855 if defined($options{payunique}) && length($options{payunique});
3856 my $cpp_new_err = $cust_pay_pending->insert; #mutex lost when this is inserted
3857 return $cpp_new_err if $cpp_new_err;
3859 my( $action1, $action2 ) = split(/\s*\,\s*/, $action );
3861 my $transaction = new Business::OnlinePayment( $processor, @bop_options );
3862 $transaction->content(
3865 'password' => $password,
3866 'action' => $action1,
3867 'description' => $options{'description'},
3868 'amount' => $amount,
3869 #'invoice_number' => $options{'invnum'},
3870 'customer_id' => $self->custnum,
3871 'last_name' => $paylast,
3872 'first_name' => $payfirst,
3874 'address' => $address,
3875 'city' => ( exists($options{'city'})
3878 'state' => ( exists($options{'state'})
3881 'zip' => ( exists($options{'zip'})
3884 'country' => ( exists($options{'country'})
3885 ? $options{'country'}
3887 'referer' => 'http://cleanwhisker.420.am/', #XXX fix referer :/
3889 'phone' => $self->daytime || $self->night,
3893 $cust_pay_pending->status('pending');
3894 my $cpp_pending_err = $cust_pay_pending->replace;
3895 return $cpp_pending_err if $cpp_pending_err;
3898 my $BOP_TESTING = 0;
3899 my $BOP_TESTING_SUCCESS = 1;
3901 unless ( $BOP_TESTING ) {
3902 $transaction->submit();
3904 if ( $BOP_TESTING_SUCCESS ) {
3905 $transaction->is_success(1);
3906 $transaction->authorization('fake auth');
3908 $transaction->is_success(0);
3909 $transaction->error_message('fake failure');
3913 if ( $transaction->is_success() && $action2 ) {
3915 $cust_pay_pending->status('authorized');
3916 my $cpp_authorized_err = $cust_pay_pending->replace;
3917 return $cpp_authorized_err if $cpp_authorized_err;
3919 my $auth = $transaction->authorization;
3920 my $ordernum = $transaction->can('order_number')
3921 ? $transaction->order_number
3925 new Business::OnlinePayment( $processor, @bop_options );
3932 password => $password,
3933 order_number => $ordernum,
3935 authorization => $auth,
3936 description => $options{'description'},
3939 foreach my $field (qw( authorization_source_code returned_ACI
3940 transaction_identifier validation_code
3941 transaction_sequence_num local_transaction_date
3942 local_transaction_time AVS_result_code )) {
3943 $capture{$field} = $transaction->$field() if $transaction->can($field);
3946 $capture->content( %capture );
3950 unless ( $capture->is_success ) {
3951 my $e = "Authorization successful but capture failed, custnum #".
3952 $self->custnum. ': '. $capture->result_code.
3953 ": ". $capture->error_message;
3960 $cust_pay_pending->status($transaction->is_success() ? 'captured' : 'declined');
3961 my $cpp_captured_err = $cust_pay_pending->replace;
3962 return $cpp_captured_err if $cpp_captured_err;
3965 # remove paycvv after initial transaction
3968 #false laziness w/misc/process/payment.cgi - check both to make sure working
3970 if ( defined $self->dbdef_table->column('paycvv')
3971 && length($self->paycvv)
3972 && ! grep { $_ eq cardtype($payinfo) } $conf->config('cvv-save')
3974 my $error = $self->remove_cvv;
3976 warn "WARNING: error removing cvv: $error\n";
3984 if ( $transaction->is_success() ) {
3987 if ( $payment_gateway ) { # agent override
3988 $paybatch = $payment_gateway->gatewaynum. '-';
3991 $paybatch .= "$processor:". $transaction->authorization;
3993 $paybatch .= ':'. $transaction->order_number
3994 if $transaction->can('order_number')
3995 && length($transaction->order_number);
3997 my $cust_pay = new FS::cust_pay ( {
3998 'custnum' => $self->custnum,
3999 'invnum' => $options{'invnum'},
4002 'payby' => $method2payby{$method},
4003 'payinfo' => $payinfo,
4004 'paybatch' => $paybatch,
4005 'paydate' => $paydate,
4007 #doesn't hurt to know, even though the dup check is in cust_pay_pending now
4008 $cust_pay->payunique( $options{payunique} )
4009 if defined($options{payunique}) && length($options{payunique});
4011 my $oldAutoCommit = $FS::UID::AutoCommit;
4012 local $FS::UID::AutoCommit = 0;
4015 #start a transaction, insert the cust_pay and set cust_pay_pending.status to done in a single transction
4017 my $error = $cust_pay->insert($options{'manual'} ? ( 'manual' => 1 ) : () );
4020 $cust_pay->invnum(''); #try again with no specific invnum
4021 my $error2 = $cust_pay->insert( $options{'manual'} ?
4022 ( 'manual' => 1 ) : ()
4025 # gah. but at least we have a record of the state we had to abort in
4026 # from cust_pay_pending now.
4027 my $e = "WARNING: $method captured but payment not recorded - ".
4028 "error inserting payment ($processor): $error2".
4029 " (previously tried insert with invnum #$options{'invnum'}" .
4030 ": $error ) - pending payment saved as paypendingnum ".
4031 $cust_pay_pending->paypendingnum. "\n";
4037 if ( $options{'paynum_ref'} ) {
4038 ${ $options{'paynum_ref'} } = $cust_pay->paynum;
4041 $cust_pay_pending->status('done');
4042 $cust_pay_pending->statustext('captured');
4043 $cust_pay_pending->paynum($cust_pay->paynum);
4044 my $cpp_done_err = $cust_pay_pending->replace;
4046 if ( $cpp_done_err ) {
4048 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
4049 my $e = "WARNING: $method captured but payment not recorded - ".
4050 "error updating status for paypendingnum ".
4051 $cust_pay_pending->paypendingnum. ": $cpp_done_err \n";
4057 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4058 return ''; #no error
4064 my $perror = "$processor error: ". $transaction->error_message;
4066 unless ( $transaction->error_message ) {
4069 if ( $transaction->can('response_page') ) {
4071 'page' => ( $transaction->can('response_page')
4072 ? $transaction->response_page
4075 'code' => ( $transaction->can('response_code')
4076 ? $transaction->response_code
4079 'headers' => ( $transaction->can('response_headers')
4080 ? $transaction->response_headers
4086 "No additional debugging information available for $processor";
4089 $perror .= "No error_message returned from $processor -- ".
4090 ( ref($t_response) ? Dumper($t_response) : $t_response );
4094 if ( !$options{'quiet'} && !$realtime_bop_decline_quiet
4095 && $conf->exists('emaildecline')
4096 && grep { $_ ne 'POST' } $self->invoicing_list
4097 && ! grep { $transaction->error_message =~ /$_/ }
4098 $conf->config('emaildecline-exclude')
4100 my @templ = $conf->config('declinetemplate');
4101 my $template = new Text::Template (
4103 SOURCE => [ map "$_\n", @templ ],
4104 ) or return "($perror) can't create template: $Text::Template::ERROR";
4105 $template->compile()
4106 or return "($perror) can't compile template: $Text::Template::ERROR";
4108 my $templ_hash = { error => $transaction->error_message };
4110 my $error = send_email(
4111 'from' => $conf->config('invoice_from', $self->agentnum ),
4112 'to' => [ grep { $_ ne 'POST' } $self->invoicing_list ],
4113 'subject' => 'Your payment could not be processed',
4114 'body' => [ $template->fill_in(HASH => $templ_hash) ],
4117 $perror .= " (also received error sending decline notification: $error)"
4122 $cust_pay_pending->status('done');
4123 $cust_pay_pending->statustext("declined: $perror");
4124 my $cpp_done_err = $cust_pay_pending->replace;
4125 if ( $cpp_done_err ) {
4126 my $e = "WARNING: $method declined but pending payment not resolved - ".
4127 "error updating status for paypendingnum ".
4128 $cust_pay_pending->paypendingnum. ": $cpp_done_err \n";
4130 $perror = "$e ($perror)";
4138 sub _bop_recurring_billing {
4139 my( $self, %opt ) = @_;
4141 my $method = $conf->config('credit_card-recurring_billing_flag');
4143 if ( $method eq 'transaction_is_recur' ) {
4145 return 1 if $opt{'trans_is_recur'};
4149 my %hash = ( 'custnum' => $self->custnum,
4154 if qsearch('cust_pay', { %hash, 'payinfo' => $opt{'payinfo'} } )
4155 || qsearch('cust_pay', { %hash, 'paymask' => $self->mask_payinfo('CARD',
4166 =item realtime_refund_bop METHOD [ OPTION => VALUE ... ]
4168 Refunds a realtime credit card, ACH (electronic check) or phone bill transaction
4169 via a Business::OnlinePayment realtime gateway. See
4170 L<http://420.am/business-onlinepayment> for supported gateways.
4172 Available methods are: I<CC>, I<ECHECK> and I<LEC>
4174 Available options are: I<amount>, I<reason>, I<paynum>, I<paydate>
4176 Most gateways require a reference to an original payment transaction to refund,
4177 so you probably need to specify a I<paynum>.
4179 I<amount> defaults to the original amount of the payment if not specified.
4181 I<reason> specifies a reason for the refund.
4183 I<paydate> specifies the expiration date for a credit card overriding the
4184 value from the customer record or the payment record. Specified as yyyy-mm-dd
4186 Implementation note: If I<amount> is unspecified or equal to the amount of the
4187 orignal payment, first an attempt is made to "void" the transaction via
4188 the gateway (to cancel a not-yet settled transaction) and then if that fails,
4189 the normal attempt is made to "refund" ("credit") the transaction via the
4190 gateway is attempted.
4192 #The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
4193 #I<zip>, I<payinfo> and I<paydate> are also available. Any of these options,
4194 #if set, will override the value from the customer record.
4196 #If an I<invnum> is specified, this payment (if successful) is applied to the
4197 #specified invoice. If you don't specify an I<invnum> you might want to
4198 #call the B<apply_payments> method.
4202 #some false laziness w/realtime_bop, not enough to make it worth merging
4203 #but some useful small subs should be pulled out
4204 sub realtime_refund_bop {
4207 return $self->_new_realtime_refund_bop(@_)
4208 if $self->_new_bop_required();
4210 my( $method, %options ) = @_;
4212 warn "$me realtime_refund_bop: $method refund\n";
4213 warn " $_ => $options{$_}\n" foreach keys %options;
4216 eval "use Business::OnlinePayment";
4220 # look up the original payment and optionally a gateway for that payment
4224 my $amount = $options{'amount'};
4226 my( $processor, $login, $password, @bop_options ) ;
4227 my( $auth, $order_number ) = ( '', '', '' );
4229 if ( $options{'paynum'} ) {
4231 warn " paynum: $options{paynum}\n" if $DEBUG > 1;
4232 $cust_pay = qsearchs('cust_pay', { paynum=>$options{'paynum'} } )
4233 or return "Unknown paynum $options{'paynum'}";
4234 $amount ||= $cust_pay->paid;
4236 $cust_pay->paybatch =~ /^((\d+)\-)?(\w+):\s*([\w\-\/ ]*)(:([\w\-]+))?$/
4237 or return "Can't parse paybatch for paynum $options{'paynum'}: ".
4238 $cust_pay->paybatch;
4239 my $gatewaynum = '';
4240 ( $gatewaynum, $processor, $auth, $order_number ) = ( $2, $3, $4, $6 );
4242 if ( $gatewaynum ) { #gateway for the payment to be refunded
4244 my $payment_gateway =
4245 qsearchs('payment_gateway', { 'gatewaynum' => $gatewaynum } );
4246 die "payment gateway $gatewaynum not found"
4247 unless $payment_gateway;
4249 $processor = $payment_gateway->gateway_module;
4250 $login = $payment_gateway->gateway_username;
4251 $password = $payment_gateway->gateway_password;
4252 @bop_options = $payment_gateway->options;
4254 } else { #try the default gateway
4256 my( $conf_processor, $unused_action );
4257 ( $conf_processor, $login, $password, $unused_action, @bop_options ) =
4258 $self->default_payment_gateway($method);
4260 return "processor of payment $options{'paynum'} $processor does not".
4261 " match default processor $conf_processor"
4262 unless $processor eq $conf_processor;
4267 } else { # didn't specify a paynum, so look for agent gateway overrides
4268 # like a normal transaction
4271 if ( $method eq 'CC' ) {
4272 $cardtype = cardtype($self->payinfo);
4273 } elsif ( $method eq 'ECHECK' ) {
4276 $cardtype = $method;
4279 qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
4280 cardtype => $cardtype,
4282 || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
4284 taxclass => '', } );
4286 if ( $override ) { #use a payment gateway override
4288 my $payment_gateway = $override->payment_gateway;
4290 $processor = $payment_gateway->gateway_module;
4291 $login = $payment_gateway->gateway_username;
4292 $password = $payment_gateway->gateway_password;
4293 #$action = $payment_gateway->gateway_action;
4294 @bop_options = $payment_gateway->options;
4296 } else { #use the standard settings from the config
4299 ( $processor, $login, $password, $unused_action, @bop_options ) =
4300 $self->default_payment_gateway($method);
4305 return "neither amount nor paynum specified" unless $amount;
4310 'password' => $password,
4311 'order_number' => $order_number,
4312 'amount' => $amount,
4313 'referer' => 'http://cleanwhisker.420.am/', #XXX fix referer :/
4315 $content{authorization} = $auth
4316 if length($auth); #echeck/ACH transactions have an order # but no auth
4317 #(at least with authorize.net)
4319 my $disable_void_after;
4320 if ($conf->exists('disable_void_after')
4321 && $conf->config('disable_void_after') =~ /^(\d+)$/) {
4322 $disable_void_after = $1;
4325 #first try void if applicable
4326 if ( $cust_pay && $cust_pay->paid == $amount
4328 ( not defined($disable_void_after) )
4329 || ( time < ($cust_pay->_date + $disable_void_after ) )
4332 warn " attempting void\n" if $DEBUG > 1;
4333 my $void = new Business::OnlinePayment( $processor, @bop_options );
4334 $void->content( 'action' => 'void', %content );
4336 if ( $void->is_success ) {
4337 my $error = $cust_pay->void($options{'reason'});
4339 # gah, even with transactions.
4340 my $e = 'WARNING: Card/ACH voided but database not updated - '.
4341 "error voiding payment: $error";
4345 warn " void successful\n" if $DEBUG > 1;
4350 warn " void unsuccessful, trying refund\n"
4354 my $address = $self->address1;
4355 $address .= ", ". $self->address2 if $self->address2;
4357 my($payname, $payfirst, $paylast);
4358 if ( $self->payname && $method ne 'ECHECK' ) {
4359 $payname = $self->payname;
4360 $payname =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
4361 or return "Illegal payname $payname";
4362 ($payfirst, $paylast) = ($1, $2);
4364 $payfirst = $self->getfield('first');
4365 $paylast = $self->getfield('last');
4366 $payname = "$payfirst $paylast";
4369 my @invoicing_list = $self->invoicing_list_emailonly;
4370 if ( $conf->exists('emailinvoiceautoalways')
4371 || $conf->exists('emailinvoiceauto') && ! @invoicing_list
4372 || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
4373 push @invoicing_list, $self->all_emails;
4376 my $email = ($conf->exists('business-onlinepayment-email-override'))
4377 ? $conf->config('business-onlinepayment-email-override')
4378 : $invoicing_list[0];
4380 my $payip = exists($options{'payip'})
4383 $content{customer_ip} = $payip
4387 if ( $method eq 'CC' ) {
4390 $content{card_number} = $payinfo = $cust_pay->payinfo;
4391 (exists($options{'paydate'}) ? $options{'paydate'} : $cust_pay->paydate)
4392 =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/ &&
4393 ($content{expiration} = "$2/$1"); # where available
4395 $content{card_number} = $payinfo = $self->payinfo;
4396 (exists($options{'paydate'}) ? $options{'paydate'} : $self->paydate)
4397 =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
4398 $content{expiration} = "$2/$1";
4401 } elsif ( $method eq 'ECHECK' ) {
4404 $payinfo = $cust_pay->payinfo;
4406 $payinfo = $self->payinfo;
4408 ( $content{account_number}, $content{routing_code} )= split('@', $payinfo );
4409 $content{bank_name} = $self->payname;
4410 $content{account_type} = 'CHECKING';
4411 $content{account_name} = $payname;
4412 $content{customer_org} = $self->company ? 'B' : 'I';
4413 $content{customer_ssn} = $self->ss;
4414 } elsif ( $method eq 'LEC' ) {
4415 $content{phone} = $payinfo = $self->payinfo;
4419 my $refund = new Business::OnlinePayment( $processor, @bop_options );
4420 my %sub_content = $refund->content(
4421 'action' => 'credit',
4422 'customer_id' => $self->custnum,
4423 'last_name' => $paylast,
4424 'first_name' => $payfirst,
4426 'address' => $address,
4427 'city' => $self->city,
4428 'state' => $self->state,
4429 'zip' => $self->zip,
4430 'country' => $self->country,
4432 'phone' => $self->daytime || $self->night,
4435 warn join('', map { " $_ => $sub_content{$_}\n" } keys %sub_content )
4439 return "$processor error: ". $refund->error_message
4440 unless $refund->is_success();
4442 my %method2payby = (
4448 my $paybatch = "$processor:". $refund->authorization;
4449 $paybatch .= ':'. $refund->order_number
4450 if $refund->can('order_number') && $refund->order_number;
4452 while ( $cust_pay && $cust_pay->unapplied < $amount ) {
4453 my @cust_bill_pay = $cust_pay->cust_bill_pay;
4454 last unless @cust_bill_pay;
4455 my $cust_bill_pay = pop @cust_bill_pay;
4456 my $error = $cust_bill_pay->delete;
4460 my $cust_refund = new FS::cust_refund ( {
4461 'custnum' => $self->custnum,
4462 'paynum' => $options{'paynum'},
4463 'refund' => $amount,
4465 'payby' => $method2payby{$method},
4466 'payinfo' => $payinfo,
4467 'paybatch' => $paybatch,
4468 'reason' => $options{'reason'} || 'card or ACH refund',
4470 my $error = $cust_refund->insert;
4472 $cust_refund->paynum(''); #try again with no specific paynum
4473 my $error2 = $cust_refund->insert;
4475 # gah, even with transactions.
4476 my $e = 'WARNING: Card/ACH refunded but database not updated - '.
4477 "error inserting refund ($processor): $error2".
4478 " (previously tried insert with paynum #$options{'paynum'}" .
4489 # does the configuration indicate the new bop routines are required?
4491 sub _new_bop_required {
4494 my $botpp = 'Business::OnlineThirdPartyPayment';
4497 if ( $conf->config('business-onlinepayment-namespace') eq $botpp ||
4498 scalar( grep { $_->gateway_namespace eq $botpp }
4499 qsearch( 'payment_gateway', { 'disabled' => '' } )
4508 =item realtime_collect [ OPTION => VALUE ... ]
4510 Runs a realtime credit card, ACH (electronic check) or phone bill transaction
4511 via a Business::OnlinePayment or Business::OnlineThirdPartyPayment realtime
4512 gateway. See L<http://420.am/business-onlinepayment> and
4513 L<http://420.am/business-onlinethirdpartypayment> for supported gateways.
4515 On failure returns an error message.
4517 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.
4519 Available options are: I<method>, I<amount>, I<description>, I<invnum>, I<quiet>, I<paynum_ref>, I<payunique>, I<session_id>
4521 I<method> is one of: I<CC>, I<ECHECK> and I<LEC>. If none is specified
4522 then it is deduced from the customer record.
4524 If no I<amount> is specified, then the customer balance is used.
4526 The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
4527 I<zip>, I<payinfo> and I<paydate> are also available. Any of these options,
4528 if set, will override the value from the customer record.
4530 I<description> is a free-text field passed to the gateway. It defaults to
4531 "Internet services".
4533 If an I<invnum> is specified, this payment (if successful) is applied to the
4534 specified invoice. If you don't specify an I<invnum> you might want to
4535 call the B<apply_payments> method.
4537 I<quiet> can be set true to surpress email decline notices.
4539 I<paynum_ref> can be set to a scalar reference. It will be filled in with the
4540 resulting paynum, if any.
4542 I<payunique> is a unique identifier for this payment.
4544 I<session_id> is a session identifier associated with this payment.
4546 I<depend_jobnum> allows payment capture to unlock export jobs
4550 sub realtime_collect {
4551 my( $self, %options ) = @_;
4554 warn "$me realtime_collect:\n";
4555 warn " $_ => $options{$_}\n" foreach keys %options;
4558 $options{amount} = $self->balance unless exists( $options{amount} );
4559 $options{method} = FS::payby->payby2bop($self->payby)
4560 unless exists( $options{method} );
4562 return $self->realtime_bop({%options});
4566 =item _realtime_bop { [ ARG => VALUE ... ] }
4568 Runs a realtime credit card, ACH (electronic check) or phone bill transaction
4569 via a Business::OnlinePayment realtime gateway. See
4570 L<http://420.am/business-onlinepayment> for supported gateways.
4572 Required arguments in the hashref are I<method>, and I<amount>
4574 Available methods are: I<CC>, I<ECHECK> and I<LEC>
4576 Available optional arguments are: I<description>, I<invnum>, I<quiet>, I<paynum_ref>, I<payunique>, I<session_id>
4578 The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
4579 I<zip>, I<payinfo> and I<paydate> are also available. Any of these options,
4580 if set, will override the value from the customer record.
4582 I<description> is a free-text field passed to the gateway. It defaults to
4583 "Internet services".
4585 If an I<invnum> is specified, this payment (if successful) is applied to the
4586 specified invoice. If you don't specify an I<invnum> you might want to
4587 call the B<apply_payments> method.
4589 I<quiet> can be set true to surpress email decline notices.
4591 I<paynum_ref> can be set to a scalar reference. It will be filled in with the
4592 resulting paynum, if any.
4594 I<payunique> is a unique identifier for this payment.
4596 I<session_id> is a session identifier associated with this payment.
4598 I<depend_jobnum> allows payment capture to unlock export jobs
4600 (moved from cust_bill) (probably should get realtime_{card,ach,lec} here too)
4604 # some helper routines
4605 sub _payment_gateway {
4606 my ($self, $options) = @_;
4608 $options->{payment_gateway} = $self->agent->payment_gateway( %$options )
4609 unless exists($options->{payment_gateway});
4611 $options->{payment_gateway};
4615 my ($self, $options) = @_;
4618 'login' => $options->{payment_gateway}->gateway_username,
4619 'password' => $options->{payment_gateway}->gateway_password,
4624 my ($self, $options) = @_;
4626 $options->{payment_gateway}->gatewaynum
4627 ? $options->{payment_gateway}->options
4628 : @{ $options->{payment_gateway}->get('options') };
4632 my ($self, $options) = @_;
4634 $options->{description} ||= 'Internet services';
4635 $options->{payinfo} = $self->payinfo unless exists( $options->{payinfo} );
4636 $options->{invnum} ||= '';
4637 $options->{payname} = $self->payname unless exists( $options->{payname} );
4641 my ($self, $options) = @_;
4644 $content{address} = exists($options->{'address1'})
4645 ? $options->{'address1'}
4647 my $address2 = exists($options->{'address2'})
4648 ? $options->{'address2'}
4650 $content{address} .= ", ". $address2 if length($address2);
4652 my $payip = exists($options->{'payip'}) ? $options->{'payip'} : $self->payip;
4653 $content{customer_ip} = $payip if length($payip);
4655 $content{invoice_number} = $options->{'invnum'}
4656 if exists($options->{'invnum'}) && length($options->{'invnum'});
4658 $content{email_customer} =
4659 ( $conf->exists('business-onlinepayment-email_customer')
4660 || $conf->exists('business-onlinepayment-email-override') );
4662 $content{payfirst} = $self->getfield('first');
4663 $content{paylast} = $self->getfield('last');
4665 $content{account_name} = "$content{payfirst} $content{paylast}"
4666 if $options->{method} eq 'ECHECK';
4668 $content{name} = $options->{payname};
4669 $content{name} = $content{account_name} if exists($content{account_name});
4671 $content{city} = exists($options->{city})
4674 $content{state} = exists($options->{state})
4677 $content{zip} = exists($options->{zip})
4680 $content{country} = exists($options->{country})
4681 ? $options->{country}
4683 $content{referer} = 'http://cleanwhisker.420.am/'; #XXX fix referer :/
4684 $content{phone} = $self->daytime || $self->night;
4689 my %bop_method2payby = (
4695 sub _new_realtime_bop {
4699 if (ref($_[0]) eq 'HASH') {
4700 %options = %{$_[0]};
4702 my ( $method, $amount ) = ( shift, shift );
4704 $options{method} = $method;
4705 $options{amount} = $amount;
4709 warn "$me realtime_bop (new): $options{method} $options{amount}\n";
4710 warn " $_ => $options{$_}\n" foreach keys %options;
4713 return $self->fake_bop(%options) if $options{'fake'};
4715 $self->_bop_defaults(\%options);
4718 # set trans_is_recur based on invnum if there is one
4721 my $trans_is_recur = 0;
4722 if ( $options{'invnum'} ) {
4724 my $cust_bill = qsearchs('cust_bill', { 'invnum' => $options{'invnum'} } );
4725 die "invnum ". $options{'invnum'}. " not found" unless $cust_bill;
4728 map { $_->part_pkg }
4730 map { $_->cust_pkg }
4731 $cust_bill->cust_bill_pkg;
4734 if grep { $_->freq ne '0' } @part_pkg;
4742 my $payment_gateway = $self->_payment_gateway( \%options );
4743 my $namespace = $payment_gateway->gateway_namespace;
4745 eval "use $namespace";
4749 # check for banned credit card/ACH
4752 my $ban = qsearchs('banned_pay', {
4753 'payby' => $bop_method2payby{$options{method}},
4754 'payinfo' => md5_base64($options{payinfo}),
4756 return "Banned credit card" if $ban;
4762 my (%bop_content) = $self->_bop_content(\%options);
4764 if ( $options{method} ne 'ECHECK' ) {
4765 $options{payname} =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
4766 or return "Illegal payname $options{payname}";
4767 ($bop_content{payfirst}, $bop_content{paylast}) = ($1, $2);
4770 my @invoicing_list = $self->invoicing_list_emailonly;
4771 if ( $conf->exists('emailinvoiceautoalways')
4772 || $conf->exists('emailinvoiceauto') && ! @invoicing_list
4773 || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
4774 push @invoicing_list, $self->all_emails;
4777 my $email = ($conf->exists('business-onlinepayment-email-override'))
4778 ? $conf->config('business-onlinepayment-email-override')
4779 : $invoicing_list[0];
4783 if ( $namespace eq 'Business::OnlinePayment' && $options{method} eq 'CC' ) {
4785 $content{card_number} = $options{payinfo};
4786 $paydate = exists($options{'paydate'})
4787 ? $options{'paydate'}
4789 $paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
4790 $content{expiration} = "$2/$1";
4792 my $paycvv = exists($options{'paycvv'})
4793 ? $options{'paycvv'}
4795 $content{cvv2} = $paycvv
4798 my $paystart_month = exists($options{'paystart_month'})
4799 ? $options{'paystart_month'}
4800 : $self->paystart_month;
4802 my $paystart_year = exists($options{'paystart_year'})
4803 ? $options{'paystart_year'}
4804 : $self->paystart_year;
4806 $content{card_start} = "$paystart_month/$paystart_year"
4807 if $paystart_month && $paystart_year;
4809 my $payissue = exists($options{'payissue'})
4810 ? $options{'payissue'}
4812 $content{issue_number} = $payissue if $payissue;
4814 if ( $self->_bop_recurring_billing( 'payinfo' => $options{'payinfo'},
4815 'trans_is_recur' => $trans_is_recur,
4819 $content{recurring_billing} = 'YES';
4820 $content{acct_code} = 'rebill'
4821 if $conf->exists('credit_card-recurring_billing_acct_code');
4824 } elsif ( $namespace eq 'Business::OnlinePayment' && $options{method} eq 'ECHECK' ){
4825 ( $content{account_number}, $content{routing_code} ) =
4826 split('@', $options{payinfo});
4827 $content{bank_name} = $options{payname};
4828 $content{bank_state} = exists($options{'paystate'})
4829 ? $options{'paystate'}
4830 : $self->getfield('paystate');
4831 $content{account_type} = exists($options{'paytype'})
4832 ? uc($options{'paytype'}) || 'CHECKING'
4833 : uc($self->getfield('paytype')) || 'CHECKING';
4834 $content{customer_org} = $self->company ? 'B' : 'I';
4835 $content{state_id} = exists($options{'stateid'})
4836 ? $options{'stateid'}
4837 : $self->getfield('stateid');
4838 $content{state_id_state} = exists($options{'stateid_state'})
4839 ? $options{'stateid_state'}
4840 : $self->getfield('stateid_state');
4841 $content{customer_ssn} = exists($options{'ss'})
4844 } elsif ( $namespace eq 'Business::OnlinePayment' && $options{method} eq 'LEC' ) {
4845 $content{phone} = $options{payinfo};
4846 } elsif ( $namespace eq 'Business::OnlineThirdPartyPayment' ) {
4853 # run transaction(s)
4856 my $balance = exists( $options{'balance'} )
4857 ? $options{'balance'}
4860 $self->select_for_update; #mutex ... just until we get our pending record in
4862 #the checks here are intended to catch concurrent payments
4863 #double-form-submission prevention is taken care of in cust_pay_pending::check
4866 return "The customer's balance has changed; $options{method} transaction aborted."
4867 if $self->balance < $balance;
4868 #&& $self->balance < $options{amount}; #might as well anyway?
4870 #also check and make sure there aren't *other* pending payments for this cust
4872 my @pending = qsearch('cust_pay_pending', {
4873 'custnum' => $self->custnum,
4874 'status' => { op=>'!=', value=>'done' }
4876 return "A payment is already being processed for this customer (".
4877 join(', ', map 'paypendingnum '. $_->paypendingnum, @pending ).
4878 "); $options{method} transaction aborted."
4879 if scalar(@pending);
4881 #okay, good to go, if we're a duplicate, cust_pay_pending will kick us out
4883 my $cust_pay_pending = new FS::cust_pay_pending {
4884 'custnum' => $self->custnum,
4885 #'invnum' => $options{'invnum'},
4886 'paid' => $options{amount},
4888 'payby' => $bop_method2payby{$options{method}},
4889 'payinfo' => $options{payinfo},
4890 'paydate' => $paydate,
4891 'recurring_billing' => $content{recurring_billing},
4893 'gatewaynum' => $payment_gateway->gatewaynum || '',
4894 'session_id' => $options{session_id} || '',
4895 'jobnum' => $options{depend_jobnum} || '',
4897 $cust_pay_pending->payunique( $options{payunique} )
4898 if defined($options{payunique}) && length($options{payunique});
4899 my $cpp_new_err = $cust_pay_pending->insert; #mutex lost when this is inserted
4900 return $cpp_new_err if $cpp_new_err;
4902 my( $action1, $action2 ) =
4903 split( /\s*\,\s*/, $payment_gateway->gateway_action );
4905 my $transaction = new $namespace( $payment_gateway->gateway_module,
4906 $self->_bop_options(\%options),
4909 $transaction->content(
4910 'type' => $options{method},
4911 $self->_bop_auth(\%options),
4912 'action' => $action1,
4913 'description' => $options{'description'},
4914 'amount' => $options{amount},
4915 #'invoice_number' => $options{'invnum'},
4916 'customer_id' => $self->custnum,
4918 'reference' => $cust_pay_pending->paypendingnum, #for now
4923 $cust_pay_pending->status('pending');
4924 my $cpp_pending_err = $cust_pay_pending->replace;
4925 return $cpp_pending_err if $cpp_pending_err;
4928 my $BOP_TESTING = 0;
4929 my $BOP_TESTING_SUCCESS = 1;
4931 unless ( $BOP_TESTING ) {
4932 $transaction->submit();
4934 if ( $BOP_TESTING_SUCCESS ) {
4935 $transaction->is_success(1);
4936 $transaction->authorization('fake auth');
4938 $transaction->is_success(0);
4939 $transaction->error_message('fake failure');
4943 if ( $transaction->is_success() && $namespace eq 'Business::OnlineThirdPartyPayment' ) {
4945 return { reference => $cust_pay_pending->paypendingnum,
4946 map { $_ => $transaction->$_ } qw ( popup_url collectitems ) };
4948 } elsif ( $transaction->is_success() && $action2 ) {
4950 $cust_pay_pending->status('authorized');
4951 my $cpp_authorized_err = $cust_pay_pending->replace;
4952 return $cpp_authorized_err if $cpp_authorized_err;
4954 my $auth = $transaction->authorization;
4955 my $ordernum = $transaction->can('order_number')
4956 ? $transaction->order_number
4960 new Business::OnlinePayment( $payment_gateway->gateway_module,
4961 $self->_bop_options(\%options),
4966 type => $options{method},
4968 $self->_bop_auth(\%options),
4969 order_number => $ordernum,
4970 amount => $options{amount},
4971 authorization => $auth,
4972 description => $options{'description'},
4975 foreach my $field (qw( authorization_source_code returned_ACI
4976 transaction_identifier validation_code
4977 transaction_sequence_num local_transaction_date
4978 local_transaction_time AVS_result_code )) {
4979 $capture{$field} = $transaction->$field() if $transaction->can($field);
4982 $capture->content( %capture );
4986 unless ( $capture->is_success ) {
4987 my $e = "Authorization successful but capture failed, custnum #".
4988 $self->custnum. ': '. $capture->result_code.
4989 ": ". $capture->error_message;
4997 # remove paycvv after initial transaction
5000 #false laziness w/misc/process/payment.cgi - check both to make sure working
5002 if ( defined $self->dbdef_table->column('paycvv')
5003 && length($self->paycvv)
5004 && ! grep { $_ eq cardtype($options{payinfo}) } $conf->config('cvv-save')
5006 my $error = $self->remove_cvv;
5008 warn "WARNING: error removing cvv: $error\n";
5016 $self->_realtime_bop_result( $cust_pay_pending, $transaction, %options );
5028 if (ref($_[0]) eq 'HASH') {
5029 %options = %{$_[0]};
5031 my ( $method, $amount ) = ( shift, shift );
5033 $options{method} = $method;
5034 $options{amount} = $amount;
5037 if ( $options{'fake_failure'} ) {
5038 return "Error: No error; test failure requested with fake_failure";
5042 #if ( $payment_gateway->gatewaynum ) { # agent override
5043 # $paybatch = $payment_gateway->gatewaynum. '-';
5046 #$paybatch .= "$processor:". $transaction->authorization;
5048 #$paybatch .= ':'. $transaction->order_number
5049 # if $transaction->can('order_number')
5050 # && length($transaction->order_number);
5052 my $paybatch = 'FakeProcessor:54:32';
5054 my $cust_pay = new FS::cust_pay ( {
5055 'custnum' => $self->custnum,
5056 'invnum' => $options{'invnum'},
5057 'paid' => $options{amount},
5059 'payby' => $bop_method2payby{$options{method}},
5060 #'payinfo' => $payinfo,
5061 'payinfo' => '4111111111111111',
5062 'paybatch' => $paybatch,
5063 #'paydate' => $paydate,
5064 'paydate' => '2012-05-01',
5066 $cust_pay->payunique( $options{payunique} ) if length($options{payunique});
5068 my $error = $cust_pay->insert($options{'manual'} ? ( 'manual' => 1 ) : () );
5071 $cust_pay->invnum(''); #try again with no specific invnum
5072 my $error2 = $cust_pay->insert( $options{'manual'} ?
5073 ( 'manual' => 1 ) : ()
5076 # gah, even with transactions.
5077 my $e = 'WARNING: Card/ACH debited but database not updated - '.
5078 "error inserting (fake!) payment: $error2".
5079 " (previously tried insert with invnum #$options{'invnum'}" .
5086 if ( $options{'paynum_ref'} ) {
5087 ${ $options{'paynum_ref'} } = $cust_pay->paynum;
5090 return ''; #no error
5095 # item _realtime_bop_result CUST_PAY_PENDING, BOP_OBJECT [ OPTION => VALUE ... ]
5097 # Wraps up processing of a realtime credit card, ACH (electronic check) or
5098 # phone bill transaction.
5100 sub _realtime_bop_result {
5101 my( $self, $cust_pay_pending, $transaction, %options ) = @_;
5103 warn "$me _realtime_bop_result: pending transaction ".
5104 $cust_pay_pending->paypendingnum. "\n";
5105 warn " $_ => $options{$_}\n" foreach keys %options;
5108 my $payment_gateway = $options{payment_gateway}
5109 or return "no payment gateway in arguments to _realtime_bop_result";
5111 $cust_pay_pending->status($transaction->is_success() ? 'captured' : 'declined');
5112 my $cpp_captured_err = $cust_pay_pending->replace;
5113 return $cpp_captured_err if $cpp_captured_err;
5115 if ( $transaction->is_success() ) {
5118 if ( $payment_gateway->gatewaynum ) { # agent override
5119 $paybatch = $payment_gateway->gatewaynum. '-';
5122 $paybatch .= $payment_gateway->gateway_module. ":".
5123 $transaction->authorization;
5125 $paybatch .= ':'. $transaction->order_number
5126 if $transaction->can('order_number')
5127 && length($transaction->order_number);
5129 my $cust_pay = new FS::cust_pay ( {
5130 'custnum' => $self->custnum,
5131 'invnum' => $options{'invnum'},
5132 'paid' => $cust_pay_pending->paid,
5134 'payby' => $cust_pay_pending->payby,
5135 #'payinfo' => $payinfo,
5136 'paybatch' => $paybatch,
5137 'paydate' => $cust_pay_pending->paydate,
5139 #doesn't hurt to know, even though the dup check is in cust_pay_pending now
5140 $cust_pay->payunique( $options{payunique} )
5141 if defined($options{payunique}) && length($options{payunique});
5143 my $oldAutoCommit = $FS::UID::AutoCommit;
5144 local $FS::UID::AutoCommit = 0;
5147 #start a transaction, insert the cust_pay and set cust_pay_pending.status to done in a single transction
5149 my $error = $cust_pay->insert($options{'manual'} ? ( 'manual' => 1 ) : () );
5152 $cust_pay->invnum(''); #try again with no specific invnum
5153 my $error2 = $cust_pay->insert( $options{'manual'} ?
5154 ( 'manual' => 1 ) : ()
5157 # gah. but at least we have a record of the state we had to abort in
5158 # from cust_pay_pending now.
5159 my $e = "WARNING: $options{method} captured but payment not recorded -".
5160 " error inserting payment (". $payment_gateway->gateway_module.
5162 " (previously tried insert with invnum #$options{'invnum'}" .
5163 ": $error ) - pending payment saved as paypendingnum ".
5164 $cust_pay_pending->paypendingnum. "\n";
5170 my $jobnum = $cust_pay_pending->jobnum;
5172 my $placeholder = qsearchs( 'queue', { 'jobnum' => $jobnum } );
5174 unless ( $placeholder ) {
5175 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
5176 my $e = "WARNING: $options{method} captured but job $jobnum not ".
5177 "found for paypendingnum ". $cust_pay_pending->paypendingnum. "\n";
5182 $error = $placeholder->delete;
5185 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
5186 my $e = "WARNING: $options{method} captured but could not delete ".
5187 "job $jobnum for paypendingnum ".
5188 $cust_pay_pending->paypendingnum. ": $error\n";
5195 if ( $options{'paynum_ref'} ) {
5196 ${ $options{'paynum_ref'} } = $cust_pay->paynum;
5199 $cust_pay_pending->status('done');
5200 $cust_pay_pending->statustext('captured');
5201 $cust_pay_pending->paynum($cust_pay->paynum);
5202 my $cpp_done_err = $cust_pay_pending->replace;
5204 if ( $cpp_done_err ) {
5206 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
5207 my $e = "WARNING: $options{method} captured but payment not recorded - ".
5208 "error updating status for paypendingnum ".
5209 $cust_pay_pending->paypendingnum. ": $cpp_done_err \n";
5215 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
5216 return ''; #no error
5222 my $perror = $payment_gateway->gateway_module. " error: ".
5223 $transaction->error_message;
5225 my $jobnum = $cust_pay_pending->jobnum;
5227 my $placeholder = qsearchs( 'queue', { 'jobnum' => $jobnum } );
5229 if ( $placeholder ) {
5230 my $error = $placeholder->depended_delete;
5231 $error ||= $placeholder->delete;
5232 warn "error removing provisioning jobs after declined paypendingnum ".
5233 $cust_pay_pending->paypendingnum. "\n";
5235 my $e = "error finding job $jobnum for declined paypendingnum ".
5236 $cust_pay_pending->paypendingnum. "\n";
5242 unless ( $transaction->error_message ) {
5245 if ( $transaction->can('response_page') ) {
5247 'page' => ( $transaction->can('response_page')
5248 ? $transaction->response_page
5251 'code' => ( $transaction->can('response_code')
5252 ? $transaction->response_code
5255 'headers' => ( $transaction->can('response_headers')
5256 ? $transaction->response_headers
5262 "No additional debugging information available for ".
5263 $payment_gateway->gateway_module;
5266 $perror .= "No error_message returned from ".
5267 $payment_gateway->gateway_module. " -- ".
5268 ( ref($t_response) ? Dumper($t_response) : $t_response );
5272 if ( !$options{'quiet'} && !$realtime_bop_decline_quiet
5273 && $conf->exists('emaildecline')
5274 && grep { $_ ne 'POST' } $self->invoicing_list
5275 && ! grep { $transaction->error_message =~ /$_/ }
5276 $conf->config('emaildecline-exclude')
5278 my @templ = $conf->config('declinetemplate');
5279 my $template = new Text::Template (
5281 SOURCE => [ map "$_\n", @templ ],
5282 ) or return "($perror) can't create template: $Text::Template::ERROR";
5283 $template->compile()
5284 or return "($perror) can't compile template: $Text::Template::ERROR";
5286 my $templ_hash = { error => $transaction->error_message };
5288 my $error = send_email(
5289 'from' => $conf->config('invoice_from', $self->agentnum ),
5290 'to' => [ grep { $_ ne 'POST' } $self->invoicing_list ],
5291 'subject' => 'Your payment could not be processed',
5292 'body' => [ $template->fill_in(HASH => $templ_hash) ],
5295 $perror .= " (also received error sending decline notification: $error)"
5300 $cust_pay_pending->status('done');
5301 $cust_pay_pending->statustext("declined: $perror");
5302 my $cpp_done_err = $cust_pay_pending->replace;
5303 if ( $cpp_done_err ) {
5304 my $e = "WARNING: $options{method} declined but pending payment not ".
5305 "resolved - error updating status for paypendingnum ".
5306 $cust_pay_pending->paypendingnum. ": $cpp_done_err \n";
5308 $perror = "$e ($perror)";
5316 =item realtime_botpp_capture CUST_PAY_PENDING [ OPTION => VALUE ... ]
5318 Verifies successful third party processing of a realtime credit card,
5319 ACH (electronic check) or phone bill transaction via a
5320 Business::OnlineThirdPartyPayment realtime gateway. See
5321 L<http://420.am/business-onlinethirdpartypayment> for supported gateways.
5323 Available options are: I<description>, I<invnum>, I<quiet>, I<paynum_ref>, I<payunique>
5325 The additional options I<payname>, I<city>, I<state>,
5326 I<zip>, I<payinfo> and I<paydate> are also available. Any of these options,
5327 if set, will override the value from the customer record.
5329 I<description> is a free-text field passed to the gateway. It defaults to
5330 "Internet services".
5332 If an I<invnum> is specified, this payment (if successful) is applied to the
5333 specified invoice. If you don't specify an I<invnum> you might want to
5334 call the B<apply_payments> method.
5336 I<quiet> can be set true to surpress email decline notices.
5338 I<paynum_ref> can be set to a scalar reference. It will be filled in with the
5339 resulting paynum, if any.
5341 I<payunique> is a unique identifier for this payment.
5343 Returns a hashref containing elements bill_error (which will be undefined
5344 upon success) and session_id of any associated session.
5348 sub realtime_botpp_capture {
5349 my( $self, $cust_pay_pending, %options ) = @_;
5351 warn "$me realtime_botpp_capture: pending transaction $cust_pay_pending\n";
5352 warn " $_ => $options{$_}\n" foreach keys %options;
5355 eval "use Business::OnlineThirdPartyPayment";
5359 # select the gateway
5362 my $method = FS::payby->payby2bop($cust_pay_pending->payby);
5364 my $payment_gateway = $cust_pay_pending->gatewaynum
5365 ? qsearchs( 'payment_gateway',
5366 { gatewaynum => $cust_pay_pending->gatewaynum }
5368 : $self->agent->payment_gateway( 'method' => $method,
5369 # 'invnum' => $cust_pay_pending->invnum,
5370 # 'payinfo' => $cust_pay_pending->payinfo,
5373 $options{payment_gateway} = $payment_gateway; # for the helper subs
5379 my @invoicing_list = $self->invoicing_list_emailonly;
5380 if ( $conf->exists('emailinvoiceautoalways')
5381 || $conf->exists('emailinvoiceauto') && ! @invoicing_list
5382 || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
5383 push @invoicing_list, $self->all_emails;
5386 my $email = ($conf->exists('business-onlinepayment-email-override'))
5387 ? $conf->config('business-onlinepayment-email-override')
5388 : $invoicing_list[0];
5392 $content{email_customer} =
5393 ( $conf->exists('business-onlinepayment-email_customer')
5394 || $conf->exists('business-onlinepayment-email-override') );
5397 # run transaction(s)
5401 new Business::OnlineThirdPartyPayment( $payment_gateway->gateway_module,
5402 $self->_bop_options(\%options),
5405 $transaction->reference({ %options });
5407 $transaction->content(
5409 $self->_bop_auth(\%options),
5410 'action' => 'Post Authorization',
5411 'description' => $options{'description'},
5412 'amount' => $cust_pay_pending->paid,
5413 #'invoice_number' => $options{'invnum'},
5414 'customer_id' => $self->custnum,
5415 'referer' => 'http://cleanwhisker.420.am/',
5416 'reference' => $cust_pay_pending->paypendingnum,
5418 'phone' => $self->daytime || $self->night,
5420 # plus whatever is required for bogus capture avoidance
5423 $transaction->submit();
5426 $self->_realtime_bop_result( $cust_pay_pending, $transaction, %options );
5429 bill_error => $error,
5430 session_id => $cust_pay_pending->session_id,
5435 =item default_payment_gateway DEPRECATED -- use agent->payment_gateway
5439 sub default_payment_gateway {
5440 my( $self, $method ) = @_;
5442 die "Real-time processing not enabled\n"
5443 unless $conf->exists('business-onlinepayment');
5445 #warn "default_payment_gateway deprecated -- use agent->payment_gateway\n";
5448 my $bop_config = 'business-onlinepayment';
5449 $bop_config .= '-ach'
5450 if $method =~ /^(ECHECK|CHEK)$/ && $conf->exists($bop_config. '-ach');
5451 my ( $processor, $login, $password, $action, @bop_options ) =
5452 $conf->config($bop_config);
5453 $action ||= 'normal authorization';
5454 pop @bop_options if scalar(@bop_options) % 2 && $bop_options[-1] =~ /^\s*$/;
5455 die "No real-time processor is enabled - ".
5456 "did you set the business-onlinepayment configuration value?\n"
5459 ( $processor, $login, $password, $action, @bop_options )
5464 Removes the I<paycvv> field from the database directly.
5466 If there is an error, returns the error, otherwise returns false.
5472 my $sth = dbh->prepare("UPDATE cust_main SET paycvv = '' WHERE custnum = ?")
5473 or return dbh->errstr;
5474 $sth->execute($self->custnum)
5475 or return $sth->errstr;
5480 =item _new_realtime_refund_bop METHOD [ OPTION => VALUE ... ]
5482 Refunds a realtime credit card, ACH (electronic check) or phone bill transaction
5483 via a Business::OnlinePayment realtime gateway. See
5484 L<http://420.am/business-onlinepayment> for supported gateways.
5486 Available methods are: I<CC>, I<ECHECK> and I<LEC>
5488 Available options are: I<amount>, I<reason>, I<paynum>, I<paydate>
5490 Most gateways require a reference to an original payment transaction to refund,
5491 so you probably need to specify a I<paynum>.
5493 I<amount> defaults to the original amount of the payment if not specified.
5495 I<reason> specifies a reason for the refund.
5497 I<paydate> specifies the expiration date for a credit card overriding the
5498 value from the customer record or the payment record. Specified as yyyy-mm-dd
5500 Implementation note: If I<amount> is unspecified or equal to the amount of the
5501 orignal payment, first an attempt is made to "void" the transaction via
5502 the gateway (to cancel a not-yet settled transaction) and then if that fails,
5503 the normal attempt is made to "refund" ("credit") the transaction via the
5504 gateway is attempted.
5506 #The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
5507 #I<zip>, I<payinfo> and I<paydate> are also available. Any of these options,
5508 #if set, will override the value from the customer record.
5510 #If an I<invnum> is specified, this payment (if successful) is applied to the
5511 #specified invoice. If you don't specify an I<invnum> you might want to
5512 #call the B<apply_payments> method.
5516 #some false laziness w/realtime_bop, not enough to make it worth merging
5517 #but some useful small subs should be pulled out
5518 sub _new_realtime_refund_bop {
5522 if (ref($_[0]) ne 'HASH') {
5523 %options = %{$_[0]};
5527 $options{method} = $method;
5531 warn "$me realtime_refund_bop (new): $options{method} refund\n";
5532 warn " $_ => $options{$_}\n" foreach keys %options;
5536 # look up the original payment and optionally a gateway for that payment
5540 my $amount = $options{'amount'};
5542 my( $processor, $login, $password, @bop_options, $namespace ) ;
5543 my( $auth, $order_number ) = ( '', '', '' );
5545 if ( $options{'paynum'} ) {
5547 warn " paynum: $options{paynum}\n" if $DEBUG > 1;
5548 $cust_pay = qsearchs('cust_pay', { paynum=>$options{'paynum'} } )
5549 or return "Unknown paynum $options{'paynum'}";
5550 $amount ||= $cust_pay->paid;
5552 $cust_pay->paybatch =~ /^((\d+)\-)?(\w+):\s*([\w\-\/ ]*)(:([\w\-]+))?$/
5553 or return "Can't parse paybatch for paynum $options{'paynum'}: ".
5554 $cust_pay->paybatch;
5555 my $gatewaynum = '';
5556 ( $gatewaynum, $processor, $auth, $order_number ) = ( $2, $3, $4, $6 );
5558 if ( $gatewaynum ) { #gateway for the payment to be refunded
5560 my $payment_gateway =
5561 qsearchs('payment_gateway', { 'gatewaynum' => $gatewaynum } );
5562 die "payment gateway $gatewaynum not found"
5563 unless $payment_gateway;
5565 $processor = $payment_gateway->gateway_module;
5566 $login = $payment_gateway->gateway_username;
5567 $password = $payment_gateway->gateway_password;
5568 $namespace = $payment_gateway->gateway_namespace;
5569 @bop_options = $payment_gateway->options;
5571 } else { #try the default gateway
5574 my $payment_gateway =
5575 $self->agent->payment_gateway('method' => $options{method});
5577 ( $conf_processor, $login, $password, $namespace ) =
5578 map { my $method = "gateway_$_"; $payment_gateway->$method }
5579 qw( module username password namespace );
5581 @bop_options = $payment_gateway->gatewaynum
5582 ? $payment_gateway->options
5583 : @{ $payment_gateway->get('options') };
5585 return "processor of payment $options{'paynum'} $processor does not".
5586 " match default processor $conf_processor"
5587 unless $processor eq $conf_processor;
5592 } else { # didn't specify a paynum, so look for agent gateway overrides
5593 # like a normal transaction
5595 my $payment_gateway =
5596 $self->agent->payment_gateway( 'method' => $options{method},
5597 #'payinfo' => $payinfo,
5599 my( $processor, $login, $password, $namespace ) =
5600 map { my $method = "gateway_$_"; $payment_gateway->$method }
5601 qw( module username password namespace );
5603 my @bop_options = $payment_gateway->gatewaynum
5604 ? $payment_gateway->options
5605 : @{ $payment_gateway->get('options') };
5608 return "neither amount nor paynum specified" unless $amount;
5610 eval "use $namespace";
5614 'type' => $options{method},
5616 'password' => $password,
5617 'order_number' => $order_number,
5618 'amount' => $amount,
5619 'referer' => 'http://cleanwhisker.420.am/', #XXX fix referer :/
5621 $content{authorization} = $auth
5622 if length($auth); #echeck/ACH transactions have an order # but no auth
5623 #(at least with authorize.net)
5625 my $disable_void_after;
5626 if ($conf->exists('disable_void_after')
5627 && $conf->config('disable_void_after') =~ /^(\d+)$/) {
5628 $disable_void_after = $1;
5631 #first try void if applicable
5632 if ( $cust_pay && $cust_pay->paid == $amount
5634 ( not defined($disable_void_after) )
5635 || ( time < ($cust_pay->_date + $disable_void_after ) )
5638 warn " attempting void\n" if $DEBUG > 1;
5639 my $void = new Business::OnlinePayment( $processor, @bop_options );
5640 $void->content( 'action' => 'void', %content );
5642 if ( $void->is_success ) {
5643 my $error = $cust_pay->void($options{'reason'});
5645 # gah, even with transactions.
5646 my $e = 'WARNING: Card/ACH voided but database not updated - '.
5647 "error voiding payment: $error";
5651 warn " void successful\n" if $DEBUG > 1;
5656 warn " void unsuccessful, trying refund\n"
5660 my $address = $self->address1;
5661 $address .= ", ". $self->address2 if $self->address2;
5663 my($payname, $payfirst, $paylast);
5664 if ( $self->payname && $options{method} ne 'ECHECK' ) {
5665 $payname = $self->payname;
5666 $payname =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
5667 or return "Illegal payname $payname";
5668 ($payfirst, $paylast) = ($1, $2);
5670 $payfirst = $self->getfield('first');
5671 $paylast = $self->getfield('last');
5672 $payname = "$payfirst $paylast";
5675 my @invoicing_list = $self->invoicing_list_emailonly;
5676 if ( $conf->exists('emailinvoiceautoalways')
5677 || $conf->exists('emailinvoiceauto') && ! @invoicing_list
5678 || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
5679 push @invoicing_list, $self->all_emails;
5682 my $email = ($conf->exists('business-onlinepayment-email-override'))
5683 ? $conf->config('business-onlinepayment-email-override')
5684 : $invoicing_list[0];
5686 my $payip = exists($options{'payip'})
5689 $content{customer_ip} = $payip
5693 if ( $options{method} eq 'CC' ) {
5696 $content{card_number} = $payinfo = $cust_pay->payinfo;
5697 (exists($options{'paydate'}) ? $options{'paydate'} : $cust_pay->paydate)
5698 =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/ &&
5699 ($content{expiration} = "$2/$1"); # where available
5701 $content{card_number} = $payinfo = $self->payinfo;
5702 (exists($options{'paydate'}) ? $options{'paydate'} : $self->paydate)
5703 =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
5704 $content{expiration} = "$2/$1";
5707 } elsif ( $options{method} eq 'ECHECK' ) {
5710 $payinfo = $cust_pay->payinfo;
5712 $payinfo = $self->payinfo;
5714 ( $content{account_number}, $content{routing_code} )= split('@', $payinfo );
5715 $content{bank_name} = $self->payname;
5716 $content{account_type} = 'CHECKING';
5717 $content{account_name} = $payname;
5718 $content{customer_org} = $self->company ? 'B' : 'I';
5719 $content{customer_ssn} = $self->ss;
5720 } elsif ( $options{method} eq 'LEC' ) {
5721 $content{phone} = $payinfo = $self->payinfo;
5725 my $refund = new Business::OnlinePayment( $processor, @bop_options );
5726 my %sub_content = $refund->content(
5727 'action' => 'credit',
5728 'customer_id' => $self->custnum,
5729 'last_name' => $paylast,
5730 'first_name' => $payfirst,
5732 'address' => $address,
5733 'city' => $self->city,
5734 'state' => $self->state,
5735 'zip' => $self->zip,
5736 'country' => $self->country,
5738 'phone' => $self->daytime || $self->night,
5741 warn join('', map { " $_ => $sub_content{$_}\n" } keys %sub_content )
5745 return "$processor error: ". $refund->error_message
5746 unless $refund->is_success();
5748 my $paybatch = "$processor:". $refund->authorization;
5749 $paybatch .= ':'. $refund->order_number
5750 if $refund->can('order_number') && $refund->order_number;
5752 while ( $cust_pay && $cust_pay->unapplied < $amount ) {
5753 my @cust_bill_pay = $cust_pay->cust_bill_pay;
5754 last unless @cust_bill_pay;
5755 my $cust_bill_pay = pop @cust_bill_pay;
5756 my $error = $cust_bill_pay->delete;
5760 my $cust_refund = new FS::cust_refund ( {
5761 'custnum' => $self->custnum,
5762 'paynum' => $options{'paynum'},
5763 'refund' => $amount,
5765 'payby' => $bop_method2payby{$options{method}},
5766 'payinfo' => $payinfo,
5767 'paybatch' => $paybatch,
5768 'reason' => $options{'reason'} || 'card or ACH refund',
5770 my $error = $cust_refund->insert;
5772 $cust_refund->paynum(''); #try again with no specific paynum
5773 my $error2 = $cust_refund->insert;
5775 # gah, even with transactions.
5776 my $e = 'WARNING: Card/ACH refunded but database not updated - '.
5777 "error inserting refund ($processor): $error2".
5778 " (previously tried insert with paynum #$options{'paynum'}" .
5789 =item batch_card OPTION => VALUE...
5791 Adds a payment for this invoice to the pending credit card batch (see
5792 L<FS::cust_pay_batch>), or, if the B<realtime> option is set to a true value,
5793 runs the payment using a realtime gateway.
5798 my ($self, %options) = @_;
5801 if (exists($options{amount})) {
5802 $amount = $options{amount};
5804 $amount = sprintf("%.2f", $self->balance - $self->in_transit_payments);
5806 return '' unless $amount > 0;
5808 my $invnum = delete $options{invnum};
5809 my $payby = $options{invnum} || $self->payby; #dubious
5811 if ($options{'realtime'}) {
5812 return $self->realtime_bop( FS::payby->payby2bop($self->payby),
5818 my $oldAutoCommit = $FS::UID::AutoCommit;
5819 local $FS::UID::AutoCommit = 0;
5822 #this needs to handle mysql as well as Pg, like svc_acct.pm
5823 #(make it into a common function if folks need to do batching with mysql)
5824 $dbh->do("LOCK TABLE pay_batch IN SHARE ROW EXCLUSIVE MODE")
5825 or return "Cannot lock pay_batch: " . $dbh->errstr;
5829 'payby' => FS::payby->payby2payment($payby),
5832 my $pay_batch = qsearchs( 'pay_batch', \%pay_batch );
5834 unless ( $pay_batch ) {
5835 $pay_batch = new FS::pay_batch \%pay_batch;
5836 my $error = $pay_batch->insert;
5838 $dbh->rollback if $oldAutoCommit;
5839 die "error creating new batch: $error\n";
5843 my $old_cust_pay_batch = qsearchs('cust_pay_batch', {
5844 'batchnum' => $pay_batch->batchnum,
5845 'custnum' => $self->custnum,
5848 foreach (qw( address1 address2 city state zip country payby payinfo paydate
5850 $options{$_} = '' unless exists($options{$_});
5853 my $cust_pay_batch = new FS::cust_pay_batch ( {
5854 'batchnum' => $pay_batch->batchnum,
5855 'invnum' => $invnum || 0, # is there a better value?
5856 # this field should be
5858 # cust_bill_pay_batch now
5859 'custnum' => $self->custnum,
5860 'last' => $self->getfield('last'),
5861 'first' => $self->getfield('first'),
5862 'address1' => $options{address1} || $self->address1,
5863 'address2' => $options{address2} || $self->address2,
5864 'city' => $options{city} || $self->city,
5865 'state' => $options{state} || $self->state,
5866 'zip' => $options{zip} || $self->zip,
5867 'country' => $options{country} || $self->country,
5868 'payby' => $options{payby} || $self->payby,
5869 'payinfo' => $options{payinfo} || $self->payinfo,
5870 'exp' => $options{paydate} || $self->paydate,
5871 'payname' => $options{payname} || $self->payname,
5872 'amount' => $amount, # consolidating
5875 $cust_pay_batch->paybatchnum($old_cust_pay_batch->paybatchnum)
5876 if $old_cust_pay_batch;
5879 if ($old_cust_pay_batch) {
5880 $error = $cust_pay_batch->replace($old_cust_pay_batch)
5882 $error = $cust_pay_batch->insert;
5886 $dbh->rollback if $oldAutoCommit;
5890 my $unapplied = $self->total_unapplied_credits
5891 + $self->total_unapplied_payments
5892 + $self->in_transit_payments;
5893 foreach my $cust_bill ($self->open_cust_bill) {
5894 #$dbh->commit or die $dbh->errstr if $oldAutoCommit;
5895 my $cust_bill_pay_batch = new FS::cust_bill_pay_batch {
5896 'invnum' => $cust_bill->invnum,
5897 'paybatchnum' => $cust_pay_batch->paybatchnum,
5898 'amount' => $cust_bill->owed,
5901 if ($unapplied >= $cust_bill_pay_batch->amount){
5902 $unapplied -= $cust_bill_pay_batch->amount;
5905 $cust_bill_pay_batch->amount(sprintf ( "%.2f",
5906 $cust_bill_pay_batch->amount - $unapplied )); $unapplied = 0;
5908 $error = $cust_bill_pay_batch->insert;
5910 $dbh->rollback if $oldAutoCommit;
5915 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
5919 =item apply_payments_and_credits
5921 Applies unapplied payments and credits.
5923 In most cases, this new method should be used in place of sequential
5924 apply_payments and apply_credits methods.
5926 If there is an error, returns the error, otherwise returns false.
5930 sub apply_payments_and_credits {
5933 local $SIG{HUP} = 'IGNORE';
5934 local $SIG{INT} = 'IGNORE';
5935 local $SIG{QUIT} = 'IGNORE';
5936 local $SIG{TERM} = 'IGNORE';
5937 local $SIG{TSTP} = 'IGNORE';
5938 local $SIG{PIPE} = 'IGNORE';
5940 my $oldAutoCommit = $FS::UID::AutoCommit;
5941 local $FS::UID::AutoCommit = 0;
5944 $self->select_for_update; #mutex
5946 foreach my $cust_bill ( $self->open_cust_bill ) {
5947 my $error = $cust_bill->apply_payments_and_credits;
5949 $dbh->rollback if $oldAutoCommit;
5950 return "Error applying: $error";
5954 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
5959 =item apply_credits OPTION => VALUE ...
5961 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
5962 to outstanding invoice balances in chronological order (or reverse
5963 chronological order if the I<order> option is set to B<newest>) and returns the
5964 value of any remaining unapplied credits available for refund (see
5965 L<FS::cust_refund>).
5967 Dies if there is an error.
5975 local $SIG{HUP} = 'IGNORE';
5976 local $SIG{INT} = 'IGNORE';
5977 local $SIG{QUIT} = 'IGNORE';
5978 local $SIG{TERM} = 'IGNORE';
5979 local $SIG{TSTP} = 'IGNORE';
5980 local $SIG{PIPE} = 'IGNORE';
5982 my $oldAutoCommit = $FS::UID::AutoCommit;
5983 local $FS::UID::AutoCommit = 0;
5986 $self->select_for_update; #mutex
5988 unless ( $self->total_unapplied_credits ) {
5989 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
5993 my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
5994 qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
5996 my @invoices = $self->open_cust_bill;
5997 @invoices = sort { $b->_date <=> $a->_date } @invoices
5998 if defined($opt{'order'}) && $opt{'order'} eq 'newest';
6001 foreach my $cust_bill ( @invoices ) {
6004 if ( !defined($credit) || $credit->credited == 0) {
6005 $credit = pop @credits or last;
6008 if ($cust_bill->owed >= $credit->credited) {
6009 $amount=$credit->credited;
6011 $amount=$cust_bill->owed;
6014 my $cust_credit_bill = new FS::cust_credit_bill ( {
6015 'crednum' => $credit->crednum,
6016 'invnum' => $cust_bill->invnum,
6017 'amount' => $amount,
6019 my $error = $cust_credit_bill->insert;
6021 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
6025 redo if ($cust_bill->owed > 0);
6029 my $total_unapplied_credits = $self->total_unapplied_credits;
6031 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
6033 return $total_unapplied_credits;
6036 =item apply_payments
6038 Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
6039 to outstanding invoice balances in chronological order.
6041 #and returns the value of any remaining unapplied payments.
6043 Dies if there is an error.
6047 sub apply_payments {
6050 local $SIG{HUP} = 'IGNORE';
6051 local $SIG{INT} = 'IGNORE';
6052 local $SIG{QUIT} = 'IGNORE';
6053 local $SIG{TERM} = 'IGNORE';
6054 local $SIG{TSTP} = 'IGNORE';
6055 local $SIG{PIPE} = 'IGNORE';
6057 my $oldAutoCommit = $FS::UID::AutoCommit;
6058 local $FS::UID::AutoCommit = 0;
6061 $self->select_for_update; #mutex
6065 my @payments = sort { $b->_date <=> $a->_date }
6066 grep { $_->unapplied > 0 }
6069 my @invoices = sort { $a->_date <=> $b->_date}
6070 grep { $_->owed > 0 }
6075 foreach my $cust_bill ( @invoices ) {
6078 if ( !defined($payment) || $payment->unapplied == 0 ) {
6079 $payment = pop @payments or last;
6082 if ( $cust_bill->owed >= $payment->unapplied ) {
6083 $amount = $payment->unapplied;
6085 $amount = $cust_bill->owed;
6088 my $cust_bill_pay = new FS::cust_bill_pay ( {
6089 'paynum' => $payment->paynum,
6090 'invnum' => $cust_bill->invnum,
6091 'amount' => $amount,
6093 my $error = $cust_bill_pay->insert;
6095 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
6099 redo if ( $cust_bill->owed > 0);
6103 my $total_unapplied_payments = $self->total_unapplied_payments;
6105 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
6107 return $total_unapplied_payments;
6112 Returns the total owed for this customer on all invoices
6113 (see L<FS::cust_bill/owed>).
6119 $self->total_owed_date(2145859200); #12/31/2037
6122 =item total_owed_date TIME
6124 Returns the total owed for this customer on all invoices with date earlier than
6125 TIME. TIME is specified as a UNIX timestamp; see L<perlfunc/"time">). Also
6126 see L<Time::Local> and L<Date::Parse> for conversion functions.
6130 sub total_owed_date {
6134 # my $custnum = $self->custnum;
6136 # my $owed_sql = FS::cust_bill->owed_sql;
6139 # SELECT SUM($owed_sql) FROM cust_bill
6140 # WHERE custnum = $custnum
6141 # AND _date <= $time
6144 # my $sth = dbh->prepare($sql) or die dbh->errstr;
6145 # $sth->execute() or die $sth->errstr;
6147 # return sprintf( '%.2f', $sth->fetchrow_arrayref->[0] );
6150 foreach my $cust_bill (
6151 grep { $_->_date <= $time }
6152 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
6154 $total_bill += $cust_bill->owed;
6156 sprintf( "%.2f", $total_bill );
6162 Returns the total amount of all payments.
6169 $total += $_->paid foreach $self->cust_pay;
6170 sprintf( "%.2f", $total );
6173 =item total_unapplied_credits
6175 Returns the total outstanding credit (see L<FS::cust_credit>) for this
6176 customer. See L<FS::cust_credit/credited>.
6178 =item total_credited
6180 Old name for total_unapplied_credits. Don't use.
6184 sub total_credited {
6185 #carp "total_credited deprecated, use total_unapplied_credits";
6186 shift->total_unapplied_credits(@_);
6189 sub total_unapplied_credits {
6191 my $total_credit = 0;
6192 $total_credit += $_->credited foreach $self->cust_credit;
6193 sprintf( "%.2f", $total_credit );
6196 =item total_unapplied_payments
6198 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
6199 See L<FS::cust_pay/unapplied>.
6203 sub total_unapplied_payments {
6205 my $total_unapplied = 0;
6206 $total_unapplied += $_->unapplied foreach $self->cust_pay;
6207 sprintf( "%.2f", $total_unapplied );
6210 =item total_unapplied_refunds
6212 Returns the total unrefunded refunds (see L<FS::cust_refund>) for this
6213 customer. See L<FS::cust_refund/unapplied>.
6217 sub total_unapplied_refunds {
6219 my $total_unapplied = 0;
6220 $total_unapplied += $_->unapplied foreach $self->cust_refund;
6221 sprintf( "%.2f", $total_unapplied );
6226 Returns the balance for this customer (total_owed plus total_unrefunded, minus
6227 total_unapplied_credits minus total_unapplied_payments).
6235 + $self->total_unapplied_refunds
6236 - $self->total_unapplied_credits
6237 - $self->total_unapplied_payments
6241 =item balance_date TIME
6243 Returns the balance for this customer, only considering invoices with date
6244 earlier than TIME (total_owed_date minus total_credited minus
6245 total_unapplied_payments). TIME is specified as a UNIX timestamp; see
6246 L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion
6255 $self->total_owed_date($time)
6256 + $self->total_unapplied_refunds
6257 - $self->total_unapplied_credits
6258 - $self->total_unapplied_payments
6262 =item in_transit_payments
6264 Returns the total of requests for payments for this customer pending in
6265 batches in transit to the bank. See L<FS::pay_batch> and L<FS::cust_pay_batch>
6269 sub in_transit_payments {
6271 my $in_transit_payments = 0;
6272 foreach my $pay_batch ( qsearch('pay_batch', {
6275 foreach my $cust_pay_batch ( qsearch('cust_pay_batch', {
6276 'batchnum' => $pay_batch->batchnum,
6277 'custnum' => $self->custnum,
6279 $in_transit_payments += $cust_pay_batch->amount;
6282 sprintf( "%.2f", $in_transit_payments );
6287 Returns a hash of useful information for making a payment.
6297 'CARD' (credit card - automatic), 'DCRD' (credit card - on-demand),
6298 'CHEK' (electronic check - automatic), 'DCHK' (electronic check - on-demand),
6299 'LECB' (Phone bill billing), 'BILL' (billing), or 'COMP' (free).
6303 For credit card transactions:
6315 For electronic check transactions:
6330 $return{balance} = $self->balance;
6332 $return{payname} = $self->payname
6333 || ( $self->first. ' '. $self->get('last') );
6335 $return{$_} = $self->get($_) for qw(address1 address2 city state zip);
6337 $return{payby} = $self->payby;
6338 $return{stateid_state} = $self->stateid_state;
6340 if ( $self->payby =~ /^(CARD|DCRD)$/ ) {
6341 $return{card_type} = cardtype($self->payinfo);
6342 $return{payinfo} = $self->paymask;
6344 @return{'month', 'year'} = $self->paydate_monthyear;
6348 if ( $self->payby =~ /^(CHEK|DCHK)$/ ) {
6349 my ($payinfo1, $payinfo2) = split '@', $self->paymask;
6350 $return{payinfo1} = $payinfo1;
6351 $return{payinfo2} = $payinfo2;
6352 $return{paytype} = $self->paytype;
6353 $return{paystate} = $self->paystate;
6357 #doubleclick protection
6359 $return{paybatch} = "webui-MyAccount-$_date-$$-". rand() * 2**32;
6365 =item paydate_monthyear
6367 Returns a two-element list consisting of the month and year of this customer's
6368 paydate (credit card expiration date for CARD customers)
6372 sub paydate_monthyear {
6374 if ( $self->paydate =~ /^(\d{4})-(\d{1,2})-\d{1,2}$/ ) { #Pg date format
6376 } elsif ( $self->paydate =~ /^(\d{1,2})-(\d{1,2}-)?(\d{4}$)/ ) {
6383 =item tax_exemption TAXNAME
6388 my( $self, $taxname ) = @_;
6390 qsearchs( 'cust_main_exemption', { 'custnum' => $self->custnum,
6391 'taxname' => $taxname,
6396 =item cust_main_exemption
6400 sub cust_main_exemption {
6402 qsearch( 'cust_main_exemption', { 'custnum' => $self->custnum } );
6405 =item invoicing_list [ ARRAYREF ]
6407 If an arguement is given, sets these email addresses as invoice recipients
6408 (see L<FS::cust_main_invoice>). Errors are not fatal and are not reported
6409 (except as warnings), so use check_invoicing_list first.
6411 Returns a list of email addresses (with svcnum entries expanded).
6413 Note: You can clear the invoicing list by passing an empty ARRAYREF. You can
6414 check it without disturbing anything by passing nothing.
6416 This interface may change in the future.
6420 sub invoicing_list {
6421 my( $self, $arrayref ) = @_;
6424 my @cust_main_invoice;
6425 if ( $self->custnum ) {
6426 @cust_main_invoice =
6427 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
6429 @cust_main_invoice = ();
6431 foreach my $cust_main_invoice ( @cust_main_invoice ) {
6432 #warn $cust_main_invoice->destnum;
6433 unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
6434 #warn $cust_main_invoice->destnum;
6435 my $error = $cust_main_invoice->delete;
6436 warn $error if $error;
6439 if ( $self->custnum ) {
6440 @cust_main_invoice =
6441 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
6443 @cust_main_invoice = ();
6445 my %seen = map { $_->address => 1 } @cust_main_invoice;
6446 foreach my $address ( @{$arrayref} ) {
6447 next if exists $seen{$address} && $seen{$address};
6448 $seen{$address} = 1;
6449 my $cust_main_invoice = new FS::cust_main_invoice ( {
6450 'custnum' => $self->custnum,
6453 my $error = $cust_main_invoice->insert;
6454 warn $error if $error;
6458 if ( $self->custnum ) {
6460 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
6467 =item check_invoicing_list ARRAYREF
6469 Checks these arguements as valid input for the invoicing_list method. If there
6470 is an error, returns the error, otherwise returns false.
6474 sub check_invoicing_list {
6475 my( $self, $arrayref ) = @_;
6477 foreach my $address ( @$arrayref ) {
6479 if ($address eq 'FAX' and $self->getfield('fax') eq '') {
6480 return 'Can\'t add FAX invoice destination with a blank FAX number.';
6483 my $cust_main_invoice = new FS::cust_main_invoice ( {
6484 'custnum' => $self->custnum,
6487 my $error = $self->custnum
6488 ? $cust_main_invoice->check
6489 : $cust_main_invoice->checkdest
6491 return $error if $error;
6495 return "Email address required"
6496 if $conf->exists('cust_main-require_invoicing_list_email')
6497 && ! grep { $_ !~ /^([A-Z]+)$/ } @$arrayref;
6502 =item set_default_invoicing_list
6504 Sets the invoicing list to all accounts associated with this customer,
6505 overwriting any previous invoicing list.
6509 sub set_default_invoicing_list {
6511 $self->invoicing_list($self->all_emails);
6516 Returns the email addresses of all accounts provisioned for this customer.
6523 foreach my $cust_pkg ( $self->all_pkgs ) {
6524 my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
6526 map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
6527 grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
6529 $list{$_}=1 foreach map { $_->email } @svc_acct;
6534 =item invoicing_list_addpost
6536 Adds postal invoicing to this customer. If this customer is already configured
6537 to receive postal invoices, does nothing.
6541 sub invoicing_list_addpost {
6543 return if grep { $_ eq 'POST' } $self->invoicing_list;
6544 my @invoicing_list = $self->invoicing_list;
6545 push @invoicing_list, 'POST';
6546 $self->invoicing_list(\@invoicing_list);
6549 =item invoicing_list_emailonly
6551 Returns the list of email invoice recipients (invoicing_list without non-email
6552 destinations such as POST and FAX).
6556 sub invoicing_list_emailonly {
6558 warn "$me invoicing_list_emailonly called"
6560 grep { $_ !~ /^([A-Z]+)$/ } $self->invoicing_list;
6563 =item invoicing_list_emailonly_scalar
6565 Returns the list of email invoice recipients (invoicing_list without non-email
6566 destinations such as POST and FAX) as a comma-separated scalar.
6570 sub invoicing_list_emailonly_scalar {
6572 warn "$me invoicing_list_emailonly_scalar called"
6574 join(', ', $self->invoicing_list_emailonly);
6577 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
6579 Returns an array of customers referred by this customer (referral_custnum set
6580 to this custnum). If DEPTH is given, recurses up to the given depth, returning
6581 customers referred by customers referred by this customer and so on, inclusive.
6582 The default behavior is DEPTH 1 (no recursion).
6586 sub referral_cust_main {
6588 my $depth = @_ ? shift : 1;
6589 my $exclude = @_ ? shift : {};
6592 map { $exclude->{$_->custnum}++; $_; }
6593 grep { ! $exclude->{ $_->custnum } }
6594 qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
6598 map { $_->referral_cust_main($depth-1, $exclude) }
6605 =item referral_cust_main_ncancelled
6607 Same as referral_cust_main, except only returns customers with uncancelled
6612 sub referral_cust_main_ncancelled {
6614 grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
6617 =item referral_cust_pkg [ DEPTH ]
6619 Like referral_cust_main, except returns a flat list of all unsuspended (and
6620 uncancelled) packages for each customer. The number of items in this list may
6621 be useful for comission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
6625 sub referral_cust_pkg {
6627 my $depth = @_ ? shift : 1;
6629 map { $_->unsuspended_pkgs }
6630 grep { $_->unsuspended_pkgs }
6631 $self->referral_cust_main($depth);
6634 =item referring_cust_main
6636 Returns the single cust_main record for the customer who referred this customer
6637 (referral_custnum), or false.
6641 sub referring_cust_main {
6643 return '' unless $self->referral_custnum;
6644 qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
6647 =item credit AMOUNT, REASON [ , OPTION => VALUE ... ]
6649 Applies a credit to this customer. If there is an error, returns the error,
6650 otherwise returns false.
6652 REASON can be a text string, an FS::reason object, or a scalar reference to
6653 a reasonnum. If a text string, it will be automatically inserted as a new
6654 reason, and a 'reason_type' option must be passed to indicate the
6655 FS::reason_type for the new reason.
6657 An I<addlinfo> option may be passed to set the credit's I<addlinfo> field.
6659 Any other options are passed to FS::cust_credit::insert.
6664 my( $self, $amount, $reason, %options ) = @_;
6666 my $cust_credit = new FS::cust_credit {
6667 'custnum' => $self->custnum,
6668 'amount' => $amount,
6671 if ( ref($reason) ) {
6673 if ( ref($reason) eq 'SCALAR' ) {
6674 $cust_credit->reasonnum( $$reason );
6676 $cust_credit->reasonnum( $reason->reasonnum );
6680 $cust_credit->set('reason', $reason)
6683 $cust_credit->addlinfo( delete $options{'addlinfo'} )
6684 if exists($options{'addlinfo'});
6686 $cust_credit->insert(%options);
6690 =item charge AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
6692 Creates a one-time charge for this customer. If there is an error, returns
6693 the error, otherwise returns false.
6699 my ( $amount, $quantity, $pkg, $comment, $classnum, $additional );
6700 my ( $setuptax, $taxclass ); #internal taxes
6701 my ( $taxproduct, $override ); #vendor (CCH) taxes
6702 if ( ref( $_[0] ) ) {
6703 $amount = $_[0]->{amount};
6704 $quantity = exists($_[0]->{quantity}) ? $_[0]->{quantity} : 1;
6705 $pkg = exists($_[0]->{pkg}) ? $_[0]->{pkg} : 'One-time charge';
6706 $comment = exists($_[0]->{comment}) ? $_[0]->{comment}
6707 : '$'. sprintf("%.2f",$amount);
6708 $setuptax = exists($_[0]->{setuptax}) ? $_[0]->{setuptax} : '';
6709 $taxclass = exists($_[0]->{taxclass}) ? $_[0]->{taxclass} : '';
6710 $classnum = exists($_[0]->{classnum}) ? $_[0]->{classnum} : '';
6711 $additional = $_[0]->{additional};
6712 $taxproduct = $_[0]->{taxproductnum};
6713 $override = { '' => $_[0]->{tax_override} };
6717 $pkg = @_ ? shift : 'One-time charge';
6718 $comment = @_ ? shift : '$'. sprintf("%.2f",$amount);
6720 $taxclass = @_ ? shift : '';
6724 local $SIG{HUP} = 'IGNORE';
6725 local $SIG{INT} = 'IGNORE';
6726 local $SIG{QUIT} = 'IGNORE';
6727 local $SIG{TERM} = 'IGNORE';
6728 local $SIG{TSTP} = 'IGNORE';
6729 local $SIG{PIPE} = 'IGNORE';
6731 my $oldAutoCommit = $FS::UID::AutoCommit;
6732 local $FS::UID::AutoCommit = 0;
6735 my $part_pkg = new FS::part_pkg ( {
6737 'comment' => $comment,
6741 'classnum' => $classnum ? $classnum : '',
6742 'setuptax' => $setuptax,
6743 'taxclass' => $taxclass,
6744 'taxproductnum' => $taxproduct,
6747 my %options = ( ( map { ("additional_info$_" => $additional->[$_] ) }
6748 ( 0 .. @$additional - 1 )
6750 'additional_count' => scalar(@$additional),
6751 'setup_fee' => $amount,
6754 my $error = $part_pkg->insert( options => \%options,
6755 tax_overrides => $override,
6758 $dbh->rollback if $oldAutoCommit;
6762 my $pkgpart = $part_pkg->pkgpart;
6763 my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
6764 unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
6765 my $type_pkgs = new FS::type_pkgs \%type_pkgs;
6766 $error = $type_pkgs->insert;
6768 $dbh->rollback if $oldAutoCommit;
6773 my $cust_pkg = new FS::cust_pkg ( {
6774 'custnum' => $self->custnum,
6775 'pkgpart' => $pkgpart,
6776 'quantity' => $quantity,
6779 $error = $cust_pkg->insert;
6781 $dbh->rollback if $oldAutoCommit;
6785 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
6790 #=item charge_postal_fee
6792 #Applies a one time charge this customer. If there is an error,
6793 #returns the error, returns the cust_pkg charge object or false
6794 #if there was no charge.
6798 # This should be a customer event. For that to work requires that bill
6799 # also be a customer event.
6801 sub charge_postal_fee {
6804 my $pkgpart = $conf->config('postal_invoice-fee_pkgpart');
6805 return '' unless ($pkgpart && grep { $_ eq 'POST' } $self->invoicing_list);
6807 my $cust_pkg = new FS::cust_pkg ( {
6808 'custnum' => $self->custnum,
6809 'pkgpart' => $pkgpart,
6813 my $error = $cust_pkg->insert;
6814 $error ? $error : $cust_pkg;
6819 Returns all the invoices (see L<FS::cust_bill>) for this customer.
6825 sort { $a->_date <=> $b->_date }
6826 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
6829 =item open_cust_bill
6831 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
6836 sub open_cust_bill {
6840 'table' => 'cust_bill',
6841 'hashref' => { 'custnum' => $self->custnum, },
6842 'extra_sql' => ' AND '. FS::cust_bill->owed_sql. ' > 0',
6843 'order_by' => 'ORDER BY _date ASC',
6850 Returns all the credits (see L<FS::cust_credit>) for this customer.
6856 sort { $a->_date <=> $b->_date }
6857 qsearch( 'cust_credit', { 'custnum' => $self->custnum } )
6862 Returns all the payments (see L<FS::cust_pay>) for this customer.
6868 sort { $a->_date <=> $b->_date }
6869 qsearch( 'cust_pay', { 'custnum' => $self->custnum } )
6874 Returns all voided payments (see L<FS::cust_pay_void>) for this customer.
6880 sort { $a->_date <=> $b->_date }
6881 qsearch( 'cust_pay_void', { 'custnum' => $self->custnum } )
6884 =item cust_pay_batch
6886 Returns all batched payments (see L<FS::cust_pay_void>) for this customer.
6890 sub cust_pay_batch {
6892 sort { $a->paybatchnum <=> $b->paybatchnum }
6893 qsearch( 'cust_pay_batch', { 'custnum' => $self->custnum } )
6896 =item cust_pay_pending
6898 Returns all pending payments (see L<FS::cust_pay_pending>) for this customer
6899 (without status "done").
6903 sub cust_pay_pending {
6905 return $self->num_cust_pay_pending unless wantarray;
6906 sort { $a->_date <=> $b->_date }
6907 qsearch( 'cust_pay_pending', {
6908 'custnum' => $self->custnum,
6909 'status' => { op=>'!=', value=>'done' },
6914 =item num_cust_pay_pending
6916 Returns the number of pending payments (see L<FS::cust_pay_pending>) for this
6917 customer (without status "done"). Also called automatically when the
6918 cust_pay_pending method is used in a scalar context.
6922 sub num_cust_pay_pending {
6924 my $sql = " SELECT COUNT(*) FROM cust_pay_pending ".
6925 " WHERE custnum = ? AND status != 'done' ";
6926 my $sth = dbh->prepare($sql) or die dbh->errstr;
6927 $sth->execute($self->custnum) or die $sth->errstr;
6928 $sth->fetchrow_arrayref->[0];
6933 Returns all the refunds (see L<FS::cust_refund>) for this customer.
6939 sort { $a->_date <=> $b->_date }
6940 qsearch( 'cust_refund', { 'custnum' => $self->custnum } )
6943 =item display_custnum
6945 Returns the displayed customer number for this customer: agent_custid if
6946 cust_main-default_agent_custid is set and it has a value, custnum otherwise.
6950 sub display_custnum {
6952 if ( $conf->exists('cust_main-default_agent_custid') && $self->agent_custid ){
6953 return $self->agent_custid;
6955 return $self->custnum;
6961 Returns a name string for this customer, either "Company (Last, First)" or
6968 my $name = $self->contact;
6969 $name = $self->company. " ($name)" if $self->company;
6975 Returns a name string for this (service/shipping) contact, either
6976 "Company (Last, First)" or "Last, First".
6982 if ( $self->get('ship_last') ) {
6983 my $name = $self->ship_contact;
6984 $name = $self->ship_company. " ($name)" if $self->ship_company;
6993 Returns a name string for this customer, either "Company" or "First Last".
6999 $self->company !~ /^\s*$/ ? $self->company : $self->contact_firstlast;
7002 =item ship_name_short
7004 Returns a name string for this (service/shipping) contact, either "Company"
7009 sub ship_name_short {
7011 if ( $self->get('ship_last') ) {
7012 $self->ship_company !~ /^\s*$/
7013 ? $self->ship_company
7014 : $self->ship_contact_firstlast;
7016 $self->name_company_or_firstlast;
7022 Returns this customer's full (billing) contact name only, "Last, First"
7028 $self->get('last'). ', '. $self->first;
7033 Returns this customer's full (shipping) contact name only, "Last, First"
7039 $self->get('ship_last')
7040 ? $self->get('ship_last'). ', '. $self->ship_first
7044 =item contact_firstlast
7046 Returns this customers full (billing) contact name only, "First Last".
7050 sub contact_firstlast {
7052 $self->first. ' '. $self->get('last');
7055 =item ship_contact_firstlast
7057 Returns this customer's full (shipping) contact name only, "First Last".
7061 sub ship_contact_firstlast {
7063 $self->get('ship_last')
7064 ? $self->first. ' '. $self->get('ship_last')
7065 : $self->contact_firstlast;
7070 Returns this customer's full country name
7076 code2country($self->country);
7079 =item geocode DATA_VENDOR
7081 Returns a value for the customer location as encoded by DATA_VENDOR.
7082 Currently this only makes sense for "CCH" as DATA_VENDOR.
7087 my ($self, $data_vendor) = (shift, shift); #always cch for now
7089 my $geocode = $self->get('geocode'); #XXX only one data_vendor for geocode
7090 return $geocode if $geocode;
7092 my $prefix = ( $conf->exists('tax-ship_address') && length($self->ship_last) )
7096 my ($zip,$plus4) = split /-/, $self->get("${prefix}zip")
7097 if $self->country eq 'US';
7099 #CCH specific location stuff
7100 my $extra_sql = "AND plus4lo <= '$plus4' AND plus4hi >= '$plus4'";
7102 my @cust_tax_location =
7104 'table' => 'cust_tax_location',
7105 'hashref' => { 'zip' => $zip, 'data_vendor' => $data_vendor },
7106 'extra_sql' => $extra_sql,
7107 'order_by' => 'ORDER BY plus4hi',#overlapping with distinct ends
7110 $geocode = $cust_tax_location[0]->geocode
7111 if scalar(@cust_tax_location);
7120 Returns a status string for this customer, currently:
7124 =item prospect - No packages have ever been ordered
7126 =item active - One or more recurring packages is active
7128 =item inactive - No active recurring packages, but otherwise unsuspended/uncancelled (the inactive status is new - previously inactive customers were mis-identified as cancelled)
7130 =item suspended - All non-cancelled recurring packages are suspended
7132 =item cancelled - All recurring packages are cancelled
7138 sub status { shift->cust_status(@_); }
7142 for my $status (qw( prospect active inactive suspended cancelled )) {
7143 my $method = $status.'_sql';
7144 my $numnum = ( my $sql = $self->$method() ) =~ s/cust_main\.custnum/?/g;
7145 my $sth = dbh->prepare("SELECT $sql") or die dbh->errstr;
7146 $sth->execute( ($self->custnum) x $numnum )
7147 or die "Error executing 'SELECT $sql': ". $sth->errstr;
7148 return $status if $sth->fetchrow_arrayref->[0];
7152 =item ucfirst_cust_status
7154 =item ucfirst_status
7156 Returns the status with the first character capitalized.
7160 sub ucfirst_status { shift->ucfirst_cust_status(@_); }
7162 sub ucfirst_cust_status {
7164 ucfirst($self->cust_status);
7169 Returns a hex triplet color string for this customer's status.
7173 use vars qw(%statuscolor);
7174 tie %statuscolor, 'Tie::IxHash',
7175 'prospect' => '7e0079', #'000000', #black? naw, purple
7176 'active' => '00CC00', #green
7177 'inactive' => '0000CC', #blue
7178 'suspended' => 'FF9900', #yellow
7179 'cancelled' => 'FF0000', #red
7182 sub statuscolor { shift->cust_statuscolor(@_); }
7184 sub cust_statuscolor {
7186 $statuscolor{$self->cust_status};
7191 Returns an array of hashes representing the customer's RT tickets.
7198 my $num = $conf->config('cust_main-max_tickets') || 10;
7201 if ( $conf->config('ticket_system') ) {
7202 unless ( $conf->config('ticket_system-custom_priority_field') ) {
7204 @tickets = @{ FS::TicketSystem->customer_tickets($self->custnum, $num) };
7208 foreach my $priority (
7209 $conf->config('ticket_system-custom_priority_field-values'), ''
7211 last if scalar(@tickets) >= $num;
7213 @{ FS::TicketSystem->customer_tickets( $self->custnum,
7214 $num - scalar(@tickets),
7224 # Return services representing svc_accts in customer support packages
7225 sub support_services {
7227 my %packages = map { $_ => 1 } $conf->config('support_packages');
7229 grep { $_->pkg_svc && $_->pkg_svc->primary_svc eq 'Y' }
7230 grep { $_->part_svc->svcdb eq 'svc_acct' }
7231 map { $_->cust_svc }
7232 grep { exists $packages{ $_->pkgpart } }
7233 $self->ncancelled_pkgs;
7239 =head1 CLASS METHODS
7245 Class method that returns the list of possible status strings for customers
7246 (see L<the status method|/status>). For example:
7248 @statuses = FS::cust_main->statuses();
7253 #my $self = shift; #could be class...
7259 Returns an SQL expression identifying prospective cust_main records (customers
7260 with no packages ever ordered)
7264 use vars qw($select_count_pkgs);
7265 $select_count_pkgs =
7266 "SELECT COUNT(*) FROM cust_pkg
7267 WHERE cust_pkg.custnum = cust_main.custnum";
7269 sub select_count_pkgs_sql {
7273 sub prospect_sql { "
7274 0 = ( $select_count_pkgs )
7279 Returns an SQL expression identifying active cust_main records (customers with
7280 active recurring packages).
7285 0 < ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. "
7291 Returns an SQL expression identifying inactive cust_main records (customers with
7292 no active recurring packages, but otherwise unsuspended/uncancelled).
7296 sub inactive_sql { "
7297 0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " )
7299 0 < ( $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " )
7305 Returns an SQL expression identifying suspended cust_main records.
7310 sub suspended_sql { susp_sql(@_); }
7312 0 < ( $select_count_pkgs AND ". FS::cust_pkg->suspended_sql. " )
7314 0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " )
7320 Returns an SQL expression identifying cancelled cust_main records.
7324 sub cancelled_sql { cancel_sql(@_); }
7327 my $recurring_sql = FS::cust_pkg->recurring_sql;
7328 my $cancelled_sql = FS::cust_pkg->cancelled_sql;
7331 0 < ( $select_count_pkgs )
7332 AND 0 < ( $select_count_pkgs AND $recurring_sql AND $cancelled_sql )
7333 AND 0 = ( $select_count_pkgs AND $recurring_sql
7334 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
7336 AND 0 = ( $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " )
7342 =item uncancelled_sql
7344 Returns an SQL expression identifying un-cancelled cust_main records.
7348 sub uncancelled_sql { uncancel_sql(@_); }
7349 sub uncancel_sql { "
7350 ( 0 < ( $select_count_pkgs
7351 AND ( cust_pkg.cancel IS NULL
7352 OR cust_pkg.cancel = 0
7355 OR 0 = ( $select_count_pkgs )
7361 Returns an SQL fragment to retreive the balance.
7366 ( SELECT COALESCE( SUM(charged), 0 ) FROM cust_bill
7367 WHERE cust_bill.custnum = cust_main.custnum )
7368 - ( SELECT COALESCE( SUM(paid), 0 ) FROM cust_pay
7369 WHERE cust_pay.custnum = cust_main.custnum )
7370 - ( SELECT COALESCE( SUM(amount), 0 ) FROM cust_credit
7371 WHERE cust_credit.custnum = cust_main.custnum )
7372 + ( SELECT COALESCE( SUM(refund), 0 ) FROM cust_refund
7373 WHERE cust_refund.custnum = cust_main.custnum )
7376 =item balance_date_sql START_TIME [ END_TIME [ OPTION => VALUE ... ] ]
7378 Returns an SQL fragment to retreive the balance for this customer, only
7379 considering invoices with date earlier than START_TIME, and optionally not
7380 later than END_TIME (total_owed_date minus total_unapplied_credits minus
7381 total_unapplied_payments).
7383 Times are specified as SQL fragments or numeric
7384 UNIX timestamps; see L<perlfunc/"time">). Also see L<Time::Local> and
7385 L<Date::Parse> for conversion functions. The empty string can be passed
7386 to disable that time constraint completely.
7388 Available options are:
7392 =item unapplied_date
7394 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)
7399 set to true to remove all customer comparison clauses, for totals
7404 WHERE clause hashref (elements "AND"ed together) (typically used with the total option)
7409 JOIN clause (typically used with the total option)
7415 sub balance_date_sql {
7416 my( $class, $start, $end, %opt ) = @_;
7418 my $owed = FS::cust_bill->owed_sql;
7419 my $unapp_refund = FS::cust_refund->unapplied_sql;
7420 my $unapp_credit = FS::cust_credit->unapplied_sql;
7421 my $unapp_pay = FS::cust_pay->unapplied_sql;
7423 my $j = $opt{'join'} || '';
7425 my $owed_wh = $class->_money_table_where( 'cust_bill', $start,$end,%opt );
7426 my $refund_wh = $class->_money_table_where( 'cust_refund', $start,$end,%opt );
7427 my $credit_wh = $class->_money_table_where( 'cust_credit', $start,$end,%opt );
7428 my $pay_wh = $class->_money_table_where( 'cust_pay', $start,$end,%opt );
7430 " ( SELECT COALESCE(SUM($owed), 0) FROM cust_bill $j $owed_wh )
7431 + ( SELECT COALESCE(SUM($unapp_refund), 0) FROM cust_refund $j $refund_wh )
7432 - ( SELECT COALESCE(SUM($unapp_credit), 0) FROM cust_credit $j $credit_wh )
7433 - ( SELECT COALESCE(SUM($unapp_pay), 0) FROM cust_pay $j $pay_wh )
7438 =item _money_table_where TABLE START_TIME [ END_TIME [ OPTION => VALUE ... ] ]
7440 Helper method for balance_date_sql; name (and usage) subject to change
7441 (suggestions welcome).
7443 Returns a WHERE clause for the specified monetary TABLE (cust_bill,
7444 cust_refund, cust_credit or cust_pay).
7446 If TABLE is "cust_bill" or the unapplied_date option is true, only
7447 considers records with date earlier than START_TIME, and optionally not
7448 later than END_TIME .
7452 sub _money_table_where {
7453 my( $class, $table, $start, $end, %opt ) = @_;
7456 push @where, "cust_main.custnum = $table.custnum" unless $opt{'total'};
7457 if ( $table eq 'cust_bill' || $opt{'unapplied_date'} ) {
7458 push @where, "$table._date <= $start" if defined($start) && length($start);
7459 push @where, "$table._date > $end" if defined($end) && length($end);
7461 push @where, @{$opt{'where'}} if $opt{'where'};
7462 my $where = scalar(@where) ? 'WHERE '. join(' AND ', @where ) : '';
7468 =item search_sql HASHREF
7472 Returns a qsearch hash expression to search for parameters specified in HREF.
7473 Valid parameters are
7481 =item cancelled_pkgs
7487 listref of start date, end date
7493 =item current_balance
7495 listref (list returned by FS::UI::Web::parse_lt_gt($cgi, 'current_balance'))
7499 =item flattened_pkgs
7508 my ($class, $params) = @_;
7519 if ( $params->{'agentnum'} =~ /^(\d+)$/ and $1 ) {
7521 "cust_main.agentnum = $1";
7528 #prospect active inactive suspended cancelled
7529 if ( grep { $params->{'status'} eq $_ } FS::cust_main->statuses() ) {
7530 my $method = $params->{'status'}. '_sql';
7531 #push @where, $class->$method();
7532 push @where, FS::cust_main->$method();
7536 # parse cancelled package checkbox
7541 $pkgwhere .= "AND (cancel = 0 or cancel is null)"
7542 unless $params->{'cancelled_pkgs'};
7548 foreach my $field (qw( signupdate )) {
7550 next unless exists($params->{$field});
7552 my($beginning, $ending) = @{$params->{$field}};
7555 "cust_main.$field IS NOT NULL",
7556 "cust_main.$field >= $beginning",
7557 "cust_main.$field <= $ending";
7559 $orderby ||= "ORDER BY cust_main.$field";
7567 my @payby = grep /^([A-Z]{4})$/, @{ $params->{'payby'} };
7569 push @where, '( '. join(' OR ', map "cust_main.payby = '$_'", @payby). ' )';
7576 #my $balance_sql = $class->balance_sql();
7577 my $balance_sql = FS::cust_main->balance_sql();
7579 push @where, map { s/current_balance/$balance_sql/; $_ }
7580 @{ $params->{'current_balance'} };
7586 if ( $params->{'custbatch'} =~ /^([\w\/\-\:\.]+)$/ and $1 ) {
7588 "cust_main.custbatch = '$1'";
7592 # setup queries, subs, etc. for the search
7595 $orderby ||= 'ORDER BY custnum';
7597 # here is the agent virtualization
7598 push @where, $FS::CurrentUser::CurrentUser->agentnums_sql;
7600 my $extra_sql = scalar(@where) ? ' WHERE '. join(' AND ', @where) : '';
7602 my $addl_from = 'LEFT JOIN cust_pkg USING ( custnum ) ';
7604 my $count_query = "SELECT COUNT(*) FROM cust_main $extra_sql";
7606 my $select = join(', ',
7607 'cust_main.custnum',
7608 FS::UI::Web::cust_sql_fields($params->{'cust_fields'}),
7611 my(@extra_headers) = ();
7612 my(@extra_fields) = ();
7614 if ($params->{'flattened_pkgs'}) {
7616 if ($dbh->{Driver}->{Name} eq 'Pg') {
7618 $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";
7620 }elsif ($dbh->{Driver}->{Name} =~ /^mysql/i) {
7621 $select .= ", GROUP_CONCAT(pkg SEPARATOR '|') as magic";
7622 $addl_from .= " LEFT JOIN part_pkg using ( pkgpart )";
7624 warn "warning: unknown database type ". $dbh->{Driver}->{Name}.
7625 "omitting packing information from report.";
7628 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";
7630 my $sth = dbh->prepare($header_query) or die dbh->errstr;
7631 $sth->execute() or die $sth->errstr;
7632 my $headerrow = $sth->fetchrow_arrayref;
7633 my $headercount = $headerrow ? $headerrow->[0] : 0;
7634 while($headercount) {
7635 unshift @extra_headers, "Package ". $headercount;
7636 unshift @extra_fields, eval q!sub {my $c = shift;
7637 my @a = split '\|', $c->magic;
7638 my $p = $a[!.--$headercount. q!];
7646 'table' => 'cust_main',
7647 'select' => $select,
7649 'extra_sql' => $extra_sql,
7650 'order_by' => $orderby,
7651 'count_query' => $count_query,
7652 'extra_headers' => \@extra_headers,
7653 'extra_fields' => \@extra_fields,
7658 =item email_search_sql HASHREF
7662 Emails a notice to the specified customers.
7664 Valid parameters are those of the L<search_sql> method, plus the following:
7686 Optional job queue job for status updates.
7690 Returns an error message, or false for success.
7692 If an error occurs during any email, stops the enture send and returns that
7693 error. Presumably if you're getting SMTP errors aborting is better than
7694 retrying everything.
7698 sub email_search_sql {
7699 my($class, $params) = @_;
7701 my $from = delete $params->{from};
7702 my $subject = delete $params->{subject};
7703 my $html_body = delete $params->{html_body};
7704 my $text_body = delete $params->{text_body};
7706 my $job = delete $params->{'job'};
7708 my $sql_query = $class->search_sql($params);
7710 my $count_query = delete($sql_query->{'count_query'});
7711 my $count_sth = dbh->prepare($count_query)
7712 or die "Error preparing $count_query: ". dbh->errstr;
7714 or die "Error executing $count_query: ". $count_sth->errstr;
7715 my $count_arrayref = $count_sth->fetchrow_arrayref;
7716 my $num_cust = $count_arrayref->[0];
7718 #my @extra_headers = @{ delete($sql_query->{'extra_headers'}) };
7719 #my @extra_fields = @{ delete($sql_query->{'extra_fields'}) };
7722 my( $num, $last, $min_sec ) = (0, time, 5); #progresbar foo
7724 #eventually order+limit magic to reduce memory use?
7725 foreach my $cust_main ( qsearch($sql_query) ) {
7727 my $to = $cust_main->invoicing_list_emailonly_scalar;
7730 my $error = send_email(
7734 'subject' => $subject,
7735 'html_body' => $html_body,
7736 'text_body' => $text_body,
7739 return $error if $error;
7741 if ( $job ) { #progressbar foo
7743 if ( time - $min_sec > $last ) {
7744 my $error = $job->update_statustext(
7745 int( 100 * $num / $num_cust )
7747 die $error if $error;
7757 use Storable qw(thaw);
7760 sub process_email_search_sql {
7762 #warn "$me process_re_X $method for job $job\n" if $DEBUG;
7764 my $param = thaw(decode_base64(shift));
7765 warn Dumper($param) if $DEBUG;
7767 $param->{'job'} = $job;
7769 my $error = FS::cust_main->email_search_sql( $param );
7770 die $error if $error;
7774 =item fuzzy_search FUZZY_HASHREF [ HASHREF, SELECT, EXTRA_SQL, CACHE_OBJ ]
7776 Performs a fuzzy (approximate) search and returns the matching FS::cust_main
7777 records. Currently, I<first>, I<last> and/or I<company> may be specified (the
7778 appropriate ship_ field is also searched).
7780 Additional options are the same as FS::Record::qsearch
7785 my( $self, $fuzzy, $hash, @opt) = @_;
7790 check_and_rebuild_fuzzyfiles();
7791 foreach my $field ( keys %$fuzzy ) {
7793 my $all = $self->all_X($field);
7794 next unless scalar(@$all);
7797 $match{$_}=1 foreach ( amatch( $fuzzy->{$field}, ['i'], @$all ) );
7800 foreach ( keys %match ) {
7801 push @fcust, qsearch('cust_main', { %$hash, $field=>$_}, @opt);
7802 push @fcust, qsearch('cust_main', { %$hash, "ship_$field"=>$_}, @opt);
7805 push @cust_main, grep { ! $fsaw{$_->custnum}++ } @fcust;
7808 # we want the components of $fuzzy ANDed, not ORed, but still don't want dupes
7810 @cust_main = grep { ++$saw{$_->custnum} == scalar(keys %$fuzzy) } @cust_main;
7818 Returns a masked version of the named field
7823 my ($self,$field) = @_;
7827 'x'x(length($self->getfield($field))-4).
7828 substr($self->getfield($field), (length($self->getfield($field))-4));
7838 =item smart_search OPTION => VALUE ...
7840 Accepts the following options: I<search>, the string to search for. The string
7841 will be searched for as a customer number, phone number, name or company name,
7842 as an exact, or, in some cases, a substring or fuzzy match (see the source code
7843 for the exact heuristics used); I<no_fuzzy_on_exact>, causes smart_search to
7844 skip fuzzy matching when an exact match is found.
7846 Any additional options are treated as an additional qualifier on the search
7849 Returns a (possibly empty) array of FS::cust_main objects.
7856 #here is the agent virtualization
7857 my $agentnums_sql = $FS::CurrentUser::CurrentUser->agentnums_sql;
7861 my $skip_fuzzy = delete $options{'no_fuzzy_on_exact'};
7862 my $search = delete $options{'search'};
7863 ( my $alphanum_search = $search ) =~ s/\W//g;
7865 if ( $alphanum_search =~ /^1?(\d{3})(\d{3})(\d{4})(\d*)$/ ) { #phone# search
7867 #false laziness w/Record::ut_phone
7868 my $phonen = "$1-$2-$3";
7869 $phonen .= " x$4" if $4;
7871 push @cust_main, qsearch( {
7872 'table' => 'cust_main',
7873 'hashref' => { %options },
7874 'extra_sql' => ( scalar(keys %options) ? ' AND ' : ' WHERE ' ).
7876 join(' OR ', map "$_ = '$phonen'",
7877 qw( daytime night fax
7878 ship_daytime ship_night ship_fax )
7881 " AND $agentnums_sql", #agent virtualization
7884 unless ( @cust_main || $phonen =~ /x\d+$/ ) { #no exact match
7885 #try looking for matches with extensions unless one was specified
7887 push @cust_main, qsearch( {
7888 'table' => 'cust_main',
7889 'hashref' => { %options },
7890 'extra_sql' => ( scalar(keys %options) ? ' AND ' : ' WHERE ' ).
7892 join(' OR ', map "$_ LIKE '$phonen\%'",
7894 ship_daytime ship_night )
7897 " AND $agentnums_sql", #agent virtualization
7902 # custnum search (also try agent_custid), with some tweaking options if your
7903 # legacy cust "numbers" have letters
7906 if ( $search =~ /^\s*(\d+)\s*$/
7907 || ( $conf->config('cust_main-agent_custid-format') eq 'ww?d+'
7908 && $search =~ /^\s*(\w\w?\d+)\s*$/
7915 if ( $num <= 2147483647 ) { #need a bigint custnum? wow.
7916 push @cust_main, qsearch( {
7917 'table' => 'cust_main',
7918 'hashref' => { 'custnum' => $num, %options },
7919 'extra_sql' => " AND $agentnums_sql", #agent virtualization
7923 push @cust_main, qsearch( {
7924 'table' => 'cust_main',
7925 'hashref' => { 'agent_custid' => $num, %options },
7926 'extra_sql' => " AND $agentnums_sql", #agent virtualization
7929 } elsif ( $search =~ /^\s*(\S.*\S)\s+\((.+), ([^,]+)\)\s*$/ ) {
7931 my($company, $last, $first) = ( $1, $2, $3 );
7933 # "Company (Last, First)"
7934 #this is probably something a browser remembered,
7935 #so just do an exact search
7937 foreach my $prefix ( '', 'ship_' ) {
7938 push @cust_main, qsearch( {
7939 'table' => 'cust_main',
7940 'hashref' => { $prefix.'first' => $first,
7941 $prefix.'last' => $last,
7942 $prefix.'company' => $company,
7945 'extra_sql' => " AND $agentnums_sql",
7949 } elsif ( $search =~ /^\s*(\S.*\S)\s*$/ ) { # value search
7950 # try (ship_){last,company}
7954 # # remove "(Last, First)" in "Company (Last, First)", otherwise the
7955 # # full strings the browser remembers won't work
7956 # $value =~ s/\([\w \,\.\-\']*\)$//; #false laziness w/Record::ut_name
7958 use Lingua::EN::NameParse;
7959 my $NameParse = new Lingua::EN::NameParse(
7961 allow_reversed => 1,
7964 my($last, $first) = ( '', '' );
7965 #maybe disable this too and just rely on NameParse?
7966 if ( $value =~ /^(.+),\s*([^,]+)$/ ) { # Last, First
7968 ($last, $first) = ( $1, $2 );
7970 #} elsif ( $value =~ /^(.+)\s+(.+)$/ ) {
7971 } elsif ( ! $NameParse->parse($value) ) {
7973 my %name = $NameParse->components;
7974 $first = $name{'given_name_1'};
7975 $last = $name{'surname_1'};
7979 if ( $first && $last ) {
7981 my($q_last, $q_first) = ( dbh->quote($last), dbh->quote($first) );
7984 my $sql = scalar(keys %options) ? ' AND ' : ' WHERE ';
7986 ( ( LOWER(last) = $q_last AND LOWER(first) = $q_first )
7987 OR ( LOWER(ship_last) = $q_last AND LOWER(ship_first) = $q_first )
7990 push @cust_main, qsearch( {
7991 'table' => 'cust_main',
7992 'hashref' => \%options,
7993 'extra_sql' => "$sql AND $agentnums_sql", #agent virtualization
7996 # or it just be something that was typed in... (try that in a sec)
8000 my $q_value = dbh->quote($value);
8003 my $sql = scalar(keys %options) ? ' AND ' : ' WHERE ';
8004 $sql .= " ( LOWER(last) = $q_value
8005 OR LOWER(company) = $q_value
8006 OR LOWER(ship_last) = $q_value
8007 OR LOWER(ship_company) = $q_value
8010 push @cust_main, qsearch( {
8011 'table' => 'cust_main',
8012 'hashref' => \%options,
8013 'extra_sql' => "$sql AND $agentnums_sql", #agent virtualization
8016 #no exact match, trying substring/fuzzy
8017 #always do substring & fuzzy (unless they're explicity config'ed off)
8018 #getting complaints searches are not returning enough
8019 unless ( @cust_main && $skip_fuzzy || $conf->exists('disable-fuzzy') ) {
8021 #still some false laziness w/search_sql (was search/cust_main.cgi)
8026 { 'company' => { op=>'ILIKE', value=>"%$value%" }, },
8027 { 'ship_company' => { op=>'ILIKE', value=>"%$value%" }, },
8030 if ( $first && $last ) {
8033 { 'first' => { op=>'ILIKE', value=>"%$first%" },
8034 'last' => { op=>'ILIKE', value=>"%$last%" },
8036 { 'ship_first' => { op=>'ILIKE', value=>"%$first%" },
8037 'ship_last' => { op=>'ILIKE', value=>"%$last%" },
8044 { 'last' => { op=>'ILIKE', value=>"%$value%" }, },
8045 { 'ship_last' => { op=>'ILIKE', value=>"%$value%" }, },
8049 foreach my $hashref ( @hashrefs ) {
8051 push @cust_main, qsearch( {
8052 'table' => 'cust_main',
8053 'hashref' => { %$hashref,
8056 'extra_sql' => " AND $agentnums_sql", #agent virtualizaiton
8065 " AND $agentnums_sql", #extra_sql #agent virtualization
8068 if ( $first && $last ) {
8069 push @cust_main, FS::cust_main->fuzzy_search(
8070 { 'last' => $last, #fuzzy hashref
8071 'first' => $first }, #
8075 foreach my $field ( 'last', 'company' ) {
8077 FS::cust_main->fuzzy_search( { $field => $value }, @fuzopts );
8082 #eliminate duplicates
8084 @cust_main = grep { !$saw{$_->custnum}++ } @cust_main;
8094 Accepts the following options: I<email>, the email address to search for. The
8095 email address will be searched for as an email invoice destination and as an
8098 #Any additional options are treated as an additional qualifier on the search
8099 #(i.e. I<agentnum>).
8101 Returns a (possibly empty) array of FS::cust_main objects (but usually just
8111 my $email = delete $options{'email'};
8113 #we're only being used by RT at the moment... no agent virtualization yet
8114 #my $agentnums_sql = $FS::CurrentUser::CurrentUser->agentnums_sql;
8118 if ( $email =~ /([^@]+)\@([^@]+)/ ) {
8120 my ( $user, $domain ) = ( $1, $2 );
8122 warn "$me smart_search: searching for $user in domain $domain"
8128 'table' => 'cust_main_invoice',
8129 'hashref' => { 'dest' => $email },
8136 map $_->cust_svc->cust_pkg,
8138 'table' => 'svc_acct',
8139 'hashref' => { 'username' => $user, },
8141 'AND ( SELECT domain FROM svc_domain
8142 WHERE svc_acct.domsvc = svc_domain.svcnum
8143 ) = '. dbh->quote($domain),
8149 @cust_main = grep { !$saw{$_->custnum}++ } @cust_main;
8151 warn "$me smart_search: found ". scalar(@cust_main). " unique customers"
8158 =item check_and_rebuild_fuzzyfiles
8162 use vars qw(@fuzzyfields);
8163 @fuzzyfields = ( 'last', 'first', 'company' );
8165 sub check_and_rebuild_fuzzyfiles {
8166 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
8167 rebuild_fuzzyfiles() if grep { ! -e "$dir/cust_main.$_" } @fuzzyfields
8170 =item rebuild_fuzzyfiles
8174 sub rebuild_fuzzyfiles {
8176 use Fcntl qw(:flock);
8178 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
8179 mkdir $dir, 0700 unless -d $dir;
8181 foreach my $fuzzy ( @fuzzyfields ) {
8183 open(LOCK,">>$dir/cust_main.$fuzzy")
8184 or die "can't open $dir/cust_main.$fuzzy: $!";
8186 or die "can't lock $dir/cust_main.$fuzzy: $!";
8188 open (CACHE,">$dir/cust_main.$fuzzy.tmp")
8189 or die "can't open $dir/cust_main.$fuzzy.tmp: $!";
8191 foreach my $field ( $fuzzy, "ship_$fuzzy" ) {
8192 my $sth = dbh->prepare("SELECT $field FROM cust_main".
8193 " WHERE $field != '' AND $field IS NOT NULL");
8194 $sth->execute or die $sth->errstr;
8196 while ( my $row = $sth->fetchrow_arrayref ) {
8197 print CACHE $row->[0]. "\n";
8202 close CACHE or die "can't close $dir/cust_main.$fuzzy.tmp: $!";
8204 rename "$dir/cust_main.$fuzzy.tmp", "$dir/cust_main.$fuzzy";
8215 my( $self, $field ) = @_;
8216 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
8217 open(CACHE,"<$dir/cust_main.$field")
8218 or die "can't open $dir/cust_main.$field: $!";
8219 my @array = map { chomp; $_; } <CACHE>;
8224 =item append_fuzzyfiles LASTNAME COMPANY
8228 sub append_fuzzyfiles {
8229 #my( $first, $last, $company ) = @_;
8231 &check_and_rebuild_fuzzyfiles;
8233 use Fcntl qw(:flock);
8235 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
8237 foreach my $field (qw( first last company )) {
8242 open(CACHE,">>$dir/cust_main.$field")
8243 or die "can't open $dir/cust_main.$field: $!";
8244 flock(CACHE,LOCK_EX)
8245 or die "can't lock $dir/cust_main.$field: $!";
8247 print CACHE "$value\n";
8249 flock(CACHE,LOCK_UN)
8250 or die "can't unlock $dir/cust_main.$field: $!";
8265 #warn join('-',keys %$param);
8266 my $fh = $param->{filehandle};
8267 my @fields = @{$param->{fields}};
8269 eval "use Text::CSV_XS;";
8272 my $csv = new Text::CSV_XS;
8279 local $SIG{HUP} = 'IGNORE';
8280 local $SIG{INT} = 'IGNORE';
8281 local $SIG{QUIT} = 'IGNORE';
8282 local $SIG{TERM} = 'IGNORE';
8283 local $SIG{TSTP} = 'IGNORE';
8284 local $SIG{PIPE} = 'IGNORE';
8286 my $oldAutoCommit = $FS::UID::AutoCommit;
8287 local $FS::UID::AutoCommit = 0;
8290 #while ( $columns = $csv->getline($fh) ) {
8292 while ( defined($line=<$fh>) ) {
8294 $csv->parse($line) or do {
8295 $dbh->rollback if $oldAutoCommit;
8296 return "can't parse: ". $csv->error_input();
8299 my @columns = $csv->fields();
8300 #warn join('-',@columns);
8303 foreach my $field ( @fields ) {
8304 $row{$field} = shift @columns;
8307 my $cust_main = qsearchs('cust_main', { 'custnum' => $row{'custnum'} } );
8308 unless ( $cust_main ) {
8309 $dbh->rollback if $oldAutoCommit;
8310 return "unknown custnum $row{'custnum'}";
8313 if ( $row{'amount'} > 0 ) {
8314 my $error = $cust_main->charge($row{'amount'}, $row{'pkg'});
8316 $dbh->rollback if $oldAutoCommit;
8320 } elsif ( $row{'amount'} < 0 ) {
8321 my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ),
8324 $dbh->rollback if $oldAutoCommit;
8334 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
8336 return "Empty file!" unless $imported;
8342 =item notify CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
8344 Sends a templated email notification to the customer (see L<Text::Template>).
8346 OPTIONS is a hash and may include
8348 I<from> - the email sender (default is invoice_from)
8350 I<to> - comma-separated scalar or arrayref of recipients
8351 (default is invoicing_list)
8353 I<subject> - The subject line of the sent email notification
8354 (default is "Notice from company_name")
8356 I<extra_fields> - a hashref of name/value pairs which will be substituted
8359 The following variables are vavailable in the template.
8361 I<$first> - the customer first name
8362 I<$last> - the customer last name
8363 I<$company> - the customer company
8364 I<$payby> - a description of the method of payment for the customer
8365 # would be nice to use FS::payby::shortname
8366 I<$payinfo> - the account information used to collect for this customer
8367 I<$expdate> - the expiration of the customer payment in seconds from epoch
8372 my ($self, $template, %options) = @_;
8374 return unless $conf->exists($template);
8376 my $from = $conf->config('invoice_from', $self->agentnum)
8377 if $conf->exists('invoice_from', $self->agentnum);
8378 $from = $options{from} if exists($options{from});
8380 my $to = join(',', $self->invoicing_list_emailonly);
8381 $to = $options{to} if exists($options{to});
8383 my $subject = "Notice from " . $conf->config('company_name', $self->agentnum)
8384 if $conf->exists('company_name', $self->agentnum);
8385 $subject = $options{subject} if exists($options{subject});
8387 my $notify_template = new Text::Template (TYPE => 'ARRAY',
8388 SOURCE => [ map "$_\n",
8389 $conf->config($template)]
8391 or die "can't create new Text::Template object: Text::Template::ERROR";
8392 $notify_template->compile()
8393 or die "can't compile template: Text::Template::ERROR";
8395 $FS::notify_template::_template::company_name =
8396 $conf->config('company_name', $self->agentnum);
8397 $FS::notify_template::_template::company_address =
8398 join("\n", $conf->config('company_address', $self->agentnum) ). "\n";
8400 my $paydate = $self->paydate || '2037-12-31';
8401 $FS::notify_template::_template::first = $self->first;
8402 $FS::notify_template::_template::last = $self->last;
8403 $FS::notify_template::_template::company = $self->company;
8404 $FS::notify_template::_template::payinfo = $self->mask_payinfo;
8405 my $payby = $self->payby;
8406 my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
8407 my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
8409 #credit cards expire at the end of the month/year of their exp date
8410 if ($payby eq 'CARD' || $payby eq 'DCRD') {
8411 $FS::notify_template::_template::payby = 'credit card';
8412 ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
8413 $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
8415 }elsif ($payby eq 'COMP') {
8416 $FS::notify_template::_template::payby = 'complimentary account';
8418 $FS::notify_template::_template::payby = 'current method';
8420 $FS::notify_template::_template::expdate = $expire_time;
8422 for (keys %{$options{extra_fields}}){
8424 ${"FS::notify_template::_template::$_"} = $options{extra_fields}->{$_};
8427 send_email(from => $from,
8429 subject => $subject,
8430 body => $notify_template->fill_in( PACKAGE =>
8431 'FS::notify_template::_template' ),
8436 =item generate_letter CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
8438 Generates a templated notification to the customer (see L<Text::Template>).
8440 OPTIONS is a hash and may include
8442 I<extra_fields> - a hashref of name/value pairs which will be substituted
8443 into the template. These values may override values mentioned below
8444 and those from the customer record.
8446 The following variables are available in the template instead of or in addition
8447 to the fields of the customer record.
8449 I<$payby> - a description of the method of payment for the customer
8450 # would be nice to use FS::payby::shortname
8451 I<$payinfo> - the masked account information used to collect for this customer
8452 I<$expdate> - the expiration of the customer payment method in seconds from epoch
8453 I<$returnaddress> - the return address defaults to invoice_latexreturnaddress or company_address
8457 sub generate_letter {
8458 my ($self, $template, %options) = @_;
8460 return unless $conf->exists($template);
8462 my $letter_template = new Text::Template
8464 SOURCE => [ map "$_\n", $conf->config($template)],
8465 DELIMITERS => [ '[@--', '--@]' ],
8467 or die "can't create new Text::Template object: Text::Template::ERROR";
8469 $letter_template->compile()
8470 or die "can't compile template: Text::Template::ERROR";
8472 my %letter_data = map { $_ => $self->$_ } $self->fields;
8473 $letter_data{payinfo} = $self->mask_payinfo;
8475 #my $paydate = $self->paydate || '2037-12-31';
8476 my $paydate = $self->paydate =~ /^\S+$/ ? $self->paydate : '2037-12-31';
8478 my $payby = $self->payby;
8479 my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
8480 my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
8482 #credit cards expire at the end of the month/year of their exp date
8483 if ($payby eq 'CARD' || $payby eq 'DCRD') {
8484 $letter_data{payby} = 'credit card';
8485 ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
8486 $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
8488 }elsif ($payby eq 'COMP') {
8489 $letter_data{payby} = 'complimentary account';
8491 $letter_data{payby} = 'current method';
8493 $letter_data{expdate} = $expire_time;
8495 for (keys %{$options{extra_fields}}){
8496 $letter_data{$_} = $options{extra_fields}->{$_};
8499 unless(exists($letter_data{returnaddress})){
8500 my $retadd = join("\n", $conf->config_orbase( 'invoice_latexreturnaddress',
8501 $self->agent_template)
8503 if ( length($retadd) ) {
8504 $letter_data{returnaddress} = $retadd;
8505 } elsif ( grep /\S/, $conf->config('company_address', $self->agentnum) ) {
8506 $letter_data{returnaddress} =
8507 join( '\\*'."\n", map s/( {2,})/'~' x length($1)/eg,
8508 $conf->config('company_address', $self->agentnum)
8511 $letter_data{returnaddress} = '~';
8515 $letter_data{conf_dir} = "$FS::UID::conf_dir/conf.$FS::UID::datasrc";
8517 $letter_data{company_name} = $conf->config('company_name', $self->agentnum);
8519 my $dir = $FS::UID::conf_dir."/cache.". $FS::UID::datasrc;
8520 my $fh = new File::Temp( TEMPLATE => 'letter.'. $self->custnum. '.XXXXXXXX',
8524 ) or die "can't open temp file: $!\n";
8526 $letter_template->fill_in( OUTPUT => $fh, HASH => \%letter_data );
8528 $fh->filename =~ /^(.*).tex$/ or die "unparsable filename: ". $fh->filename;
8532 =item print_ps TEMPLATE
8534 Returns an postscript letter filled in from TEMPLATE, as a scalar.
8540 my $file = $self->generate_letter(@_);
8541 FS::Misc::generate_ps($file);
8544 =item print TEMPLATE
8546 Prints the filled in template.
8548 TEMPLATE is the name of a L<Text::Template> to fill in and print.
8552 sub queueable_print {
8555 my $self = qsearchs('cust_main', { 'custnum' => $opt{custnum} } )
8556 or die "invalid customer number: " . $opt{custvnum};
8558 my $error = $self->print( $opt{template} );
8559 die $error if $error;
8563 my ($self, $template) = (shift, shift);
8564 do_print [ $self->print_ps($template) ];
8567 #these three subs should just go away once agent stuff is all config overrides
8569 sub agent_template {
8571 $self->_agent_plandata('agent_templatename');
8574 sub agent_invoice_from {
8576 $self->_agent_plandata('agent_invoice_from');
8579 sub _agent_plandata {
8580 my( $self, $option ) = @_;
8582 #yuck. this whole thing needs to be reconciled better with 1.9's idea of
8583 #agent-specific Conf
8585 use FS::part_event::Condition;
8587 my $agentnum = $self->agentnum;
8590 if ( driver_name =~ /^Pg/i ) {
8592 } elsif ( driver_name =~ /^mysql/i ) {
8595 die "don't know how to use regular expressions in ". driver_name. " databases";
8598 my $part_event_option =
8600 'select' => 'part_event_option.*',
8601 'table' => 'part_event_option',
8603 LEFT JOIN part_event USING ( eventpart )
8604 LEFT JOIN part_event_option AS peo_agentnum
8605 ON ( part_event.eventpart = peo_agentnum.eventpart
8606 AND peo_agentnum.optionname = 'agentnum'
8607 AND peo_agentnum.optionvalue }. $regexp. q{ '(^|,)}. $agentnum. q{(,|$)'
8609 LEFT JOIN part_event_condition
8610 ON ( part_event.eventpart = part_event_condition.eventpart
8611 AND part_event_condition.conditionname = 'cust_bill_age'
8613 LEFT JOIN part_event_condition_option
8614 ON ( part_event_condition.eventconditionnum = part_event_condition_option.eventconditionnum
8615 AND part_event_condition_option.optionname = 'age'
8618 #'hashref' => { 'optionname' => $option },
8619 #'hashref' => { 'part_event_option.optionname' => $option },
8621 " WHERE part_event_option.optionname = ". dbh->quote($option).
8622 " AND action = 'cust_bill_send_agent' ".
8623 " AND ( disabled IS NULL OR disabled != 'Y' ) ".
8624 " AND peo_agentnum.optionname = 'agentnum' ".
8625 " AND ( agentnum IS NULL OR agentnum = $agentnum ) ".
8627 CASE WHEN part_event_condition_option.optionname IS NULL
8629 ELSE ". FS::part_event::Condition->age2seconds_sql('part_event_condition_option.optionvalue').
8631 , part_event.weight".
8635 unless ( $part_event_option ) {
8636 return $self->agent->invoice_template || ''
8637 if $option eq 'agent_templatename';
8641 $part_event_option->optionvalue;
8646 ## actual sub, not a method, designed to be called from the queue.
8647 ## sets up the customer, and calls the bill_and_collect
8648 my (%args) = @_; #, ($time, $invoice_time, $check_freq, $resetup) = @_;
8649 my $cust_main = qsearchs( 'cust_main', { custnum => $args{'custnum'} } );
8650 $cust_main->bill_and_collect(
8655 sub _upgrade_data { #class method
8656 my ($class, %opts) = @_;
8658 my $sql = 'UPDATE h_cust_main SET paycvv = NULL WHERE paycvv IS NOT NULL';
8659 my $sth = dbh->prepare($sql) or die dbh->errstr;
8660 $sth->execute or die $sth->errstr;
8670 The delete method should possibly take an FS::cust_main object reference
8671 instead of a scalar customer number.
8673 Bill and collect options should probably be passed as references instead of a
8676 There should probably be a configuration file with a list of allowed credit
8679 No multiple currency support (probably a larger project than just this module).
8681 payinfo_masked false laziness with cust_pay.pm and cust_refund.pm
8683 Birthdates rely on negative epoch values.
8685 The payby for card/check batches is broken. With mixed batching, bad
8688 B<collect> I<invoice_time> should be renamed I<time>, like B<bill>.
8692 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
8693 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
8694 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.