5 use vars qw( @ISA @EXPORT_OK $DEBUG $me $conf
7 $import $ignore_expired_card
8 $skip_fuzzyfiles @fuzzyfields
11 use vars qw( $realtime_bop_decline_quiet ); #ugh
15 use Scalar::Util qw( blessed );
16 use List::Util qw( min );
17 use Time::Local qw(timelocal);
20 use Digest::MD5 qw(md5_base64);
23 use File::Temp qw( tempfile );
24 use String::Approx qw(amatch);
25 use Business::CreditCard 0.28;
27 use FS::UID qw( getotaker dbh driver_name );
28 use FS::Record qw( qsearchs qsearch dbdef );
29 use FS::Misc qw( generate_email send_email generate_ps do_print );
30 use FS::Msgcat qw(gettext);
35 use FS::cust_bill_pkg;
36 use FS::cust_bill_pkg_display;
37 use FS::cust_bill_pkg_tax_location;
38 use FS::cust_bill_pkg_tax_rate_location;
40 use FS::cust_pay_pending;
41 use FS::cust_pay_void;
42 use FS::cust_pay_batch;
45 use FS::part_referral;
46 use FS::cust_main_county;
47 use FS::cust_location;
48 use FS::cust_main_exemption;
49 use FS::cust_tax_adjustment;
51 use FS::tax_rate_location;
52 use FS::cust_tax_location;
53 use FS::part_pkg_taxrate;
55 use FS::cust_main_invoice;
56 use FS::cust_credit_bill;
57 use FS::cust_bill_pay;
58 use FS::prepay_credit;
62 use FS::part_event_condition;
65 use FS::payment_gateway;
66 use FS::agent_payment_gateway;
68 use FS::payinfo_Mixin;
71 @ISA = qw( FS::payinfo_Mixin FS::Record );
73 @EXPORT_OK = qw( smart_search );
75 $realtime_bop_decline_quiet = 0;
77 # 1 is mostly method/subroutine entry and options
78 # 2 traces progress of some operations
79 # 3 is even more information including possibly sensitive data
81 $me = '[FS::cust_main]';
84 $ignore_expired_card = 0;
87 @fuzzyfields = ( 'first', 'last', 'company', 'address1' );
89 @encrypted_fields = ('payinfo', 'paycvv');
90 sub nohistory_fields { ('paycvv'); }
92 @paytypes = ('', 'Personal checking', 'Personal savings', 'Business checking', 'Business savings');
94 #ask FS::UID to run this stuff for us later
95 #$FS::UID::callback{'FS::cust_main'} = sub {
96 install_callback FS::UID sub {
98 #yes, need it for stuff below (prolly should be cached)
103 my ( $hashref, $cache ) = @_;
104 if ( exists $hashref->{'pkgnum'} ) {
105 #@{ $self->{'_pkgnum'} } = ();
106 my $subcache = $cache->subcache( 'pkgnum', 'cust_pkg', $hashref->{custnum});
107 $self->{'_pkgnum'} = $subcache;
108 #push @{ $self->{'_pkgnum'} },
109 FS::cust_pkg->new_or_cached($hashref, $subcache) if $hashref->{pkgnum};
115 FS::cust_main - Object methods for cust_main records
121 $record = new FS::cust_main \%hash;
122 $record = new FS::cust_main { 'column' => 'value' };
124 $error = $record->insert;
126 $error = $new_record->replace($old_record);
128 $error = $record->delete;
130 $error = $record->check;
132 @cust_pkg = $record->all_pkgs;
134 @cust_pkg = $record->ncancelled_pkgs;
136 @cust_pkg = $record->suspended_pkgs;
138 $error = $record->bill;
139 $error = $record->bill %options;
140 $error = $record->bill 'time' => $time;
142 $error = $record->collect;
143 $error = $record->collect %options;
144 $error = $record->collect 'invoice_time' => $time,
149 An FS::cust_main object represents a customer. FS::cust_main inherits from
150 FS::Record. The following fields are currently supported:
156 Primary key (assigned automatically for new customers)
160 Agent (see L<FS::agent>)
164 Advertising source (see L<FS::part_referral>)
176 Cocial security number (optional)
192 (optional, see L<FS::cust_main_county>)
196 (see L<FS::cust_main_county>)
202 (see L<FS::cust_main_county>)
238 (optional, see L<FS::cust_main_county>)
242 (see L<FS::cust_main_county>)
248 (see L<FS::cust_main_county>)
264 Payment Type (See L<FS::payinfo_Mixin> for valid payby values)
268 Payment Information (See L<FS::payinfo_Mixin> for data format)
272 Masked payinfo (See L<FS::payinfo_Mixin> for how this works)
276 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
280 Expiration date, mm/yyyy, m/yyyy, mm/yy or m/yy
284 Start date month (maestro/solo cards only)
288 Start date year (maestro/solo cards only)
292 Issue number (maestro/solo cards only)
296 Name on card or billing name
300 IP address from which payment information was received
304 Tax exempt, empty or `Y'
308 Order taker (assigned automatically, see L<FS::UID>)
314 =item referral_custnum
316 Referring customer number
320 Enable individual CDR spooling, empty or `Y'
324 A suggestion to events (see L<FS::part_bill_event">) to delay until this unix timestamp
328 Discourage individual CDR printing, empty or `Y'
338 Creates a new customer. To add the customer to the database, see L<"insert">.
340 Note that this stores the hash reference, not a distinct copy of the hash it
341 points to. You can ask the object for a copy with the I<hash> method.
345 sub table { 'cust_main'; }
347 =item insert [ CUST_PKG_HASHREF [ , INVOICING_LIST_ARYREF ] [ , OPTION => VALUE ... ] ]
349 Adds this customer to the database. If there is an error, returns the error,
350 otherwise returns false.
352 CUST_PKG_HASHREF: If you pass a Tie::RefHash data structure to the insert
353 method containing FS::cust_pkg and FS::svc_I<tablename> objects, all records
354 are inserted atomicly, or the transaction is rolled back. Passing an empty
355 hash reference is equivalent to not supplying this parameter. There should be
356 a better explanation of this, but until then, here's an example:
359 tie %hash, 'Tie::RefHash'; #this part is important
361 $cust_pkg => [ $svc_acct ],
364 $cust_main->insert( \%hash );
366 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
367 be set as the invoicing list (see L<"invoicing_list">). Errors return as
368 expected and rollback the entire transaction; it is not necessary to call
369 check_invoicing_list first. The invoicing_list is set after the records in the
370 CUST_PKG_HASHREF above are inserted, so it is now possible to set an
371 invoicing_list destination to the newly-created svc_acct. Here's an example:
373 $cust_main->insert( {}, [ $email, 'POST' ] );
375 Currently available options are: I<depend_jobnum>, I<noexport> and I<tax_exemption>.
377 If I<depend_jobnum> is set, all provisioning jobs will have a dependancy
378 on the supplied jobnum (they will not run until the specific job completes).
379 This can be used to defer provisioning until some action completes (such
380 as running the customer's credit card successfully).
382 The I<noexport> option is deprecated. If I<noexport> is set true, no
383 provisioning jobs (exports) are scheduled. (You can schedule them later with
384 the B<reexport> method.)
386 The I<tax_exemption> option can be set to an arrayref of tax names.
387 FS::cust_main_exemption records will be created and inserted.
393 my $cust_pkgs = @_ ? shift : {};
394 my $invoicing_list = @_ ? shift : '';
396 warn "$me insert called with options ".
397 join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
400 local $SIG{HUP} = 'IGNORE';
401 local $SIG{INT} = 'IGNORE';
402 local $SIG{QUIT} = 'IGNORE';
403 local $SIG{TERM} = 'IGNORE';
404 local $SIG{TSTP} = 'IGNORE';
405 local $SIG{PIPE} = 'IGNORE';
407 my $oldAutoCommit = $FS::UID::AutoCommit;
408 local $FS::UID::AutoCommit = 0;
411 my $prepay_identifier = '';
412 my( $amount, $seconds, $upbytes, $downbytes, $totalbytes ) = (0, 0, 0, 0, 0);
414 if ( $self->payby eq 'PREPAY' ) {
416 $self->payby('BILL');
417 $prepay_identifier = $self->payinfo;
420 warn " looking up prepaid card $prepay_identifier\n"
423 my $error = $self->get_prepay( $prepay_identifier,
424 'amount_ref' => \$amount,
425 'seconds_ref' => \$seconds,
426 'upbytes_ref' => \$upbytes,
427 'downbytes_ref' => \$downbytes,
428 'totalbytes_ref' => \$totalbytes,
431 $dbh->rollback if $oldAutoCommit;
432 #return "error applying prepaid card (transaction rolled back): $error";
436 $payby = 'PREP' if $amount;
438 } elsif ( $self->payby =~ /^(CASH|WEST|MCRD)$/ ) {
441 $self->payby('BILL');
442 $amount = $self->paid;
446 warn " inserting $self\n"
449 $self->signupdate(time) unless $self->signupdate;
451 $self->auto_agent_custid()
452 if $conf->config('cust_main-auto_agent_custid') && ! $self->agent_custid;
454 my $error = $self->SUPER::insert;
456 $dbh->rollback if $oldAutoCommit;
457 #return "inserting cust_main record (transaction rolled back): $error";
461 warn " setting invoicing list\n"
464 if ( $invoicing_list ) {
465 $error = $self->check_invoicing_list( $invoicing_list );
467 $dbh->rollback if $oldAutoCommit;
468 #return "checking invoicing_list (transaction rolled back): $error";
471 $self->invoicing_list( $invoicing_list );
474 warn " setting cust_main_exemption\n"
477 my $tax_exemption = delete $options{'tax_exemption'};
478 if ( $tax_exemption ) {
479 foreach my $taxname ( @$tax_exemption ) {
480 my $cust_main_exemption = new FS::cust_main_exemption {
481 'custnum' => $self->custnum,
482 'taxname' => $taxname,
484 my $error = $cust_main_exemption->insert;
486 $dbh->rollback if $oldAutoCommit;
487 return "inserting cust_main_exemption (transaction rolled back): $error";
492 if ( $conf->config('cust_main-skeleton_tables')
493 && $conf->config('cust_main-skeleton_custnum') ) {
495 warn " inserting skeleton records\n"
498 my $error = $self->start_copy_skel;
500 $dbh->rollback if $oldAutoCommit;
506 warn " ordering packages\n"
509 $error = $self->order_pkgs( $cust_pkgs,
511 'seconds_ref' => \$seconds,
512 'upbytes_ref' => \$upbytes,
513 'downbytes_ref' => \$downbytes,
514 'totalbytes_ref' => \$totalbytes,
517 $dbh->rollback if $oldAutoCommit;
522 $dbh->rollback if $oldAutoCommit;
523 return "No svc_acct record to apply pre-paid time";
525 if ( $upbytes || $downbytes || $totalbytes ) {
526 $dbh->rollback if $oldAutoCommit;
527 return "No svc_acct record to apply pre-paid data";
531 warn " inserting initial $payby payment of $amount\n"
533 $error = $self->insert_cust_pay($payby, $amount, $prepay_identifier);
535 $dbh->rollback if $oldAutoCommit;
536 return "inserting payment (transaction rolled back): $error";
540 unless ( $import || $skip_fuzzyfiles ) {
541 warn " queueing fuzzyfiles update\n"
543 $error = $self->queue_fuzzyfiles_update;
545 $dbh->rollback if $oldAutoCommit;
546 return "updating fuzzy search cache: $error";
550 warn " insert complete; committing transaction\n"
553 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
558 use File::CounterFile;
559 sub auto_agent_custid {
562 my $format = $conf->config('cust_main-auto_agent_custid');
564 if ( $format eq '1YMMXXXXXXXX' ) {
566 my $counter = new File::CounterFile 'cust_main.agent_custid';
569 my $ym = 100000000000 + time2str('%y%m00000000', time);
570 if ( $ym > $counter->value ) {
571 $counter->{'value'} = $agent_custid = $ym;
572 $counter->{'updated'} = 1;
574 $agent_custid = $counter->inc;
580 die "Unknown cust_main-auto_agent_custid format: $format";
583 $self->agent_custid($agent_custid);
587 sub start_copy_skel {
590 #'mg_user_preference' => {},
591 #'mg_user_indicator_profile.user_indicator_profile_id' => { 'mg_profile_indicator.profile_indicator_id' => { 'mg_profile_details.profile_detail_id' }, },
592 #'mg_watchlist_header.watchlist_header_id' => { 'mg_watchlist_details.watchlist_details_id' },
593 #'mg_user_grid_header.grid_header_id' => { 'mg_user_grid_details.user_grid_details_id' },
594 #'mg_portfolio_header.portfolio_header_id' => { 'mg_portfolio_trades.portfolio_trades_id' => { 'mg_portfolio_trades_positions.portfolio_trades_positions_id' } },
595 my @tables = eval(join('\n',$conf->config('cust_main-skeleton_tables')));
598 _copy_skel( 'cust_main', #tablename
599 $conf->config('cust_main-skeleton_custnum'), #sourceid
600 $self->custnum, #destid
601 @tables, #child tables
605 #recursive subroutine, not a method
607 my( $table, $sourceid, $destid, %child_tables ) = @_;
610 if ( $table =~ /^(\w+)\.(\w+)$/ ) {
611 ( $table, $primary_key ) = ( $1, $2 );
613 my $dbdef_table = dbdef->table($table);
614 $primary_key = $dbdef_table->primary_key
615 or return "$table has no primary key".
616 " (or do you need to run dbdef-create?)";
619 warn " _copy_skel: $table.$primary_key $sourceid to $destid for ".
620 join (', ', keys %child_tables). "\n"
623 foreach my $child_table_def ( keys %child_tables ) {
627 if ( $child_table_def =~ /^(\w+)\.(\w+)$/ ) {
628 ( $child_table, $child_pkey ) = ( $1, $2 );
630 $child_table = $child_table_def;
632 $child_pkey = dbdef->table($child_table)->primary_key;
633 # or return "$table has no primary key".
634 # " (or do you need to run dbdef-create?)\n";
638 if ( keys %{ $child_tables{$child_table_def} } ) {
640 return "$child_table has no primary key".
641 " (run dbdef-create or try specifying it?)\n"
644 #false laziness w/Record::insert and only works on Pg
645 #refactor the proper last-inserted-id stuff out of Record::insert if this
646 # ever gets use for anything besides a quick kludge for one customer
647 my $default = dbdef->table($child_table)->column($child_pkey)->default;
648 $default =~ /^nextval\(\(?'"?([\w\.]+)"?'/i
649 or return "can't parse $child_table.$child_pkey default value ".
650 " for sequence name: $default";
655 my @sel_columns = grep { $_ ne $primary_key }
656 dbdef->table($child_table)->columns;
657 my $sel_columns = join(', ', @sel_columns );
659 my @ins_columns = grep { $_ ne $child_pkey } @sel_columns;
660 my $ins_columns = ' ( '. join(', ', $primary_key, @ins_columns ). ' ) ';
661 my $placeholders = ' ( ?, '. join(', ', map '?', @ins_columns ). ' ) ';
663 my $sel_st = "SELECT $sel_columns FROM $child_table".
664 " WHERE $primary_key = $sourceid";
667 my $sel_sth = dbh->prepare( $sel_st )
668 or return dbh->errstr;
670 $sel_sth->execute or return $sel_sth->errstr;
672 while ( my $row = $sel_sth->fetchrow_hashref ) {
674 warn " selected row: ".
675 join(', ', map { "$_=".$row->{$_} } keys %$row ). "\n"
679 "INSERT INTO $child_table $ins_columns VALUES $placeholders";
680 my $ins_sth =dbh->prepare($statement)
681 or return dbh->errstr;
682 my @param = ( $destid, map $row->{$_}, @ins_columns );
683 warn " $statement: [ ". join(', ', @param). " ]\n"
685 $ins_sth->execute( @param )
686 or return $ins_sth->errstr;
688 #next unless keys %{ $child_tables{$child_table} };
689 next unless $sequence;
691 #another section of that laziness
692 my $seq_sql = "SELECT currval('$sequence')";
693 my $seq_sth = dbh->prepare($seq_sql) or return dbh->errstr;
694 $seq_sth->execute or return $seq_sth->errstr;
695 my $insertid = $seq_sth->fetchrow_arrayref->[0];
697 # don't drink soap! recurse! recurse! okay!
699 _copy_skel( $child_table_def,
700 $row->{$child_pkey}, #sourceid
702 %{ $child_tables{$child_table_def} },
704 return $error if $error;
714 =item order_pkg HASHREF | OPTION => VALUE ...
716 Orders a single package.
718 Options may be passed as a list of key/value pairs or as a hash reference.
729 Optional FS::cust_location object
733 Optional arryaref of FS::svc_* service objects.
737 If this option is set to a job queue jobnum (see L<FS::queue>), all provisioning
738 jobs will have a dependancy on the supplied job (they will not run until the
739 specific job completes). This can be used to defer provisioning until some
740 action completes (such as running the customer's credit card successfully).
744 Optional subject for a ticket created and attached to this customer
748 Optional queue name for ticket additions
756 my $opt = ref($_[0]) ? shift : { @_ };
758 warn "$me order_pkg called with options ".
759 join(', ', map { "$_: $opt->{$_}" } keys %$opt ). "\n"
762 my $cust_pkg = $opt->{'cust_pkg'};
763 my $svcs = $opt->{'svcs'} || [];
765 my %svc_options = ();
766 $svc_options{'depend_jobnum'} = $opt->{'depend_jobnum'}
767 if exists($opt->{'depend_jobnum'}) && $opt->{'depend_jobnum'};
769 my %insert_params = map { $opt->{$_} ? ( $_ => $opt->{$_} ) : () }
770 qw( ticket_subject ticket_queue );
772 local $SIG{HUP} = 'IGNORE';
773 local $SIG{INT} = 'IGNORE';
774 local $SIG{QUIT} = 'IGNORE';
775 local $SIG{TERM} = 'IGNORE';
776 local $SIG{TSTP} = 'IGNORE';
777 local $SIG{PIPE} = 'IGNORE';
779 my $oldAutoCommit = $FS::UID::AutoCommit;
780 local $FS::UID::AutoCommit = 0;
783 if ( $opt->{'cust_location'} &&
784 ( ! $cust_pkg->locationnum || $cust_pkg->locationnum == -1 ) ) {
785 my $error = $opt->{'cust_location'}->insert;
787 $dbh->rollback if $oldAutoCommit;
788 return "inserting cust_location (transaction rolled back): $error";
790 $cust_pkg->locationnum($opt->{'cust_location'}->locationnum);
793 $cust_pkg->custnum( $self->custnum );
795 my $error = $cust_pkg->insert( %insert_params );
797 $dbh->rollback if $oldAutoCommit;
798 return "inserting cust_pkg (transaction rolled back): $error";
801 foreach my $svc_something ( @{ $opt->{'svcs'} } ) {
802 if ( $svc_something->svcnum ) {
803 my $old_cust_svc = $svc_something->cust_svc;
804 my $new_cust_svc = new FS::cust_svc { $old_cust_svc->hash };
805 $new_cust_svc->pkgnum( $cust_pkg->pkgnum);
806 $error = $new_cust_svc->replace($old_cust_svc);
808 $svc_something->pkgnum( $cust_pkg->pkgnum );
809 if ( $svc_something->isa('FS::svc_acct') ) {
810 foreach ( grep { $opt->{$_.'_ref'} && ${ $opt->{$_.'_ref'} } }
811 qw( seconds upbytes downbytes totalbytes ) ) {
812 $svc_something->$_( $svc_something->$_() + ${ $opt->{$_.'_ref'} } );
813 ${ $opt->{$_.'_ref'} } = 0;
816 $error = $svc_something->insert(%svc_options);
819 $dbh->rollback if $oldAutoCommit;
820 return "inserting svc_ (transaction rolled back): $error";
824 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
829 #deprecated #=item order_pkgs HASHREF [ , SECONDSREF ] [ , OPTION => VALUE ... ]
830 =item order_pkgs HASHREF [ , OPTION => VALUE ... ]
832 Like the insert method on an existing record, this method orders multiple
833 packages and included services atomicaly. Pass a Tie::RefHash data structure
834 to this method containing FS::cust_pkg and FS::svc_I<tablename> objects.
835 There should be a better explanation of this, but until then, here's an
839 tie %hash, 'Tie::RefHash'; #this part is important
841 $cust_pkg => [ $svc_acct ],
844 $cust_main->order_pkgs( \%hash, 'noexport'=>1 );
846 Services can be new, in which case they are inserted, or existing unaudited
847 services, in which case they are linked to the newly-created package.
849 Currently available options are: I<depend_jobnum>, I<noexport>, I<seconds_ref>,
850 I<upbytes_ref>, I<downbytes_ref>, and I<totalbytes_ref>.
852 If I<depend_jobnum> is set, all provisioning jobs will have a dependancy
853 on the supplied jobnum (they will not run until the specific job completes).
854 This can be used to defer provisioning until some action completes (such
855 as running the customer's credit card successfully).
857 The I<noexport> option is deprecated. If I<noexport> is set true, no
858 provisioning jobs (exports) are scheduled. (You can schedule them later with
859 the B<reexport> method for each cust_pkg object. Using the B<reexport> method
860 on the cust_main object is not recommended, as existing services will also be
863 If I<seconds_ref>, I<upbytes_ref>, I<downbytes_ref>, or I<totalbytes_ref> is
864 provided, the scalars (provided by references) will be incremented by the
865 values of the prepaid card.`
871 my $cust_pkgs = shift;
872 my $seconds_ref = ref($_[0]) ? shift : ''; #deprecated
874 $seconds_ref ||= $options{'seconds_ref'};
876 warn "$me order_pkgs called with options ".
877 join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
880 local $SIG{HUP} = 'IGNORE';
881 local $SIG{INT} = 'IGNORE';
882 local $SIG{QUIT} = 'IGNORE';
883 local $SIG{TERM} = 'IGNORE';
884 local $SIG{TSTP} = 'IGNORE';
885 local $SIG{PIPE} = 'IGNORE';
887 my $oldAutoCommit = $FS::UID::AutoCommit;
888 local $FS::UID::AutoCommit = 0;
891 local $FS::svc_Common::noexport_hack = 1 if $options{'noexport'};
893 foreach my $cust_pkg ( keys %$cust_pkgs ) {
895 my $error = $self->order_pkg(
896 'cust_pkg' => $cust_pkg,
897 'svcs' => $cust_pkgs->{$cust_pkg},
898 'seconds_ref' => $seconds_ref,
899 map { $_ => $options{$_} } qw( upbytes_ref downbytes_ref totalbytes_ref
904 $dbh->rollback if $oldAutoCommit;
910 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
914 =item recharge_prepay IDENTIFIER | PREPAY_CREDIT_OBJ [ , AMOUNTREF, SECONDSREF, UPBYTEREF, DOWNBYTEREF ]
916 Recharges this (existing) customer with the specified prepaid card (see
917 L<FS::prepay_credit>), specified either by I<identifier> or as an
918 FS::prepay_credit object. If there is an error, returns the error, otherwise
921 Optionally, five scalar references can be passed as well. They will have their
922 values filled in with the amount, number of seconds, and number of upload,
923 download, and total bytes applied by this prepaid card.
927 #the ref bullshit here should be refactored like get_prepay. MyAccount.pm is
928 #the only place that uses these args
929 sub recharge_prepay {
930 my( $self, $prepay_credit, $amountref, $secondsref,
931 $upbytesref, $downbytesref, $totalbytesref ) = @_;
933 local $SIG{HUP} = 'IGNORE';
934 local $SIG{INT} = 'IGNORE';
935 local $SIG{QUIT} = 'IGNORE';
936 local $SIG{TERM} = 'IGNORE';
937 local $SIG{TSTP} = 'IGNORE';
938 local $SIG{PIPE} = 'IGNORE';
940 my $oldAutoCommit = $FS::UID::AutoCommit;
941 local $FS::UID::AutoCommit = 0;
944 my( $amount, $seconds, $upbytes, $downbytes, $totalbytes) = ( 0, 0, 0, 0, 0 );
946 my $error = $self->get_prepay( $prepay_credit,
947 'amount_ref' => \$amount,
948 'seconds_ref' => \$seconds,
949 'upbytes_ref' => \$upbytes,
950 'downbytes_ref' => \$downbytes,
951 'totalbytes_ref' => \$totalbytes,
953 || $self->increment_seconds($seconds)
954 || $self->increment_upbytes($upbytes)
955 || $self->increment_downbytes($downbytes)
956 || $self->increment_totalbytes($totalbytes)
957 || $self->insert_cust_pay_prepay( $amount,
959 ? $prepay_credit->identifier
964 $dbh->rollback if $oldAutoCommit;
968 if ( defined($amountref) ) { $$amountref = $amount; }
969 if ( defined($secondsref) ) { $$secondsref = $seconds; }
970 if ( defined($upbytesref) ) { $$upbytesref = $upbytes; }
971 if ( defined($downbytesref) ) { $$downbytesref = $downbytes; }
972 if ( defined($totalbytesref) ) { $$totalbytesref = $totalbytes; }
974 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
979 =item get_prepay IDENTIFIER | PREPAY_CREDIT_OBJ [ , OPTION => VALUE ... ]
981 Looks up and deletes a prepaid card (see L<FS::prepay_credit>),
982 specified either by I<identifier> or as an FS::prepay_credit object.
984 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
985 incremented by the values of the prepaid card.
987 If the prepaid card specifies an I<agentnum> (see L<FS::agent>), it is used to
988 check or set this customer's I<agentnum>.
990 If there is an error, returns the error, otherwise returns false.
996 my( $self, $prepay_credit, %opt ) = @_;
998 local $SIG{HUP} = 'IGNORE';
999 local $SIG{INT} = 'IGNORE';
1000 local $SIG{QUIT} = 'IGNORE';
1001 local $SIG{TERM} = 'IGNORE';
1002 local $SIG{TSTP} = 'IGNORE';
1003 local $SIG{PIPE} = 'IGNORE';
1005 my $oldAutoCommit = $FS::UID::AutoCommit;
1006 local $FS::UID::AutoCommit = 0;
1009 unless ( ref($prepay_credit) ) {
1011 my $identifier = $prepay_credit;
1013 $prepay_credit = qsearchs(
1015 { 'identifier' => $prepay_credit },
1020 unless ( $prepay_credit ) {
1021 $dbh->rollback if $oldAutoCommit;
1022 return "Invalid prepaid card: ". $identifier;
1027 if ( $prepay_credit->agentnum ) {
1028 if ( $self->agentnum && $self->agentnum != $prepay_credit->agentnum ) {
1029 $dbh->rollback if $oldAutoCommit;
1030 return "prepaid card not valid for agent ". $self->agentnum;
1032 $self->agentnum($prepay_credit->agentnum);
1035 my $error = $prepay_credit->delete;
1037 $dbh->rollback if $oldAutoCommit;
1038 return "removing prepay_credit (transaction rolled back): $error";
1041 ${ $opt{$_.'_ref'} } += $prepay_credit->$_()
1042 for grep $opt{$_.'_ref'}, qw( amount seconds upbytes downbytes totalbytes );
1044 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1049 =item increment_upbytes SECONDS
1051 Updates this customer's single or primary account (see L<FS::svc_acct>) by
1052 the specified number of upbytes. If there is an error, returns the error,
1053 otherwise returns false.
1057 sub increment_upbytes {
1058 _increment_column( shift, 'upbytes', @_);
1061 =item increment_downbytes SECONDS
1063 Updates this customer's single or primary account (see L<FS::svc_acct>) by
1064 the specified number of downbytes. If there is an error, returns the error,
1065 otherwise returns false.
1069 sub increment_downbytes {
1070 _increment_column( shift, 'downbytes', @_);
1073 =item increment_totalbytes SECONDS
1075 Updates this customer's single or primary account (see L<FS::svc_acct>) by
1076 the specified number of totalbytes. If there is an error, returns the error,
1077 otherwise returns false.
1081 sub increment_totalbytes {
1082 _increment_column( shift, 'totalbytes', @_);
1085 =item increment_seconds SECONDS
1087 Updates this customer's single or primary account (see L<FS::svc_acct>) by
1088 the specified number of seconds. If there is an error, returns the error,
1089 otherwise returns false.
1093 sub increment_seconds {
1094 _increment_column( shift, 'seconds', @_);
1097 =item _increment_column AMOUNT
1099 Updates this customer's single or primary account (see L<FS::svc_acct>) by
1100 the specified number of seconds or bytes. If there is an error, returns
1101 the error, otherwise returns false.
1105 sub _increment_column {
1106 my( $self, $column, $amount ) = @_;
1107 warn "$me increment_column called: $column, $amount\n"
1110 return '' unless $amount;
1112 my @cust_pkg = grep { $_->part_pkg->svcpart('svc_acct') }
1113 $self->ncancelled_pkgs;
1115 if ( ! @cust_pkg ) {
1116 return 'No packages with primary or single services found'.
1117 ' to apply pre-paid time';
1118 } elsif ( scalar(@cust_pkg) > 1 ) {
1119 #maybe have a way to specify the package/account?
1120 return 'Multiple packages found to apply pre-paid time';
1123 my $cust_pkg = $cust_pkg[0];
1124 warn " found package pkgnum ". $cust_pkg->pkgnum. "\n"
1128 $cust_pkg->cust_svc( $cust_pkg->part_pkg->svcpart('svc_acct') );
1130 if ( ! @cust_svc ) {
1131 return 'No account found to apply pre-paid time';
1132 } elsif ( scalar(@cust_svc) > 1 ) {
1133 return 'Multiple accounts found to apply pre-paid time';
1136 my $svc_acct = $cust_svc[0]->svc_x;
1137 warn " found service svcnum ". $svc_acct->pkgnum.
1138 ' ('. $svc_acct->email. ")\n"
1141 $column = "increment_$column";
1142 $svc_acct->$column($amount);
1146 =item insert_cust_pay_prepay AMOUNT [ PAYINFO ]
1148 Inserts a prepayment in the specified amount for this customer. An optional
1149 second argument can specify the prepayment identifier for tracking purposes.
1150 If there is an error, returns the error, otherwise returns false.
1154 sub insert_cust_pay_prepay {
1155 shift->insert_cust_pay('PREP', @_);
1158 =item insert_cust_pay_cash AMOUNT [ PAYINFO ]
1160 Inserts a cash payment in the specified amount for this customer. An optional
1161 second argument can specify the payment identifier for tracking purposes.
1162 If there is an error, returns the error, otherwise returns false.
1166 sub insert_cust_pay_cash {
1167 shift->insert_cust_pay('CASH', @_);
1170 =item insert_cust_pay_west AMOUNT [ PAYINFO ]
1172 Inserts a Western Union payment in the specified amount for this customer. An
1173 optional second argument can specify the prepayment identifier for tracking
1174 purposes. If there is an error, returns the error, otherwise returns false.
1178 sub insert_cust_pay_west {
1179 shift->insert_cust_pay('WEST', @_);
1182 sub insert_cust_pay {
1183 my( $self, $payby, $amount ) = splice(@_, 0, 3);
1184 my $payinfo = scalar(@_) ? shift : '';
1186 my $cust_pay = new FS::cust_pay {
1187 'custnum' => $self->custnum,
1188 'paid' => sprintf('%.2f', $amount),
1189 #'_date' => #date the prepaid card was purchased???
1191 'payinfo' => $payinfo,
1199 This method is deprecated. See the I<depend_jobnum> option to the insert and
1200 order_pkgs methods for a better way to defer provisioning.
1202 Re-schedules all exports by calling the B<reexport> method of all associated
1203 packages (see L<FS::cust_pkg>). If there is an error, returns the error;
1204 otherwise returns false.
1211 carp "WARNING: FS::cust_main::reexport is deprectated; ".
1212 "use the depend_jobnum option to insert or order_pkgs to delay export";
1214 local $SIG{HUP} = 'IGNORE';
1215 local $SIG{INT} = 'IGNORE';
1216 local $SIG{QUIT} = 'IGNORE';
1217 local $SIG{TERM} = 'IGNORE';
1218 local $SIG{TSTP} = 'IGNORE';
1219 local $SIG{PIPE} = 'IGNORE';
1221 my $oldAutoCommit = $FS::UID::AutoCommit;
1222 local $FS::UID::AutoCommit = 0;
1225 foreach my $cust_pkg ( $self->ncancelled_pkgs ) {
1226 my $error = $cust_pkg->reexport;
1228 $dbh->rollback if $oldAutoCommit;
1233 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1238 =item delete NEW_CUSTNUM
1240 This deletes the customer. If there is an error, returns the error, otherwise
1243 This will completely remove all traces of the customer record. This is not
1244 what you want when a customer cancels service; for that, cancel all of the
1245 customer's packages (see L</cancel>).
1247 If the customer has any uncancelled packages, you need to pass a new (valid)
1248 customer number for those packages to be transferred to. Cancelled packages
1249 will be deleted. Did I mention that this is NOT what you want when a customer
1250 cancels service and that you really should be looking see L<FS::cust_pkg/cancel>?
1252 You can't delete a customer with invoices (see L<FS::cust_bill>),
1253 or credits (see L<FS::cust_credit>), payments (see L<FS::cust_pay>) or
1254 refunds (see L<FS::cust_refund>).
1261 local $SIG{HUP} = 'IGNORE';
1262 local $SIG{INT} = 'IGNORE';
1263 local $SIG{QUIT} = 'IGNORE';
1264 local $SIG{TERM} = 'IGNORE';
1265 local $SIG{TSTP} = 'IGNORE';
1266 local $SIG{PIPE} = 'IGNORE';
1268 my $oldAutoCommit = $FS::UID::AutoCommit;
1269 local $FS::UID::AutoCommit = 0;
1272 if ( $self->cust_bill ) {
1273 $dbh->rollback if $oldAutoCommit;
1274 return "Can't delete a customer with invoices";
1276 if ( $self->cust_credit ) {
1277 $dbh->rollback if $oldAutoCommit;
1278 return "Can't delete a customer with credits";
1280 if ( $self->cust_pay ) {
1281 $dbh->rollback if $oldAutoCommit;
1282 return "Can't delete a customer with payments";
1284 if ( $self->cust_refund ) {
1285 $dbh->rollback if $oldAutoCommit;
1286 return "Can't delete a customer with refunds";
1289 my @cust_pkg = $self->ncancelled_pkgs;
1291 my $new_custnum = shift;
1292 unless ( qsearchs( 'cust_main', { 'custnum' => $new_custnum } ) ) {
1293 $dbh->rollback if $oldAutoCommit;
1294 return "Invalid new customer number: $new_custnum";
1296 foreach my $cust_pkg ( @cust_pkg ) {
1297 my %hash = $cust_pkg->hash;
1298 $hash{'custnum'} = $new_custnum;
1299 my $new_cust_pkg = new FS::cust_pkg ( \%hash );
1300 my $error = $new_cust_pkg->replace($cust_pkg,
1301 options => { $cust_pkg->options },
1304 $dbh->rollback if $oldAutoCommit;
1309 my @cancelled_cust_pkg = $self->all_pkgs;
1310 foreach my $cust_pkg ( @cancelled_cust_pkg ) {
1311 my $error = $cust_pkg->delete;
1313 $dbh->rollback if $oldAutoCommit;
1318 foreach my $cust_main_invoice ( #(email invoice destinations, not invoices)
1319 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } )
1321 my $error = $cust_main_invoice->delete;
1323 $dbh->rollback if $oldAutoCommit;
1328 foreach my $cust_main_exemption (
1329 qsearch( 'cust_main_exemption', { 'custnum' => $self->custnum } )
1331 my $error = $cust_main_exemption->delete;
1333 $dbh->rollback if $oldAutoCommit;
1338 my $error = $self->SUPER::delete;
1340 $dbh->rollback if $oldAutoCommit;
1344 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1349 =item replace [ OLD_RECORD ] [ INVOICING_LIST_ARYREF ] [ , OPTION => VALUE ... ] ]
1352 Replaces the OLD_RECORD with this one in the database. If there is an error,
1353 returns the error, otherwise returns false.
1355 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
1356 be set as the invoicing list (see L<"invoicing_list">). Errors return as
1357 expected and rollback the entire transaction; it is not necessary to call
1358 check_invoicing_list first. Here's an example:
1360 $new_cust_main->replace( $old_cust_main, [ $email, 'POST' ] );
1362 Currently available options are: I<tax_exemption>.
1364 The I<tax_exemption> option can be set to an arrayref of tax names.
1365 FS::cust_main_exemption records will be deleted and inserted as appropriate.
1372 my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
1374 : $self->replace_old;
1378 warn "$me replace called\n"
1381 my $curuser = $FS::CurrentUser::CurrentUser;
1382 if ( $self->payby eq 'COMP'
1383 && $self->payby ne $old->payby
1384 && ! $curuser->access_right('Complimentary customer')
1387 return "You are not permitted to create complimentary accounts.";
1390 local($ignore_expired_card) = 1
1391 if $old->payby =~ /^(CARD|DCRD)$/
1392 && $self->payby =~ /^(CARD|DCRD)$/
1393 && ( $old->payinfo eq $self->payinfo || $old->paymask eq $self->paymask );
1395 local $SIG{HUP} = 'IGNORE';
1396 local $SIG{INT} = 'IGNORE';
1397 local $SIG{QUIT} = 'IGNORE';
1398 local $SIG{TERM} = 'IGNORE';
1399 local $SIG{TSTP} = 'IGNORE';
1400 local $SIG{PIPE} = 'IGNORE';
1402 my $oldAutoCommit = $FS::UID::AutoCommit;
1403 local $FS::UID::AutoCommit = 0;
1406 my $error = $self->SUPER::replace($old);
1409 $dbh->rollback if $oldAutoCommit;
1413 if ( @param && ref($param[0]) eq 'ARRAY' ) { # INVOICING_LIST_ARYREF
1414 my $invoicing_list = shift @param;
1415 $error = $self->check_invoicing_list( $invoicing_list );
1417 $dbh->rollback if $oldAutoCommit;
1420 $self->invoicing_list( $invoicing_list );
1423 my %options = @param;
1425 my $tax_exemption = delete $options{'tax_exemption'};
1426 if ( $tax_exemption ) {
1428 my %cust_main_exemption =
1429 map { $_->taxname => $_ }
1430 qsearch('cust_main_exemption', { 'custnum' => $old->custnum } );
1432 foreach my $taxname ( @$tax_exemption ) {
1434 next if delete $cust_main_exemption{$taxname};
1436 my $cust_main_exemption = new FS::cust_main_exemption {
1437 'custnum' => $self->custnum,
1438 'taxname' => $taxname,
1440 my $error = $cust_main_exemption->insert;
1442 $dbh->rollback if $oldAutoCommit;
1443 return "inserting cust_main_exemption (transaction rolled back): $error";
1447 foreach my $cust_main_exemption ( values %cust_main_exemption ) {
1448 my $error = $cust_main_exemption->delete;
1450 $dbh->rollback if $oldAutoCommit;
1451 return "deleting cust_main_exemption (transaction rolled back): $error";
1457 if ( $self->payby =~ /^(CARD|CHEK|LECB)$/ &&
1458 grep { $self->get($_) ne $old->get($_) } qw(payinfo paydate payname) ) {
1459 # card/check/lec info has changed, want to retry realtime_ invoice events
1460 my $error = $self->retry_realtime;
1462 $dbh->rollback if $oldAutoCommit;
1467 unless ( $import || $skip_fuzzyfiles ) {
1468 $error = $self->queue_fuzzyfiles_update;
1470 $dbh->rollback if $oldAutoCommit;
1471 return "updating fuzzy search cache: $error";
1475 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1480 =item queue_fuzzyfiles_update
1482 Used by insert & replace to update the fuzzy search cache
1486 sub queue_fuzzyfiles_update {
1489 local $SIG{HUP} = 'IGNORE';
1490 local $SIG{INT} = 'IGNORE';
1491 local $SIG{QUIT} = 'IGNORE';
1492 local $SIG{TERM} = 'IGNORE';
1493 local $SIG{TSTP} = 'IGNORE';
1494 local $SIG{PIPE} = 'IGNORE';
1496 my $oldAutoCommit = $FS::UID::AutoCommit;
1497 local $FS::UID::AutoCommit = 0;
1500 my $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
1501 my $error = $queue->insert( map $self->getfield($_), @fuzzyfields );
1503 $dbh->rollback if $oldAutoCommit;
1504 return "queueing job (transaction rolled back): $error";
1507 if ( $self->ship_last ) {
1508 $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
1509 $error = $queue->insert( map $self->getfield("ship_$_"), @fuzzyfields );
1511 $dbh->rollback if $oldAutoCommit;
1512 return "queueing job (transaction rolled back): $error";
1516 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1523 Checks all fields to make sure this is a valid customer record. If there is
1524 an error, returns the error, otherwise returns false. Called by the insert
1525 and replace methods.
1532 warn "$me check BEFORE: \n". $self->_dump
1536 $self->ut_numbern('custnum')
1537 || $self->ut_number('agentnum')
1538 || $self->ut_textn('agent_custid')
1539 || $self->ut_number('refnum')
1540 || $self->ut_textn('custbatch')
1541 || $self->ut_name('last')
1542 || $self->ut_name('first')
1543 || $self->ut_snumbern('birthdate')
1544 || $self->ut_snumbern('signupdate')
1545 || $self->ut_textn('company')
1546 || $self->ut_text('address1')
1547 || $self->ut_textn('address2')
1548 || $self->ut_text('city')
1549 || $self->ut_textn('county')
1550 || $self->ut_textn('state')
1551 || $self->ut_country('country')
1552 || $self->ut_anything('comments')
1553 || $self->ut_numbern('referral_custnum')
1554 || $self->ut_textn('stateid')
1555 || $self->ut_textn('stateid_state')
1556 || $self->ut_textn('invoice_terms')
1557 || $self->ut_alphan('geocode')
1558 || $self->ut_floatn('cdr_termination_percentage')
1561 #barf. need message catalogs. i18n. etc.
1562 $error .= "Please select an advertising source."
1563 if $error =~ /^Illegal or empty \(numeric\) refnum: /;
1564 return $error if $error;
1566 return "Unknown agent"
1567 unless qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
1569 return "Unknown refnum"
1570 unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } );
1572 return "Unknown referring custnum: ". $self->referral_custnum
1573 unless ! $self->referral_custnum
1574 || qsearchs( 'cust_main', { 'custnum' => $self->referral_custnum } );
1576 if ( $self->censustract ne '' ) {
1577 $self->censustract =~ /^\s*(\d{9})\.?(\d{2})\s*$/
1578 or return "Illegal census tract: ". $self->censustract;
1580 $self->censustract("$1.$2");
1583 if ( $self->ss eq '' ) {
1588 $ss =~ /^(\d{3})(\d{2})(\d{4})$/
1589 or return "Illegal social security number: ". $self->ss;
1590 $self->ss("$1-$2-$3");
1594 # bad idea to disable, causes billing to fail because of no tax rates later
1595 # unless ( $import ) {
1596 unless ( qsearch('cust_main_county', {
1597 'country' => $self->country,
1600 return "Unknown state/county/country: ".
1601 $self->state. "/". $self->county. "/". $self->country
1602 unless qsearch('cust_main_county',{
1603 'state' => $self->state,
1604 'county' => $self->county,
1605 'country' => $self->country,
1611 $self->ut_phonen('daytime', $self->country)
1612 || $self->ut_phonen('night', $self->country)
1613 || $self->ut_phonen('fax', $self->country)
1614 || $self->ut_zip('zip', $self->country)
1616 return $error if $error;
1618 if ( $conf->exists('cust_main-require_phone')
1619 && ! length($self->daytime) && ! length($self->night)
1622 my $daytime_label = FS::Msgcat::_gettext('daytime') =~ /^(daytime)?$/
1624 : FS::Msgcat::_gettext('daytime');
1625 my $night_label = FS::Msgcat::_gettext('night') =~ /^(night)?$/
1627 : FS::Msgcat::_gettext('night');
1629 return "$daytime_label or $night_label is required"
1633 if ( $self->has_ship_address
1634 && scalar ( grep { $self->getfield($_) ne $self->getfield("ship_$_") }
1635 $self->addr_fields )
1639 $self->ut_name('ship_last')
1640 || $self->ut_name('ship_first')
1641 || $self->ut_textn('ship_company')
1642 || $self->ut_text('ship_address1')
1643 || $self->ut_textn('ship_address2')
1644 || $self->ut_text('ship_city')
1645 || $self->ut_textn('ship_county')
1646 || $self->ut_textn('ship_state')
1647 || $self->ut_country('ship_country')
1649 return $error if $error;
1651 #false laziness with above
1652 unless ( qsearchs('cust_main_county', {
1653 'country' => $self->ship_country,
1656 return "Unknown ship_state/ship_county/ship_country: ".
1657 $self->ship_state. "/". $self->ship_county. "/". $self->ship_country
1658 unless qsearch('cust_main_county',{
1659 'state' => $self->ship_state,
1660 'county' => $self->ship_county,
1661 'country' => $self->ship_country,
1667 $self->ut_phonen('ship_daytime', $self->ship_country)
1668 || $self->ut_phonen('ship_night', $self->ship_country)
1669 || $self->ut_phonen('ship_fax', $self->ship_country)
1670 || $self->ut_zip('ship_zip', $self->ship_country)
1672 return $error if $error;
1674 return "Unit # is required."
1675 if $self->ship_address2 =~ /^\s*$/
1676 && $conf->exists('cust_main-require_address2');
1678 } else { # ship_ info eq billing info, so don't store dup info in database
1680 $self->setfield("ship_$_", '')
1681 foreach $self->addr_fields;
1683 return "Unit # is required."
1684 if $self->address2 =~ /^\s*$/
1685 && $conf->exists('cust_main-require_address2');
1689 #$self->payby =~ /^(CARD|DCRD|CHEK|DCHK|LECB|BILL|COMP|PREPAY|CASH|WEST|MCRD)$/
1690 # or return "Illegal payby: ". $self->payby;
1692 FS::payby->can_payby($self->table, $self->payby)
1693 or return "Illegal payby: ". $self->payby;
1695 $error = $self->ut_numbern('paystart_month')
1696 || $self->ut_numbern('paystart_year')
1697 || $self->ut_numbern('payissue')
1698 || $self->ut_textn('paytype')
1700 return $error if $error;
1702 if ( $self->payip eq '' ) {
1705 $error = $self->ut_ip('payip');
1706 return $error if $error;
1709 # If it is encrypted and the private key is not availaible then we can't
1710 # check the credit card.
1712 my $check_payinfo = 1;
1714 if ($self->is_encrypted($self->payinfo)) {
1718 if ( $check_payinfo && $self->payby =~ /^(CARD|DCRD)$/ ) {
1720 my $payinfo = $self->payinfo;
1721 $payinfo =~ s/\D//g;
1722 $payinfo =~ /^(\d{13,16})$/
1723 or return gettext('invalid_card'); # . ": ". $self->payinfo;
1725 $self->payinfo($payinfo);
1727 or return gettext('invalid_card'); # . ": ". $self->payinfo;
1729 return gettext('unknown_card_type')
1730 if cardtype($self->payinfo) eq "Unknown";
1732 my $ban = qsearchs('banned_pay', $self->_banned_pay_hashref);
1734 return 'Banned credit card: banned on '.
1735 time2str('%a %h %o at %r', $ban->_date).
1736 ' by '. $ban->otaker.
1737 ' (ban# '. $ban->bannum. ')';
1740 if (length($self->paycvv) && !$self->is_encrypted($self->paycvv)) {
1741 if ( cardtype($self->payinfo) eq 'American Express card' ) {
1742 $self->paycvv =~ /^(\d{4})$/
1743 or return "CVV2 (CID) for American Express cards is four digits.";
1746 $self->paycvv =~ /^(\d{3})$/
1747 or return "CVV2 (CVC2/CID) is three digits.";
1754 my $cardtype = cardtype($payinfo);
1755 if ( $cardtype =~ /^(Switch|Solo)$/i ) {
1757 return "Start date or issue number is required for $cardtype cards"
1758 unless $self->paystart_month && $self->paystart_year or $self->payissue;
1760 return "Start month must be between 1 and 12"
1761 if $self->paystart_month
1762 and $self->paystart_month < 1 || $self->paystart_month > 12;
1764 return "Start year must be 1990 or later"
1765 if $self->paystart_year
1766 and $self->paystart_year < 1990;
1768 return "Issue number must be beween 1 and 99"
1770 and $self->payissue < 1 || $self->payissue > 99;
1773 $self->paystart_month('');
1774 $self->paystart_year('');
1775 $self->payissue('');
1778 } elsif ( $check_payinfo && $self->payby =~ /^(CHEK|DCHK)$/ ) {
1780 my $payinfo = $self->payinfo;
1781 $payinfo =~ s/[^\d\@]//g;
1782 if ( $conf->exists('echeck-nonus') ) {
1783 $payinfo =~ /^(\d+)\@(\d+)$/ or return 'invalid echeck account@aba';
1784 $payinfo = "$1\@$2";
1786 $payinfo =~ /^(\d+)\@(\d{9})$/ or return 'invalid echeck account@aba';
1787 $payinfo = "$1\@$2";
1789 $self->payinfo($payinfo);
1792 my $ban = qsearchs('banned_pay', $self->_banned_pay_hashref);
1794 return 'Banned ACH account: banned on '.
1795 time2str('%a %h %o at %r', $ban->_date).
1796 ' by '. $ban->otaker.
1797 ' (ban# '. $ban->bannum. ')';
1800 } elsif ( $self->payby eq 'LECB' ) {
1802 my $payinfo = $self->payinfo;
1803 $payinfo =~ s/\D//g;
1804 $payinfo =~ /^1?(\d{10})$/ or return 'invalid btn billing telephone number';
1806 $self->payinfo($payinfo);
1809 } elsif ( $self->payby eq 'BILL' ) {
1811 $error = $self->ut_textn('payinfo');
1812 return "Illegal P.O. number: ". $self->payinfo if $error;
1815 } elsif ( $self->payby eq 'COMP' ) {
1817 my $curuser = $FS::CurrentUser::CurrentUser;
1818 if ( ! $self->custnum
1819 && ! $curuser->access_right('Complimentary customer')
1822 return "You are not permitted to create complimentary accounts."
1825 $error = $self->ut_textn('payinfo');
1826 return "Illegal comp account issuer: ". $self->payinfo if $error;
1829 } elsif ( $self->payby eq 'PREPAY' ) {
1831 my $payinfo = $self->payinfo;
1832 $payinfo =~ s/\W//g; #anything else would just confuse things
1833 $self->payinfo($payinfo);
1834 $error = $self->ut_alpha('payinfo');
1835 return "Illegal prepayment identifier: ". $self->payinfo if $error;
1836 return "Unknown prepayment identifier"
1837 unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } );
1842 if ( $self->paydate eq '' || $self->paydate eq '-' ) {
1843 return "Expiration date required"
1844 unless $self->payby =~ /^(BILL|PREPAY|CHEK|DCHK|LECB|CASH|WEST|MCRD)$/;
1848 if ( $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/ ) {
1849 ( $m, $y ) = ( $1, length($2) == 4 ? $2 : "20$2" );
1850 } elsif ( $self->paydate =~ /^19(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) {
1851 ( $m, $y ) = ( $2, "19$1" );
1852 } elsif ( $self->paydate =~ /^(20)?(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) {
1853 ( $m, $y ) = ( $3, "20$2" );
1855 return "Illegal expiration date: ". $self->paydate;
1857 $self->paydate("$y-$m-01");
1858 my($nowm,$nowy)=(localtime(time))[4,5]; $nowm++; $nowy+=1900;
1859 return gettext('expired_card')
1861 && !$ignore_expired_card
1862 && ( $y<$nowy || ( $y==$nowy && $1<$nowm ) );
1865 if ( $self->payname eq '' && $self->payby !~ /^(CHEK|DCHK)$/ &&
1866 ( ! $conf->exists('require_cardname')
1867 || $self->payby !~ /^(CARD|DCRD)$/ )
1869 $self->payname( $self->first. " ". $self->getfield('last') );
1871 $self->payname =~ /^([\w \,\.\-\'\&]+)$/
1872 or return gettext('illegal_name'). " payname: ". $self->payname;
1876 foreach my $flag (qw( tax spool_cdr squelch_cdr archived email_csv_cdr )) {
1877 $self->$flag() =~ /^(Y?)$/ or return "Illegal $flag: ". $self->$flag();
1881 $self->otaker(getotaker) unless $self->otaker;
1883 warn "$me check AFTER: \n". $self->_dump
1886 $self->SUPER::check;
1891 Returns a list of fields which have ship_ duplicates.
1896 qw( last first company
1897 address1 address2 city county state zip country
1902 =item has_ship_address
1904 Returns true if this customer record has a separate shipping address.
1908 sub has_ship_address {
1910 scalar( grep { $self->getfield("ship_$_") ne '' } $self->addr_fields );
1913 =item all_pkgs [ EXTRA_QSEARCH_PARAMS_HASHREF ]
1915 Returns all packages (see L<FS::cust_pkg>) for this customer.
1921 my $extra_qsearch = ref($_[0]) ? shift : {};
1923 return $self->num_pkgs unless wantarray || keys(%$extra_qsearch);
1926 if ( $self->{'_pkgnum'} ) {
1927 @cust_pkg = values %{ $self->{'_pkgnum'}->cache };
1929 @cust_pkg = $self->_cust_pkg($extra_qsearch);
1932 sort sort_packages @cust_pkg;
1937 Synonym for B<all_pkgs>.
1942 shift->all_pkgs(@_);
1947 Returns all locations (see L<FS::cust_location>) for this customer.
1953 qsearch('cust_location', { 'custnum' => $self->custnum } );
1956 =item ncancelled_pkgs [ EXTRA_QSEARCH_PARAMS_HASHREF ]
1958 Returns all non-cancelled packages (see L<FS::cust_pkg>) for this customer.
1962 sub ncancelled_pkgs {
1964 my $extra_qsearch = ref($_[0]) ? shift : {};
1966 return $self->num_ncancelled_pkgs unless wantarray;
1969 if ( $self->{'_pkgnum'} ) {
1971 warn "$me ncancelled_pkgs: returning cached objects"
1974 @cust_pkg = grep { ! $_->getfield('cancel') }
1975 values %{ $self->{'_pkgnum'}->cache };
1979 warn "$me ncancelled_pkgs: searching for packages with custnum ".
1980 $self->custnum. "\n"
1983 $extra_qsearch->{'extra_sql'} .= ' AND ( cancel IS NULL OR cancel = 0 ) ';
1985 @cust_pkg = $self->_cust_pkg($extra_qsearch);
1989 sort sort_packages @cust_pkg;
1995 my $extra_qsearch = ref($_[0]) ? shift : {};
1997 $extra_qsearch->{'select'} ||= '*';
1998 $extra_qsearch->{'select'} .=
1999 ',( SELECT COUNT(*) FROM cust_svc WHERE cust_pkg.pkgnum = cust_svc.pkgnum )
2003 $_->{'_num_cust_svc'} = $_->get('_num_cust_svc');
2008 'table' => 'cust_pkg',
2009 'hashref' => { 'custnum' => $self->custnum },
2014 # This should be generalized to use config options to determine order.
2017 if ( $a->get('cancel') xor $b->get('cancel') ) {
2018 return -1 if $b->get('cancel');
2019 return 1 if $a->get('cancel');
2020 #shouldn't get here...
2023 my $a_num_cust_svc = $a->num_cust_svc;
2024 my $b_num_cust_svc = $b->num_cust_svc;
2025 return 0 if !$a_num_cust_svc && !$b_num_cust_svc;
2026 return -1 if $a_num_cust_svc && !$b_num_cust_svc;
2027 return 1 if !$a_num_cust_svc && $b_num_cust_svc;
2028 my @a_cust_svc = $a->cust_svc;
2029 my @b_cust_svc = $b->cust_svc;
2030 $a_cust_svc[0]->svc_x->label cmp $b_cust_svc[0]->svc_x->label;
2035 =item suspended_pkgs
2037 Returns all suspended packages (see L<FS::cust_pkg>) for this customer.
2041 sub suspended_pkgs {
2043 grep { $_->susp } $self->ncancelled_pkgs;
2046 =item unflagged_suspended_pkgs
2048 Returns all unflagged suspended packages (see L<FS::cust_pkg>) for this
2049 customer (thouse packages without the `manual_flag' set).
2053 sub unflagged_suspended_pkgs {
2055 return $self->suspended_pkgs
2056 unless dbdef->table('cust_pkg')->column('manual_flag');
2057 grep { ! $_->manual_flag } $self->suspended_pkgs;
2060 =item unsuspended_pkgs
2062 Returns all unsuspended (and uncancelled) packages (see L<FS::cust_pkg>) for
2067 sub unsuspended_pkgs {
2069 grep { ! $_->susp } $self->ncancelled_pkgs;
2072 =item next_bill_date
2074 Returns the next date this customer will be billed, as a UNIX timestamp, or
2075 undef if no active package has a next bill date.
2079 sub next_bill_date {
2081 min( map $_->get('bill'), grep $_->get('bill'), $self->unsuspended_pkgs );
2084 =item num_cancelled_pkgs
2086 Returns the number of cancelled packages (see L<FS::cust_pkg>) for this
2091 sub num_cancelled_pkgs {
2092 shift->num_pkgs("cust_pkg.cancel IS NOT NULL AND cust_pkg.cancel != 0");
2095 sub num_ncancelled_pkgs {
2096 shift->num_pkgs("( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )");
2100 my( $self ) = shift;
2101 my $sql = scalar(@_) ? shift : '';
2102 $sql = "AND $sql" if $sql && $sql !~ /^\s*$/ && $sql !~ /^\s*AND/i;
2103 my $sth = dbh->prepare(
2104 "SELECT COUNT(*) FROM cust_pkg WHERE custnum = ? $sql"
2105 ) or die dbh->errstr;
2106 $sth->execute($self->custnum) or die $sth->errstr;
2107 $sth->fetchrow_arrayref->[0];
2112 Unsuspends all unflagged suspended packages (see L</unflagged_suspended_pkgs>
2113 and L<FS::cust_pkg>) for this customer. Always returns a list: an empty list
2114 on success or a list of errors.
2120 grep { $_->unsuspend } $self->suspended_pkgs;
2125 Suspends all unsuspended packages (see L<FS::cust_pkg>) for this customer.
2127 Returns a list: an empty list on success or a list of errors.
2133 grep { $_->suspend(@_) } $self->unsuspended_pkgs;
2136 =item suspend_if_pkgpart HASHREF | PKGPART [ , PKGPART ... ]
2138 Suspends all unsuspended packages (see L<FS::cust_pkg>) matching the listed
2139 PKGPARTs (see L<FS::part_pkg>). Preferred usage is to pass a hashref instead
2140 of a list of pkgparts; the hashref has the following keys:
2144 =item pkgparts - listref of pkgparts
2146 =item (other options are passed to the suspend method)
2151 Returns a list: an empty list on success or a list of errors.
2155 sub suspend_if_pkgpart {
2157 my (@pkgparts, %opt);
2158 if (ref($_[0]) eq 'HASH'){
2159 @pkgparts = @{$_[0]{pkgparts}};
2164 grep { $_->suspend(%opt) }
2165 grep { my $pkgpart = $_->pkgpart; grep { $pkgpart eq $_ } @pkgparts }
2166 $self->unsuspended_pkgs;
2169 =item suspend_unless_pkgpart HASHREF | PKGPART [ , PKGPART ... ]
2171 Suspends all unsuspended packages (see L<FS::cust_pkg>) unless they match the
2172 given PKGPARTs (see L<FS::part_pkg>). Preferred usage is to pass a hashref
2173 instead of a list of pkgparts; the hashref has the following keys:
2177 =item pkgparts - listref of pkgparts
2179 =item (other options are passed to the suspend method)
2183 Returns a list: an empty list on success or a list of errors.
2187 sub suspend_unless_pkgpart {
2189 my (@pkgparts, %opt);
2190 if (ref($_[0]) eq 'HASH'){
2191 @pkgparts = @{$_[0]{pkgparts}};
2196 grep { $_->suspend(%opt) }
2197 grep { my $pkgpart = $_->pkgpart; ! grep { $pkgpart eq $_ } @pkgparts }
2198 $self->unsuspended_pkgs;
2201 =item cancel [ OPTION => VALUE ... ]
2203 Cancels all uncancelled packages (see L<FS::cust_pkg>) for this customer.
2205 Available options are:
2209 =item quiet - can be set true to supress email cancellation notices.
2211 =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.
2213 =item ban - can be set true to ban this customer's credit card or ACH information, if present.
2215 =item nobill - can be set true to skip billing if it might otherwise be done.
2219 Always returns a list: an empty list on success or a list of errors.
2223 # nb that dates are not specified as valid options to this method
2226 my( $self, %opt ) = @_;
2228 warn "$me cancel called on customer ". $self->custnum. " with options ".
2229 join(', ', map { "$_: $opt{$_}" } keys %opt ). "\n"
2232 return ( 'access denied' )
2233 unless $FS::CurrentUser::CurrentUser->access_right('Cancel customer');
2235 if ( $opt{'ban'} && $self->payby =~ /^(CARD|DCRD|CHEK|DCHK)$/ ) {
2237 #should try decryption (we might have the private key)
2238 # and if not maybe queue a job for the server that does?
2239 return ( "Can't (yet) ban encrypted credit cards" )
2240 if $self->is_encrypted($self->payinfo);
2242 my $ban = new FS::banned_pay $self->_banned_pay_hashref;
2243 my $error = $ban->insert;
2244 return ( $error ) if $error;
2248 my @pkgs = $self->ncancelled_pkgs;
2250 if ( !$opt{nobill} && $conf->exists('bill_usage_on_cancel') ) {
2252 my $error = $self->bill( pkg_list => [ @pkgs ], cancel => 1 );
2253 warn "Error billing during cancel, custnum ". $self->custnum. ": $error"
2257 warn "$me cancelling ". scalar($self->ncancelled_pkgs). "/".
2258 scalar(@pkgs). " packages for customer ". $self->custnum. "\n"
2261 grep { $_ } map { $_->cancel(%opt) } $self->ncancelled_pkgs;
2264 sub _banned_pay_hashref {
2275 'payby' => $payby2ban{$self->payby},
2276 'payinfo' => md5_base64($self->payinfo),
2277 #don't ever *search* on reason! #'reason' =>
2283 Returns all notes (see L<FS::cust_main_note>) for this customer.
2290 qsearch( 'cust_main_note',
2291 { 'custnum' => $self->custnum },
2293 'ORDER BY _DATE DESC'
2299 Returns the agent (see L<FS::agent>) for this customer.
2305 qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
2308 =item bill_and_collect
2310 Cancels and suspends any packages due, generates bills, applies payments and
2313 Warns on errors (Does not currently: If there is an error, returns the error, otherwise returns false.)
2315 Options are passed as name-value pairs. Currently available options are:
2321 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:
2325 $cust_main->bill( 'time' => str2time('April 20th, 2001') );
2329 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.
2333 "1d" for the traditional, daily events (the default), or "1m" for the new monthly events (part_event.check_freq)
2337 If set true, re-charges setup fees.
2341 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)
2345 Options are passed to the B<bill> and B<collect> methods verbatim, so all
2346 options of those methods are also available.
2350 sub bill_and_collect {
2351 my( $self, %options ) = @_;
2353 #$options{actual_time} not $options{time} because freeside-daily -d is for
2354 #pre-printing invoices
2355 $self->cancel_expired_pkgs( $options{actual_time} );
2356 $self->suspend_adjourned_pkgs( $options{actual_time} );
2358 my $error = $self->bill( %options );
2359 warn "Error billing, custnum ". $self->custnum. ": $error" if $error;
2361 $self->apply_payments_and_credits;
2363 unless ( $conf->exists('cancelled_cust-noevents')
2364 && ! $self->num_ncancelled_pkgs
2367 $error = $self->collect( %options );
2368 warn "Error collecting, custnum". $self->custnum. ": $error" if $error;
2374 sub cancel_expired_pkgs {
2375 my ( $self, $time ) = @_;
2377 my @cancel_pkgs = $self->ncancelled_pkgs( {
2378 'extra_sql' => " AND expire IS NOT NULL AND expire > 0 AND expire <= $time "
2381 foreach my $cust_pkg ( @cancel_pkgs ) {
2382 my $cpr = $cust_pkg->last_cust_pkg_reason('expire');
2383 my $error = $cust_pkg->cancel($cpr ? ( 'reason' => $cpr->reasonnum,
2384 'reason_otaker' => $cpr->otaker
2388 warn "Error cancelling expired pkg ". $cust_pkg->pkgnum.
2389 " for custnum ". $self->custnum. ": $error"
2395 sub suspend_adjourned_pkgs {
2396 my ( $self, $time ) = @_;
2398 my @susp_pkgs = $self->ncancelled_pkgs( {
2400 " AND ( susp IS NULL OR susp = 0 )
2401 AND ( ( bill IS NOT NULL AND bill != 0 AND bill < $time )
2402 OR ( adjourn IS NOT NULL AND adjourn != 0 AND adjourn <= $time )
2407 #only because there's no SQL test for is_prepaid :/
2409 grep { ( $_->part_pkg->is_prepaid
2414 && $_->adjourn <= $time
2420 foreach my $cust_pkg ( @susp_pkgs ) {
2421 my $cpr = $cust_pkg->last_cust_pkg_reason('adjourn')
2422 if ($cust_pkg->adjourn && $cust_pkg->adjourn < $^T);
2423 my $error = $cust_pkg->suspend($cpr ? ( 'reason' => $cpr->reasonnum,
2424 'reason_otaker' => $cpr->otaker
2429 warn "Error suspending package ". $cust_pkg->pkgnum.
2430 " for custnum ". $self->custnum. ": $error"
2438 Generates invoices (see L<FS::cust_bill>) for this customer. Usually used in
2439 conjunction with the collect method by calling B<bill_and_collect>.
2441 If there is an error, returns the error, otherwise returns false.
2443 Options are passed as name-value pairs. Currently available options are:
2449 If set true, re-charges setup fees.
2453 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:
2457 $cust_main->bill( 'time' => str2time('April 20th, 2001') );
2461 An array ref of specific packages (objects) to attempt billing, instead trying all of them.
2463 $cust_main->bill( pkg_list => [$pkg1, $pkg2] );
2467 A hashref of pkgparts to exclude from this billing run (can also be specified as a comma-separated scalar).
2471 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.
2475 This boolean value informs the us that the package is being cancelled. This
2476 typically might mean not charging the normal recurring fee but only usage
2477 fees since the last billing. Setup charges may be charged. Not all package
2478 plans support this feature (they tend to charge 0).
2482 Optional terms to be printed on this invoice. Otherwise, customer-specific
2483 terms or the default terms are used.
2490 my( $self, %options ) = @_;
2491 return '' if $self->payby eq 'COMP';
2492 warn "$me bill customer ". $self->custnum. "\n"
2495 my $time = $options{'time'} || time;
2496 my $invoice_time = $options{'invoice_time'} || $time;
2498 $options{'not_pkgpart'} ||= {};
2499 $options{'not_pkgpart'} = { map { $_ => 1 }
2500 split(/\s*,\s*/, $options{'not_pkgpart'})
2502 unless ref($options{'not_pkgpart'});
2504 local $SIG{HUP} = 'IGNORE';
2505 local $SIG{INT} = 'IGNORE';
2506 local $SIG{QUIT} = 'IGNORE';
2507 local $SIG{TERM} = 'IGNORE';
2508 local $SIG{TSTP} = 'IGNORE';
2509 local $SIG{PIPE} = 'IGNORE';
2511 my $oldAutoCommit = $FS::UID::AutoCommit;
2512 local $FS::UID::AutoCommit = 0;
2515 $self->select_for_update; #mutex
2517 my $error = $self->do_cust_event(
2518 'debug' => ( $options{'debug'} || 0 ),
2519 'time' => $invoice_time,
2520 'check_freq' => $options{'check_freq'},
2521 'stage' => 'pre-bill',
2524 $dbh->rollback if $oldAutoCommit;
2528 my @cust_bill_pkg = ();
2531 # find the packages which are due for billing, find out how much they are
2532 # & generate invoice database.
2535 my( $total_setup, $total_recur, $postal_charge ) = ( 0, 0, 0 );
2537 my @precommit_hooks = ();
2539 $options{'pkg_list'} ||= [ $self->ncancelled_pkgs ]; #param checks?
2540 foreach my $cust_pkg ( @{ $options{'pkg_list'} } ) {
2542 next if $options{'not_pkgpart'}->{$cust_pkg->pkgpart};
2544 warn " bill package ". $cust_pkg->pkgnum. "\n" if $DEBUG > 1;
2546 #? to avoid use of uninitialized value errors... ?
2547 $cust_pkg->setfield('bill', '')
2548 unless defined($cust_pkg->bill);
2550 #my $part_pkg = $cust_pkg->part_pkg;
2552 my $real_pkgpart = $cust_pkg->pkgpart;
2553 my %hash = $cust_pkg->hash;
2555 foreach my $part_pkg ( $cust_pkg->part_pkg->self_and_bill_linked ) {
2557 $cust_pkg->set($_, $hash{$_}) foreach qw ( setup last_bill bill );
2560 $self->_make_lines( 'part_pkg' => $part_pkg,
2561 'cust_pkg' => $cust_pkg,
2562 'precommit_hooks' => \@precommit_hooks,
2563 'line_items' => \@cust_bill_pkg,
2564 'setup' => \$total_setup,
2565 'recur' => \$total_recur,
2566 'tax_matrix' => \%taxlisthash,
2568 'real_pkgpart' => $real_pkgpart,
2569 'options' => \%options,
2572 $dbh->rollback if $oldAutoCommit;
2576 } #foreach my $part_pkg
2578 } #foreach my $cust_pkg
2580 unless ( @cust_bill_pkg ) { #don't create an invoice w/o line items
2581 #but do commit any package date cycling that happened
2582 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2586 if ( scalar( grep { $_->recur && $_->recur > 0 } @cust_bill_pkg) ||
2587 !$conf->exists('postal_invoice-recurring_only')
2591 my $postal_pkg = $self->charge_postal_fee();
2592 if ( $postal_pkg && !ref( $postal_pkg ) ) {
2594 $dbh->rollback if $oldAutoCommit;
2595 return "can't charge postal invoice fee for customer ".
2596 $self->custnum. ": $postal_pkg";
2598 } elsif ( $postal_pkg ) {
2600 my $real_pkgpart = $postal_pkg->pkgpart;
2601 foreach my $part_pkg ( $postal_pkg->part_pkg->self_and_bill_linked ) {
2602 my %postal_options = %options;
2603 delete $postal_options{cancel};
2605 $self->_make_lines( 'part_pkg' => $part_pkg,
2606 'cust_pkg' => $postal_pkg,
2607 'precommit_hooks' => \@precommit_hooks,
2608 'line_items' => \@cust_bill_pkg,
2609 'setup' => \$total_setup,
2610 'recur' => \$total_recur,
2611 'tax_matrix' => \%taxlisthash,
2613 'real_pkgpart' => $real_pkgpart,
2614 'options' => \%postal_options,
2617 $dbh->rollback if $oldAutoCommit;
2626 warn "having a look at the taxes we found...\n" if $DEBUG > 2;
2628 # keys are tax names (as printed on invoices / itemdesc )
2629 # values are listrefs of taxlisthash keys (internal identifiers)
2632 # keys are taxlisthash keys (internal identifiers)
2633 # values are (cumulative) amounts
2636 # keys are taxlisthash keys (internal identifiers)
2637 # values are listrefs of cust_bill_pkg_tax_location hashrefs
2638 my %tax_location = ();
2640 # keys are taxlisthash keys (internal identifiers)
2641 # values are listrefs of cust_bill_pkg_tax_rate_location hashrefs
2642 my %tax_rate_location = ();
2644 foreach my $tax ( keys %taxlisthash ) {
2645 my $tax_object = shift @{ $taxlisthash{$tax} };
2646 warn "found ". $tax_object->taxname. " as $tax\n" if $DEBUG > 2;
2647 warn " ". join('/', @{ $taxlisthash{$tax} } ). "\n" if $DEBUG > 2;
2648 my $hashref_or_error =
2649 $tax_object->taxline( $taxlisthash{$tax},
2650 'custnum' => $self->custnum,
2651 'invoice_time' => $invoice_time
2653 unless ( ref($hashref_or_error) ) {
2654 $dbh->rollback if $oldAutoCommit;
2655 return $hashref_or_error;
2657 unshift @{ $taxlisthash{$tax} }, $tax_object;
2659 my $name = $hashref_or_error->{'name'};
2660 my $amount = $hashref_or_error->{'amount'};
2662 #warn "adding $amount as $name\n";
2663 $taxname{ $name } ||= [];
2664 push @{ $taxname{ $name } }, $tax;
2666 $tax{ $tax } += $amount;
2668 $tax_location{ $tax } ||= [];
2669 if ( $tax_object->get('pkgnum') || $tax_object->get('locationnum') ) {
2670 push @{ $tax_location{ $tax } },
2672 'taxnum' => $tax_object->taxnum,
2673 'taxtype' => ref($tax_object),
2674 'pkgnum' => $tax_object->get('pkgnum'),
2675 'locationnum' => $tax_object->get('locationnum'),
2676 'amount' => sprintf('%.2f', $amount ),
2680 $tax_rate_location{ $tax } ||= [];
2681 if ( ref($tax_object) eq 'FS::tax_rate' ) {
2682 my $taxratelocationnum =
2683 $tax_object->tax_rate_location->taxratelocationnum;
2684 push @{ $tax_rate_location{ $tax } },
2686 'taxnum' => $tax_object->taxnum,
2687 'taxtype' => ref($tax_object),
2688 'amount' => sprintf('%.2f', $amount ),
2689 'locationtaxid' => $tax_object->location,
2690 'taxratelocationnum' => $taxratelocationnum,
2696 #move the cust_tax_exempt_pkg records to the cust_bill_pkgs we will commit
2697 my %packagemap = map { $_->pkgnum => $_ } @cust_bill_pkg;
2698 foreach my $tax ( keys %taxlisthash ) {
2699 foreach ( @{ $taxlisthash{$tax} }[1 ... scalar(@{ $taxlisthash{$tax} })] ) {
2700 next unless ref($_) eq 'FS::cust_bill_pkg';
2702 push @{ $packagemap{$_->pkgnum}->_cust_tax_exempt_pkg },
2703 splice( @{ $_->_cust_tax_exempt_pkg } );
2707 #consolidate and create tax line items
2708 warn "consolidating and generating...\n" if $DEBUG > 2;
2709 foreach my $taxname ( keys %taxname ) {
2712 my @cust_bill_pkg_tax_location = ();
2713 my @cust_bill_pkg_tax_rate_location = ();
2714 warn "adding $taxname\n" if $DEBUG > 1;
2715 foreach my $taxitem ( @{ $taxname{$taxname} } ) {
2716 next if $seen{$taxitem}++;
2717 warn "adding $tax{$taxitem}\n" if $DEBUG > 1;
2718 $tax += $tax{$taxitem};
2719 push @cust_bill_pkg_tax_location,
2720 map { new FS::cust_bill_pkg_tax_location $_ }
2721 @{ $tax_location{ $taxitem } };
2722 push @cust_bill_pkg_tax_rate_location,
2723 map { new FS::cust_bill_pkg_tax_rate_location $_ }
2724 @{ $tax_rate_location{ $taxitem } };
2728 $tax = sprintf('%.2f', $tax );
2729 $total_setup = sprintf('%.2f', $total_setup+$tax );
2731 my $pkg_category = qsearchs( 'pkg_category', { 'categoryname' => $taxname,
2737 if ( $pkg_category and
2738 $conf->config('invoice_latexsummary') ||
2739 $conf->config('invoice_htmlsummary')
2743 my %hash = ( 'section' => $pkg_category->categoryname );
2744 push @display, new FS::cust_bill_pkg_display { type => 'S', %hash };
2748 push @cust_bill_pkg, new FS::cust_bill_pkg {
2754 'itemdesc' => $taxname,
2755 'display' => \@display,
2756 'cust_bill_pkg_tax_location' => \@cust_bill_pkg_tax_location,
2757 'cust_bill_pkg_tax_rate_location' => \@cust_bill_pkg_tax_rate_location,
2762 #add tax adjustments
2763 warn "adding tax adjustments...\n" if $DEBUG > 2;
2764 foreach my $cust_tax_adjustment (
2765 qsearch('cust_tax_adjustment', { 'custnum' => $self->custnum,
2771 my $tax = sprintf('%.2f', $cust_tax_adjustment->amount );
2772 $total_setup = sprintf('%.2f', $total_setup+$tax );
2774 my $itemdesc = $cust_tax_adjustment->taxname;
2775 $itemdesc = '' if $itemdesc eq 'Tax';
2777 push @cust_bill_pkg, new FS::cust_bill_pkg {
2783 'itemdesc' => $itemdesc,
2784 'itemcomment' => $cust_tax_adjustment->comment,
2785 'cust_tax_adjustment' => $cust_tax_adjustment,
2786 #'cust_bill_pkg_tax_location' => \@cust_bill_pkg_tax_location,
2791 my $charged = sprintf('%.2f', $total_setup + $total_recur );
2793 my @cust_bill = $self->cust_bill;
2794 my $balance = $self->balance;
2795 my $previous_balance = scalar(@cust_bill)
2796 ? ( $cust_bill[$#cust_bill]->billing_balance || 0 )
2799 $previous_balance += $cust_bill[$#cust_bill]->charged
2800 if scalar(@cust_bill);
2801 #my $balance_adjustments =
2802 # sprintf('%.2f', $balance - $prior_prior_balance - $prior_charged);
2804 #create the new invoice
2805 my $cust_bill = new FS::cust_bill ( {
2806 'custnum' => $self->custnum,
2807 '_date' => ( $invoice_time ),
2808 'charged' => $charged,
2809 'billing_balance' => $balance,
2810 'previous_balance' => $previous_balance,
2811 'invoice_terms' => $options{'invoice_terms'},
2813 $error = $cust_bill->insert;
2815 $dbh->rollback if $oldAutoCommit;
2816 return "can't create invoice for customer #". $self->custnum. ": $error";
2819 foreach my $cust_bill_pkg ( @cust_bill_pkg ) {
2820 $cust_bill_pkg->invnum($cust_bill->invnum);
2821 my $error = $cust_bill_pkg->insert;
2823 $dbh->rollback if $oldAutoCommit;
2824 return "can't create invoice line item: $error";
2829 foreach my $hook ( @precommit_hooks ) {
2831 &{$hook}; #($self) ?
2834 $dbh->rollback if $oldAutoCommit;
2835 return "$@ running precommit hook $hook\n";
2839 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2845 my ($self, %params) = @_;
2847 my $part_pkg = $params{part_pkg} or die "no part_pkg specified";
2848 my $cust_pkg = $params{cust_pkg} or die "no cust_pkg specified";
2849 my $precommit_hooks = $params{precommit_hooks} or die "no package specified";
2850 my $cust_bill_pkgs = $params{line_items} or die "no line buffer specified";
2851 my $total_setup = $params{setup} or die "no setup accumulator specified";
2852 my $total_recur = $params{recur} or die "no recur accumulator specified";
2853 my $taxlisthash = $params{tax_matrix} or die "no tax accumulator specified";
2854 my $time = $params{'time'} or die "no time specified";
2855 my (%options) = %{$params{options}};
2858 my $real_pkgpart = $params{real_pkgpart};
2859 my %hash = $cust_pkg->hash;
2860 my $old_cust_pkg = new FS::cust_pkg \%hash;
2866 $cust_pkg->pkgpart($part_pkg->pkgpart);
2874 if ( $options{'resetup'}
2875 || ( ! $cust_pkg->setup
2876 && ( ! $cust_pkg->start_date
2877 || $cust_pkg->start_date <= $time
2879 && ( ! $conf->exists('disable_setup_suspended_pkgs')
2880 || ( $conf->exists('disable_setup_suspended_pkgs') &&
2881 ! $cust_pkg->getfield('susp')
2888 warn " bill setup\n" if $DEBUG > 1;
2891 $setup = eval { $cust_pkg->calc_setup( $time, \@details ) };
2892 return "$@ running calc_setup for $cust_pkg\n"
2895 $unitsetup = $cust_pkg->part_pkg->unit_setup || $setup; #XXX uuh
2897 $cust_pkg->setfield('setup', $time)
2898 unless $cust_pkg->setup;
2899 #do need it, but it won't get written to the db
2900 #|| $cust_pkg->pkgpart != $real_pkgpart;
2902 $cust_pkg->setfield('start_date', '')
2903 if $cust_pkg->start_date;
2908 # bill recurring fee
2911 #XXX unit stuff here too
2915 if ( ! $cust_pkg->get('susp')
2916 and ! $cust_pkg->get('start_date')
2917 and ( $part_pkg->getfield('freq') ne '0'
2918 && ( $cust_pkg->getfield('bill') || 0 ) <= $time
2920 || ( $part_pkg->plan eq 'voip_cdr'
2921 && $part_pkg->option('bill_every_call')
2923 || ( $options{cancel} )
2926 # XXX should this be a package event? probably. events are called
2927 # at collection time at the moment, though...
2928 $part_pkg->reset_usage($cust_pkg, 'debug'=>$DEBUG)
2929 if $part_pkg->can('reset_usage');
2930 #don't want to reset usage just cause we want a line item??
2931 #&& $part_pkg->pkgpart == $real_pkgpart;
2933 warn " bill recur\n" if $DEBUG > 1;
2936 # XXX shared with $recur_prog
2937 $sdate = ( $options{cancel} ? $cust_pkg->last_bill : $cust_pkg->bill )
2941 #over two params! lets at least switch to a hashref for the rest...
2942 my $increment_next_bill = ( $part_pkg->freq ne '0'
2943 && ( $cust_pkg->getfield('bill') || 0 ) <= $time
2944 && !$options{cancel}
2946 my %param = ( 'precommit_hooks' => $precommit_hooks,
2947 'increment_next_bill' => $increment_next_bill,
2950 my $method = $options{cancel} ? 'calc_cancel' : 'calc_recur';
2951 $recur = eval { $cust_pkg->$method( \$sdate, \@details, \%param ) };
2952 return "$@ running $method for $cust_pkg\n"
2955 if ( $increment_next_bill ) {
2957 my $next_bill = $part_pkg->add_freq($sdate);
2958 return "unparsable frequency: ". $part_pkg->freq
2959 if $next_bill == -1;
2961 #pro-rating magic - if $recur_prog fiddled $sdate, want to use that
2962 # only for figuring next bill date, nothing else, so, reset $sdate again
2964 $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
2965 #no need, its in $hash{last_bill}# my $last_bill = $cust_pkg->last_bill;
2966 $cust_pkg->last_bill($sdate);
2968 $cust_pkg->setfield('bill', $next_bill );
2974 warn "\$setup is undefined" unless defined($setup);
2975 warn "\$recur is undefined" unless defined($recur);
2976 warn "\$cust_pkg->bill is undefined" unless defined($cust_pkg->bill);
2979 # If there's line items, create em cust_bill_pkg records
2980 # If $cust_pkg has been modified, update it (if we're a real pkgpart)
2985 if ( $cust_pkg->modified && $cust_pkg->pkgpart == $real_pkgpart ) {
2986 # hmm.. and if just the options are modified in some weird price plan?
2988 warn " package ". $cust_pkg->pkgnum. " modified; updating\n"
2991 my $error = $cust_pkg->replace( $old_cust_pkg,
2992 'options' => { $cust_pkg->options },
2994 return "Error modifying pkgnum ". $cust_pkg->pkgnum. ": $error"
2995 if $error; #just in case
2998 $setup = sprintf( "%.2f", $setup );
2999 $recur = sprintf( "%.2f", $recur );
3000 if ( $setup < 0 && ! $conf->exists('allow_negative_charges') ) {
3001 return "negative setup $setup for pkgnum ". $cust_pkg->pkgnum;
3003 if ( $recur < 0 && ! $conf->exists('allow_negative_charges') ) {
3004 return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum;
3007 if ( $setup != 0 || $recur != 0 ) {
3009 warn " charges (setup=$setup, recur=$recur); adding line items\n"
3012 my @cust_pkg_detail = map { $_->detail } $cust_pkg->cust_pkg_detail('I');
3014 warn " adding customer package invoice detail: $_\n"
3015 foreach @cust_pkg_detail;
3017 push @details, @cust_pkg_detail;
3019 my $cust_bill_pkg = new FS::cust_bill_pkg {
3020 'pkgnum' => $cust_pkg->pkgnum,
3022 'unitsetup' => $unitsetup,
3024 'unitrecur' => $unitrecur,
3025 'quantity' => $cust_pkg->quantity,
3026 'details' => \@details,
3027 'hidden' => $part_pkg->hidden,
3030 if ( $part_pkg->option('recur_temporality', 1) eq 'preceding' ) {
3031 $cust_bill_pkg->sdate( $hash{last_bill} );
3032 $cust_bill_pkg->edate( $sdate - 86399 ); #60s*60m*24h-1
3033 $cust_bill_pkg->edate( $time ) if $options{cancel};
3034 } else { #if ( $part_pkg->option('recur_temporality', 1) eq 'upcoming' ) {
3035 $cust_bill_pkg->sdate( $sdate );
3036 $cust_bill_pkg->edate( $cust_pkg->bill );
3037 #$cust_bill_pkg->edate( $time ) if $options{cancel};
3040 $cust_bill_pkg->pkgpart_override($part_pkg->pkgpart)
3041 unless $part_pkg->pkgpart == $real_pkgpart;
3043 $$total_setup += $setup;
3044 $$total_recur += $recur;
3051 $self->_handle_taxes($part_pkg, $taxlisthash, $cust_bill_pkg, $cust_pkg, $options{invoice_time}, $real_pkgpart, \%options);
3052 return $error if $error;
3054 push @$cust_bill_pkgs, $cust_bill_pkg;
3056 } #if $setup != 0 || $recur != 0
3066 my $part_pkg = shift;
3067 my $taxlisthash = shift;
3068 my $cust_bill_pkg = shift;
3069 my $cust_pkg = shift;
3070 my $invoice_time = shift;
3071 my $real_pkgpart = shift;
3072 my $options = shift;
3074 my %cust_bill_pkg = ();
3078 #push @classes, $cust_bill_pkg->usage_classes if $cust_bill_pkg->type eq 'U';
3079 push @classes, $cust_bill_pkg->usage_classes if $cust_bill_pkg->usage;
3080 push @classes, 'setup' if ($cust_bill_pkg->setup && !$options->{cancel});
3081 push @classes, 'recur' if ($cust_bill_pkg->recur && !$options->{cancel});
3083 if ( $self->tax !~ /Y/i && $self->payby ne 'COMP' ) {
3085 if ( $conf->exists('enable_taxproducts')
3086 && ( scalar($part_pkg->part_pkg_taxoverride)
3087 || $part_pkg->has_taxproduct
3092 if ( $conf->exists('tax-pkg_address') && $cust_pkg->locationnum ) {
3093 return "fatal: Can't (yet) use tax-pkg_address with taxproducts";
3096 foreach my $class (@classes) {
3097 my $err_or_ref = $self->_gather_taxes( $part_pkg, $class );
3098 return $err_or_ref unless ref($err_or_ref);
3099 $taxes{$class} = $err_or_ref;
3102 unless (exists $taxes{''}) {
3103 my $err_or_ref = $self->_gather_taxes( $part_pkg, '' );
3104 return $err_or_ref unless ref($err_or_ref);
3105 $taxes{''} = $err_or_ref;
3110 my @loc_keys = qw( state county country );
3112 if ( $conf->exists('tax-pkg_address') && $cust_pkg->locationnum ) {
3113 my $cust_location = $cust_pkg->cust_location;
3114 %taxhash = map { $_ => $cust_location->$_() } @loc_keys;
3117 ( $conf->exists('tax-ship_address') && length($self->ship_last) )
3120 %taxhash = map { $_ => $self->get("$prefix$_") } @loc_keys;
3123 $taxhash{'taxclass'} = $part_pkg->taxclass;
3125 my @taxes = qsearch( 'cust_main_county', \%taxhash );
3127 my %taxhash_elim = %taxhash;
3129 my @elim = qw( taxclass county state );
3130 while ( !scalar(@taxes) && scalar(@elim) ) {
3131 $taxhash_elim{ shift(@elim) } = '';
3132 @taxes = qsearch( 'cust_main_county', \%taxhash_elim );
3135 @taxes = grep { ! $_->taxname or ! $self->tax_exemption($_->taxname) }
3137 if $self->cust_main_exemption; #just to be safe
3139 if ( $conf->exists('tax-pkg_address') && $cust_pkg->locationnum ) {
3141 $_->set('pkgnum', $cust_pkg->pkgnum );
3142 $_->set('locationnum', $cust_pkg->locationnum );
3146 $taxes{''} = [ @taxes ];
3147 $taxes{'setup'} = [ @taxes ];
3148 $taxes{'recur'} = [ @taxes ];
3149 $taxes{$_} = [ @taxes ] foreach (@classes);
3151 # # maybe eliminate this entirely, along with all the 0% records
3152 # unless ( @taxes ) {
3154 # "fatal: can't find tax rate for state/county/country/taxclass ".
3155 # join('/', map $taxhash{$_}, qw(state county country taxclass) );
3158 } #if $conf->exists('enable_taxproducts') ...
3163 my $separate = $conf->exists('separate_usage');
3164 my $usage_mandate = $cust_pkg->part_pkg->option('usage_mandate', 'Hush!');
3165 if ( $separate || $cust_bill_pkg->hidden || $usage_mandate ) {
3167 my $temp_pkg = new FS::cust_pkg { pkgpart => $real_pkgpart };
3168 my %hash = $cust_bill_pkg->hidden # maybe for all bill linked?
3169 ? ( 'section' => $temp_pkg->part_pkg->categoryname )
3172 my $section = $cust_pkg->part_pkg->option('usage_section', 'Hush!');
3173 my $summary = $cust_pkg->part_pkg->option('summarize_usage', 'Hush!');
3175 push @display, new FS::cust_bill_pkg_display { type => 'S', %hash };
3176 push @display, new FS::cust_bill_pkg_display { type => 'R', %hash };
3178 push @display, new FS::cust_bill_pkg_display
3181 ( ( $usage_mandate ) ? ( 'summary' => 'Y' ) : () ),
3185 if ($separate && $section && $summary) {
3186 push @display, new FS::cust_bill_pkg_display { type => 'U',
3191 if ($usage_mandate || $section && $summary) {
3192 $hash{post_total} = 'Y';
3195 $hash{section} = $section if ($separate || $usage_mandate);
3196 push @display, new FS::cust_bill_pkg_display { type => 'U', %hash };
3199 $cust_bill_pkg->set('display', \@display);
3201 my %tax_cust_bill_pkg = $cust_bill_pkg->disintegrate;
3202 foreach my $key (keys %tax_cust_bill_pkg) {
3203 my @taxes = @{ $taxes{$key} || [] };
3204 my $tax_cust_bill_pkg = $tax_cust_bill_pkg{$key};
3206 my %localtaxlisthash = ();
3207 foreach my $tax ( @taxes ) {
3209 my $taxname = ref( $tax ). ' '. $tax->taxnum;
3210 # $taxname .= ' pkgnum'. $cust_pkg->pkgnum.
3211 # ' locationnum'. $cust_pkg->locationnum
3212 # if $conf->exists('tax-pkg_address') && $cust_pkg->locationnum;
3214 $taxlisthash->{ $taxname } ||= [ $tax ];
3215 push @{ $taxlisthash->{ $taxname } }, $tax_cust_bill_pkg;
3217 $localtaxlisthash{ $taxname } ||= [ $tax ];
3218 push @{ $localtaxlisthash{ $taxname } }, $tax_cust_bill_pkg;
3222 warn "finding taxed taxes...\n" if $DEBUG > 2;
3223 foreach my $tax ( keys %localtaxlisthash ) {
3224 my $tax_object = shift @{ $localtaxlisthash{$tax} };
3225 warn "found possible taxed tax ". $tax_object->taxname. " we call $tax\n"
3227 next unless $tax_object->can('tax_on_tax');
3229 foreach my $tot ( $tax_object->tax_on_tax( $self ) ) {
3230 my $totname = ref( $tot ). ' '. $tot->taxnum;
3232 warn "checking $totname which we call ". $tot->taxname. " as applicable\n"
3234 next unless exists( $localtaxlisthash{ $totname } ); # only increase
3236 warn "adding $totname to taxed taxes\n" if $DEBUG > 2;
3237 my $hashref_or_error =
3238 $tax_object->taxline( $localtaxlisthash{$tax},
3239 'custnum' => $self->custnum,
3240 'invoice_time' => $invoice_time,
3242 return $hashref_or_error
3243 unless ref($hashref_or_error);
3245 $taxlisthash->{ $totname } ||= [ $tot ];
3246 push @{ $taxlisthash->{ $totname } }, $hashref_or_error->{amount};
3258 my $part_pkg = shift;
3262 my $geocode = $self->geocode('cch');
3264 my @taxclassnums = map { $_->taxclassnum }
3265 $part_pkg->part_pkg_taxoverride($class);
3267 unless (@taxclassnums) {
3268 @taxclassnums = map { $_->taxclassnum }
3269 grep { $_->taxable eq 'Y' }
3270 $part_pkg->part_pkg_taxrate('cch', $geocode, $class);
3272 warn "Found taxclassnum values of ". join(',', @taxclassnums)
3277 join(' OR ', map { "taxclassnum = $_" } @taxclassnums ). ")";
3279 @taxes = qsearch({ 'table' => 'tax_rate',
3280 'hashref' => { 'geocode' => $geocode, },
3281 'extra_sql' => $extra_sql,
3283 if scalar(@taxclassnums);
3285 warn "Found taxes ".
3286 join(',', map{ ref($_). " ". $_->get($_->primary_key) } @taxes). "\n"
3293 =item collect [ HASHREF | OPTION => VALUE ... ]
3295 (Attempt to) collect money for this customer's outstanding invoices (see
3296 L<FS::cust_bill>). Usually used after the bill method.
3298 Actions are now triggered by billing events; see L<FS::part_event> and the
3299 billing events web interface. Old-style invoice events (see
3300 L<FS::part_bill_event>) have been deprecated.
3302 If there is an error, returns the error, otherwise returns false.
3304 Options are passed as name-value pairs.
3306 Currently available options are:
3312 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.
3316 Retry card/echeck/LEC transactions even when not scheduled by invoice events.
3320 "1d" for the traditional, daily events (the default), or "1m" for the new monthly events (part_event.check_freq)
3324 set true to surpress email card/ACH decline notices.
3328 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)
3334 # allows for one time override of normal customer billing method
3339 my( $self, %options ) = @_;
3340 my $invoice_time = $options{'invoice_time'} || time;
3343 local $SIG{HUP} = 'IGNORE';
3344 local $SIG{INT} = 'IGNORE';
3345 local $SIG{QUIT} = 'IGNORE';
3346 local $SIG{TERM} = 'IGNORE';
3347 local $SIG{TSTP} = 'IGNORE';
3348 local $SIG{PIPE} = 'IGNORE';
3350 my $oldAutoCommit = $FS::UID::AutoCommit;
3351 local $FS::UID::AutoCommit = 0;
3354 $self->select_for_update; #mutex
3357 my $balance = $self->balance;
3358 warn "$me collect customer ". $self->custnum. ": balance $balance\n"
3361 if ( exists($options{'retry_card'}) ) {
3362 carp 'retry_card option passed to collect is deprecated; use retry';
3363 $options{'retry'} ||= $options{'retry_card'};
3365 if ( exists($options{'retry'}) && $options{'retry'} ) {
3366 my $error = $self->retry_realtime;
3368 $dbh->rollback if $oldAutoCommit;
3373 my $error = $self->do_cust_event(
3374 'debug' => ( $options{'debug'} || 0 ),
3375 'time' => $invoice_time,
3376 'check_freq' => $options{'check_freq'},
3377 'stage' => 'collect',
3380 $dbh->rollback if $oldAutoCommit;
3384 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3389 =item do_cust_event [ HASHREF | OPTION => VALUE ... ]
3391 Runs billing events; see L<FS::part_event> and the billing events web
3394 If there is an error, returns the error, otherwise returns false.
3396 Options are passed as name-value pairs.
3398 Currently available options are:
3404 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.
3408 "1d" for the traditional, daily events (the default), or "1m" for the new monthly events (part_event.check_freq)
3412 "collect" (the default) or "pre-bill"
3416 set true to surpress email card/ACH decline notices.
3420 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)
3426 # allows for one time override of normal customer billing method
3430 # Retry card/echeck/LEC transactions even when not scheduled by invoice events.
3433 my( $self, %options ) = @_;
3434 my $time = $options{'time'} || time;
3437 local $SIG{HUP} = 'IGNORE';
3438 local $SIG{INT} = 'IGNORE';
3439 local $SIG{QUIT} = 'IGNORE';
3440 local $SIG{TERM} = 'IGNORE';
3441 local $SIG{TSTP} = 'IGNORE';
3442 local $SIG{PIPE} = 'IGNORE';
3444 my $oldAutoCommit = $FS::UID::AutoCommit;
3445 local $FS::UID::AutoCommit = 0;
3448 $self->select_for_update; #mutex
3451 my $balance = $self->balance;
3452 warn "$me do_cust_event customer ". $self->custnum. ": balance $balance\n"
3455 # if ( exists($options{'retry_card'}) ) {
3456 # carp 'retry_card option passed to collect is deprecated; use retry';
3457 # $options{'retry'} ||= $options{'retry_card'};
3459 # if ( exists($options{'retry'}) && $options{'retry'} ) {
3460 # my $error = $self->retry_realtime;
3462 # $dbh->rollback if $oldAutoCommit;
3467 # false laziness w/pay_batch::import_results
3469 my $due_cust_event = $self->due_cust_event(
3470 'debug' => ( $options{'debug'} || 0 ),
3472 'check_freq' => $options{'check_freq'},
3473 'stage' => ( $options{'stage'} || 'collect' ),
3475 unless( ref($due_cust_event) ) {
3476 $dbh->rollback if $oldAutoCommit;
3477 return $due_cust_event;
3480 foreach my $cust_event ( @$due_cust_event ) {
3484 #re-eval event conditions (a previous event could have changed things)
3485 unless ( $cust_event->test_conditions( 'time' => $time ) ) {
3486 #don't leave stray "new/locked" records around
3487 my $error = $cust_event->delete;
3489 #gah, even with transactions
3490 $dbh->commit if $oldAutoCommit; #well.
3497 local $realtime_bop_decline_quiet = 1 if $options{'quiet'};
3498 warn " running cust_event ". $cust_event->eventnum. "\n"
3502 #if ( my $error = $cust_event->do_event(%options) ) { #XXX %options?
3503 if ( my $error = $cust_event->do_event() ) {
3504 #XXX wtf is this? figure out a proper dealio with return value
3506 # gah, even with transactions.
3507 $dbh->commit if $oldAutoCommit; #well.
3514 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3519 =item due_cust_event [ HASHREF | OPTION => VALUE ... ]
3521 Inserts database records for and returns an ordered listref of new events due
3522 for this customer, as FS::cust_event objects (see L<FS::cust_event>). If no
3523 events are due, an empty listref is returned. If there is an error, returns a
3524 scalar error message.
3526 To actually run the events, call each event's test_condition method, and if
3527 still true, call the event's do_event method.
3529 Options are passed as a hashref or as a list of name-value pairs. Available
3536 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.
3540 "collect" (the default) or "pre-bill"
3544 "Current time" for the events.
3548 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)
3552 Only return events for the specified eventtable (by default, events of all eventtables are returned)
3556 Explicitly pass the objects to be tested (typically used with eventtable).
3560 Set to true to return the objects, but not actually insert them into the
3567 sub due_cust_event {
3569 my %opt = ref($_[0]) ? %{ $_[0] } : @_;
3572 #my $DEBUG = $opt{'debug'}
3573 local($DEBUG) = $opt{'debug'}
3574 if defined($opt{'debug'}) && $opt{'debug'} > $DEBUG;
3576 warn "$me due_cust_event called with options ".
3577 join(', ', map { "$_: $opt{$_}" } keys %opt). "\n"
3580 $opt{'time'} ||= time;
3582 local $SIG{HUP} = 'IGNORE';
3583 local $SIG{INT} = 'IGNORE';
3584 local $SIG{QUIT} = 'IGNORE';
3585 local $SIG{TERM} = 'IGNORE';
3586 local $SIG{TSTP} = 'IGNORE';
3587 local $SIG{PIPE} = 'IGNORE';
3589 my $oldAutoCommit = $FS::UID::AutoCommit;
3590 local $FS::UID::AutoCommit = 0;
3593 $self->select_for_update #mutex
3594 unless $opt{testonly};
3597 # find possible events (initial search)
3600 my @cust_event = ();
3602 my @eventtable = $opt{'eventtable'}
3603 ? ( $opt{'eventtable'} )
3604 : FS::part_event->eventtables_runorder;
3606 foreach my $eventtable ( @eventtable ) {
3609 if ( $opt{'objects'} ) {
3611 @objects = @{ $opt{'objects'} };
3615 #my @objects = $self->eventtable(); # sub cust_main { @{ [ $self ] }; }
3616 @objects = ( $eventtable eq 'cust_main' )
3618 : ( $self->$eventtable() );
3622 my @e_cust_event = ();
3624 my $cross = "CROSS JOIN $eventtable";
3625 $cross .= ' LEFT JOIN cust_main USING ( custnum )'
3626 unless $eventtable eq 'cust_main';
3628 foreach my $object ( @objects ) {
3630 #this first search uses the condition_sql magic for optimization.
3631 #the more possible events we can eliminate in this step the better
3633 my $cross_where = '';
3634 my $pkey = $object->primary_key;
3635 $cross_where = "$eventtable.$pkey = ". $object->$pkey();
3637 my $join = FS::part_event_condition->join_conditions_sql( $eventtable );
3639 FS::part_event_condition->where_conditions_sql( $eventtable,
3640 'time'=>$opt{'time'}
3642 my $order = FS::part_event_condition->order_conditions_sql( $eventtable );
3644 $extra_sql = "AND $extra_sql" if $extra_sql;
3646 #here is the agent virtualization
3647 $extra_sql .= " AND ( part_event.agentnum IS NULL
3648 OR part_event.agentnum = ". $self->agentnum. ' )';
3650 $extra_sql .= " $order";
3652 warn "searching for events for $eventtable ". $object->$pkey. "\n"
3653 if $opt{'debug'} > 2;
3654 my @part_event = qsearch( {
3655 'debug' => ( $opt{'debug'} > 3 ? 1 : 0 ),
3656 'select' => 'part_event.*',
3657 'table' => 'part_event',
3658 'addl_from' => "$cross $join",
3659 'hashref' => { 'check_freq' => ( $opt{'check_freq'} || '1d' ),
3660 'eventtable' => $eventtable,
3663 'extra_sql' => "AND $cross_where $extra_sql",
3667 my $pkey = $object->primary_key;
3668 warn " ". scalar(@part_event).
3669 " possible events found for $eventtable ". $object->$pkey(). "\n";
3672 push @e_cust_event, map { $_->new_cust_event($object) } @part_event;
3676 warn " ". scalar(@e_cust_event).
3677 " subtotal possible cust events found for $eventtable\n"
3680 push @cust_event, @e_cust_event;
3684 warn " ". scalar(@cust_event).
3685 " total possible cust events found in initial search\n"
3693 $opt{stage} ||= 'collect';
3695 grep { my $stage = $_->part_event->event_stage;
3696 $opt{stage} eq $stage or ( ! $stage && $opt{stage} eq 'collect' )
3706 @cust_event = grep $_->test_conditions( 'time' => $opt{'time'},
3707 'stats_hashref' => \%unsat ),
3710 warn " ". scalar(@cust_event). " cust events left satisfying conditions\n"
3713 warn " invalid conditions not eliminated with condition_sql:\n".
3714 join('', map " $_: ".$unsat{$_}."\n", keys %unsat )
3721 unless( $opt{testonly} ) {
3722 foreach my $cust_event ( @cust_event ) {
3724 my $error = $cust_event->insert();
3726 $dbh->rollback if $oldAutoCommit;
3733 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3739 warn " returning events: ". Dumper(@cust_event). "\n"
3746 =item retry_realtime
3748 Schedules realtime / batch credit card / electronic check / LEC billing
3749 events for for retry. Useful if card information has changed or manual
3750 retry is desired. The 'collect' method must be called to actually retry
3753 Implementation details: For either this customer, or for each of this
3754 customer's open invoices, changes the status of the first "done" (with
3755 statustext error) realtime processing event to "failed".
3759 sub retry_realtime {
3762 local $SIG{HUP} = 'IGNORE';
3763 local $SIG{INT} = 'IGNORE';
3764 local $SIG{QUIT} = 'IGNORE';
3765 local $SIG{TERM} = 'IGNORE';
3766 local $SIG{TSTP} = 'IGNORE';
3767 local $SIG{PIPE} = 'IGNORE';
3769 my $oldAutoCommit = $FS::UID::AutoCommit;
3770 local $FS::UID::AutoCommit = 0;
3773 #a little false laziness w/due_cust_event (not too bad, really)
3775 my $join = FS::part_event_condition->join_conditions_sql;
3776 my $order = FS::part_event_condition->order_conditions_sql;
3779 . join ( ' OR ' , map {
3780 "( part_event.eventtable = " . dbh->quote($_)
3781 . " AND tablenum IN( SELECT " . dbdef->table($_)->primary_key . " from $_ where custnum = " . dbh->quote( $self->custnum ) . "))" ;
3782 } FS::part_event->eventtables)
3785 #here is the agent virtualization
3786 my $agent_virt = " ( part_event.agentnum IS NULL
3787 OR part_event.agentnum = ". $self->agentnum. ' )';
3789 #XXX this shouldn't be hardcoded, actions should declare it...
3790 my @realtime_events = qw(
3791 cust_bill_realtime_card
3792 cust_bill_realtime_check
3793 cust_bill_realtime_lec
3797 my $is_realtime_event = ' ( '. join(' OR ', map "part_event.action = '$_'",
3802 my @cust_event = qsearchs({
3803 'table' => 'cust_event',
3804 'select' => 'cust_event.*',
3805 'addl_from' => "LEFT JOIN part_event USING ( eventpart ) $join",
3806 'hashref' => { 'status' => 'done' },
3807 'extra_sql' => " AND statustext IS NOT NULL AND statustext != '' ".
3808 " AND $mine AND $is_realtime_event AND $agent_virt $order" # LIMIT 1"
3811 my %seen_invnum = ();
3812 foreach my $cust_event (@cust_event) {
3814 #max one for the customer, one for each open invoice
3815 my $cust_X = $cust_event->cust_X;
3816 next if $seen_invnum{ $cust_event->part_event->eventtable eq 'cust_bill'
3820 or $cust_event->part_event->eventtable eq 'cust_bill'
3823 my $error = $cust_event->retry;
3825 $dbh->rollback if $oldAutoCommit;
3826 return "error scheduling event for retry: $error";
3831 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3836 # some horrid false laziness here to avoid refactor fallout
3837 # eventually realtime realtime_bop and realtime_refund_bop should go
3838 # away and be replaced by _new_realtime_bop and _new_realtime_refund_bop
3840 =item realtime_bop METHOD AMOUNT [ OPTION => VALUE ... ]
3842 Runs a realtime credit card, ACH (electronic check) or phone bill transaction
3843 via a Business::OnlinePayment realtime gateway. See
3844 L<http://420.am/business-onlinepayment> for supported gateways.
3846 Available methods are: I<CC>, I<ECHECK> and I<LEC>
3848 Available options are: I<description>, I<invnum>, I<quiet>, I<paynum_ref>, I<payunique>
3850 The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
3851 I<zip>, I<payinfo> and I<paydate> are also available. Any of these options,
3852 if set, will override the value from the customer record.
3854 I<description> is a free-text field passed to the gateway. It defaults to
3855 the value defined by the business-onlinepayment-description configuration
3856 option, or "Internet services" if that is unset.
3858 If an I<invnum> is specified, this payment (if successful) is applied to the
3859 specified invoice. If you don't specify an I<invnum> you might want to
3860 call the B<apply_payments> method or set the I<apply> option.
3862 I<apply> can be set to true to apply a resulting payment.
3864 I<quiet> can be set true to surpress email decline notices.
3866 I<paynum_ref> can be set to a scalar reference. It will be filled in with the
3867 resulting paynum, if any.
3869 I<payunique> is a unique identifier for this payment.
3871 (moved from cust_bill) (probably should get realtime_{card,ach,lec} here too)
3878 return $self->_new_realtime_bop(@_)
3879 if $self->_new_bop_required();
3881 my($method, $amount);
3883 if (ref($_[0]) eq 'HASH') {
3884 %options = %{$_[0]};
3885 $method = $options{method};
3886 $amount = $options{amount};
3888 ( $method, $amount ) = ( shift, shift );
3892 warn "$me realtime_bop: $method $amount\n";
3893 warn " $_ => $options{$_}\n" foreach keys %options;
3896 unless ( $options{'description'} ) {
3897 if ( $conf->exists('business-onlinepayment-description') ) {
3898 my $dtempl = $conf->config('business-onlinepayment-description');
3900 my $agent = $self->agent->agent;
3902 $options{'description'} = eval qq("$dtempl");
3904 $options{'description'} = 'Internet services';
3908 return $self->fake_bop($method, $amount, %options) if $options{'fake'};
3910 eval "use Business::OnlinePayment";
3913 my $payinfo = exists($options{'payinfo'})
3914 ? $options{'payinfo'}
3917 my %method2payby = (
3924 # check for banned credit card/ACH
3927 my $ban = qsearchs('banned_pay', {
3928 'payby' => $method2payby{$method},
3929 'payinfo' => md5_base64($payinfo),
3931 return "Banned credit card" if $ban;
3934 # set taxclass and trans_is_recur based on invnum if there is one
3938 my $trans_is_recur = 0;
3939 if ( $options{'invnum'} ) {
3941 my $cust_bill = qsearchs('cust_bill', { 'invnum' => $options{'invnum'} } );
3942 die "invnum ". $options{'invnum'}. " not found" unless $cust_bill;
3945 map { $_->part_pkg }
3947 map { $_->cust_pkg }
3948 $cust_bill->cust_bill_pkg;
3950 my @taxclasses = map $_->taxclass, @part_pkg;
3951 $taxclass = $taxclasses[0]
3952 unless grep { $taxclasses[0] ne $_ } @taxclasses; #unless there are
3953 #different taxclasses
3955 if grep { $_->freq ne '0' } @part_pkg;
3963 #look for an agent gateway override first
3965 if ( $method eq 'CC' ) {
3966 $cardtype = cardtype($payinfo);
3967 } elsif ( $method eq 'ECHECK' ) {
3970 $cardtype = $method;
3974 qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
3975 cardtype => $cardtype,
3976 taxclass => $taxclass, } )
3977 || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
3979 taxclass => $taxclass, } )
3980 || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
3981 cardtype => $cardtype,
3983 || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
3985 taxclass => '', } );
3987 my $payment_gateway = '';
3988 my( $processor, $login, $password, $action, @bop_options );
3989 if ( $override ) { #use a payment gateway override
3991 $payment_gateway = $override->payment_gateway;
3993 $processor = $payment_gateway->gateway_module;
3994 $login = $payment_gateway->gateway_username;
3995 $password = $payment_gateway->gateway_password;
3996 $action = $payment_gateway->gateway_action;
3997 @bop_options = $payment_gateway->options;
3999 } else { #use the standard settings from the config
4001 ( $processor, $login, $password, $action, @bop_options ) =
4002 $self->default_payment_gateway($method);
4010 my $address = exists($options{'address1'})
4011 ? $options{'address1'}
4013 my $address2 = exists($options{'address2'})
4014 ? $options{'address2'}
4016 $address .= ", ". $address2 if length($address2);
4018 my $o_payname = exists($options{'payname'})
4019 ? $options{'payname'}
4021 my($payname, $payfirst, $paylast);
4022 if ( $o_payname && $method ne 'ECHECK' ) {
4023 ($payname = $o_payname) =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
4024 or return "Illegal payname $payname";
4025 ($payfirst, $paylast) = ($1, $2);
4027 $payfirst = $self->getfield('first');
4028 $paylast = $self->getfield('last');
4029 $payname = "$payfirst $paylast";
4032 my @invoicing_list = $self->invoicing_list_emailonly;
4033 if ( $conf->exists('emailinvoiceautoalways')
4034 || $conf->exists('emailinvoiceauto') && ! @invoicing_list
4035 || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
4036 push @invoicing_list, $self->all_emails;
4039 my $email = ($conf->exists('business-onlinepayment-email-override'))
4040 ? $conf->config('business-onlinepayment-email-override')
4041 : $invoicing_list[0];
4045 my $payip = exists($options{'payip'})
4048 $content{customer_ip} = $payip
4051 $content{invoice_number} = $options{'invnum'}
4052 if exists($options{'invnum'}) && length($options{'invnum'});
4054 $content{email_customer} =
4055 ( $conf->exists('business-onlinepayment-email_customer')
4056 || $conf->exists('business-onlinepayment-email-override') );
4059 if ( $method eq 'CC' ) {
4061 $content{card_number} = $payinfo;
4062 $paydate = exists($options{'paydate'})
4063 ? $options{'paydate'}
4065 $paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
4066 $content{expiration} = "$2/$1";
4068 my $paycvv = exists($options{'paycvv'})
4069 ? $options{'paycvv'}
4071 $content{cvv2} = $paycvv
4074 my $paystart_month = exists($options{'paystart_month'})
4075 ? $options{'paystart_month'}
4076 : $self->paystart_month;
4078 my $paystart_year = exists($options{'paystart_year'})
4079 ? $options{'paystart_year'}
4080 : $self->paystart_year;
4082 $content{card_start} = "$paystart_month/$paystart_year"
4083 if $paystart_month && $paystart_year;
4085 my $payissue = exists($options{'payissue'})
4086 ? $options{'payissue'}
4088 $content{issue_number} = $payissue if $payissue;
4090 if ( $self->_bop_recurring_billing( 'payinfo' => $payinfo,
4091 'trans_is_recur' => $trans_is_recur,
4095 $content{recurring_billing} = 'YES';
4096 $content{acct_code} = 'rebill'
4097 if $conf->exists('credit_card-recurring_billing_acct_code');
4100 } elsif ( $method eq 'ECHECK' ) {
4101 ( $content{account_number}, $content{routing_code} ) =
4102 split('@', $payinfo);
4103 $content{bank_name} = $o_payname;
4104 $content{bank_state} = exists($options{'paystate'})
4105 ? $options{'paystate'}
4106 : $self->getfield('paystate');
4107 $content{account_type} = exists($options{'paytype'})
4108 ? uc($options{'paytype'}) || 'CHECKING'
4109 : uc($self->getfield('paytype')) || 'CHECKING';
4110 $content{account_name} = $payname;
4111 $content{customer_org} = $self->company ? 'B' : 'I';
4112 $content{state_id} = exists($options{'stateid'})
4113 ? $options{'stateid'}
4114 : $self->getfield('stateid');
4115 $content{state_id_state} = exists($options{'stateid_state'})
4116 ? $options{'stateid_state'}
4117 : $self->getfield('stateid_state');
4118 $content{customer_ssn} = exists($options{'ss'})
4121 } elsif ( $method eq 'LEC' ) {
4122 $content{phone} = $payinfo;
4126 # run transaction(s)
4129 my $balance = exists( $options{'balance'} )
4130 ? $options{'balance'}
4133 $self->select_for_update; #mutex ... just until we get our pending record in
4135 #the checks here are intended to catch concurrent payments
4136 #double-form-submission prevention is taken care of in cust_pay_pending::check
4139 return "The customer's balance has changed; $method transaction aborted."
4140 if $self->balance < $balance;
4141 #&& $self->balance < $amount; #might as well anyway?
4143 #also check and make sure there aren't *other* pending payments for this cust
4145 my @pending = qsearch('cust_pay_pending', {
4146 'custnum' => $self->custnum,
4147 'status' => { op=>'!=', value=>'done' }
4149 return "A payment is already being processed for this customer (".
4150 join(', ', map 'paypendingnum '. $_->paypendingnum, @pending ).
4151 "); $method transaction aborted."
4152 if scalar(@pending);
4154 #okay, good to go, if we're a duplicate, cust_pay_pending will kick us out
4156 my $cust_pay_pending = new FS::cust_pay_pending {
4157 'custnum' => $self->custnum,
4158 #'invnum' => $options{'invnum'},
4161 'payby' => $method2payby{$method},
4162 'payinfo' => $payinfo,
4163 'paydate' => $paydate,
4164 'recurring_billing' => $content{recurring_billing},
4165 'pkgnum' => $options{'pkgnum'},
4167 'gatewaynum' => ( $payment_gateway ? $payment_gateway->gatewaynum : '' ),
4169 $cust_pay_pending->payunique( $options{payunique} )
4170 if defined($options{payunique}) && length($options{payunique});
4171 my $cpp_new_err = $cust_pay_pending->insert; #mutex lost when this is inserted
4172 return $cpp_new_err if $cpp_new_err;
4174 my( $action1, $action2 ) = split(/\s*\,\s*/, $action );
4176 my $transaction = new Business::OnlinePayment( $processor, @bop_options );
4177 $transaction->content(
4180 'password' => $password,
4181 'action' => $action1,
4182 'description' => $options{'description'},
4183 'amount' => $amount,
4184 #'invoice_number' => $options{'invnum'},
4185 'customer_id' => $self->custnum,
4186 'last_name' => $paylast,
4187 'first_name' => $payfirst,
4189 'address' => $address,
4190 'city' => ( exists($options{'city'})
4193 'state' => ( exists($options{'state'})
4196 'zip' => ( exists($options{'zip'})
4199 'country' => ( exists($options{'country'})
4200 ? $options{'country'}
4202 'referer' => 'http://cleanwhisker.420.am/', #XXX fix referer :/
4204 'phone' => $self->daytime || $self->night,
4208 $cust_pay_pending->status('pending');
4209 my $cpp_pending_err = $cust_pay_pending->replace;
4210 return $cpp_pending_err if $cpp_pending_err;
4213 my $BOP_TESTING = 0;
4214 my $BOP_TESTING_SUCCESS = 1;
4216 unless ( $BOP_TESTING ) {
4217 $transaction->submit();
4219 if ( $BOP_TESTING_SUCCESS ) {
4220 $transaction->is_success(1);
4221 $transaction->authorization('fake auth');
4223 $transaction->is_success(0);
4224 $transaction->error_message('fake failure');
4228 if ( $transaction->is_success() && $action2 ) {
4230 $cust_pay_pending->status('authorized');
4231 my $cpp_authorized_err = $cust_pay_pending->replace;
4232 return $cpp_authorized_err if $cpp_authorized_err;
4234 my $auth = $transaction->authorization;
4235 my $ordernum = $transaction->can('order_number')
4236 ? $transaction->order_number
4240 new Business::OnlinePayment( $processor, @bop_options );
4247 password => $password,
4248 order_number => $ordernum,
4250 authorization => $auth,
4251 description => $options{'description'},
4254 foreach my $field (qw( authorization_source_code returned_ACI
4255 transaction_identifier validation_code
4256 transaction_sequence_num local_transaction_date
4257 local_transaction_time AVS_result_code )) {
4258 $capture{$field} = $transaction->$field() if $transaction->can($field);
4261 $capture->content( %capture );
4265 unless ( $capture->is_success ) {
4266 my $e = "Authorization successful but capture failed, custnum #".
4267 $self->custnum. ': '. $capture->result_code.
4268 ": ". $capture->error_message;
4275 $cust_pay_pending->status($transaction->is_success() ? 'captured' : 'declined');
4276 my $cpp_captured_err = $cust_pay_pending->replace;
4277 return $cpp_captured_err if $cpp_captured_err;
4280 # remove paycvv after initial transaction
4283 #false laziness w/misc/process/payment.cgi - check both to make sure working
4285 if ( defined $self->dbdef_table->column('paycvv')
4286 && length($self->paycvv)
4287 && ! grep { $_ eq cardtype($payinfo) } $conf->config('cvv-save')
4289 my $error = $self->remove_cvv;
4291 warn "WARNING: error removing cvv: $error\n";
4299 if ( $transaction->is_success() ) {
4302 if ( $payment_gateway ) { # agent override
4303 $paybatch = $payment_gateway->gatewaynum. '-';
4306 $paybatch .= "$processor:". $transaction->authorization;
4308 $paybatch .= ':'. $transaction->order_number
4309 if $transaction->can('order_number')
4310 && length($transaction->order_number);
4312 my $cust_pay = new FS::cust_pay ( {
4313 'custnum' => $self->custnum,
4314 'invnum' => $options{'invnum'},
4317 'payby' => $method2payby{$method},
4318 'payinfo' => $payinfo,
4319 'paybatch' => $paybatch,
4320 'paydate' => $paydate,
4321 'pkgnum' => $options{'pkgnum'},
4323 #doesn't hurt to know, even though the dup check is in cust_pay_pending now
4324 $cust_pay->payunique( $options{payunique} )
4325 if defined($options{payunique}) && length($options{payunique});
4327 my $oldAutoCommit = $FS::UID::AutoCommit;
4328 local $FS::UID::AutoCommit = 0;
4331 #start a transaction, insert the cust_pay and set cust_pay_pending.status to done in a single transction
4333 my $error = $cust_pay->insert($options{'manual'} ? ( 'manual' => 1 ) : () );
4336 $cust_pay->invnum(''); #try again with no specific invnum
4337 my $error2 = $cust_pay->insert( $options{'manual'} ?
4338 ( 'manual' => 1 ) : ()
4341 # gah. but at least we have a record of the state we had to abort in
4342 # from cust_pay_pending now.
4343 my $e = "WARNING: $method captured but payment not recorded - ".
4344 "error inserting payment ($processor): $error2".
4345 " (previously tried insert with invnum #$options{'invnum'}" .
4346 ": $error ) - pending payment saved as paypendingnum ".
4347 $cust_pay_pending->paypendingnum. "\n";
4353 if ( $options{'paynum_ref'} ) {
4354 ${ $options{'paynum_ref'} } = $cust_pay->paynum;
4357 $cust_pay_pending->status('done');
4358 $cust_pay_pending->statustext('captured');
4359 $cust_pay_pending->paynum($cust_pay->paynum);
4360 my $cpp_done_err = $cust_pay_pending->replace;
4362 if ( $cpp_done_err ) {
4364 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
4365 my $e = "WARNING: $method captured but payment not recorded - ".
4366 "error updating status for paypendingnum ".
4367 $cust_pay_pending->paypendingnum. ": $cpp_done_err \n";
4373 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4375 if ( $options{'apply'} ) {
4376 my $apply_error = $self->apply_payments_and_credits;
4377 if ( $apply_error ) {
4378 warn "WARNING: error applying payment: $apply_error\n";
4379 #but we still should return no error cause the payment otherwise went
4384 return ''; #no error
4390 my $perror = "$processor error: ". $transaction->error_message;
4392 unless ( $transaction->error_message ) {
4395 if ( $transaction->can('response_page') ) {
4397 'page' => ( $transaction->can('response_page')
4398 ? $transaction->response_page
4401 'code' => ( $transaction->can('response_code')
4402 ? $transaction->response_code
4405 'headers' => ( $transaction->can('response_headers')
4406 ? $transaction->response_headers
4412 "No additional debugging information available for $processor";
4415 $perror .= "No error_message returned from $processor -- ".
4416 ( ref($t_response) ? Dumper($t_response) : $t_response );
4420 if ( !$options{'quiet'} && !$realtime_bop_decline_quiet
4421 && $conf->exists('emaildecline')
4422 && grep { $_ ne 'POST' } $self->invoicing_list
4423 && ! grep { $transaction->error_message =~ /$_/ }
4424 $conf->config('emaildecline-exclude')
4426 my @templ = $conf->config('declinetemplate');
4427 my $template = new Text::Template (
4429 SOURCE => [ map "$_\n", @templ ],
4430 ) or return "($perror) can't create template: $Text::Template::ERROR";
4431 $template->compile()
4432 or return "($perror) can't compile template: $Text::Template::ERROR";
4436 scalar( $conf->config('company_name', $self->agentnum ) ),
4437 'company_address' =>
4438 join("\n", $conf->config('company_address', $self->agentnum ) ),
4439 'error' => $transaction->error_message,
4442 my $error = send_email(
4443 'from' => $conf->config('invoice_from', $self->agentnum ),
4444 'to' => [ grep { $_ ne 'POST' } $self->invoicing_list ],
4445 'subject' => 'Your payment could not be processed',
4446 'body' => [ $template->fill_in(HASH => $templ_hash) ],
4449 $perror .= " (also received error sending decline notification: $error)"
4454 $cust_pay_pending->status('done');
4455 $cust_pay_pending->statustext("declined: $perror");
4456 my $cpp_done_err = $cust_pay_pending->replace;
4457 if ( $cpp_done_err ) {
4458 my $e = "WARNING: $method declined but pending payment not resolved - ".
4459 "error updating status for paypendingnum ".
4460 $cust_pay_pending->paypendingnum. ": $cpp_done_err \n";
4462 $perror = "$e ($perror)";
4470 sub _bop_recurring_billing {
4471 my( $self, %opt ) = @_;
4473 my $method = scalar($conf->config('credit_card-recurring_billing_flag'));
4475 if ( defined($method) && $method eq 'transaction_is_recur' ) {
4477 return 1 if $opt{'trans_is_recur'};
4481 my %hash = ( 'custnum' => $self->custnum,
4486 if qsearch('cust_pay', { %hash, 'payinfo' => $opt{'payinfo'} } )
4487 || qsearch('cust_pay', { %hash, 'paymask' => $self->mask_payinfo('CARD',
4498 =item realtime_refund_bop METHOD [ OPTION => VALUE ... ]
4500 Refunds a realtime credit card, ACH (electronic check) or phone bill transaction
4501 via a Business::OnlinePayment realtime gateway. See
4502 L<http://420.am/business-onlinepayment> for supported gateways.
4504 Available methods are: I<CC>, I<ECHECK> and I<LEC>
4506 Available options are: I<amount>, I<reason>, I<paynum>, I<paydate>
4508 Most gateways require a reference to an original payment transaction to refund,
4509 so you probably need to specify a I<paynum>.
4511 I<amount> defaults to the original amount of the payment if not specified.
4513 I<reason> specifies a reason for the refund.
4515 I<paydate> specifies the expiration date for a credit card overriding the
4516 value from the customer record or the payment record. Specified as yyyy-mm-dd
4518 Implementation note: If I<amount> is unspecified or equal to the amount of the
4519 orignal payment, first an attempt is made to "void" the transaction via
4520 the gateway (to cancel a not-yet settled transaction) and then if that fails,
4521 the normal attempt is made to "refund" ("credit") the transaction via the
4522 gateway is attempted.
4524 #The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
4525 #I<zip>, I<payinfo> and I<paydate> are also available. Any of these options,
4526 #if set, will override the value from the customer record.
4528 #If an I<invnum> is specified, this payment (if successful) is applied to the
4529 #specified invoice. If you don't specify an I<invnum> you might want to
4530 #call the B<apply_payments> method.
4534 #some false laziness w/realtime_bop, not enough to make it worth merging
4535 #but some useful small subs should be pulled out
4536 sub realtime_refund_bop {
4539 return $self->_new_realtime_refund_bop(@_)
4540 if $self->_new_bop_required();
4542 my( $method, %options ) = @_;
4544 warn "$me realtime_refund_bop: $method refund\n";
4545 warn " $_ => $options{$_}\n" foreach keys %options;
4548 eval "use Business::OnlinePayment";
4552 # look up the original payment and optionally a gateway for that payment
4556 my $amount = $options{'amount'};
4558 my( $processor, $login, $password, @bop_options ) ;
4559 my( $auth, $order_number ) = ( '', '', '' );
4561 if ( $options{'paynum'} ) {
4563 warn " paynum: $options{paynum}\n" if $DEBUG > 1;
4564 $cust_pay = qsearchs('cust_pay', { paynum=>$options{'paynum'} } )
4565 or return "Unknown paynum $options{'paynum'}";
4566 $amount ||= $cust_pay->paid;
4568 $cust_pay->paybatch =~ /^((\d+)\-)?(\w+):\s*([\w\-\/ ]*)(:([\w\-]+))?$/
4569 or return "Can't parse paybatch for paynum $options{'paynum'}: ".
4570 $cust_pay->paybatch;
4571 my $gatewaynum = '';
4572 ( $gatewaynum, $processor, $auth, $order_number ) = ( $2, $3, $4, $6 );
4574 if ( $gatewaynum ) { #gateway for the payment to be refunded
4576 my $payment_gateway =
4577 qsearchs('payment_gateway', { 'gatewaynum' => $gatewaynum } );
4578 die "payment gateway $gatewaynum not found"
4579 unless $payment_gateway;
4581 $processor = $payment_gateway->gateway_module;
4582 $login = $payment_gateway->gateway_username;
4583 $password = $payment_gateway->gateway_password;
4584 @bop_options = $payment_gateway->options;
4586 } else { #try the default gateway
4588 my( $conf_processor, $unused_action );
4589 ( $conf_processor, $login, $password, $unused_action, @bop_options ) =
4590 $self->default_payment_gateway($method);
4592 return "processor of payment $options{'paynum'} $processor does not".
4593 " match default processor $conf_processor"
4594 unless $processor eq $conf_processor;
4599 } else { # didn't specify a paynum, so look for agent gateway overrides
4600 # like a normal transaction
4603 if ( $method eq 'CC' ) {
4604 $cardtype = cardtype($self->payinfo);
4605 } elsif ( $method eq 'ECHECK' ) {
4608 $cardtype = $method;
4611 qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
4612 cardtype => $cardtype,
4614 || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
4616 taxclass => '', } );
4618 if ( $override ) { #use a payment gateway override
4620 my $payment_gateway = $override->payment_gateway;
4622 $processor = $payment_gateway->gateway_module;
4623 $login = $payment_gateway->gateway_username;
4624 $password = $payment_gateway->gateway_password;
4625 #$action = $payment_gateway->gateway_action;
4626 @bop_options = $payment_gateway->options;
4628 } else { #use the standard settings from the config
4631 ( $processor, $login, $password, $unused_action, @bop_options ) =
4632 $self->default_payment_gateway($method);
4637 return "neither amount nor paynum specified" unless $amount;
4642 'password' => $password,
4643 'order_number' => $order_number,
4644 'amount' => $amount,
4645 'referer' => 'http://cleanwhisker.420.am/', #XXX fix referer :/
4647 $content{authorization} = $auth
4648 if length($auth); #echeck/ACH transactions have an order # but no auth
4649 #(at least with authorize.net)
4651 my $disable_void_after;
4652 if ($conf->exists('disable_void_after')
4653 && $conf->config('disable_void_after') =~ /^(\d+)$/) {
4654 $disable_void_after = $1;
4657 #first try void if applicable
4658 if ( $cust_pay && $cust_pay->paid == $amount
4660 ( not defined($disable_void_after) )
4661 || ( time < ($cust_pay->_date + $disable_void_after ) )
4664 warn " attempting void\n" if $DEBUG > 1;
4665 my $void = new Business::OnlinePayment( $processor, @bop_options );
4666 $content{'card_number'} = $cust_pay->payinfo
4667 if $cust_pay->payby eq 'CARD'
4668 && $void->can('info') && $void->info('CC_void_requires_card');
4669 $void->content( 'action' => 'void', %content );
4671 if ( $void->is_success ) {
4672 my $error = $cust_pay->void($options{'reason'});
4674 # gah, even with transactions.
4675 my $e = 'WARNING: Card/ACH voided but database not updated - '.
4676 "error voiding payment: $error";
4680 warn " void successful\n" if $DEBUG > 1;
4685 warn " void unsuccessful, trying refund\n"
4689 my $address = $self->address1;
4690 $address .= ", ". $self->address2 if $self->address2;
4692 my($payname, $payfirst, $paylast);
4693 if ( $self->payname && $method ne 'ECHECK' ) {
4694 $payname = $self->payname;
4695 $payname =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
4696 or return "Illegal payname $payname";
4697 ($payfirst, $paylast) = ($1, $2);
4699 $payfirst = $self->getfield('first');
4700 $paylast = $self->getfield('last');
4701 $payname = "$payfirst $paylast";
4704 my @invoicing_list = $self->invoicing_list_emailonly;
4705 if ( $conf->exists('emailinvoiceautoalways')
4706 || $conf->exists('emailinvoiceauto') && ! @invoicing_list
4707 || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
4708 push @invoicing_list, $self->all_emails;
4711 my $email = ($conf->exists('business-onlinepayment-email-override'))
4712 ? $conf->config('business-onlinepayment-email-override')
4713 : $invoicing_list[0];
4715 my $payip = exists($options{'payip'})
4718 $content{customer_ip} = $payip
4722 if ( $method eq 'CC' ) {
4725 $content{card_number} = $payinfo = $cust_pay->payinfo;
4726 (exists($options{'paydate'}) ? $options{'paydate'} : $cust_pay->paydate)
4727 =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/ &&
4728 ($content{expiration} = "$2/$1"); # where available
4730 $content{card_number} = $payinfo = $self->payinfo;
4731 (exists($options{'paydate'}) ? $options{'paydate'} : $self->paydate)
4732 =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
4733 $content{expiration} = "$2/$1";
4736 } elsif ( $method eq 'ECHECK' ) {
4739 $payinfo = $cust_pay->payinfo;
4741 $payinfo = $self->payinfo;
4743 ( $content{account_number}, $content{routing_code} )= split('@', $payinfo );
4744 $content{bank_name} = $self->payname;
4745 $content{account_type} = 'CHECKING';
4746 $content{account_name} = $payname;
4747 $content{customer_org} = $self->company ? 'B' : 'I';
4748 $content{customer_ssn} = $self->ss;
4749 } elsif ( $method eq 'LEC' ) {
4750 $content{phone} = $payinfo = $self->payinfo;
4754 my $refund = new Business::OnlinePayment( $processor, @bop_options );
4755 my %sub_content = $refund->content(
4756 'action' => 'credit',
4757 'customer_id' => $self->custnum,
4758 'last_name' => $paylast,
4759 'first_name' => $payfirst,
4761 'address' => $address,
4762 'city' => $self->city,
4763 'state' => $self->state,
4764 'zip' => $self->zip,
4765 'country' => $self->country,
4767 'phone' => $self->daytime || $self->night,
4770 warn join('', map { " $_ => $sub_content{$_}\n" } keys %sub_content )
4774 return "$processor error: ". $refund->error_message
4775 unless $refund->is_success();
4777 my %method2payby = (
4783 my $paybatch = "$processor:". $refund->authorization;
4784 $paybatch .= ':'. $refund->order_number
4785 if $refund->can('order_number') && $refund->order_number;
4787 while ( $cust_pay && $cust_pay->unapplied < $amount ) {
4788 my @cust_bill_pay = $cust_pay->cust_bill_pay;
4789 last unless @cust_bill_pay;
4790 my $cust_bill_pay = pop @cust_bill_pay;
4791 my $error = $cust_bill_pay->delete;
4795 my $cust_refund = new FS::cust_refund ( {
4796 'custnum' => $self->custnum,
4797 'paynum' => $options{'paynum'},
4798 'refund' => $amount,
4800 'payby' => $method2payby{$method},
4801 'payinfo' => $payinfo,
4802 'paybatch' => $paybatch,
4803 'reason' => $options{'reason'} || 'card or ACH refund',
4805 my $error = $cust_refund->insert;
4807 $cust_refund->paynum(''); #try again with no specific paynum
4808 my $error2 = $cust_refund->insert;
4810 # gah, even with transactions.
4811 my $e = 'WARNING: Card/ACH refunded but database not updated - '.
4812 "error inserting refund ($processor): $error2".
4813 " (previously tried insert with paynum #$options{'paynum'}" .
4824 # does the configuration indicate the new bop routines are required?
4826 sub _new_bop_required {
4829 my $botpp = 'Business::OnlineThirdPartyPayment';
4832 if ( $conf->config('business-onlinepayment-namespace') eq $botpp ||
4833 scalar( grep { $_->gateway_namespace eq $botpp }
4834 qsearch( 'payment_gateway', { 'disabled' => '' } )
4842 =item realtime_collect [ OPTION => VALUE ... ]
4844 Runs a realtime credit card, ACH (electronic check) or phone bill transaction
4845 via a Business::OnlinePayment or Business::OnlineThirdPartyPayment realtime
4846 gateway. See L<http://420.am/business-onlinepayment> and
4847 L<http://420.am/business-onlinethirdpartypayment> for supported gateways.
4849 On failure returns an error message.
4851 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.
4853 Available options are: I<method>, I<amount>, I<description>, I<invnum>, I<quiet>, I<paynum_ref>, I<payunique>, I<session_id>, I<pkgnum>
4855 I<method> is one of: I<CC>, I<ECHECK> and I<LEC>. If none is specified
4856 then it is deduced from the customer record.
4858 If no I<amount> is specified, then the customer balance is used.
4860 The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
4861 I<zip>, I<payinfo> and I<paydate> are also available. Any of these options,
4862 if set, will override the value from the customer record.
4864 I<description> is a free-text field passed to the gateway. It defaults to
4865 the value defined by the business-onlinepayment-description configuration
4866 option, or "Internet services" if that is unset.
4868 If an I<invnum> is specified, this payment (if successful) is applied to the
4869 specified invoice. If you don't specify an I<invnum> you might want to
4870 call the B<apply_payments> method or set the I<apply> option.
4872 I<apply> can be set to true to apply a resulting payment.
4874 I<quiet> can be set true to surpress email decline notices.
4876 I<paynum_ref> can be set to a scalar reference. It will be filled in with the
4877 resulting paynum, if any.
4879 I<payunique> is a unique identifier for this payment.
4881 I<session_id> is a session identifier associated with this payment.
4883 I<depend_jobnum> allows payment capture to unlock export jobs
4887 sub realtime_collect {
4888 my( $self, %options ) = @_;
4891 warn "$me realtime_collect:\n";
4892 warn " $_ => $options{$_}\n" foreach keys %options;
4895 $options{amount} = $self->balance unless exists( $options{amount} );
4896 $options{method} = FS::payby->payby2bop($self->payby)
4897 unless exists( $options{method} );
4899 return $self->realtime_bop({%options});
4903 =item _realtime_bop { [ ARG => VALUE ... ] }
4905 Runs a realtime credit card, ACH (electronic check) or phone bill transaction
4906 via a Business::OnlinePayment realtime gateway. See
4907 L<http://420.am/business-onlinepayment> for supported gateways.
4909 Required arguments in the hashref are I<method>, and I<amount>
4911 Available methods are: I<CC>, I<ECHECK> and I<LEC>
4913 Available optional arguments are: I<description>, I<invnum>, I<quiet>, I<paynum_ref>, I<payunique>, I<session_id>
4915 The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
4916 I<zip>, I<payinfo> and I<paydate> are also available. Any of these options,
4917 if set, will override the value from the customer record.
4919 I<description> is a free-text field passed to the gateway. It defaults to
4920 the value defined by the business-onlinepayment-description configuration
4921 option, or "Internet services" if that is unset.
4923 If an I<invnum> is specified, this payment (if successful) is applied to the
4924 specified invoice. If you don't specify an I<invnum> you might want to
4925 call the B<apply_payments> method.
4927 I<quiet> can be set true to surpress email decline notices.
4929 I<paynum_ref> can be set to a scalar reference. It will be filled in with the
4930 resulting paynum, if any.
4932 I<payunique> is a unique identifier for this payment.
4934 I<session_id> is a session identifier associated with this payment.
4936 I<depend_jobnum> allows payment capture to unlock export jobs
4938 (moved from cust_bill) (probably should get realtime_{card,ach,lec} here too)
4942 # some helper routines
4943 sub _payment_gateway {
4944 my ($self, $options) = @_;
4946 $options->{payment_gateway} = $self->agent->payment_gateway( %$options )
4947 unless exists($options->{payment_gateway});
4949 $options->{payment_gateway};
4953 my ($self, $options) = @_;
4956 'login' => $options->{payment_gateway}->gateway_username,
4957 'password' => $options->{payment_gateway}->gateway_password,
4962 my ($self, $options) = @_;
4964 $options->{payment_gateway}->gatewaynum
4965 ? $options->{payment_gateway}->options
4966 : @{ $options->{payment_gateway}->get('options') };
4970 my ($self, $options) = @_;
4972 unless ( $options->{'description'} ) {
4973 if ( $conf->exists('business-onlinepayment-description') ) {
4974 my $dtempl = $conf->config('business-onlinepayment-description');
4976 my $agent = $self->agent->agent;
4978 $options->{'description'} = eval qq("$dtempl");
4980 $options->{'description'} = 'Internet services';
4984 $options->{payinfo} = $self->payinfo unless exists( $options->{payinfo} );
4985 $options->{invnum} ||= '';
4986 $options->{payname} = $self->payname unless exists( $options->{payname} );
4990 my ($self, $options) = @_;
4993 $content{address} = exists($options->{'address1'})
4994 ? $options->{'address1'}
4996 my $address2 = exists($options->{'address2'})
4997 ? $options->{'address2'}
4999 $content{address} .= ", ". $address2 if length($address2);
5001 my $payip = exists($options->{'payip'}) ? $options->{'payip'} : $self->payip;
5002 $content{customer_ip} = $payip if length($payip);
5004 $content{invoice_number} = $options->{'invnum'}
5005 if exists($options->{'invnum'}) && length($options->{'invnum'});
5007 $content{email_customer} =
5008 ( $conf->exists('business-onlinepayment-email_customer')
5009 || $conf->exists('business-onlinepayment-email-override') );
5011 $content{payfirst} = $self->getfield('first');
5012 $content{paylast} = $self->getfield('last');
5014 $content{account_name} = "$content{payfirst} $content{paylast}"
5015 if $options->{method} eq 'ECHECK';
5017 $content{name} = $options->{payname};
5018 $content{name} = $content{account_name} if exists($content{account_name});
5020 $content{city} = exists($options->{city})
5023 $content{state} = exists($options->{state})
5026 $content{zip} = exists($options->{zip})
5029 $content{country} = exists($options->{country})
5030 ? $options->{country}
5032 $content{referer} = 'http://cleanwhisker.420.am/'; #XXX fix referer :/
5033 $content{phone} = $self->daytime || $self->night;
5038 my %bop_method2payby = (
5044 sub _new_realtime_bop {
5048 if (ref($_[0]) eq 'HASH') {
5049 %options = %{$_[0]};
5051 my ( $method, $amount ) = ( shift, shift );
5053 $options{method} = $method;
5054 $options{amount} = $amount;
5058 warn "$me realtime_bop (new): $options{method} $options{amount}\n";
5059 warn " $_ => $options{$_}\n" foreach keys %options;
5062 return $self->fake_bop(%options) if $options{'fake'};
5064 $self->_bop_defaults(\%options);
5067 # set trans_is_recur based on invnum if there is one
5070 my $trans_is_recur = 0;
5071 if ( $options{'invnum'} ) {
5073 my $cust_bill = qsearchs('cust_bill', { 'invnum' => $options{'invnum'} } );
5074 die "invnum ". $options{'invnum'}. " not found" unless $cust_bill;
5077 map { $_->part_pkg }
5079 map { $_->cust_pkg }
5080 $cust_bill->cust_bill_pkg;
5083 if grep { $_->freq ne '0' } @part_pkg;
5091 my $payment_gateway = $self->_payment_gateway( \%options );
5092 my $namespace = $payment_gateway->gateway_namespace;
5094 eval "use $namespace";
5098 # check for banned credit card/ACH
5101 my $ban = qsearchs('banned_pay', {
5102 'payby' => $bop_method2payby{$options{method}},
5103 'payinfo' => md5_base64($options{payinfo}),
5105 return "Banned credit card" if $ban;
5111 my (%bop_content) = $self->_bop_content(\%options);
5113 if ( $options{method} ne 'ECHECK' ) {
5114 $options{payname} =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
5115 or return "Illegal payname $options{payname}";
5116 ($bop_content{payfirst}, $bop_content{paylast}) = ($1, $2);
5119 my @invoicing_list = $self->invoicing_list_emailonly;
5120 if ( $conf->exists('emailinvoiceautoalways')
5121 || $conf->exists('emailinvoiceauto') && ! @invoicing_list
5122 || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
5123 push @invoicing_list, $self->all_emails;
5126 my $email = ($conf->exists('business-onlinepayment-email-override'))
5127 ? $conf->config('business-onlinepayment-email-override')
5128 : $invoicing_list[0];
5132 if ( $namespace eq 'Business::OnlinePayment' && $options{method} eq 'CC' ) {
5134 $content{card_number} = $options{payinfo};
5135 $paydate = exists($options{'paydate'})
5136 ? $options{'paydate'}
5138 $paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
5139 $content{expiration} = "$2/$1";
5141 my $paycvv = exists($options{'paycvv'})
5142 ? $options{'paycvv'}
5144 $content{cvv2} = $paycvv
5147 my $paystart_month = exists($options{'paystart_month'})
5148 ? $options{'paystart_month'}
5149 : $self->paystart_month;
5151 my $paystart_year = exists($options{'paystart_year'})
5152 ? $options{'paystart_year'}
5153 : $self->paystart_year;
5155 $content{card_start} = "$paystart_month/$paystart_year"
5156 if $paystart_month && $paystart_year;
5158 my $payissue = exists($options{'payissue'})
5159 ? $options{'payissue'}
5161 $content{issue_number} = $payissue if $payissue;
5163 if ( $self->_bop_recurring_billing( 'payinfo' => $options{'payinfo'},
5164 'trans_is_recur' => $trans_is_recur,
5168 $content{recurring_billing} = 'YES';
5169 $content{acct_code} = 'rebill'
5170 if $conf->exists('credit_card-recurring_billing_acct_code');
5173 } elsif ( $namespace eq 'Business::OnlinePayment' && $options{method} eq 'ECHECK' ){
5174 ( $content{account_number}, $content{routing_code} ) =
5175 split('@', $options{payinfo});
5176 $content{bank_name} = $options{payname};
5177 $content{bank_state} = exists($options{'paystate'})
5178 ? $options{'paystate'}
5179 : $self->getfield('paystate');
5180 $content{account_type} = exists($options{'paytype'})
5181 ? uc($options{'paytype'}) || 'CHECKING'
5182 : uc($self->getfield('paytype')) || 'CHECKING';
5183 $content{customer_org} = $self->company ? 'B' : 'I';
5184 $content{state_id} = exists($options{'stateid'})
5185 ? $options{'stateid'}
5186 : $self->getfield('stateid');
5187 $content{state_id_state} = exists($options{'stateid_state'})
5188 ? $options{'stateid_state'}
5189 : $self->getfield('stateid_state');
5190 $content{customer_ssn} = exists($options{'ss'})
5193 } elsif ( $namespace eq 'Business::OnlinePayment' && $options{method} eq 'LEC' ) {
5194 $content{phone} = $options{payinfo};
5195 } elsif ( $namespace eq 'Business::OnlineThirdPartyPayment' ) {
5202 # run transaction(s)
5205 my $balance = exists( $options{'balance'} )
5206 ? $options{'balance'}
5209 $self->select_for_update; #mutex ... just until we get our pending record in
5211 #the checks here are intended to catch concurrent payments
5212 #double-form-submission prevention is taken care of in cust_pay_pending::check
5215 return "The customer's balance has changed; $options{method} transaction aborted."
5216 if $self->balance < $balance;
5217 #&& $self->balance < $options{amount}; #might as well anyway?
5219 #also check and make sure there aren't *other* pending payments for this cust
5221 my @pending = qsearch('cust_pay_pending', {
5222 'custnum' => $self->custnum,
5223 'status' => { op=>'!=', value=>'done' }
5225 return "A payment is already being processed for this customer (".
5226 join(', ', map 'paypendingnum '. $_->paypendingnum, @pending ).
5227 "); $options{method} transaction aborted."
5228 if scalar(@pending);
5230 #okay, good to go, if we're a duplicate, cust_pay_pending will kick us out
5232 my $cust_pay_pending = new FS::cust_pay_pending {
5233 'custnum' => $self->custnum,
5234 #'invnum' => $options{'invnum'},
5235 'paid' => $options{amount},
5237 'payby' => $bop_method2payby{$options{method}},
5238 'payinfo' => $options{payinfo},
5239 'paydate' => $paydate,
5240 'recurring_billing' => $content{recurring_billing},
5241 'pkgnum' => $options{'pkgnum'},
5243 'gatewaynum' => $payment_gateway->gatewaynum || '',
5244 'session_id' => $options{session_id} || '',
5245 'jobnum' => $options{depend_jobnum} || '',
5247 $cust_pay_pending->payunique( $options{payunique} )
5248 if defined($options{payunique}) && length($options{payunique});
5249 my $cpp_new_err = $cust_pay_pending->insert; #mutex lost when this is inserted
5250 return $cpp_new_err if $cpp_new_err;
5252 my( $action1, $action2 ) =
5253 split( /\s*\,\s*/, $payment_gateway->gateway_action );
5255 my $transaction = new $namespace( $payment_gateway->gateway_module,
5256 $self->_bop_options(\%options),
5259 $transaction->content(
5260 'type' => $options{method},
5261 $self->_bop_auth(\%options),
5262 'action' => $action1,
5263 'description' => $options{'description'},
5264 'amount' => $options{amount},
5265 #'invoice_number' => $options{'invnum'},
5266 'customer_id' => $self->custnum,
5268 'reference' => $cust_pay_pending->paypendingnum, #for now
5273 $cust_pay_pending->status('pending');
5274 my $cpp_pending_err = $cust_pay_pending->replace;
5275 return $cpp_pending_err if $cpp_pending_err;
5278 my $BOP_TESTING = 0;
5279 my $BOP_TESTING_SUCCESS = 1;
5281 unless ( $BOP_TESTING ) {
5282 $transaction->submit();
5284 if ( $BOP_TESTING_SUCCESS ) {
5285 $transaction->is_success(1);
5286 $transaction->authorization('fake auth');
5288 $transaction->is_success(0);
5289 $transaction->error_message('fake failure');
5293 if ( $transaction->is_success() && $namespace eq 'Business::OnlineThirdPartyPayment' ) {
5295 return { reference => $cust_pay_pending->paypendingnum,
5296 map { $_ => $transaction->$_ } qw ( popup_url collectitems ) };
5298 } elsif ( $transaction->is_success() && $action2 ) {
5300 $cust_pay_pending->status('authorized');
5301 my $cpp_authorized_err = $cust_pay_pending->replace;
5302 return $cpp_authorized_err if $cpp_authorized_err;
5304 my $auth = $transaction->authorization;
5305 my $ordernum = $transaction->can('order_number')
5306 ? $transaction->order_number
5310 new Business::OnlinePayment( $payment_gateway->gateway_module,
5311 $self->_bop_options(\%options),
5316 type => $options{method},
5318 $self->_bop_auth(\%options),
5319 order_number => $ordernum,
5320 amount => $options{amount},
5321 authorization => $auth,
5322 description => $options{'description'},
5325 foreach my $field (qw( authorization_source_code returned_ACI
5326 transaction_identifier validation_code
5327 transaction_sequence_num local_transaction_date
5328 local_transaction_time AVS_result_code )) {
5329 $capture{$field} = $transaction->$field() if $transaction->can($field);
5332 $capture->content( %capture );
5336 unless ( $capture->is_success ) {
5337 my $e = "Authorization successful but capture failed, custnum #".
5338 $self->custnum. ': '. $capture->result_code.
5339 ": ". $capture->error_message;
5347 # remove paycvv after initial transaction
5350 #false laziness w/misc/process/payment.cgi - check both to make sure working
5352 if ( defined $self->dbdef_table->column('paycvv')
5353 && length($self->paycvv)
5354 && ! grep { $_ eq cardtype($options{payinfo}) } $conf->config('cvv-save')
5356 my $error = $self->remove_cvv;
5358 warn "WARNING: error removing cvv: $error\n";
5366 $self->_realtime_bop_result( $cust_pay_pending, $transaction, %options );
5378 if (ref($_[0]) eq 'HASH') {
5379 %options = %{$_[0]};
5381 my ( $method, $amount ) = ( shift, shift );
5383 $options{method} = $method;
5384 $options{amount} = $amount;
5387 if ( $options{'fake_failure'} ) {
5388 return "Error: No error; test failure requested with fake_failure";
5392 #if ( $payment_gateway->gatewaynum ) { # agent override
5393 # $paybatch = $payment_gateway->gatewaynum. '-';
5396 #$paybatch .= "$processor:". $transaction->authorization;
5398 #$paybatch .= ':'. $transaction->order_number
5399 # if $transaction->can('order_number')
5400 # && length($transaction->order_number);
5402 my $paybatch = 'FakeProcessor:54:32';
5404 my $cust_pay = new FS::cust_pay ( {
5405 'custnum' => $self->custnum,
5406 'invnum' => $options{'invnum'},
5407 'paid' => $options{amount},
5409 'payby' => $bop_method2payby{$options{method}},
5410 #'payinfo' => $payinfo,
5411 'payinfo' => '4111111111111111',
5412 'paybatch' => $paybatch,
5413 #'paydate' => $paydate,
5414 'paydate' => '2012-05-01',
5416 $cust_pay->payunique( $options{payunique} ) if length($options{payunique});
5418 my $error = $cust_pay->insert($options{'manual'} ? ( 'manual' => 1 ) : () );
5421 $cust_pay->invnum(''); #try again with no specific invnum
5422 my $error2 = $cust_pay->insert( $options{'manual'} ?
5423 ( 'manual' => 1 ) : ()
5426 # gah, even with transactions.
5427 my $e = 'WARNING: Card/ACH debited but database not updated - '.
5428 "error inserting (fake!) payment: $error2".
5429 " (previously tried insert with invnum #$options{'invnum'}" .
5436 if ( $options{'paynum_ref'} ) {
5437 ${ $options{'paynum_ref'} } = $cust_pay->paynum;
5440 return ''; #no error
5445 # item _realtime_bop_result CUST_PAY_PENDING, BOP_OBJECT [ OPTION => VALUE ... ]
5447 # Wraps up processing of a realtime credit card, ACH (electronic check) or
5448 # phone bill transaction.
5450 sub _realtime_bop_result {
5451 my( $self, $cust_pay_pending, $transaction, %options ) = @_;
5453 warn "$me _realtime_bop_result: pending transaction ".
5454 $cust_pay_pending->paypendingnum. "\n";
5455 warn " $_ => $options{$_}\n" foreach keys %options;
5458 my $payment_gateway = $options{payment_gateway}
5459 or return "no payment gateway in arguments to _realtime_bop_result";
5461 $cust_pay_pending->status($transaction->is_success() ? 'captured' : 'declined');
5462 my $cpp_captured_err = $cust_pay_pending->replace;
5463 return $cpp_captured_err if $cpp_captured_err;
5465 if ( $transaction->is_success() ) {
5468 if ( $payment_gateway->gatewaynum ) { # agent override
5469 $paybatch = $payment_gateway->gatewaynum. '-';
5472 $paybatch .= $payment_gateway->gateway_module. ":".
5473 $transaction->authorization;
5475 $paybatch .= ':'. $transaction->order_number
5476 if $transaction->can('order_number')
5477 && length($transaction->order_number);
5479 my $cust_pay = new FS::cust_pay ( {
5480 'custnum' => $self->custnum,
5481 'invnum' => $options{'invnum'},
5482 'paid' => $cust_pay_pending->paid,
5484 'payby' => $cust_pay_pending->payby,
5485 #'payinfo' => $payinfo,
5486 'paybatch' => $paybatch,
5487 'paydate' => $cust_pay_pending->paydate,
5488 'pkgnum' => $cust_pay_pending->pkgnum,
5490 #doesn't hurt to know, even though the dup check is in cust_pay_pending now
5491 $cust_pay->payunique( $options{payunique} )
5492 if defined($options{payunique}) && length($options{payunique});
5494 my $oldAutoCommit = $FS::UID::AutoCommit;
5495 local $FS::UID::AutoCommit = 0;
5498 #start a transaction, insert the cust_pay and set cust_pay_pending.status to done in a single transction
5500 my $error = $cust_pay->insert($options{'manual'} ? ( 'manual' => 1 ) : () );
5503 $cust_pay->invnum(''); #try again with no specific invnum
5504 my $error2 = $cust_pay->insert( $options{'manual'} ?
5505 ( 'manual' => 1 ) : ()
5508 # gah. but at least we have a record of the state we had to abort in
5509 # from cust_pay_pending now.
5510 my $e = "WARNING: $options{method} captured but payment not recorded -".
5511 " error inserting payment (". $payment_gateway->gateway_module.
5513 " (previously tried insert with invnum #$options{'invnum'}" .
5514 ": $error ) - pending payment saved as paypendingnum ".
5515 $cust_pay_pending->paypendingnum. "\n";
5521 my $jobnum = $cust_pay_pending->jobnum;
5523 my $placeholder = qsearchs( 'queue', { 'jobnum' => $jobnum } );
5525 unless ( $placeholder ) {
5526 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
5527 my $e = "WARNING: $options{method} captured but job $jobnum not ".
5528 "found for paypendingnum ". $cust_pay_pending->paypendingnum. "\n";
5533 $error = $placeholder->delete;
5536 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
5537 my $e = "WARNING: $options{method} captured but could not delete ".
5538 "job $jobnum for paypendingnum ".
5539 $cust_pay_pending->paypendingnum. ": $error\n";
5546 if ( $options{'paynum_ref'} ) {
5547 ${ $options{'paynum_ref'} } = $cust_pay->paynum;
5550 $cust_pay_pending->status('done');
5551 $cust_pay_pending->statustext('captured');
5552 $cust_pay_pending->paynum($cust_pay->paynum);
5553 my $cpp_done_err = $cust_pay_pending->replace;
5555 if ( $cpp_done_err ) {
5557 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
5558 my $e = "WARNING: $options{method} captured but payment not recorded - ".
5559 "error updating status for paypendingnum ".
5560 $cust_pay_pending->paypendingnum. ": $cpp_done_err \n";
5566 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
5568 if ( $options{'apply'} ) {
5569 my $apply_error = $self->apply_payments_and_credits;
5570 if ( $apply_error ) {
5571 warn "WARNING: error applying payment: $apply_error\n";
5572 #but we still should return no error cause the payment otherwise went
5577 return ''; #no error
5583 my $perror = $payment_gateway->gateway_module. " error: ".
5584 $transaction->error_message;
5586 my $jobnum = $cust_pay_pending->jobnum;
5588 my $placeholder = qsearchs( 'queue', { 'jobnum' => $jobnum } );
5590 if ( $placeholder ) {
5591 my $error = $placeholder->depended_delete;
5592 $error ||= $placeholder->delete;
5593 warn "error removing provisioning jobs after declined paypendingnum ".
5594 $cust_pay_pending->paypendingnum. "\n";
5596 my $e = "error finding job $jobnum for declined paypendingnum ".
5597 $cust_pay_pending->paypendingnum. "\n";
5603 unless ( $transaction->error_message ) {
5606 if ( $transaction->can('response_page') ) {
5608 'page' => ( $transaction->can('response_page')
5609 ? $transaction->response_page
5612 'code' => ( $transaction->can('response_code')
5613 ? $transaction->response_code
5616 'headers' => ( $transaction->can('response_headers')
5617 ? $transaction->response_headers
5623 "No additional debugging information available for ".
5624 $payment_gateway->gateway_module;
5627 $perror .= "No error_message returned from ".
5628 $payment_gateway->gateway_module. " -- ".
5629 ( ref($t_response) ? Dumper($t_response) : $t_response );
5633 if ( !$options{'quiet'} && !$realtime_bop_decline_quiet
5634 && $conf->exists('emaildecline')
5635 && grep { $_ ne 'POST' } $self->invoicing_list
5636 && ! grep { $transaction->error_message =~ /$_/ }
5637 $conf->config('emaildecline-exclude')
5639 my @templ = $conf->config('declinetemplate');
5640 my $template = new Text::Template (
5642 SOURCE => [ map "$_\n", @templ ],
5643 ) or return "($perror) can't create template: $Text::Template::ERROR";
5644 $template->compile()
5645 or return "($perror) can't compile template: $Text::Template::ERROR";
5649 scalar( $conf->config('company_name', $self->agentnum ) ),
5650 'company_address' =>
5651 join("\n", $conf->config('company_address', $self->agentnum ) ),
5652 'error' => $transaction->error_message,
5655 my $error = send_email(
5656 'from' => $conf->config('invoice_from', $self->agentnum ),
5657 'to' => [ grep { $_ ne 'POST' } $self->invoicing_list ],
5658 'subject' => 'Your payment could not be processed',
5659 'body' => [ $template->fill_in(HASH => $templ_hash) ],
5662 $perror .= " (also received error sending decline notification: $error)"
5667 $cust_pay_pending->status('done');
5668 $cust_pay_pending->statustext("declined: $perror");
5669 my $cpp_done_err = $cust_pay_pending->replace;
5670 if ( $cpp_done_err ) {
5671 my $e = "WARNING: $options{method} declined but pending payment not ".
5672 "resolved - error updating status for paypendingnum ".
5673 $cust_pay_pending->paypendingnum. ": $cpp_done_err \n";
5675 $perror = "$e ($perror)";
5683 =item realtime_botpp_capture CUST_PAY_PENDING [ OPTION => VALUE ... ]
5685 Verifies successful third party processing of a realtime credit card,
5686 ACH (electronic check) or phone bill transaction via a
5687 Business::OnlineThirdPartyPayment realtime gateway. See
5688 L<http://420.am/business-onlinethirdpartypayment> for supported gateways.
5690 Available options are: I<description>, I<invnum>, I<quiet>, I<paynum_ref>, I<payunique>
5692 The additional options I<payname>, I<city>, I<state>,
5693 I<zip>, I<payinfo> and I<paydate> are also available. Any of these options,
5694 if set, will override the value from the customer record.
5696 I<description> is a free-text field passed to the gateway. It defaults to
5697 "Internet services".
5699 If an I<invnum> is specified, this payment (if successful) is applied to the
5700 specified invoice. If you don't specify an I<invnum> you might want to
5701 call the B<apply_payments> method.
5703 I<quiet> can be set true to surpress email decline notices.
5705 I<paynum_ref> can be set to a scalar reference. It will be filled in with the
5706 resulting paynum, if any.
5708 I<payunique> is a unique identifier for this payment.
5710 Returns a hashref containing elements bill_error (which will be undefined
5711 upon success) and session_id of any associated session.
5715 sub realtime_botpp_capture {
5716 my( $self, $cust_pay_pending, %options ) = @_;
5718 warn "$me realtime_botpp_capture: pending transaction $cust_pay_pending\n";
5719 warn " $_ => $options{$_}\n" foreach keys %options;
5722 eval "use Business::OnlineThirdPartyPayment";
5726 # select the gateway
5729 my $method = FS::payby->payby2bop($cust_pay_pending->payby);
5731 my $payment_gateway = $cust_pay_pending->gatewaynum
5732 ? qsearchs( 'payment_gateway',
5733 { gatewaynum => $cust_pay_pending->gatewaynum }
5735 : $self->agent->payment_gateway( 'method' => $method,
5736 # 'invnum' => $cust_pay_pending->invnum,
5737 # 'payinfo' => $cust_pay_pending->payinfo,
5740 $options{payment_gateway} = $payment_gateway; # for the helper subs
5746 my @invoicing_list = $self->invoicing_list_emailonly;
5747 if ( $conf->exists('emailinvoiceautoalways')
5748 || $conf->exists('emailinvoiceauto') && ! @invoicing_list
5749 || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
5750 push @invoicing_list, $self->all_emails;
5753 my $email = ($conf->exists('business-onlinepayment-email-override'))
5754 ? $conf->config('business-onlinepayment-email-override')
5755 : $invoicing_list[0];
5759 $content{email_customer} =
5760 ( $conf->exists('business-onlinepayment-email_customer')
5761 || $conf->exists('business-onlinepayment-email-override') );
5764 # run transaction(s)
5768 new Business::OnlineThirdPartyPayment( $payment_gateway->gateway_module,
5769 $self->_bop_options(\%options),
5772 $transaction->reference({ %options });
5774 $transaction->content(
5776 $self->_bop_auth(\%options),
5777 'action' => 'Post Authorization',
5778 'description' => $options{'description'},
5779 'amount' => $cust_pay_pending->paid,
5780 #'invoice_number' => $options{'invnum'},
5781 'customer_id' => $self->custnum,
5782 'referer' => 'http://cleanwhisker.420.am/',
5783 'reference' => $cust_pay_pending->paypendingnum,
5785 'phone' => $self->daytime || $self->night,
5787 # plus whatever is required for bogus capture avoidance
5790 $transaction->submit();
5793 $self->_realtime_bop_result( $cust_pay_pending, $transaction, %options );
5796 bill_error => $error,
5797 session_id => $cust_pay_pending->session_id,
5802 =item default_payment_gateway DEPRECATED -- use agent->payment_gateway
5806 sub default_payment_gateway {
5807 my( $self, $method ) = @_;
5809 die "Real-time processing not enabled\n"
5810 unless $conf->exists('business-onlinepayment');
5812 #warn "default_payment_gateway deprecated -- use agent->payment_gateway\n";
5815 my $bop_config = 'business-onlinepayment';
5816 $bop_config .= '-ach'
5817 if $method =~ /^(ECHECK|CHEK)$/ && $conf->exists($bop_config. '-ach');
5818 my ( $processor, $login, $password, $action, @bop_options ) =
5819 $conf->config($bop_config);
5820 $action ||= 'normal authorization';
5821 pop @bop_options if scalar(@bop_options) % 2 && $bop_options[-1] =~ /^\s*$/;
5822 die "No real-time processor is enabled - ".
5823 "did you set the business-onlinepayment configuration value?\n"
5826 ( $processor, $login, $password, $action, @bop_options )
5831 Removes the I<paycvv> field from the database directly.
5833 If there is an error, returns the error, otherwise returns false.
5839 my $sth = dbh->prepare("UPDATE cust_main SET paycvv = '' WHERE custnum = ?")
5840 or return dbh->errstr;
5841 $sth->execute($self->custnum)
5842 or return $sth->errstr;
5847 =item _new_realtime_refund_bop METHOD [ OPTION => VALUE ... ]
5849 Refunds a realtime credit card, ACH (electronic check) or phone bill transaction
5850 via a Business::OnlinePayment realtime gateway. See
5851 L<http://420.am/business-onlinepayment> for supported gateways.
5853 Available methods are: I<CC>, I<ECHECK> and I<LEC>
5855 Available options are: I<amount>, I<reason>, I<paynum>, I<paydate>
5857 Most gateways require a reference to an original payment transaction to refund,
5858 so you probably need to specify a I<paynum>.
5860 I<amount> defaults to the original amount of the payment if not specified.
5862 I<reason> specifies a reason for the refund.
5864 I<paydate> specifies the expiration date for a credit card overriding the
5865 value from the customer record or the payment record. Specified as yyyy-mm-dd
5867 Implementation note: If I<amount> is unspecified or equal to the amount of the
5868 orignal payment, first an attempt is made to "void" the transaction via
5869 the gateway (to cancel a not-yet settled transaction) and then if that fails,
5870 the normal attempt is made to "refund" ("credit") the transaction via the
5871 gateway is attempted.
5873 #The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
5874 #I<zip>, I<payinfo> and I<paydate> are also available. Any of these options,
5875 #if set, will override the value from the customer record.
5877 #If an I<invnum> is specified, this payment (if successful) is applied to the
5878 #specified invoice. If you don't specify an I<invnum> you might want to
5879 #call the B<apply_payments> method.
5883 #some false laziness w/realtime_bop, not enough to make it worth merging
5884 #but some useful small subs should be pulled out
5885 sub _new_realtime_refund_bop {
5889 if (ref($_[0]) ne 'HASH') {
5890 %options = %{$_[0]};
5894 $options{method} = $method;
5898 warn "$me realtime_refund_bop (new): $options{method} refund\n";
5899 warn " $_ => $options{$_}\n" foreach keys %options;
5903 # look up the original payment and optionally a gateway for that payment
5907 my $amount = $options{'amount'};
5909 my( $processor, $login, $password, @bop_options, $namespace ) ;
5910 my( $auth, $order_number ) = ( '', '', '' );
5912 if ( $options{'paynum'} ) {
5914 warn " paynum: $options{paynum}\n" if $DEBUG > 1;
5915 $cust_pay = qsearchs('cust_pay', { paynum=>$options{'paynum'} } )
5916 or return "Unknown paynum $options{'paynum'}";
5917 $amount ||= $cust_pay->paid;
5919 $cust_pay->paybatch =~ /^((\d+)\-)?(\w+):\s*([\w\-\/ ]*)(:([\w\-]+))?$/
5920 or return "Can't parse paybatch for paynum $options{'paynum'}: ".
5921 $cust_pay->paybatch;
5922 my $gatewaynum = '';
5923 ( $gatewaynum, $processor, $auth, $order_number ) = ( $2, $3, $4, $6 );
5925 if ( $gatewaynum ) { #gateway for the payment to be refunded
5927 my $payment_gateway =
5928 qsearchs('payment_gateway', { 'gatewaynum' => $gatewaynum } );
5929 die "payment gateway $gatewaynum not found"
5930 unless $payment_gateway;
5932 $processor = $payment_gateway->gateway_module;
5933 $login = $payment_gateway->gateway_username;
5934 $password = $payment_gateway->gateway_password;
5935 $namespace = $payment_gateway->gateway_namespace;
5936 @bop_options = $payment_gateway->options;
5938 } else { #try the default gateway
5941 my $payment_gateway =
5942 $self->agent->payment_gateway('method' => $options{method});
5944 ( $conf_processor, $login, $password, $namespace ) =
5945 map { my $method = "gateway_$_"; $payment_gateway->$method }
5946 qw( module username password namespace );
5948 @bop_options = $payment_gateway->gatewaynum
5949 ? $payment_gateway->options
5950 : @{ $payment_gateway->get('options') };
5952 return "processor of payment $options{'paynum'} $processor does not".
5953 " match default processor $conf_processor"
5954 unless $processor eq $conf_processor;
5959 } else { # didn't specify a paynum, so look for agent gateway overrides
5960 # like a normal transaction
5962 my $payment_gateway =
5963 $self->agent->payment_gateway( 'method' => $options{method},
5964 #'payinfo' => $payinfo,
5966 my( $processor, $login, $password, $namespace ) =
5967 map { my $method = "gateway_$_"; $payment_gateway->$method }
5968 qw( module username password namespace );
5970 my @bop_options = $payment_gateway->gatewaynum
5971 ? $payment_gateway->options
5972 : @{ $payment_gateway->get('options') };
5975 return "neither amount nor paynum specified" unless $amount;
5977 eval "use $namespace";
5981 'type' => $options{method},
5983 'password' => $password,
5984 'order_number' => $order_number,
5985 'amount' => $amount,
5986 'referer' => 'http://cleanwhisker.420.am/', #XXX fix referer :/
5988 $content{authorization} = $auth
5989 if length($auth); #echeck/ACH transactions have an order # but no auth
5990 #(at least with authorize.net)
5992 my $disable_void_after;
5993 if ($conf->exists('disable_void_after')
5994 && $conf->config('disable_void_after') =~ /^(\d+)$/) {
5995 $disable_void_after = $1;
5998 #first try void if applicable
5999 if ( $cust_pay && $cust_pay->paid == $amount
6001 ( not defined($disable_void_after) )
6002 || ( time < ($cust_pay->_date + $disable_void_after ) )
6005 warn " attempting void\n" if $DEBUG > 1;
6006 my $void = new Business::OnlinePayment( $processor, @bop_options );
6007 $content{'card_number'} = $cust_pay->payinfo
6008 if $cust_pay->payby eq 'CARD'
6009 && $void->can('info') && $void->info('CC_void_requires_card');
6010 $void->content( 'action' => 'void', %content );
6012 if ( $void->is_success ) {
6013 my $error = $cust_pay->void($options{'reason'});
6015 # gah, even with transactions.
6016 my $e = 'WARNING: Card/ACH voided but database not updated - '.
6017 "error voiding payment: $error";
6021 warn " void successful\n" if $DEBUG > 1;
6026 warn " void unsuccessful, trying refund\n"
6030 my $address = $self->address1;
6031 $address .= ", ". $self->address2 if $self->address2;
6033 my($payname, $payfirst, $paylast);
6034 if ( $self->payname && $options{method} ne 'ECHECK' ) {
6035 $payname = $self->payname;
6036 $payname =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
6037 or return "Illegal payname $payname";
6038 ($payfirst, $paylast) = ($1, $2);
6040 $payfirst = $self->getfield('first');
6041 $paylast = $self->getfield('last');
6042 $payname = "$payfirst $paylast";
6045 my @invoicing_list = $self->invoicing_list_emailonly;
6046 if ( $conf->exists('emailinvoiceautoalways')
6047 || $conf->exists('emailinvoiceauto') && ! @invoicing_list
6048 || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
6049 push @invoicing_list, $self->all_emails;
6052 my $email = ($conf->exists('business-onlinepayment-email-override'))
6053 ? $conf->config('business-onlinepayment-email-override')
6054 : $invoicing_list[0];
6056 my $payip = exists($options{'payip'})
6059 $content{customer_ip} = $payip
6063 if ( $options{method} eq 'CC' ) {
6066 $content{card_number} = $payinfo = $cust_pay->payinfo;
6067 (exists($options{'paydate'}) ? $options{'paydate'} : $cust_pay->paydate)
6068 =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/ &&
6069 ($content{expiration} = "$2/$1"); # where available
6071 $content{card_number} = $payinfo = $self->payinfo;
6072 (exists($options{'paydate'}) ? $options{'paydate'} : $self->paydate)
6073 =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
6074 $content{expiration} = "$2/$1";
6077 } elsif ( $options{method} eq 'ECHECK' ) {
6080 $payinfo = $cust_pay->payinfo;
6082 $payinfo = $self->payinfo;
6084 ( $content{account_number}, $content{routing_code} )= split('@', $payinfo );
6085 $content{bank_name} = $self->payname;
6086 $content{account_type} = 'CHECKING';
6087 $content{account_name} = $payname;
6088 $content{customer_org} = $self->company ? 'B' : 'I';
6089 $content{customer_ssn} = $self->ss;
6090 } elsif ( $options{method} eq 'LEC' ) {
6091 $content{phone} = $payinfo = $self->payinfo;
6095 my $refund = new Business::OnlinePayment( $processor, @bop_options );
6096 my %sub_content = $refund->content(
6097 'action' => 'credit',
6098 'customer_id' => $self->custnum,
6099 'last_name' => $paylast,
6100 'first_name' => $payfirst,
6102 'address' => $address,
6103 'city' => $self->city,
6104 'state' => $self->state,
6105 'zip' => $self->zip,
6106 'country' => $self->country,
6108 'phone' => $self->daytime || $self->night,
6111 warn join('', map { " $_ => $sub_content{$_}\n" } keys %sub_content )
6115 return "$processor error: ". $refund->error_message
6116 unless $refund->is_success();
6118 my $paybatch = "$processor:". $refund->authorization;
6119 $paybatch .= ':'. $refund->order_number
6120 if $refund->can('order_number') && $refund->order_number;
6122 while ( $cust_pay && $cust_pay->unapplied < $amount ) {
6123 my @cust_bill_pay = $cust_pay->cust_bill_pay;
6124 last unless @cust_bill_pay;
6125 my $cust_bill_pay = pop @cust_bill_pay;
6126 my $error = $cust_bill_pay->delete;
6130 my $cust_refund = new FS::cust_refund ( {
6131 'custnum' => $self->custnum,
6132 'paynum' => $options{'paynum'},
6133 'refund' => $amount,
6135 'payby' => $bop_method2payby{$options{method}},
6136 'payinfo' => $payinfo,
6137 'paybatch' => $paybatch,
6138 'reason' => $options{'reason'} || 'card or ACH refund',
6140 my $error = $cust_refund->insert;
6142 $cust_refund->paynum(''); #try again with no specific paynum
6143 my $error2 = $cust_refund->insert;
6145 # gah, even with transactions.
6146 my $e = 'WARNING: Card/ACH refunded but database not updated - '.
6147 "error inserting refund ($processor): $error2".
6148 " (previously tried insert with paynum #$options{'paynum'}" .
6159 =item batch_card OPTION => VALUE...
6161 Adds a payment for this invoice to the pending credit card batch (see
6162 L<FS::cust_pay_batch>), or, if the B<realtime> option is set to a true value,
6163 runs the payment using a realtime gateway.
6168 my ($self, %options) = @_;
6171 if (exists($options{amount})) {
6172 $amount = $options{amount};
6174 $amount = sprintf("%.2f", $self->balance - $self->in_transit_payments);
6176 return '' unless $amount > 0;
6178 my $invnum = delete $options{invnum};
6179 my $payby = $options{invnum} || $self->payby; #dubious
6181 if ($options{'realtime'}) {
6182 return $self->realtime_bop( FS::payby->payby2bop($self->payby),
6188 my $oldAutoCommit = $FS::UID::AutoCommit;
6189 local $FS::UID::AutoCommit = 0;
6192 #this needs to handle mysql as well as Pg, like svc_acct.pm
6193 #(make it into a common function if folks need to do batching with mysql)
6194 $dbh->do("LOCK TABLE pay_batch IN SHARE ROW EXCLUSIVE MODE")
6195 or return "Cannot lock pay_batch: " . $dbh->errstr;
6199 'payby' => FS::payby->payby2payment($payby),
6202 my $pay_batch = qsearchs( 'pay_batch', \%pay_batch );
6204 unless ( $pay_batch ) {
6205 $pay_batch = new FS::pay_batch \%pay_batch;
6206 my $error = $pay_batch->insert;
6208 $dbh->rollback if $oldAutoCommit;
6209 die "error creating new batch: $error\n";
6213 my $old_cust_pay_batch = qsearchs('cust_pay_batch', {
6214 'batchnum' => $pay_batch->batchnum,
6215 'custnum' => $self->custnum,
6218 foreach (qw( address1 address2 city state zip country payby payinfo paydate
6220 $options{$_} = '' unless exists($options{$_});
6223 my $cust_pay_batch = new FS::cust_pay_batch ( {
6224 'batchnum' => $pay_batch->batchnum,
6225 'invnum' => $invnum || 0, # is there a better value?
6226 # this field should be
6228 # cust_bill_pay_batch now
6229 'custnum' => $self->custnum,
6230 'last' => $self->getfield('last'),
6231 'first' => $self->getfield('first'),
6232 'address1' => $options{address1} || $self->address1,
6233 'address2' => $options{address2} || $self->address2,
6234 'city' => $options{city} || $self->city,
6235 'state' => $options{state} || $self->state,
6236 'zip' => $options{zip} || $self->zip,
6237 'country' => $options{country} || $self->country,
6238 'payby' => $options{payby} || $self->payby,
6239 'payinfo' => $options{payinfo} || $self->payinfo,
6240 'exp' => $options{paydate} || $self->paydate,
6241 'payname' => $options{payname} || $self->payname,
6242 'amount' => $amount, # consolidating
6245 $cust_pay_batch->paybatchnum($old_cust_pay_batch->paybatchnum)
6246 if $old_cust_pay_batch;
6249 if ($old_cust_pay_batch) {
6250 $error = $cust_pay_batch->replace($old_cust_pay_batch)
6252 $error = $cust_pay_batch->insert;
6256 $dbh->rollback if $oldAutoCommit;
6260 my $unapplied = $self->total_unapplied_credits
6261 + $self->total_unapplied_payments
6262 + $self->in_transit_payments;
6263 foreach my $cust_bill ($self->open_cust_bill) {
6264 #$dbh->commit or die $dbh->errstr if $oldAutoCommit;
6265 my $cust_bill_pay_batch = new FS::cust_bill_pay_batch {
6266 'invnum' => $cust_bill->invnum,
6267 'paybatchnum' => $cust_pay_batch->paybatchnum,
6268 'amount' => $cust_bill->owed,
6271 if ($unapplied >= $cust_bill_pay_batch->amount){
6272 $unapplied -= $cust_bill_pay_batch->amount;
6275 $cust_bill_pay_batch->amount(sprintf ( "%.2f",
6276 $cust_bill_pay_batch->amount - $unapplied )); $unapplied = 0;
6278 $error = $cust_bill_pay_batch->insert;
6280 $dbh->rollback if $oldAutoCommit;
6285 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
6289 =item apply_payments_and_credits [ OPTION => VALUE ... ]
6291 Applies unapplied payments and credits.
6293 In most cases, this new method should be used in place of sequential
6294 apply_payments and apply_credits methods.
6296 A hash of optional arguments may be passed. Currently "manual" is supported.
6297 If true, a payment receipt is sent instead of a statement when
6298 'payment_receipt_email' configuration option is set.
6300 If there is an error, returns the error, otherwise returns false.
6304 sub apply_payments_and_credits {
6305 my( $self, %options ) = @_;
6307 local $SIG{HUP} = 'IGNORE';
6308 local $SIG{INT} = 'IGNORE';
6309 local $SIG{QUIT} = 'IGNORE';
6310 local $SIG{TERM} = 'IGNORE';
6311 local $SIG{TSTP} = 'IGNORE';
6312 local $SIG{PIPE} = 'IGNORE';
6314 my $oldAutoCommit = $FS::UID::AutoCommit;
6315 local $FS::UID::AutoCommit = 0;
6318 $self->select_for_update; #mutex
6320 foreach my $cust_bill ( $self->open_cust_bill ) {
6321 my $error = $cust_bill->apply_payments_and_credits(%options);
6323 $dbh->rollback if $oldAutoCommit;
6324 return "Error applying: $error";
6328 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
6333 =item apply_credits OPTION => VALUE ...
6335 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
6336 to outstanding invoice balances in chronological order (or reverse
6337 chronological order if the I<order> option is set to B<newest>) and returns the
6338 value of any remaining unapplied credits available for refund (see
6339 L<FS::cust_refund>).
6341 Dies if there is an error.
6349 local $SIG{HUP} = 'IGNORE';
6350 local $SIG{INT} = 'IGNORE';
6351 local $SIG{QUIT} = 'IGNORE';
6352 local $SIG{TERM} = 'IGNORE';
6353 local $SIG{TSTP} = 'IGNORE';
6354 local $SIG{PIPE} = 'IGNORE';
6356 my $oldAutoCommit = $FS::UID::AutoCommit;
6357 local $FS::UID::AutoCommit = 0;
6360 $self->select_for_update; #mutex
6362 unless ( $self->total_unapplied_credits ) {
6363 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
6367 my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
6368 qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
6370 my @invoices = $self->open_cust_bill;
6371 @invoices = sort { $b->_date <=> $a->_date } @invoices
6372 if defined($opt{'order'}) && $opt{'order'} eq 'newest';
6374 if ( $conf->exists('pkg-balances') ) {
6375 # limit @credits to those w/ a pkgnum grepped from $self
6377 foreach my $i (@invoices) {
6378 foreach my $li ( $i->cust_bill_pkg ) {
6379 $pkgnums{$li->pkgnum} = 1;
6382 @credits = grep { ! $_->pkgnum || $pkgnums{$_->pkgnum} } @credits;
6387 foreach my $cust_bill ( @invoices ) {
6389 if ( !defined($credit) || $credit->credited == 0) {
6390 $credit = pop @credits or last;
6394 if ( $conf->exists('pkg-balances') && $credit->pkgnum ) {
6395 $owed = $cust_bill->owed_pkgnum($credit->pkgnum);
6397 $owed = $cust_bill->owed;
6399 unless ( $owed > 0 ) {
6400 push @credits, $credit;
6404 my $amount = min( $credit->credited, $owed );
6406 my $cust_credit_bill = new FS::cust_credit_bill ( {
6407 'crednum' => $credit->crednum,
6408 'invnum' => $cust_bill->invnum,
6409 'amount' => $amount,
6411 $cust_credit_bill->pkgnum( $credit->pkgnum )
6412 if $conf->exists('pkg-balances') && $credit->pkgnum;
6413 my $error = $cust_credit_bill->insert;
6415 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
6419 redo if ($cust_bill->owed > 0) && ! $conf->exists('pkg-balances');
6423 my $total_unapplied_credits = $self->total_unapplied_credits;
6425 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
6427 return $total_unapplied_credits;
6430 =item apply_payments [ OPTION => VALUE ... ]
6432 Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
6433 to outstanding invoice balances in chronological order.
6435 #and returns the value of any remaining unapplied payments.
6437 A hash of optional arguments may be passed. Currently "manual" is supported.
6438 If true, a payment receipt is sent instead of a statement when
6439 'payment_receipt_email' configuration option is set.
6441 Dies if there is an error.
6445 sub apply_payments {
6446 my( $self, %options ) = @_;
6448 local $SIG{HUP} = 'IGNORE';
6449 local $SIG{INT} = 'IGNORE';
6450 local $SIG{QUIT} = 'IGNORE';
6451 local $SIG{TERM} = 'IGNORE';
6452 local $SIG{TSTP} = 'IGNORE';
6453 local $SIG{PIPE} = 'IGNORE';
6455 my $oldAutoCommit = $FS::UID::AutoCommit;
6456 local $FS::UID::AutoCommit = 0;
6459 $self->select_for_update; #mutex
6463 my @payments = sort { $b->_date <=> $a->_date }
6464 grep { $_->unapplied > 0 }
6467 my @invoices = sort { $a->_date <=> $b->_date}
6468 grep { $_->owed > 0 }
6471 if ( $conf->exists('pkg-balances') ) {
6472 # limit @payments to those w/ a pkgnum grepped from $self
6474 foreach my $i (@invoices) {
6475 foreach my $li ( $i->cust_bill_pkg ) {
6476 $pkgnums{$li->pkgnum} = 1;
6479 @payments = grep { ! $_->pkgnum || $pkgnums{$_->pkgnum} } @payments;
6484 foreach my $cust_bill ( @invoices ) {
6486 if ( !defined($payment) || $payment->unapplied == 0 ) {
6487 $payment = pop @payments or last;
6491 if ( $conf->exists('pkg-balances') && $payment->pkgnum ) {
6492 $owed = $cust_bill->owed_pkgnum($payment->pkgnum);
6494 $owed = $cust_bill->owed;
6496 unless ( $owed > 0 ) {
6497 push @payments, $payment;
6501 my $amount = min( $payment->unapplied, $owed );
6503 my $cust_bill_pay = new FS::cust_bill_pay ( {
6504 'paynum' => $payment->paynum,
6505 'invnum' => $cust_bill->invnum,
6506 'amount' => $amount,
6508 $cust_bill_pay->pkgnum( $payment->pkgnum )
6509 if $conf->exists('pkg-balances') && $payment->pkgnum;
6510 my $error = $cust_bill_pay->insert(%options);
6512 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
6516 redo if ( $cust_bill->owed > 0) && ! $conf->exists('pkg-balances');
6520 my $total_unapplied_payments = $self->total_unapplied_payments;
6522 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
6524 return $total_unapplied_payments;
6529 Returns the total owed for this customer on all invoices
6530 (see L<FS::cust_bill/owed>).
6536 $self->total_owed_date(2145859200); #12/31/2037
6539 =item total_owed_date TIME
6541 Returns the total owed for this customer on all invoices with date earlier than
6542 TIME. TIME is specified as a UNIX timestamp; see L<perlfunc/"time">). Also
6543 see L<Time::Local> and L<Date::Parse> for conversion functions.
6547 sub total_owed_date {
6551 # my $custnum = $self->custnum;
6553 # my $owed_sql = FS::cust_bill->owed_sql;
6556 # SELECT SUM($owed_sql) FROM cust_bill
6557 # WHERE custnum = $custnum
6558 # AND _date <= $time
6561 # my $sth = dbh->prepare($sql) or die dbh->errstr;
6562 # $sth->execute() or die $sth->errstr;
6564 # return sprintf( '%.2f', $sth->fetchrow_arrayref->[0] );
6567 foreach my $cust_bill (
6568 grep { $_->_date <= $time }
6569 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
6571 $total_bill += $cust_bill->owed;
6573 sprintf( "%.2f", $total_bill );
6577 =item total_owed_pkgnum PKGNUM
6579 Returns the total owed on all invoices for this customer's specific package
6580 when using experimental package balances (see L<FS::cust_bill/owed_pkgnum>).
6584 sub total_owed_pkgnum {
6585 my( $self, $pkgnum ) = @_;
6586 $self->total_owed_date_pkgnum(2145859200, $pkgnum); #12/31/2037
6589 =item total_owed_date_pkgnum TIME PKGNUM
6591 Returns the total owed for this customer's specific package when using
6592 experimental package balances on all invoices with date earlier than
6593 TIME. TIME is specified as a UNIX timestamp; see L<perlfunc/"time">). Also
6594 see L<Time::Local> and L<Date::Parse> for conversion functions.
6598 sub total_owed_date_pkgnum {
6599 my( $self, $time, $pkgnum ) = @_;
6602 foreach my $cust_bill (
6603 grep { $_->_date <= $time }
6604 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
6606 $total_bill += $cust_bill->owed_pkgnum($pkgnum);
6608 sprintf( "%.2f", $total_bill );
6614 Returns the total amount of all payments.
6621 $total += $_->paid foreach $self->cust_pay;
6622 sprintf( "%.2f", $total );
6625 =item total_unapplied_credits
6627 Returns the total outstanding credit (see L<FS::cust_credit>) for this
6628 customer. See L<FS::cust_credit/credited>.
6630 =item total_credited
6632 Old name for total_unapplied_credits. Don't use.
6636 sub total_credited {
6637 #carp "total_credited deprecated, use total_unapplied_credits";
6638 shift->total_unapplied_credits(@_);
6641 sub total_unapplied_credits {
6643 my $total_credit = 0;
6644 $total_credit += $_->credited foreach $self->cust_credit;
6645 sprintf( "%.2f", $total_credit );
6648 =item total_unapplied_credits_pkgnum PKGNUM
6650 Returns the total outstanding credit (see L<FS::cust_credit>) for this
6651 customer. See L<FS::cust_credit/credited>.
6655 sub total_unapplied_credits_pkgnum {
6656 my( $self, $pkgnum ) = @_;
6657 my $total_credit = 0;
6658 $total_credit += $_->credited foreach $self->cust_credit_pkgnum($pkgnum);
6659 sprintf( "%.2f", $total_credit );
6663 =item total_unapplied_payments
6665 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
6666 See L<FS::cust_pay/unapplied>.
6670 sub total_unapplied_payments {
6672 my $total_unapplied = 0;
6673 $total_unapplied += $_->unapplied foreach $self->cust_pay;
6674 sprintf( "%.2f", $total_unapplied );
6677 =item total_unapplied_payments_pkgnum PKGNUM
6679 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer's
6680 specific package when using experimental package balances. See
6681 L<FS::cust_pay/unapplied>.
6685 sub total_unapplied_payments_pkgnum {
6686 my( $self, $pkgnum ) = @_;
6687 my $total_unapplied = 0;
6688 $total_unapplied += $_->unapplied foreach $self->cust_pay_pkgnum($pkgnum);
6689 sprintf( "%.2f", $total_unapplied );
6693 =item total_unapplied_refunds
6695 Returns the total unrefunded refunds (see L<FS::cust_refund>) for this
6696 customer. See L<FS::cust_refund/unapplied>.
6700 sub total_unapplied_refunds {
6702 my $total_unapplied = 0;
6703 $total_unapplied += $_->unapplied foreach $self->cust_refund;
6704 sprintf( "%.2f", $total_unapplied );
6709 Returns the balance for this customer (total_owed plus total_unrefunded, minus
6710 total_unapplied_credits minus total_unapplied_payments).
6718 + $self->total_unapplied_refunds
6719 - $self->total_unapplied_credits
6720 - $self->total_unapplied_payments
6724 =item balance_date TIME
6726 Returns the balance for this customer, only considering invoices with date
6727 earlier than TIME (total_owed_date minus total_credited minus
6728 total_unapplied_payments). TIME is specified as a UNIX timestamp; see
6729 L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion
6738 $self->total_owed_date($time)
6739 + $self->total_unapplied_refunds
6740 - $self->total_unapplied_credits
6741 - $self->total_unapplied_payments
6745 =item balance_pkgnum PKGNUM
6747 Returns the balance for this customer's specific package when using
6748 experimental package balances (total_owed plus total_unrefunded, minus
6749 total_unapplied_credits minus total_unapplied_payments)
6753 sub balance_pkgnum {
6754 my( $self, $pkgnum ) = @_;
6757 $self->total_owed_pkgnum($pkgnum)
6758 # n/a - refunds aren't part of pkg-balances since they don't apply to invoices
6759 # + $self->total_unapplied_refunds_pkgnum($pkgnum)
6760 - $self->total_unapplied_credits_pkgnum($pkgnum)
6761 - $self->total_unapplied_payments_pkgnum($pkgnum)
6765 =item in_transit_payments
6767 Returns the total of requests for payments for this customer pending in
6768 batches in transit to the bank. See L<FS::pay_batch> and L<FS::cust_pay_batch>
6772 sub in_transit_payments {
6774 my $in_transit_payments = 0;
6775 foreach my $pay_batch ( qsearch('pay_batch', {
6778 foreach my $cust_pay_batch ( qsearch('cust_pay_batch', {
6779 'batchnum' => $pay_batch->batchnum,
6780 'custnum' => $self->custnum,
6782 $in_transit_payments += $cust_pay_batch->amount;
6785 sprintf( "%.2f", $in_transit_payments );
6790 Returns a hash of useful information for making a payment.
6800 'CARD' (credit card - automatic), 'DCRD' (credit card - on-demand),
6801 'CHEK' (electronic check - automatic), 'DCHK' (electronic check - on-demand),
6802 'LECB' (Phone bill billing), 'BILL' (billing), or 'COMP' (free).
6806 For credit card transactions:
6818 For electronic check transactions:
6833 $return{balance} = $self->balance;
6835 $return{payname} = $self->payname
6836 || ( $self->first. ' '. $self->get('last') );
6838 $return{$_} = $self->get($_) for qw(address1 address2 city state zip);
6840 $return{payby} = $self->payby;
6841 $return{stateid_state} = $self->stateid_state;
6843 if ( $self->payby =~ /^(CARD|DCRD)$/ ) {
6844 $return{card_type} = cardtype($self->payinfo);
6845 $return{payinfo} = $self->paymask;
6847 @return{'month', 'year'} = $self->paydate_monthyear;
6851 if ( $self->payby =~ /^(CHEK|DCHK)$/ ) {
6852 my ($payinfo1, $payinfo2) = split '@', $self->paymask;
6853 $return{payinfo1} = $payinfo1;
6854 $return{payinfo2} = $payinfo2;
6855 $return{paytype} = $self->paytype;
6856 $return{paystate} = $self->paystate;
6860 #doubleclick protection
6862 $return{paybatch} = "webui-MyAccount-$_date-$$-". rand() * 2**32;
6868 =item paydate_monthyear
6870 Returns a two-element list consisting of the month and year of this customer's
6871 paydate (credit card expiration date for CARD customers)
6875 sub paydate_monthyear {
6877 if ( $self->paydate =~ /^(\d{4})-(\d{1,2})-\d{1,2}$/ ) { #Pg date format
6879 } elsif ( $self->paydate =~ /^(\d{1,2})-(\d{1,2}-)?(\d{4}$)/ ) {
6886 =item tax_exemption TAXNAME
6891 my( $self, $taxname ) = @_;
6893 qsearchs( 'cust_main_exemption', { 'custnum' => $self->custnum,
6894 'taxname' => $taxname,
6899 =item cust_main_exemption
6903 sub cust_main_exemption {
6905 qsearch( 'cust_main_exemption', { 'custnum' => $self->custnum } );
6908 =item invoicing_list [ ARRAYREF ]
6910 If an arguement is given, sets these email addresses as invoice recipients
6911 (see L<FS::cust_main_invoice>). Errors are not fatal and are not reported
6912 (except as warnings), so use check_invoicing_list first.
6914 Returns a list of email addresses (with svcnum entries expanded).
6916 Note: You can clear the invoicing list by passing an empty ARRAYREF. You can
6917 check it without disturbing anything by passing nothing.
6919 This interface may change in the future.
6923 sub invoicing_list {
6924 my( $self, $arrayref ) = @_;
6927 my @cust_main_invoice;
6928 if ( $self->custnum ) {
6929 @cust_main_invoice =
6930 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
6932 @cust_main_invoice = ();
6934 foreach my $cust_main_invoice ( @cust_main_invoice ) {
6935 #warn $cust_main_invoice->destnum;
6936 unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
6937 #warn $cust_main_invoice->destnum;
6938 my $error = $cust_main_invoice->delete;
6939 warn $error if $error;
6942 if ( $self->custnum ) {
6943 @cust_main_invoice =
6944 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
6946 @cust_main_invoice = ();
6948 my %seen = map { $_->address => 1 } @cust_main_invoice;
6949 foreach my $address ( @{$arrayref} ) {
6950 next if exists $seen{$address} && $seen{$address};
6951 $seen{$address} = 1;
6952 my $cust_main_invoice = new FS::cust_main_invoice ( {
6953 'custnum' => $self->custnum,
6956 my $error = $cust_main_invoice->insert;
6957 warn $error if $error;
6961 if ( $self->custnum ) {
6963 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
6970 =item check_invoicing_list ARRAYREF
6972 Checks these arguements as valid input for the invoicing_list method. If there
6973 is an error, returns the error, otherwise returns false.
6977 sub check_invoicing_list {
6978 my( $self, $arrayref ) = @_;
6980 foreach my $address ( @$arrayref ) {
6982 if ($address eq 'FAX' and $self->getfield('fax') eq '') {
6983 return 'Can\'t add FAX invoice destination with a blank FAX number.';
6986 my $cust_main_invoice = new FS::cust_main_invoice ( {
6987 'custnum' => $self->custnum,
6990 my $error = $self->custnum
6991 ? $cust_main_invoice->check
6992 : $cust_main_invoice->checkdest
6994 return $error if $error;
6998 return "Email address required"
6999 if $conf->exists('cust_main-require_invoicing_list_email')
7000 && ! grep { $_ !~ /^([A-Z]+)$/ } @$arrayref;
7005 =item set_default_invoicing_list
7007 Sets the invoicing list to all accounts associated with this customer,
7008 overwriting any previous invoicing list.
7012 sub set_default_invoicing_list {
7014 $self->invoicing_list($self->all_emails);
7019 Returns the email addresses of all accounts provisioned for this customer.
7026 foreach my $cust_pkg ( $self->all_pkgs ) {
7027 my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
7029 map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
7030 grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
7032 $list{$_}=1 foreach map { $_->email } @svc_acct;
7037 =item invoicing_list_addpost
7039 Adds postal invoicing to this customer. If this customer is already configured
7040 to receive postal invoices, does nothing.
7044 sub invoicing_list_addpost {
7046 return if grep { $_ eq 'POST' } $self->invoicing_list;
7047 my @invoicing_list = $self->invoicing_list;
7048 push @invoicing_list, 'POST';
7049 $self->invoicing_list(\@invoicing_list);
7052 =item invoicing_list_emailonly
7054 Returns the list of email invoice recipients (invoicing_list without non-email
7055 destinations such as POST and FAX).
7059 sub invoicing_list_emailonly {
7061 warn "$me invoicing_list_emailonly called"
7063 grep { $_ !~ /^([A-Z]+)$/ } $self->invoicing_list;
7066 =item invoicing_list_emailonly_scalar
7068 Returns the list of email invoice recipients (invoicing_list without non-email
7069 destinations such as POST and FAX) as a comma-separated scalar.
7073 sub invoicing_list_emailonly_scalar {
7075 warn "$me invoicing_list_emailonly_scalar called"
7077 join(', ', $self->invoicing_list_emailonly);
7080 =item referral_custnum_cust_main
7082 Returns the customer who referred this customer (or the empty string, if
7083 this customer was not referred).
7085 Note the difference with referral_cust_main method: This method,
7086 referral_custnum_cust_main returns the single customer (if any) who referred
7087 this customer, while referral_cust_main returns an array of customers referred
7092 sub referral_custnum_cust_main {
7094 return '' unless $self->referral_custnum;
7095 qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
7098 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
7100 Returns an array of customers referred by this customer (referral_custnum set
7101 to this custnum). If DEPTH is given, recurses up to the given depth, returning
7102 customers referred by customers referred by this customer and so on, inclusive.
7103 The default behavior is DEPTH 1 (no recursion).
7105 Note the difference with referral_custnum_cust_main method: This method,
7106 referral_cust_main, returns an array of customers referred BY this customer,
7107 while referral_custnum_cust_main returns the single customer (if any) who
7108 referred this customer.
7112 sub referral_cust_main {
7114 my $depth = @_ ? shift : 1;
7115 my $exclude = @_ ? shift : {};
7118 map { $exclude->{$_->custnum}++; $_; }
7119 grep { ! $exclude->{ $_->custnum } }
7120 qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
7124 map { $_->referral_cust_main($depth-1, $exclude) }
7131 =item referral_cust_main_ncancelled
7133 Same as referral_cust_main, except only returns customers with uncancelled
7138 sub referral_cust_main_ncancelled {
7140 grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
7143 =item referral_cust_pkg [ DEPTH ]
7145 Like referral_cust_main, except returns a flat list of all unsuspended (and
7146 uncancelled) packages for each customer. The number of items in this list may
7147 be useful for comission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
7151 sub referral_cust_pkg {
7153 my $depth = @_ ? shift : 1;
7155 map { $_->unsuspended_pkgs }
7156 grep { $_->unsuspended_pkgs }
7157 $self->referral_cust_main($depth);
7160 =item referring_cust_main
7162 Returns the single cust_main record for the customer who referred this customer
7163 (referral_custnum), or false.
7167 sub referring_cust_main {
7169 return '' unless $self->referral_custnum;
7170 qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
7173 =item credit AMOUNT, REASON [ , OPTION => VALUE ... ]
7175 Applies a credit to this customer. If there is an error, returns the error,
7176 otherwise returns false.
7178 REASON can be a text string, an FS::reason object, or a scalar reference to
7179 a reasonnum. If a text string, it will be automatically inserted as a new
7180 reason, and a 'reason_type' option must be passed to indicate the
7181 FS::reason_type for the new reason.
7183 An I<addlinfo> option may be passed to set the credit's I<addlinfo> field.
7185 Any other options are passed to FS::cust_credit::insert.
7190 my( $self, $amount, $reason, %options ) = @_;
7192 my $cust_credit = new FS::cust_credit {
7193 'custnum' => $self->custnum,
7194 'amount' => $amount,
7197 if ( ref($reason) ) {
7199 if ( ref($reason) eq 'SCALAR' ) {
7200 $cust_credit->reasonnum( $$reason );
7202 $cust_credit->reasonnum( $reason->reasonnum );
7206 $cust_credit->set('reason', $reason)
7209 $cust_credit->addlinfo( delete $options{'addlinfo'} )
7210 if exists($options{'addlinfo'});
7212 $cust_credit->insert(%options);
7216 =item charge HASHREF || AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
7218 Creates a one-time charge for this customer. If there is an error, returns
7219 the error, otherwise returns false.
7221 New-style, with a hashref of options:
7223 my $error = $cust_main->charge(
7227 'start_date' => str2time('7/4/2009'),
7228 'pkg' => 'Description',
7229 'comment' => 'Comment',
7230 'additional' => [], #extra invoice detail
7231 'classnum' => 1, #pkg_class
7233 'setuptax' => '', # or 'Y' for tax exempt
7236 'taxclass' => 'Tax class',
7239 'taxproduct' => 2, #part_pkg_taxproduct
7240 'override' => {}, #XXX describe
7242 #will be filled in with the new object
7243 'cust_pkg_ref' => \$cust_pkg,
7245 #generate an invoice immediately
7247 'invoice_terms' => '', #with these terms
7253 my $error = $cust_main->charge( 54.32, 'Description', 'Comment', 'Tax class' );
7259 my ( $amount, $quantity, $start_date, $classnum );
7260 my ( $pkg, $comment, $additional );
7261 my ( $setuptax, $taxclass ); #internal taxes
7262 my ( $taxproduct, $override ); #vendor (CCH) taxes
7263 my $cust_pkg_ref = '';
7264 my ( $bill_now, $invoice_terms ) = ( 0, '' );
7265 if ( ref( $_[0] ) ) {
7266 $amount = $_[0]->{amount};
7267 $quantity = exists($_[0]->{quantity}) ? $_[0]->{quantity} : 1;
7268 $start_date = exists($_[0]->{start_date}) ? $_[0]->{start_date} : '';
7269 $pkg = exists($_[0]->{pkg}) ? $_[0]->{pkg} : 'One-time charge';
7270 $comment = exists($_[0]->{comment}) ? $_[0]->{comment}
7271 : '$'. sprintf("%.2f",$amount);
7272 $setuptax = exists($_[0]->{setuptax}) ? $_[0]->{setuptax} : '';
7273 $taxclass = exists($_[0]->{taxclass}) ? $_[0]->{taxclass} : '';
7274 $classnum = exists($_[0]->{classnum}) ? $_[0]->{classnum} : '';
7275 $additional = $_[0]->{additional} || [];
7276 $taxproduct = $_[0]->{taxproductnum};
7277 $override = { '' => $_[0]->{tax_override} };
7278 $cust_pkg_ref = exists($_[0]->{cust_pkg_ref}) ? $_[0]->{cust_pkg_ref} : '';
7279 $bill_now = exists($_[0]->{bill_now}) ? $_[0]->{bill_now} : '';
7280 $invoice_terms = exists($_[0]->{invoice_terms}) ? $_[0]->{invoice_terms} : '';
7285 $pkg = @_ ? shift : 'One-time charge';
7286 $comment = @_ ? shift : '$'. sprintf("%.2f",$amount);
7288 $taxclass = @_ ? shift : '';
7292 local $SIG{HUP} = 'IGNORE';
7293 local $SIG{INT} = 'IGNORE';
7294 local $SIG{QUIT} = 'IGNORE';
7295 local $SIG{TERM} = 'IGNORE';
7296 local $SIG{TSTP} = 'IGNORE';
7297 local $SIG{PIPE} = 'IGNORE';
7299 my $oldAutoCommit = $FS::UID::AutoCommit;
7300 local $FS::UID::AutoCommit = 0;
7303 my $part_pkg = new FS::part_pkg ( {
7305 'comment' => $comment,
7309 'classnum' => $classnum ? $classnum : '',
7310 'setuptax' => $setuptax,
7311 'taxclass' => $taxclass,
7312 'taxproductnum' => $taxproduct,
7315 my %options = ( ( map { ("additional_info$_" => $additional->[$_] ) }
7316 ( 0 .. @$additional - 1 )
7318 'additional_count' => scalar(@$additional),
7319 'setup_fee' => $amount,
7322 my $error = $part_pkg->insert( options => \%options,
7323 tax_overrides => $override,
7326 $dbh->rollback if $oldAutoCommit;
7330 my $pkgpart = $part_pkg->pkgpart;
7331 my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
7332 unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
7333 my $type_pkgs = new FS::type_pkgs \%type_pkgs;
7334 $error = $type_pkgs->insert;
7336 $dbh->rollback if $oldAutoCommit;
7341 my $cust_pkg = new FS::cust_pkg ( {
7342 'custnum' => $self->custnum,
7343 'pkgpart' => $pkgpart,
7344 'quantity' => $quantity,
7345 'start_date' => $start_date,
7348 $error = $cust_pkg->insert;
7350 $dbh->rollback if $oldAutoCommit;
7352 } elsif ( $cust_pkg_ref ) {
7353 ${$cust_pkg_ref} = $cust_pkg;
7357 my $error = $self->bill( 'invoice_terms' => $invoice_terms,
7358 'pkg_list' => [ $cust_pkg ],
7361 $dbh->rollback if $oldAutoCommit;
7366 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
7371 #=item charge_postal_fee
7373 #Applies a one time charge this customer. If there is an error,
7374 #returns the error, returns the cust_pkg charge object or false
7375 #if there was no charge.
7379 # This should be a customer event. For that to work requires that bill
7380 # also be a customer event.
7382 sub charge_postal_fee {
7385 my $pkgpart = $conf->config('postal_invoice-fee_pkgpart');
7386 return '' unless ($pkgpart && grep { $_ eq 'POST' } $self->invoicing_list);
7388 my $cust_pkg = new FS::cust_pkg ( {
7389 'custnum' => $self->custnum,
7390 'pkgpart' => $pkgpart,
7394 my $error = $cust_pkg->insert;
7395 $error ? $error : $cust_pkg;
7400 Returns all the invoices (see L<FS::cust_bill>) for this customer.
7406 map { $_ } #return $self->num_cust_bill unless wantarray;
7407 sort { $a->_date <=> $b->_date }
7408 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
7411 =item open_cust_bill
7413 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
7418 sub open_cust_bill {
7422 'table' => 'cust_bill',
7423 'hashref' => { 'custnum' => $self->custnum, },
7424 'extra_sql' => ' AND '. FS::cust_bill->owed_sql. ' > 0',
7425 'order_by' => 'ORDER BY _date ASC',
7430 =item cust_statements
7432 Returns all the statements (see L<FS::cust_statement>) for this customer.
7436 sub cust_statement {
7438 map { $_ } #return $self->num_cust_statement unless wantarray;
7439 sort { $a->_date <=> $b->_date }
7440 qsearch('cust_statement', { 'custnum' => $self->custnum, } )
7445 Returns all the credits (see L<FS::cust_credit>) for this customer.
7451 map { $_ } #return $self->num_cust_credit unless wantarray;
7452 sort { $a->_date <=> $b->_date }
7453 qsearch( 'cust_credit', { 'custnum' => $self->custnum } )
7456 =item cust_credit_pkgnum
7458 Returns all the credits (see L<FS::cust_credit>) for this customer's specific
7459 package when using experimental package balances.
7463 sub cust_credit_pkgnum {
7464 my( $self, $pkgnum ) = @_;
7465 map { $_ } #return $self->num_cust_credit_pkgnum($pkgnum) unless wantarray;
7466 sort { $a->_date <=> $b->_date }
7467 qsearch( 'cust_credit', { 'custnum' => $self->custnum,
7468 'pkgnum' => $pkgnum,
7475 Returns all the payments (see L<FS::cust_pay>) for this customer.
7481 return $self->num_cust_pay unless wantarray;
7482 sort { $a->_date <=> $b->_date }
7483 qsearch( 'cust_pay', { 'custnum' => $self->custnum } )
7488 Returns the number of payments (see L<FS::cust_pay>) for this customer. Also
7489 called automatically when the cust_pay method is used in a scalar context.
7495 my $sql = "SELECT COUNT(*) FROM cust_pay WHERE custnum = ?";
7496 my $sth = dbh->prepare($sql) or die dbh->errstr;
7497 $sth->execute($self->custnum) or die $sth->errstr;
7498 $sth->fetchrow_arrayref->[0];
7501 =item cust_pay_pkgnum
7503 Returns all the payments (see L<FS::cust_pay>) for this customer's specific
7504 package when using experimental package balances.
7508 sub cust_pay_pkgnum {
7509 my( $self, $pkgnum ) = @_;
7510 map { $_ } #return $self->num_cust_pay_pkgnum($pkgnum) unless wantarray;
7511 sort { $a->_date <=> $b->_date }
7512 qsearch( 'cust_pay', { 'custnum' => $self->custnum,
7513 'pkgnum' => $pkgnum,
7520 Returns all voided payments (see L<FS::cust_pay_void>) for this customer.
7526 map { $_ } #return $self->num_cust_pay_void unless wantarray;
7527 sort { $a->_date <=> $b->_date }
7528 qsearch( 'cust_pay_void', { 'custnum' => $self->custnum } )
7531 =item cust_pay_batch
7533 Returns all batched payments (see L<FS::cust_pay_void>) for this customer.
7537 sub cust_pay_batch {
7539 map { $_ } #return $self->num_cust_pay_batch unless wantarray;
7540 sort { $a->paybatchnum <=> $b->paybatchnum }
7541 qsearch( 'cust_pay_batch', { 'custnum' => $self->custnum } )
7544 =item cust_pay_pending
7546 Returns all pending payments (see L<FS::cust_pay_pending>) for this customer
7547 (without status "done").
7551 sub cust_pay_pending {
7553 return $self->num_cust_pay_pending unless wantarray;
7554 sort { $a->_date <=> $b->_date }
7555 qsearch( 'cust_pay_pending', {
7556 'custnum' => $self->custnum,
7557 'status' => { op=>'!=', value=>'done' },
7562 =item num_cust_pay_pending
7564 Returns the number of pending payments (see L<FS::cust_pay_pending>) for this
7565 customer (without status "done"). Also called automatically when the
7566 cust_pay_pending method is used in a scalar context.
7570 sub num_cust_pay_pending {
7572 my $sql = " SELECT COUNT(*) FROM cust_pay_pending ".
7573 " WHERE custnum = ? AND status != 'done' ";
7574 my $sth = dbh->prepare($sql) or die dbh->errstr;
7575 $sth->execute($self->custnum) or die $sth->errstr;
7576 $sth->fetchrow_arrayref->[0];
7581 Returns all the refunds (see L<FS::cust_refund>) for this customer.
7587 map { $_ } #return $self->num_cust_refund unless wantarray;
7588 sort { $a->_date <=> $b->_date }
7589 qsearch( 'cust_refund', { 'custnum' => $self->custnum } )
7592 =item display_custnum
7594 Returns the displayed customer number for this customer: agent_custid if
7595 cust_main-default_agent_custid is set and it has a value, custnum otherwise.
7599 sub display_custnum {
7601 if ( $conf->exists('cust_main-default_agent_custid') && $self->agent_custid ){
7602 return $self->agent_custid;
7604 return $self->custnum;
7610 Returns a name string for this customer, either "Company (Last, First)" or
7617 my $name = $self->contact;
7618 $name = $self->company. " ($name)" if $self->company;
7624 Returns a name string for this (service/shipping) contact, either
7625 "Company (Last, First)" or "Last, First".
7631 if ( $self->get('ship_last') ) {
7632 my $name = $self->ship_contact;
7633 $name = $self->ship_company. " ($name)" if $self->ship_company;
7642 Returns a name string for this customer, either "Company" or "First Last".
7648 $self->company !~ /^\s*$/ ? $self->company : $self->contact_firstlast;
7651 =item ship_name_short
7653 Returns a name string for this (service/shipping) contact, either "Company"
7658 sub ship_name_short {
7660 if ( $self->get('ship_last') ) {
7661 $self->ship_company !~ /^\s*$/
7662 ? $self->ship_company
7663 : $self->ship_contact_firstlast;
7665 $self->name_company_or_firstlast;
7671 Returns this customer's full (billing) contact name only, "Last, First"
7677 $self->get('last'). ', '. $self->first;
7682 Returns this customer's full (shipping) contact name only, "Last, First"
7688 $self->get('ship_last')
7689 ? $self->get('ship_last'). ', '. $self->ship_first
7693 =item contact_firstlast
7695 Returns this customers full (billing) contact name only, "First Last".
7699 sub contact_firstlast {
7701 $self->first. ' '. $self->get('last');
7704 =item ship_contact_firstlast
7706 Returns this customer's full (shipping) contact name only, "First Last".
7710 sub ship_contact_firstlast {
7712 $self->get('ship_last')
7713 ? $self->first. ' '. $self->get('ship_last')
7714 : $self->contact_firstlast;
7719 Returns this customer's full country name
7725 code2country($self->country);
7728 =item geocode DATA_VENDOR
7730 Returns a value for the customer location as encoded by DATA_VENDOR.
7731 Currently this only makes sense for "CCH" as DATA_VENDOR.
7736 my ($self, $data_vendor) = (shift, shift); #always cch for now
7738 my $geocode = $self->get('geocode'); #XXX only one data_vendor for geocode
7739 return $geocode if $geocode;
7741 my $prefix = ( $conf->exists('tax-ship_address') && length($self->ship_last) )
7745 my ($zip,$plus4) = split /-/, $self->get("${prefix}zip")
7746 if $self->country eq 'US';
7748 #CCH specific location stuff
7749 my $extra_sql = "AND plus4lo <= '$plus4' AND plus4hi >= '$plus4'";
7751 my @cust_tax_location =
7753 'table' => 'cust_tax_location',
7754 'hashref' => { 'zip' => $zip, 'data_vendor' => $data_vendor },
7755 'extra_sql' => $extra_sql,
7756 'order_by' => 'ORDER BY plus4hi',#overlapping with distinct ends
7759 $geocode = $cust_tax_location[0]->geocode
7760 if scalar(@cust_tax_location);
7769 Returns a status string for this customer, currently:
7773 =item prospect - No packages have ever been ordered
7775 =item active - One or more recurring packages is active
7777 =item inactive - No active recurring packages, but otherwise unsuspended/uncancelled (the inactive status is new - previously inactive customers were mis-identified as cancelled)
7779 =item suspended - All non-cancelled recurring packages are suspended
7781 =item cancelled - All recurring packages are cancelled
7787 sub status { shift->cust_status(@_); }
7791 for my $status (qw( prospect active inactive suspended cancelled )) {
7792 my $method = $status.'_sql';
7793 my $numnum = ( my $sql = $self->$method() ) =~ s/cust_main\.custnum/?/g;
7794 my $sth = dbh->prepare("SELECT $sql") or die dbh->errstr;
7795 $sth->execute( ($self->custnum) x $numnum )
7796 or die "Error executing 'SELECT $sql': ". $sth->errstr;
7797 return $status if $sth->fetchrow_arrayref->[0];
7801 =item ucfirst_cust_status
7803 =item ucfirst_status
7805 Returns the status with the first character capitalized.
7809 sub ucfirst_status { shift->ucfirst_cust_status(@_); }
7811 sub ucfirst_cust_status {
7813 ucfirst($self->cust_status);
7818 Returns a hex triplet color string for this customer's status.
7822 use vars qw(%statuscolor);
7823 tie %statuscolor, 'Tie::IxHash',
7824 'prospect' => '7e0079', #'000000', #black? naw, purple
7825 'active' => '00CC00', #green
7826 'inactive' => '0000CC', #blue
7827 'suspended' => 'FF9900', #yellow
7828 'cancelled' => 'FF0000', #red
7831 sub statuscolor { shift->cust_statuscolor(@_); }
7833 sub cust_statuscolor {
7835 $statuscolor{$self->cust_status};
7840 Returns an array of hashes representing the customer's RT tickets.
7847 my $num = $conf->config('cust_main-max_tickets') || 10;
7850 if ( $conf->config('ticket_system') ) {
7851 unless ( $conf->config('ticket_system-custom_priority_field') ) {
7853 @tickets = @{ FS::TicketSystem->customer_tickets($self->custnum, $num) };
7857 foreach my $priority (
7858 $conf->config('ticket_system-custom_priority_field-values'), ''
7860 last if scalar(@tickets) >= $num;
7862 @{ FS::TicketSystem->customer_tickets( $self->custnum,
7863 $num - scalar(@tickets),
7873 # Return services representing svc_accts in customer support packages
7874 sub support_services {
7876 my %packages = map { $_ => 1 } $conf->config('support_packages');
7878 grep { $_->pkg_svc && $_->pkg_svc->primary_svc eq 'Y' }
7879 grep { $_->part_svc->svcdb eq 'svc_acct' }
7880 map { $_->cust_svc }
7881 grep { exists $packages{ $_->pkgpart } }
7882 $self->ncancelled_pkgs;
7886 # Return a list of latitude/longitude for one of the services (if any)
7887 sub service_coordinates {
7891 grep { $_->latitude && $_->longitude }
7893 map { $_->cust_svc }
7894 $self->ncancelled_pkgs;
7896 scalar(@svc_X) ? ( $svc_X[0]->latitude, $svc_X[0]->longitude ) : ()
7901 =head1 CLASS METHODS
7907 Class method that returns the list of possible status strings for customers
7908 (see L<the status method|/status>). For example:
7910 @statuses = FS::cust_main->statuses();
7915 #my $self = shift; #could be class...
7921 Returns an SQL expression identifying prospective cust_main records (customers
7922 with no packages ever ordered)
7926 use vars qw($select_count_pkgs);
7927 $select_count_pkgs =
7928 "SELECT COUNT(*) FROM cust_pkg
7929 WHERE cust_pkg.custnum = cust_main.custnum";
7931 sub select_count_pkgs_sql {
7935 sub prospect_sql { "
7936 0 = ( $select_count_pkgs )
7941 Returns an SQL expression identifying active cust_main records (customers with
7942 active recurring packages).
7947 0 < ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. "
7953 Returns an SQL expression identifying inactive cust_main records (customers with
7954 no active recurring packages, but otherwise unsuspended/uncancelled).
7958 sub inactive_sql { "
7959 0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " )
7961 0 < ( $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " )
7967 Returns an SQL expression identifying suspended cust_main records.
7972 sub suspended_sql { susp_sql(@_); }
7974 0 < ( $select_count_pkgs AND ". FS::cust_pkg->suspended_sql. " )
7976 0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " )
7982 Returns an SQL expression identifying cancelled cust_main records.
7986 sub cancelled_sql { cancel_sql(@_); }
7989 my $recurring_sql = FS::cust_pkg->recurring_sql;
7990 my $cancelled_sql = FS::cust_pkg->cancelled_sql;
7993 0 < ( $select_count_pkgs )
7994 AND 0 < ( $select_count_pkgs AND $recurring_sql AND $cancelled_sql )
7995 AND 0 = ( $select_count_pkgs AND $recurring_sql
7996 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
7998 AND 0 = ( $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " )
8004 =item uncancelled_sql
8006 Returns an SQL expression identifying un-cancelled cust_main records.
8010 sub uncancelled_sql { uncancel_sql(@_); }
8011 sub uncancel_sql { "
8012 ( 0 < ( $select_count_pkgs
8013 AND ( cust_pkg.cancel IS NULL
8014 OR cust_pkg.cancel = 0
8017 OR 0 = ( $select_count_pkgs )
8023 Returns an SQL fragment to retreive the balance.
8028 ( SELECT COALESCE( SUM(charged), 0 ) FROM cust_bill
8029 WHERE cust_bill.custnum = cust_main.custnum )
8030 - ( SELECT COALESCE( SUM(paid), 0 ) FROM cust_pay
8031 WHERE cust_pay.custnum = cust_main.custnum )
8032 - ( SELECT COALESCE( SUM(amount), 0 ) FROM cust_credit
8033 WHERE cust_credit.custnum = cust_main.custnum )
8034 + ( SELECT COALESCE( SUM(refund), 0 ) FROM cust_refund
8035 WHERE cust_refund.custnum = cust_main.custnum )
8038 =item balance_date_sql START_TIME [ END_TIME [ OPTION => VALUE ... ] ]
8040 Returns an SQL fragment to retreive the balance for this customer, only
8041 considering invoices with date earlier than START_TIME, and optionally not
8042 later than END_TIME (total_owed_date minus total_unapplied_credits minus
8043 total_unapplied_payments).
8045 Times are specified as SQL fragments or numeric
8046 UNIX timestamps; see L<perlfunc/"time">). Also see L<Time::Local> and
8047 L<Date::Parse> for conversion functions. The empty string can be passed
8048 to disable that time constraint completely.
8050 Available options are:
8054 =item unapplied_date
8056 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)
8061 set to true to remove all customer comparison clauses, for totals
8066 WHERE clause hashref (elements "AND"ed together) (typically used with the total option)
8071 JOIN clause (typically used with the total option)
8077 sub balance_date_sql {
8078 my( $class, $start, $end, %opt ) = @_;
8080 my $owed = FS::cust_bill->owed_sql;
8081 my $unapp_refund = FS::cust_refund->unapplied_sql;
8082 my $unapp_credit = FS::cust_credit->unapplied_sql;
8083 my $unapp_pay = FS::cust_pay->unapplied_sql;
8085 my $j = $opt{'join'} || '';
8087 my $owed_wh = $class->_money_table_where( 'cust_bill', $start,$end,%opt );
8088 my $refund_wh = $class->_money_table_where( 'cust_refund', $start,$end,%opt );
8089 my $credit_wh = $class->_money_table_where( 'cust_credit', $start,$end,%opt );
8090 my $pay_wh = $class->_money_table_where( 'cust_pay', $start,$end,%opt );
8092 " ( SELECT COALESCE(SUM($owed), 0) FROM cust_bill $j $owed_wh )
8093 + ( SELECT COALESCE(SUM($unapp_refund), 0) FROM cust_refund $j $refund_wh )
8094 - ( SELECT COALESCE(SUM($unapp_credit), 0) FROM cust_credit $j $credit_wh )
8095 - ( SELECT COALESCE(SUM($unapp_pay), 0) FROM cust_pay $j $pay_wh )
8100 =item unapplied_payments_date_sql START_TIME [ END_TIME ]
8102 Returns an SQL fragment to retreive the total unapplied payments for this
8103 customer, only considering invoices with date earlier than START_TIME, and
8104 optionally not later than END_TIME.
8106 Times are specified as SQL fragments or numeric
8107 UNIX timestamps; see L<perlfunc/"time">). Also see L<Time::Local> and
8108 L<Date::Parse> for conversion functions. The empty string can be passed
8109 to disable that time constraint completely.
8111 Available options are:
8115 sub unapplied_payments_date_sql {
8116 my( $class, $start, $end, ) = @_;
8118 my $unapp_pay = FS::cust_pay->unapplied_sql;
8120 my $pay_where = $class->_money_table_where( 'cust_pay', $start, $end,
8121 'unapplied_date'=>1 );
8123 " ( SELECT COALESCE(SUM($unapp_pay), 0) FROM cust_pay $pay_where ) ";
8126 =item _money_table_where TABLE START_TIME [ END_TIME [ OPTION => VALUE ... ] ]
8128 Helper method for balance_date_sql; name (and usage) subject to change
8129 (suggestions welcome).
8131 Returns a WHERE clause for the specified monetary TABLE (cust_bill,
8132 cust_refund, cust_credit or cust_pay).
8134 If TABLE is "cust_bill" or the unapplied_date option is true, only
8135 considers records with date earlier than START_TIME, and optionally not
8136 later than END_TIME .
8140 sub _money_table_where {
8141 my( $class, $table, $start, $end, %opt ) = @_;
8144 push @where, "cust_main.custnum = $table.custnum" unless $opt{'total'};
8145 if ( $table eq 'cust_bill' || $opt{'unapplied_date'} ) {
8146 push @where, "$table._date <= $start" if defined($start) && length($start);
8147 push @where, "$table._date > $end" if defined($end) && length($end);
8149 push @where, @{$opt{'where'}} if $opt{'where'};
8150 my $where = scalar(@where) ? 'WHERE '. join(' AND ', @where ) : '';
8156 =item search HASHREF
8160 Returns a qsearch hash expression to search for parameters specified in HREF.
8161 Valid parameters are
8169 =item cancelled_pkgs
8175 listref of start date, end date
8185 =item current_balance
8187 listref (list returned by FS::UI::Web::parse_lt_gt($cgi, 'current_balance'))
8191 =item flattened_pkgs
8200 my ($class, $params) = @_;
8211 if ( $params->{'agentnum'} =~ /^(\d+)$/ and $1 ) {
8213 "cust_main.agentnum = $1";
8220 #prospect active inactive suspended cancelled
8221 if ( grep { $params->{'status'} eq $_ } FS::cust_main->statuses() ) {
8222 my $method = $params->{'status'}. '_sql';
8223 #push @where, $class->$method();
8224 push @where, FS::cust_main->$method();
8228 # parse cancelled package checkbox
8233 $pkgwhere .= "AND (cancel = 0 or cancel is null)"
8234 unless $params->{'cancelled_pkgs'};
8237 # parse without census tract checkbox
8240 push @where, "(censustract = '' or censustract is null)"
8241 if $params->{'no_censustract'};
8247 foreach my $field (qw( signupdate )) {
8249 next unless exists($params->{$field});
8251 my($beginning, $ending) = @{$params->{$field}};
8254 "cust_main.$field IS NOT NULL",
8255 "cust_main.$field >= $beginning",
8256 "cust_main.$field <= $ending";
8258 $orderby ||= "ORDER BY cust_main.$field";
8266 my @payby = grep /^([A-Z]{4})$/, @{ $params->{'payby'} };
8268 push @where, '( '. join(' OR ', map "cust_main.payby = '$_'", @payby). ' )';
8272 # paydate_year / paydate_month
8275 if ( $params->{'paydate_year'} =~ /^(\d{4})$/ ) {
8277 $params->{'paydate_month'} =~ /^(\d\d?)$/
8278 or die "paydate_year without paydate_month?";
8282 'paydate IS NOT NULL',
8284 "CAST(paydate AS timestamp) < CAST('$year-$month-01' AS timestamp )"
8292 if ( $params->{'invoice_terms'} =~ /^([\w ]+)$/ ) {
8294 if ( $1 eq 'NULL' ) {
8296 "( cust_main.invoice_terms IS NULL OR cust_main.invoice_terms = '' )";
8299 "cust_main.invoice_terms IS NOT NULL",
8300 "cust_main.invoice_terms = '$1'";
8308 if ( $params->{'current_balance'} ) {
8310 #my $balance_sql = $class->balance_sql();
8311 my $balance_sql = FS::cust_main->balance_sql();
8313 my @current_balance =
8314 ref( $params->{'current_balance'} )
8315 ? @{ $params->{'current_balance'} }
8316 : ( $params->{'current_balance'} );
8318 push @where, map { s/current_balance/$balance_sql/; $_ }
8327 if ( $params->{'custbatch'} =~ /^([\w\/\-\:\.]+)$/ and $1 ) {
8329 "cust_main.custbatch = '$1'";
8333 # setup queries, subs, etc. for the search
8336 $orderby ||= 'ORDER BY custnum';
8338 # here is the agent virtualization
8339 push @where, $FS::CurrentUser::CurrentUser->agentnums_sql;
8341 my $extra_sql = scalar(@where) ? ' WHERE '. join(' AND ', @where) : '';
8343 my $addl_from = 'LEFT JOIN cust_pkg USING ( custnum ) ';
8345 my $count_query = "SELECT COUNT(*) FROM cust_main $extra_sql";
8347 my $select = join(', ',
8348 'cust_main.custnum',
8349 FS::UI::Web::cust_sql_fields($params->{'cust_fields'}),
8352 my(@extra_headers) = ();
8353 my(@extra_fields) = ();
8355 if ($params->{'flattened_pkgs'}) {
8357 if ($dbh->{Driver}->{Name} eq 'Pg') {
8359 $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";
8361 }elsif ($dbh->{Driver}->{Name} =~ /^mysql/i) {
8362 $select .= ", GROUP_CONCAT(pkg SEPARATOR '|') as magic";
8363 $addl_from .= " LEFT JOIN part_pkg using ( pkgpart )";
8365 warn "warning: unknown database type ". $dbh->{Driver}->{Name}.
8366 "omitting packing information from report.";
8369 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";
8371 my $sth = dbh->prepare($header_query) or die dbh->errstr;
8372 $sth->execute() or die $sth->errstr;
8373 my $headerrow = $sth->fetchrow_arrayref;
8374 my $headercount = $headerrow ? $headerrow->[0] : 0;
8375 while($headercount) {
8376 unshift @extra_headers, "Package ". $headercount;
8377 unshift @extra_fields, eval q!sub {my $c = shift;
8378 my @a = split '\|', $c->magic;
8379 my $p = $a[!.--$headercount. q!];
8387 'table' => 'cust_main',
8388 'select' => $select,
8390 'extra_sql' => $extra_sql,
8391 'order_by' => $orderby,
8392 'count_query' => $count_query,
8393 'extra_headers' => \@extra_headers,
8394 'extra_fields' => \@extra_fields,
8399 =item email_search_result HASHREF
8403 Emails a notice to the specified customers.
8405 Valid parameters are those of the L<search> method, plus the following:
8427 Optional job queue job for status updates.
8431 Returns an error message, or false for success.
8433 If an error occurs during any email, stops the enture send and returns that
8434 error. Presumably if you're getting SMTP errors aborting is better than
8435 retrying everything.
8439 sub email_search_result {
8440 my($class, $params) = @_;
8442 my $from = delete $params->{from};
8443 my $subject = delete $params->{subject};
8444 my $html_body = delete $params->{html_body};
8445 my $text_body = delete $params->{text_body};
8447 my $job = delete $params->{'job'};
8449 $params->{'payby'} = [ split(/\0/, $params->{'payby'}) ]
8450 unless ref($params->{'payby'});
8452 my $sql_query = $class->search($params);
8454 my $count_query = delete($sql_query->{'count_query'});
8455 my $count_sth = dbh->prepare($count_query)
8456 or die "Error preparing $count_query: ". dbh->errstr;
8458 or die "Error executing $count_query: ". $count_sth->errstr;
8459 my $count_arrayref = $count_sth->fetchrow_arrayref;
8460 my $num_cust = $count_arrayref->[0];
8462 #my @extra_headers = @{ delete($sql_query->{'extra_headers'}) };
8463 #my @extra_fields = @{ delete($sql_query->{'extra_fields'}) };
8466 my( $num, $last, $min_sec ) = (0, time, 5); #progresbar foo
8468 #eventually order+limit magic to reduce memory use?
8469 foreach my $cust_main ( qsearch($sql_query) ) {
8471 my $to = $cust_main->invoicing_list_emailonly_scalar;
8474 my $error = send_email(
8478 'subject' => $subject,
8479 'html_body' => $html_body,
8480 'text_body' => $text_body,
8483 return $error if $error;
8485 if ( $job ) { #progressbar foo
8487 if ( time - $min_sec > $last ) {
8488 my $error = $job->update_statustext(
8489 int( 100 * $num / $num_cust )
8491 die $error if $error;
8501 use Storable qw(thaw);
8504 sub process_email_search_result {
8506 #warn "$me process_re_X $method for job $job\n" if $DEBUG;
8508 my $param = thaw(decode_base64(shift));
8509 warn Dumper($param) if $DEBUG;
8511 $param->{'job'} = $job;
8513 $param->{'payby'} = [ split(/\0/, $param->{'payby'}) ]
8514 unless ref($param->{'payby'});
8516 my $error = FS::cust_main->email_search_result( $param );
8517 die $error if $error;
8521 =item fuzzy_search FUZZY_HASHREF [ HASHREF, SELECT, EXTRA_SQL, CACHE_OBJ ]
8523 Performs a fuzzy (approximate) search and returns the matching FS::cust_main
8524 records. Currently, I<first>, I<last>, I<company> and/or I<address1> may be
8525 specified (the appropriate ship_ field is also searched).
8527 Additional options are the same as FS::Record::qsearch
8532 my( $self, $fuzzy, $hash, @opt) = @_;
8537 check_and_rebuild_fuzzyfiles();
8538 foreach my $field ( keys %$fuzzy ) {
8540 my $all = $self->all_X($field);
8541 next unless scalar(@$all);
8544 $match{$_}=1 foreach ( amatch( $fuzzy->{$field}, ['i'], @$all ) );
8547 foreach ( keys %match ) {
8548 push @fcust, qsearch('cust_main', { %$hash, $field=>$_}, @opt);
8549 push @fcust, qsearch('cust_main', { %$hash, "ship_$field"=>$_}, @opt);
8552 push @cust_main, grep { ! $fsaw{$_->custnum}++ } @fcust;
8555 # we want the components of $fuzzy ANDed, not ORed, but still don't want dupes
8557 @cust_main = grep { ++$saw{$_->custnum} == scalar(keys %$fuzzy) } @cust_main;
8565 Returns a masked version of the named field
8570 my ($self,$field) = @_;
8574 'x'x(length($self->getfield($field))-4).
8575 substr($self->getfield($field), (length($self->getfield($field))-4));
8585 =item smart_search OPTION => VALUE ...
8587 Accepts the following options: I<search>, the string to search for. The string
8588 will be searched for as a customer number, phone number, name or company name,
8589 as an exact, or, in some cases, a substring or fuzzy match (see the source code
8590 for the exact heuristics used); I<no_fuzzy_on_exact>, causes smart_search to
8591 skip fuzzy matching when an exact match is found.
8593 Any additional options are treated as an additional qualifier on the search
8596 Returns a (possibly empty) array of FS::cust_main objects.
8603 #here is the agent virtualization
8604 my $agentnums_sql = $FS::CurrentUser::CurrentUser->agentnums_sql;
8608 my $skip_fuzzy = delete $options{'no_fuzzy_on_exact'};
8609 my $search = delete $options{'search'};
8610 ( my $alphanum_search = $search ) =~ s/\W//g;
8612 if ( $alphanum_search =~ /^1?(\d{3})(\d{3})(\d{4})(\d*)$/ ) { #phone# search
8614 #false laziness w/Record::ut_phone
8615 my $phonen = "$1-$2-$3";
8616 $phonen .= " x$4" if $4;
8618 push @cust_main, qsearch( {
8619 'table' => 'cust_main',
8620 'hashref' => { %options },
8621 'extra_sql' => ( scalar(keys %options) ? ' AND ' : ' WHERE ' ).
8623 join(' OR ', map "$_ = '$phonen'",
8624 qw( daytime night fax
8625 ship_daytime ship_night ship_fax )
8628 " AND $agentnums_sql", #agent virtualization
8631 unless ( @cust_main || $phonen =~ /x\d+$/ ) { #no exact match
8632 #try looking for matches with extensions unless one was specified
8634 push @cust_main, qsearch( {
8635 'table' => 'cust_main',
8636 'hashref' => { %options },
8637 'extra_sql' => ( scalar(keys %options) ? ' AND ' : ' WHERE ' ).
8639 join(' OR ', map "$_ LIKE '$phonen\%'",
8641 ship_daytime ship_night )
8644 " AND $agentnums_sql", #agent virtualization
8649 # custnum search (also try agent_custid), with some tweaking options if your
8650 # legacy cust "numbers" have letters
8653 if ( $search =~ /^\s*(\d+)\s*$/
8654 || ( $conf->config('cust_main-agent_custid-format') eq 'ww?d+'
8655 && $search =~ /^\s*(\w\w?\d+)\s*$/
8657 || ( $conf->exists('address1-search' )
8658 && $search =~ /^\s*(\d+\-?\w*)\s*$/ #i.e. 1234A or 9432-D
8665 if ( $num =~ /^(\d+)$/ && $num <= 2147483647 ) { #need a bigint custnum? wow
8666 push @cust_main, qsearch( {
8667 'table' => 'cust_main',
8668 'hashref' => { 'custnum' => $num, %options },
8669 'extra_sql' => " AND $agentnums_sql", #agent virtualization
8673 push @cust_main, qsearch( {
8674 'table' => 'cust_main',
8675 'hashref' => { 'agent_custid' => $num, %options },
8676 'extra_sql' => " AND $agentnums_sql", #agent virtualization
8679 if ( $conf->exists('address1-search') ) {
8680 my $len = length($num);
8682 foreach my $prefix ( '', 'ship_' ) {
8683 push @cust_main, qsearch( {
8684 'table' => 'cust_main',
8685 'hashref' => { %options, },
8687 ( keys(%options) ? ' AND ' : ' WHERE ' ).
8688 " LOWER(SUBSTRING(${prefix}address1 FROM 1 FOR $len)) = '$num' ".
8689 " AND $agentnums_sql",
8694 } elsif ( $search =~ /^\s*(\S.*\S)\s+\((.+), ([^,]+)\)\s*$/ ) {
8696 my($company, $last, $first) = ( $1, $2, $3 );
8698 # "Company (Last, First)"
8699 #this is probably something a browser remembered,
8700 #so just do an exact search (but case-insensitive, so USPS standardization
8701 #doesn't throw a wrench in the works)
8703 foreach my $prefix ( '', 'ship_' ) {
8704 push @cust_main, qsearch( {
8705 'table' => 'cust_main',
8706 'hashref' => { %options },
8708 ( keys(%options) ? ' AND ' : ' WHERE ' ).
8710 " LOWER(${prefix}first) = ". dbh->quote(lc($first)),
8711 " LOWER(${prefix}last) = ". dbh->quote(lc($last)),
8712 " LOWER(${prefix}company) = ". dbh->quote(lc($company)),
8718 } elsif ( $search =~ /^\s*(\S.*\S)\s*$/ ) { # value search
8719 # try (ship_){last,company}
8723 # # remove "(Last, First)" in "Company (Last, First)", otherwise the
8724 # # full strings the browser remembers won't work
8725 # $value =~ s/\([\w \,\.\-\']*\)$//; #false laziness w/Record::ut_name
8727 use Lingua::EN::NameParse;
8728 my $NameParse = new Lingua::EN::NameParse(
8730 allow_reversed => 1,
8733 my($last, $first) = ( '', '' );
8734 #maybe disable this too and just rely on NameParse?
8735 if ( $value =~ /^(.+),\s*([^,]+)$/ ) { # Last, First
8737 ($last, $first) = ( $1, $2 );
8739 #} elsif ( $value =~ /^(.+)\s+(.+)$/ ) {
8740 } elsif ( ! $NameParse->parse($value) ) {
8742 my %name = $NameParse->components;
8743 $first = $name{'given_name_1'};
8744 $last = $name{'surname_1'};
8748 if ( $first && $last ) {
8750 my($q_last, $q_first) = ( dbh->quote($last), dbh->quote($first) );
8753 my $sql = scalar(keys %options) ? ' AND ' : ' WHERE ';
8755 ( ( LOWER(last) = $q_last AND LOWER(first) = $q_first )
8756 OR ( LOWER(ship_last) = $q_last AND LOWER(ship_first) = $q_first )
8759 push @cust_main, qsearch( {
8760 'table' => 'cust_main',
8761 'hashref' => \%options,
8762 'extra_sql' => "$sql AND $agentnums_sql", #agent virtualization
8765 # or it just be something that was typed in... (try that in a sec)
8769 my $q_value = dbh->quote($value);
8772 my $sql = scalar(keys %options) ? ' AND ' : ' WHERE ';
8773 $sql .= " ( LOWER(last) = $q_value
8774 OR LOWER(company) = $q_value
8775 OR LOWER(ship_last) = $q_value
8776 OR LOWER(ship_company) = $q_value
8778 $sql .= " OR LOWER(address1) = $q_value
8779 OR LOWER(ship_address1) = $q_value
8781 if $conf->exists('address1-search');
8784 push @cust_main, qsearch( {
8785 'table' => 'cust_main',
8786 'hashref' => \%options,
8787 'extra_sql' => "$sql AND $agentnums_sql", #agent virtualization
8790 #no exact match, trying substring/fuzzy
8791 #always do substring & fuzzy (unless they're explicity config'ed off)
8792 #getting complaints searches are not returning enough
8793 unless ( @cust_main && $skip_fuzzy || $conf->exists('disable-fuzzy') ) {
8795 #still some false laziness w/search (was search/cust_main.cgi)
8800 { 'company' => { op=>'ILIKE', value=>"%$value%" }, },
8801 { 'ship_company' => { op=>'ILIKE', value=>"%$value%" }, },
8804 if ( $first && $last ) {
8807 { 'first' => { op=>'ILIKE', value=>"%$first%" },
8808 'last' => { op=>'ILIKE', value=>"%$last%" },
8810 { 'ship_first' => { op=>'ILIKE', value=>"%$first%" },
8811 'ship_last' => { op=>'ILIKE', value=>"%$last%" },
8818 { 'last' => { op=>'ILIKE', value=>"%$value%" }, },
8819 { 'ship_last' => { op=>'ILIKE', value=>"%$value%" }, },
8823 if ( $conf->exists('address1-search') ) {
8825 { 'address1' => { op=>'ILIKE', value=>"%$value%" }, },
8826 { 'ship_address1' => { op=>'ILIKE', value=>"%$value%" }, },
8830 foreach my $hashref ( @hashrefs ) {
8832 push @cust_main, qsearch( {
8833 'table' => 'cust_main',
8834 'hashref' => { %$hashref,
8837 'extra_sql' => " AND $agentnums_sql", #agent virtualizaiton
8846 " AND $agentnums_sql", #extra_sql #agent virtualization
8849 if ( $first && $last ) {
8850 push @cust_main, FS::cust_main->fuzzy_search(
8851 { 'last' => $last, #fuzzy hashref
8852 'first' => $first }, #
8856 foreach my $field ( 'last', 'company' ) {
8858 FS::cust_main->fuzzy_search( { $field => $value }, @fuzopts );
8860 if ( $conf->exists('address1-search') ) {
8862 FS::cust_main->fuzzy_search( { 'address1' => $value }, @fuzopts );
8869 #eliminate duplicates
8871 @cust_main = grep { !$saw{$_->custnum}++ } @cust_main;
8879 Accepts the following options: I<email>, the email address to search for. The
8880 email address will be searched for as an email invoice destination and as an
8883 #Any additional options are treated as an additional qualifier on the search
8884 #(i.e. I<agentnum>).
8886 Returns a (possibly empty) array of FS::cust_main objects (but usually just
8896 my $email = delete $options{'email'};
8898 #we're only being used by RT at the moment... no agent virtualization yet
8899 #my $agentnums_sql = $FS::CurrentUser::CurrentUser->agentnums_sql;
8903 if ( $email =~ /([^@]+)\@([^@]+)/ ) {
8905 my ( $user, $domain ) = ( $1, $2 );
8907 warn "$me smart_search: searching for $user in domain $domain"
8913 'table' => 'cust_main_invoice',
8914 'hashref' => { 'dest' => $email },
8921 map $_->cust_svc->cust_pkg,
8923 'table' => 'svc_acct',
8924 'hashref' => { 'username' => $user, },
8926 'AND ( SELECT domain FROM svc_domain
8927 WHERE svc_acct.domsvc = svc_domain.svcnum
8928 ) = '. dbh->quote($domain),
8934 @cust_main = grep { !$saw{$_->custnum}++ } @cust_main;
8936 warn "$me smart_search: found ". scalar(@cust_main). " unique customers"
8943 =item check_and_rebuild_fuzzyfiles
8947 sub check_and_rebuild_fuzzyfiles {
8948 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
8949 rebuild_fuzzyfiles() if grep { ! -e "$dir/cust_main.$_" } @fuzzyfields
8952 =item rebuild_fuzzyfiles
8956 sub rebuild_fuzzyfiles {
8958 use Fcntl qw(:flock);
8960 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
8961 mkdir $dir, 0700 unless -d $dir;
8963 foreach my $fuzzy ( @fuzzyfields ) {
8965 open(LOCK,">>$dir/cust_main.$fuzzy")
8966 or die "can't open $dir/cust_main.$fuzzy: $!";
8968 or die "can't lock $dir/cust_main.$fuzzy: $!";
8970 open (CACHE,">$dir/cust_main.$fuzzy.tmp")
8971 or die "can't open $dir/cust_main.$fuzzy.tmp: $!";
8973 foreach my $field ( $fuzzy, "ship_$fuzzy" ) {
8974 my $sth = dbh->prepare("SELECT $field FROM cust_main".
8975 " WHERE $field != '' AND $field IS NOT NULL");
8976 $sth->execute or die $sth->errstr;
8978 while ( my $row = $sth->fetchrow_arrayref ) {
8979 print CACHE $row->[0]. "\n";
8984 close CACHE or die "can't close $dir/cust_main.$fuzzy.tmp: $!";
8986 rename "$dir/cust_main.$fuzzy.tmp", "$dir/cust_main.$fuzzy";
8997 my( $self, $field ) = @_;
8998 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
8999 open(CACHE,"<$dir/cust_main.$field")
9000 or die "can't open $dir/cust_main.$field: $!";
9001 my @array = map { chomp; $_; } <CACHE>;
9006 =item append_fuzzyfiles FIRSTNAME LASTNAME COMPANY ADDRESS1
9010 sub append_fuzzyfiles {
9011 #my( $first, $last, $company ) = @_;
9013 &check_and_rebuild_fuzzyfiles;
9015 use Fcntl qw(:flock);
9017 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
9019 foreach my $field (@fuzzyfields) {
9024 open(CACHE,">>$dir/cust_main.$field")
9025 or die "can't open $dir/cust_main.$field: $!";
9026 flock(CACHE,LOCK_EX)
9027 or die "can't lock $dir/cust_main.$field: $!";
9029 print CACHE "$value\n";
9031 flock(CACHE,LOCK_UN)
9032 or die "can't unlock $dir/cust_main.$field: $!";
9047 #warn join('-',keys %$param);
9048 my $fh = $param->{filehandle};
9049 my @fields = @{$param->{fields}};
9051 eval "use Text::CSV_XS;";
9054 my $csv = new Text::CSV_XS;
9061 local $SIG{HUP} = 'IGNORE';
9062 local $SIG{INT} = 'IGNORE';
9063 local $SIG{QUIT} = 'IGNORE';
9064 local $SIG{TERM} = 'IGNORE';
9065 local $SIG{TSTP} = 'IGNORE';
9066 local $SIG{PIPE} = 'IGNORE';
9068 my $oldAutoCommit = $FS::UID::AutoCommit;
9069 local $FS::UID::AutoCommit = 0;
9072 #while ( $columns = $csv->getline($fh) ) {
9074 while ( defined($line=<$fh>) ) {
9076 $csv->parse($line) or do {
9077 $dbh->rollback if $oldAutoCommit;
9078 return "can't parse: ". $csv->error_input();
9081 my @columns = $csv->fields();
9082 #warn join('-',@columns);
9085 foreach my $field ( @fields ) {
9086 $row{$field} = shift @columns;
9089 my $cust_main = qsearchs('cust_main', { 'custnum' => $row{'custnum'} } );
9090 unless ( $cust_main ) {
9091 $dbh->rollback if $oldAutoCommit;
9092 return "unknown custnum $row{'custnum'}";
9095 if ( $row{'amount'} > 0 ) {
9096 my $error = $cust_main->charge($row{'amount'}, $row{'pkg'});
9098 $dbh->rollback if $oldAutoCommit;
9102 } elsif ( $row{'amount'} < 0 ) {
9103 my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ),
9106 $dbh->rollback if $oldAutoCommit;
9116 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
9118 return "Empty file!" unless $imported;
9124 =item notify CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
9126 Sends a templated email notification to the customer (see L<Text::Template>).
9128 OPTIONS is a hash and may include
9130 I<from> - the email sender (default is invoice_from)
9132 I<to> - comma-separated scalar or arrayref of recipients
9133 (default is invoicing_list)
9135 I<subject> - The subject line of the sent email notification
9136 (default is "Notice from company_name")
9138 I<extra_fields> - a hashref of name/value pairs which will be substituted
9141 The following variables are vavailable in the template.
9143 I<$first> - the customer first name
9144 I<$last> - the customer last name
9145 I<$company> - the customer company
9146 I<$payby> - a description of the method of payment for the customer
9147 # would be nice to use FS::payby::shortname
9148 I<$payinfo> - the account information used to collect for this customer
9149 I<$expdate> - the expiration of the customer payment in seconds from epoch
9154 my ($self, $template, %options) = @_;
9156 return unless $conf->exists($template);
9158 my $from = $conf->config('invoice_from', $self->agentnum)
9159 if $conf->exists('invoice_from', $self->agentnum);
9160 $from = $options{from} if exists($options{from});
9162 my $to = join(',', $self->invoicing_list_emailonly);
9163 $to = $options{to} if exists($options{to});
9165 my $subject = "Notice from " . $conf->config('company_name', $self->agentnum)
9166 if $conf->exists('company_name', $self->agentnum);
9167 $subject = $options{subject} if exists($options{subject});
9169 my $notify_template = new Text::Template (TYPE => 'ARRAY',
9170 SOURCE => [ map "$_\n",
9171 $conf->config($template)]
9173 or die "can't create new Text::Template object: Text::Template::ERROR";
9174 $notify_template->compile()
9175 or die "can't compile template: Text::Template::ERROR";
9177 $FS::notify_template::_template::company_name =
9178 $conf->config('company_name', $self->agentnum);
9179 $FS::notify_template::_template::company_address =
9180 join("\n", $conf->config('company_address', $self->agentnum) ). "\n";
9182 my $paydate = $self->paydate || '2037-12-31';
9183 $FS::notify_template::_template::first = $self->first;
9184 $FS::notify_template::_template::last = $self->last;
9185 $FS::notify_template::_template::company = $self->company;
9186 $FS::notify_template::_template::payinfo = $self->mask_payinfo;
9187 my $payby = $self->payby;
9188 my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
9189 my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
9191 #credit cards expire at the end of the month/year of their exp date
9192 if ($payby eq 'CARD' || $payby eq 'DCRD') {
9193 $FS::notify_template::_template::payby = 'credit card';
9194 ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
9195 $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
9197 }elsif ($payby eq 'COMP') {
9198 $FS::notify_template::_template::payby = 'complimentary account';
9200 $FS::notify_template::_template::payby = 'current method';
9202 $FS::notify_template::_template::expdate = $expire_time;
9204 for (keys %{$options{extra_fields}}){
9206 ${"FS::notify_template::_template::$_"} = $options{extra_fields}->{$_};
9209 send_email(from => $from,
9211 subject => $subject,
9212 body => $notify_template->fill_in( PACKAGE =>
9213 'FS::notify_template::_template' ),
9218 =item generate_letter CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
9220 Generates a templated notification to the customer (see L<Text::Template>).
9222 OPTIONS is a hash and may include
9224 I<extra_fields> - a hashref of name/value pairs which will be substituted
9225 into the template. These values may override values mentioned below
9226 and those from the customer record.
9228 The following variables are available in the template instead of or in addition
9229 to the fields of the customer record.
9231 I<$payby> - a description of the method of payment for the customer
9232 # would be nice to use FS::payby::shortname
9233 I<$payinfo> - the masked account information used to collect for this customer
9234 I<$expdate> - the expiration of the customer payment method in seconds from epoch
9235 I<$returnaddress> - the return address defaults to invoice_latexreturnaddress or company_address
9239 sub generate_letter {
9240 my ($self, $template, %options) = @_;
9242 return unless $conf->exists($template);
9244 my $letter_template = new Text::Template
9246 SOURCE => [ map "$_\n", $conf->config($template)],
9247 DELIMITERS => [ '[@--', '--@]' ],
9249 or die "can't create new Text::Template object: Text::Template::ERROR";
9251 $letter_template->compile()
9252 or die "can't compile template: Text::Template::ERROR";
9254 my %letter_data = map { $_ => $self->$_ } $self->fields;
9255 $letter_data{payinfo} = $self->mask_payinfo;
9257 #my $paydate = $self->paydate || '2037-12-31';
9258 my $paydate = $self->paydate =~ /^\S+$/ ? $self->paydate : '2037-12-31';
9260 my $payby = $self->payby;
9261 my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
9262 my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
9264 #credit cards expire at the end of the month/year of their exp date
9265 if ($payby eq 'CARD' || $payby eq 'DCRD') {
9266 $letter_data{payby} = 'credit card';
9267 ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
9268 $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
9270 }elsif ($payby eq 'COMP') {
9271 $letter_data{payby} = 'complimentary account';
9273 $letter_data{payby} = 'current method';
9275 $letter_data{expdate} = $expire_time;
9277 for (keys %{$options{extra_fields}}){
9278 $letter_data{$_} = $options{extra_fields}->{$_};
9281 unless(exists($letter_data{returnaddress})){
9282 my $retadd = join("\n", $conf->config_orbase( 'invoice_latexreturnaddress',
9283 $self->agent_template)
9285 if ( length($retadd) ) {
9286 $letter_data{returnaddress} = $retadd;
9287 } elsif ( grep /\S/, $conf->config('company_address', $self->agentnum) ) {
9288 $letter_data{returnaddress} =
9289 join( '\\*'."\n", map s/( {2,})/'~' x length($1)/eg,
9290 $conf->config('company_address', $self->agentnum)
9293 $letter_data{returnaddress} = '~';
9297 $letter_data{conf_dir} = "$FS::UID::conf_dir/conf.$FS::UID::datasrc";
9299 $letter_data{company_name} = $conf->config('company_name', $self->agentnum);
9301 my $dir = $FS::UID::conf_dir."/cache.". $FS::UID::datasrc;
9302 my $fh = new File::Temp( TEMPLATE => 'letter.'. $self->custnum. '.XXXXXXXX',
9306 ) or die "can't open temp file: $!\n";
9308 $letter_template->fill_in( OUTPUT => $fh, HASH => \%letter_data );
9310 $fh->filename =~ /^(.*).tex$/ or die "unparsable filename: ". $fh->filename;
9314 =item print_ps TEMPLATE
9316 Returns an postscript letter filled in from TEMPLATE, as a scalar.
9322 my $file = $self->generate_letter(@_);
9323 FS::Misc::generate_ps($file);
9326 =item print TEMPLATE
9328 Prints the filled in template.
9330 TEMPLATE is the name of a L<Text::Template> to fill in and print.
9334 sub queueable_print {
9337 my $self = qsearchs('cust_main', { 'custnum' => $opt{custnum} } )
9338 or die "invalid customer number: " . $opt{custvnum};
9340 my $error = $self->print( $opt{template} );
9341 die $error if $error;
9345 my ($self, $template) = (shift, shift);
9346 do_print [ $self->print_ps($template) ];
9349 #these three subs should just go away once agent stuff is all config overrides
9351 sub agent_template {
9353 $self->_agent_plandata('agent_templatename');
9356 sub agent_invoice_from {
9358 $self->_agent_plandata('agent_invoice_from');
9361 sub _agent_plandata {
9362 my( $self, $option ) = @_;
9364 #yuck. this whole thing needs to be reconciled better with 1.9's idea of
9365 #agent-specific Conf
9367 use FS::part_event::Condition;
9369 my $agentnum = $self->agentnum;
9372 if ( driver_name =~ /^Pg/i ) {
9374 } elsif ( driver_name =~ /^mysql/i ) {
9377 die "don't know how to use regular expressions in ". driver_name. " databases";
9380 my $part_event_option =
9382 'select' => 'part_event_option.*',
9383 'table' => 'part_event_option',
9385 LEFT JOIN part_event USING ( eventpart )
9386 LEFT JOIN part_event_option AS peo_agentnum
9387 ON ( part_event.eventpart = peo_agentnum.eventpart
9388 AND peo_agentnum.optionname = 'agentnum'
9389 AND peo_agentnum.optionvalue }. $regexp. q{ '(^|,)}. $agentnum. q{(,|$)'
9391 LEFT JOIN part_event_condition
9392 ON ( part_event.eventpart = part_event_condition.eventpart
9393 AND part_event_condition.conditionname = 'cust_bill_age'
9395 LEFT JOIN part_event_condition_option
9396 ON ( part_event_condition.eventconditionnum = part_event_condition_option.eventconditionnum
9397 AND part_event_condition_option.optionname = 'age'
9400 #'hashref' => { 'optionname' => $option },
9401 #'hashref' => { 'part_event_option.optionname' => $option },
9403 " WHERE part_event_option.optionname = ". dbh->quote($option).
9404 " AND action = 'cust_bill_send_agent' ".
9405 " AND ( disabled IS NULL OR disabled != 'Y' ) ".
9406 " AND peo_agentnum.optionname = 'agentnum' ".
9407 " AND ( agentnum IS NULL OR agentnum = $agentnum ) ".
9409 CASE WHEN part_event_condition_option.optionname IS NULL
9411 ELSE ". FS::part_event::Condition->age2seconds_sql('part_event_condition_option.optionvalue').
9413 , part_event.weight".
9417 unless ( $part_event_option ) {
9418 return $self->agent->invoice_template || ''
9419 if $option eq 'agent_templatename';
9423 $part_event_option->optionvalue;
9428 ## actual sub, not a method, designed to be called from the queue.
9429 ## sets up the customer, and calls the bill_and_collect
9430 my (%args) = @_; #, ($time, $invoice_time, $check_freq, $resetup) = @_;
9431 my $cust_main = qsearchs( 'cust_main', { custnum => $args{'custnum'} } );
9432 $cust_main->bill_and_collect(
9437 sub _upgrade_data { #class method
9438 my ($class, %opts) = @_;
9440 my $sql = 'UPDATE h_cust_main SET paycvv = NULL WHERE paycvv IS NOT NULL';
9441 my $sth = dbh->prepare($sql) or die dbh->errstr;
9442 $sth->execute or die $sth->errstr;
9452 The delete method should possibly take an FS::cust_main object reference
9453 instead of a scalar customer number.
9455 Bill and collect options should probably be passed as references instead of a
9458 There should probably be a configuration file with a list of allowed credit
9461 No multiple currency support (probably a larger project than just this module).
9463 payinfo_masked false laziness with cust_pay.pm and cust_refund.pm
9465 Birthdates rely on negative epoch values.
9467 The payby for card/check batches is broken. With mixed batching, bad
9470 B<collect> I<invoice_time> should be renamed I<time>, like B<bill>.
9474 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
9475 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
9476 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.