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;
49 use FS::cust_main_exemption;
50 use FS::cust_tax_adjustment;
52 use FS::tax_rate_location;
53 use FS::cust_tax_location;
54 use FS::part_pkg_taxrate;
56 use FS::cust_main_invoice;
57 use FS::cust_credit_bill;
58 use FS::cust_bill_pay;
59 use FS::prepay_credit;
63 use FS::part_event_condition;
66 use FS::payment_gateway;
67 use FS::agent_payment_gateway;
69 use FS::payinfo_Mixin;
72 @ISA = qw( FS::payinfo_Mixin FS::Record );
74 @EXPORT_OK = qw( smart_search );
76 $realtime_bop_decline_quiet = 0;
78 # 1 is mostly method/subroutine entry and options
79 # 2 traces progress of some operations
80 # 3 is even more information including possibly sensitive data
82 $me = '[FS::cust_main]';
85 $ignore_expired_card = 0;
88 @fuzzyfields = ( 'first', 'last', 'company', 'address1' );
90 @encrypted_fields = ('payinfo', 'paycvv');
91 sub nohistory_fields { ('paycvv'); }
93 @paytypes = ('', 'Personal checking', 'Personal savings', 'Business checking', 'Business savings');
95 #ask FS::UID to run this stuff for us later
96 #$FS::UID::callback{'FS::cust_main'} = sub {
97 install_callback FS::UID sub {
99 #yes, need it for stuff below (prolly should be cached)
104 my ( $hashref, $cache ) = @_;
105 if ( exists $hashref->{'pkgnum'} ) {
106 #@{ $self->{'_pkgnum'} } = ();
107 my $subcache = $cache->subcache( 'pkgnum', 'cust_pkg', $hashref->{custnum});
108 $self->{'_pkgnum'} = $subcache;
109 #push @{ $self->{'_pkgnum'} },
110 FS::cust_pkg->new_or_cached($hashref, $subcache) if $hashref->{pkgnum};
116 FS::cust_main - Object methods for cust_main records
122 $record = new FS::cust_main \%hash;
123 $record = new FS::cust_main { 'column' => 'value' };
125 $error = $record->insert;
127 $error = $new_record->replace($old_record);
129 $error = $record->delete;
131 $error = $record->check;
133 @cust_pkg = $record->all_pkgs;
135 @cust_pkg = $record->ncancelled_pkgs;
137 @cust_pkg = $record->suspended_pkgs;
139 $error = $record->bill;
140 $error = $record->bill %options;
141 $error = $record->bill 'time' => $time;
143 $error = $record->collect;
144 $error = $record->collect %options;
145 $error = $record->collect 'invoice_time' => $time,
150 An FS::cust_main object represents a customer. FS::cust_main inherits from
151 FS::Record. The following fields are currently supported:
157 Primary key (assigned automatically for new customers)
161 Agent (see L<FS::agent>)
165 Advertising source (see L<FS::part_referral>)
177 Cocial security number (optional)
193 (optional, see L<FS::cust_main_county>)
197 (see L<FS::cust_main_county>)
203 (see L<FS::cust_main_county>)
239 (optional, see L<FS::cust_main_county>)
243 (see L<FS::cust_main_county>)
249 (see L<FS::cust_main_county>)
265 Payment Type (See L<FS::payinfo_Mixin> for valid payby values)
269 Payment Information (See L<FS::payinfo_Mixin> for data format)
273 Masked payinfo (See L<FS::payinfo_Mixin> for how this works)
277 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
281 Expiration date, mm/yyyy, m/yyyy, mm/yy or m/yy
285 Start date month (maestro/solo cards only)
289 Start date year (maestro/solo cards only)
293 Issue number (maestro/solo cards only)
297 Name on card or billing name
301 IP address from which payment information was received
305 Tax exempt, empty or `Y'
309 Order taker (assigned automatically, see L<FS::UID>)
315 =item referral_custnum
317 Referring customer number
321 Enable individual CDR spooling, empty or `Y'
325 A suggestion to events (see L<FS::part_bill_event">) to delay until this unix timestamp
329 Discourage individual CDR printing, empty or `Y'
339 Creates a new customer. To add the customer to the database, see L<"insert">.
341 Note that this stores the hash reference, not a distinct copy of the hash it
342 points to. You can ask the object for a copy with the I<hash> method.
346 sub table { 'cust_main'; }
348 =item insert [ CUST_PKG_HASHREF [ , INVOICING_LIST_ARYREF ] [ , OPTION => VALUE ... ] ]
350 Adds this customer to the database. If there is an error, returns the error,
351 otherwise returns false.
353 CUST_PKG_HASHREF: If you pass a Tie::RefHash data structure to the insert
354 method containing FS::cust_pkg and FS::svc_I<tablename> objects, all records
355 are inserted atomicly, or the transaction is rolled back. Passing an empty
356 hash reference is equivalent to not supplying this parameter. There should be
357 a better explanation of this, but until then, here's an example:
360 tie %hash, 'Tie::RefHash'; #this part is important
362 $cust_pkg => [ $svc_acct ],
365 $cust_main->insert( \%hash );
367 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
368 be set as the invoicing list (see L<"invoicing_list">). Errors return as
369 expected and rollback the entire transaction; it is not necessary to call
370 check_invoicing_list first. The invoicing_list is set after the records in the
371 CUST_PKG_HASHREF above are inserted, so it is now possible to set an
372 invoicing_list destination to the newly-created svc_acct. Here's an example:
374 $cust_main->insert( {}, [ $email, 'POST' ] );
376 Currently available options are: I<depend_jobnum>, I<noexport> and I<tax_exemption>.
378 If I<depend_jobnum> is set, all provisioning jobs will have a dependancy
379 on the supplied jobnum (they will not run until the specific job completes).
380 This can be used to defer provisioning until some action completes (such
381 as running the customer's credit card successfully).
383 The I<noexport> option is deprecated. If I<noexport> is set true, no
384 provisioning jobs (exports) are scheduled. (You can schedule them later with
385 the B<reexport> method.)
387 The I<tax_exemption> option can be set to an arrayref of tax names.
388 FS::cust_main_exemption records will be created and inserted.
394 my $cust_pkgs = @_ ? shift : {};
395 my $invoicing_list = @_ ? shift : '';
397 warn "$me insert called with options ".
398 join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
401 local $SIG{HUP} = 'IGNORE';
402 local $SIG{INT} = 'IGNORE';
403 local $SIG{QUIT} = 'IGNORE';
404 local $SIG{TERM} = 'IGNORE';
405 local $SIG{TSTP} = 'IGNORE';
406 local $SIG{PIPE} = 'IGNORE';
408 my $oldAutoCommit = $FS::UID::AutoCommit;
409 local $FS::UID::AutoCommit = 0;
412 my $prepay_identifier = '';
413 my( $amount, $seconds, $upbytes, $downbytes, $totalbytes ) = (0, 0, 0, 0, 0);
415 if ( $self->payby eq 'PREPAY' ) {
417 $self->payby('BILL');
418 $prepay_identifier = $self->payinfo;
421 warn " looking up prepaid card $prepay_identifier\n"
424 my $error = $self->get_prepay( $prepay_identifier,
425 'amount_ref' => \$amount,
426 'seconds_ref' => \$seconds,
427 'upbytes_ref' => \$upbytes,
428 'downbytes_ref' => \$downbytes,
429 'totalbytes_ref' => \$totalbytes,
432 $dbh->rollback if $oldAutoCommit;
433 #return "error applying prepaid card (transaction rolled back): $error";
437 $payby = 'PREP' if $amount;
439 } elsif ( $self->payby =~ /^(CASH|WEST|MCRD)$/ ) {
442 $self->payby('BILL');
443 $amount = $self->paid;
447 warn " inserting $self\n"
450 $self->signupdate(time) unless $self->signupdate;
452 $self->auto_agent_custid()
453 if $conf->config('cust_main-auto_agent_custid') && ! $self->agent_custid;
455 my $error = $self->SUPER::insert;
457 $dbh->rollback if $oldAutoCommit;
458 #return "inserting cust_main record (transaction rolled back): $error";
462 warn " setting invoicing list\n"
465 if ( $invoicing_list ) {
466 $error = $self->check_invoicing_list( $invoicing_list );
468 $dbh->rollback if $oldAutoCommit;
469 #return "checking invoicing_list (transaction rolled back): $error";
472 $self->invoicing_list( $invoicing_list );
475 warn " setting cust_main_exemption\n"
478 my $tax_exemption = delete $options{'tax_exemption'};
479 if ( $tax_exemption ) {
480 foreach my $taxname ( @$tax_exemption ) {
481 my $cust_main_exemption = new FS::cust_main_exemption {
482 'custnum' => $self->custnum,
483 'taxname' => $taxname,
485 my $error = $cust_main_exemption->insert;
487 $dbh->rollback if $oldAutoCommit;
488 return "inserting cust_main_exemption (transaction rolled back): $error";
493 if ( $conf->config('cust_main-skeleton_tables')
494 && $conf->config('cust_main-skeleton_custnum') ) {
496 warn " inserting skeleton records\n"
499 my $error = $self->start_copy_skel;
501 $dbh->rollback if $oldAutoCommit;
507 warn " ordering packages\n"
510 $error = $self->order_pkgs( $cust_pkgs,
512 'seconds_ref' => \$seconds,
513 'upbytes_ref' => \$upbytes,
514 'downbytes_ref' => \$downbytes,
515 'totalbytes_ref' => \$totalbytes,
518 $dbh->rollback if $oldAutoCommit;
523 $dbh->rollback if $oldAutoCommit;
524 return "No svc_acct record to apply pre-paid time";
526 if ( $upbytes || $downbytes || $totalbytes ) {
527 $dbh->rollback if $oldAutoCommit;
528 return "No svc_acct record to apply pre-paid data";
532 warn " inserting initial $payby payment of $amount\n"
534 $error = $self->insert_cust_pay($payby, $amount, $prepay_identifier);
536 $dbh->rollback if $oldAutoCommit;
537 return "inserting payment (transaction rolled back): $error";
541 unless ( $import || $skip_fuzzyfiles ) {
542 warn " queueing fuzzyfiles update\n"
544 $error = $self->queue_fuzzyfiles_update;
546 $dbh->rollback if $oldAutoCommit;
547 return "updating fuzzy search cache: $error";
551 warn " insert complete; committing transaction\n"
554 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
559 use File::CounterFile;
560 sub auto_agent_custid {
563 my $format = $conf->config('cust_main-auto_agent_custid');
565 if ( $format eq '1YMMXXXXXXXX' ) {
567 my $counter = new File::CounterFile 'cust_main.agent_custid';
570 my $ym = 100000000000 + time2str('%y%m00000000', time);
571 if ( $ym > $counter->value ) {
572 $counter->{'value'} = $agent_custid = $ym;
573 $counter->{'updated'} = 1;
575 $agent_custid = $counter->inc;
581 die "Unknown cust_main-auto_agent_custid format: $format";
584 $self->agent_custid($agent_custid);
588 sub start_copy_skel {
591 #'mg_user_preference' => {},
592 #'mg_user_indicator_profile.user_indicator_profile_id' => { 'mg_profile_indicator.profile_indicator_id' => { 'mg_profile_details.profile_detail_id' }, },
593 #'mg_watchlist_header.watchlist_header_id' => { 'mg_watchlist_details.watchlist_details_id' },
594 #'mg_user_grid_header.grid_header_id' => { 'mg_user_grid_details.user_grid_details_id' },
595 #'mg_portfolio_header.portfolio_header_id' => { 'mg_portfolio_trades.portfolio_trades_id' => { 'mg_portfolio_trades_positions.portfolio_trades_positions_id' } },
596 my @tables = eval(join('\n',$conf->config('cust_main-skeleton_tables')));
599 _copy_skel( 'cust_main', #tablename
600 $conf->config('cust_main-skeleton_custnum'), #sourceid
601 $self->custnum, #destid
602 @tables, #child tables
606 #recursive subroutine, not a method
608 my( $table, $sourceid, $destid, %child_tables ) = @_;
611 if ( $table =~ /^(\w+)\.(\w+)$/ ) {
612 ( $table, $primary_key ) = ( $1, $2 );
614 my $dbdef_table = dbdef->table($table);
615 $primary_key = $dbdef_table->primary_key
616 or return "$table has no primary key".
617 " (or do you need to run dbdef-create?)";
620 warn " _copy_skel: $table.$primary_key $sourceid to $destid for ".
621 join (', ', keys %child_tables). "\n"
624 foreach my $child_table_def ( keys %child_tables ) {
628 if ( $child_table_def =~ /^(\w+)\.(\w+)$/ ) {
629 ( $child_table, $child_pkey ) = ( $1, $2 );
631 $child_table = $child_table_def;
633 $child_pkey = dbdef->table($child_table)->primary_key;
634 # or return "$table has no primary key".
635 # " (or do you need to run dbdef-create?)\n";
639 if ( keys %{ $child_tables{$child_table_def} } ) {
641 return "$child_table has no primary key".
642 " (run dbdef-create or try specifying it?)\n"
645 #false laziness w/Record::insert and only works on Pg
646 #refactor the proper last-inserted-id stuff out of Record::insert if this
647 # ever gets use for anything besides a quick kludge for one customer
648 my $default = dbdef->table($child_table)->column($child_pkey)->default;
649 $default =~ /^nextval\(\(?'"?([\w\.]+)"?'/i
650 or return "can't parse $child_table.$child_pkey default value ".
651 " for sequence name: $default";
656 my @sel_columns = grep { $_ ne $primary_key }
657 dbdef->table($child_table)->columns;
658 my $sel_columns = join(', ', @sel_columns );
660 my @ins_columns = grep { $_ ne $child_pkey } @sel_columns;
661 my $ins_columns = ' ( '. join(', ', $primary_key, @ins_columns ). ' ) ';
662 my $placeholders = ' ( ?, '. join(', ', map '?', @ins_columns ). ' ) ';
664 my $sel_st = "SELECT $sel_columns FROM $child_table".
665 " WHERE $primary_key = $sourceid";
668 my $sel_sth = dbh->prepare( $sel_st )
669 or return dbh->errstr;
671 $sel_sth->execute or return $sel_sth->errstr;
673 while ( my $row = $sel_sth->fetchrow_hashref ) {
675 warn " selected row: ".
676 join(', ', map { "$_=".$row->{$_} } keys %$row ). "\n"
680 "INSERT INTO $child_table $ins_columns VALUES $placeholders";
681 my $ins_sth =dbh->prepare($statement)
682 or return dbh->errstr;
683 my @param = ( $destid, map $row->{$_}, @ins_columns );
684 warn " $statement: [ ". join(', ', @param). " ]\n"
686 $ins_sth->execute( @param )
687 or return $ins_sth->errstr;
689 #next unless keys %{ $child_tables{$child_table} };
690 next unless $sequence;
692 #another section of that laziness
693 my $seq_sql = "SELECT currval('$sequence')";
694 my $seq_sth = dbh->prepare($seq_sql) or return dbh->errstr;
695 $seq_sth->execute or return $seq_sth->errstr;
696 my $insertid = $seq_sth->fetchrow_arrayref->[0];
698 # don't drink soap! recurse! recurse! okay!
700 _copy_skel( $child_table_def,
701 $row->{$child_pkey}, #sourceid
703 %{ $child_tables{$child_table_def} },
705 return $error if $error;
715 =item order_pkg HASHREF | OPTION => VALUE ...
717 Orders a single package.
719 Options may be passed as a list of key/value pairs or as a hash reference.
730 Optional FS::cust_location object
734 Optional arryaref of FS::svc_* service objects.
738 If this option is set to a job queue jobnum (see L<FS::queue>), all provisioning
739 jobs will have a dependancy on the supplied job (they will not run until the
740 specific job completes). This can be used to defer provisioning until some
741 action completes (such as running the customer's credit card successfully).
745 Optional subject for a ticket created and attached to this customer
749 Optional queue name for ticket additions
757 my $opt = ref($_[0]) ? shift : { @_ };
759 warn "$me order_pkg called with options ".
760 join(', ', map { "$_: $opt->{$_}" } keys %$opt ). "\n"
763 my $cust_pkg = $opt->{'cust_pkg'};
764 my $svcs = $opt->{'svcs'} || [];
766 my %svc_options = ();
767 $svc_options{'depend_jobnum'} = $opt->{'depend_jobnum'}
768 if exists($opt->{'depend_jobnum'}) && $opt->{'depend_jobnum'};
770 my %insert_params = map { $opt->{$_} ? ( $_ => $opt->{$_} ) : () }
771 qw( ticket_subject ticket_queue );
773 local $SIG{HUP} = 'IGNORE';
774 local $SIG{INT} = 'IGNORE';
775 local $SIG{QUIT} = 'IGNORE';
776 local $SIG{TERM} = 'IGNORE';
777 local $SIG{TSTP} = 'IGNORE';
778 local $SIG{PIPE} = 'IGNORE';
780 my $oldAutoCommit = $FS::UID::AutoCommit;
781 local $FS::UID::AutoCommit = 0;
784 if ( $opt->{'cust_location'} &&
785 ( ! $cust_pkg->locationnum || $cust_pkg->locationnum == -1 ) ) {
786 my $error = $opt->{'cust_location'}->insert;
788 $dbh->rollback if $oldAutoCommit;
789 return "inserting cust_location (transaction rolled back): $error";
791 $cust_pkg->locationnum($opt->{'cust_location'}->locationnum);
794 $cust_pkg->custnum( $self->custnum );
796 my $error = $cust_pkg->insert( %insert_params );
798 $dbh->rollback if $oldAutoCommit;
799 return "inserting cust_pkg (transaction rolled back): $error";
802 foreach my $svc_something ( @{ $opt->{'svcs'} } ) {
803 if ( $svc_something->svcnum ) {
804 my $old_cust_svc = $svc_something->cust_svc;
805 my $new_cust_svc = new FS::cust_svc { $old_cust_svc->hash };
806 $new_cust_svc->pkgnum( $cust_pkg->pkgnum);
807 $error = $new_cust_svc->replace($old_cust_svc);
809 $svc_something->pkgnum( $cust_pkg->pkgnum );
810 if ( $svc_something->isa('FS::svc_acct') ) {
811 foreach ( grep { $opt->{$_.'_ref'} && ${ $opt->{$_.'_ref'} } }
812 qw( seconds upbytes downbytes totalbytes ) ) {
813 $svc_something->$_( $svc_something->$_() + ${ $opt->{$_.'_ref'} } );
814 ${ $opt->{$_.'_ref'} } = 0;
817 $error = $svc_something->insert(%svc_options);
820 $dbh->rollback if $oldAutoCommit;
821 return "inserting svc_ (transaction rolled back): $error";
825 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
830 #deprecated #=item order_pkgs HASHREF [ , SECONDSREF ] [ , OPTION => VALUE ... ]
831 =item order_pkgs HASHREF [ , OPTION => VALUE ... ]
833 Like the insert method on an existing record, this method orders multiple
834 packages and included services atomicaly. Pass a Tie::RefHash data structure
835 to this method containing FS::cust_pkg and FS::svc_I<tablename> objects.
836 There should be a better explanation of this, but until then, here's an
840 tie %hash, 'Tie::RefHash'; #this part is important
842 $cust_pkg => [ $svc_acct ],
845 $cust_main->order_pkgs( \%hash, 'noexport'=>1 );
847 Services can be new, in which case they are inserted, or existing unaudited
848 services, in which case they are linked to the newly-created package.
850 Currently available options are: I<depend_jobnum>, I<noexport>, I<seconds_ref>,
851 I<upbytes_ref>, I<downbytes_ref>, and I<totalbytes_ref>.
853 If I<depend_jobnum> is set, all provisioning jobs will have a dependancy
854 on the supplied jobnum (they will not run until the specific job completes).
855 This can be used to defer provisioning until some action completes (such
856 as running the customer's credit card successfully).
858 The I<noexport> option is deprecated. If I<noexport> is set true, no
859 provisioning jobs (exports) are scheduled. (You can schedule them later with
860 the B<reexport> method for each cust_pkg object. Using the B<reexport> method
861 on the cust_main object is not recommended, as existing services will also be
864 If I<seconds_ref>, I<upbytes_ref>, I<downbytes_ref>, or I<totalbytes_ref> is
865 provided, the scalars (provided by references) will be incremented by the
866 values of the prepaid card.`
872 my $cust_pkgs = shift;
873 my $seconds_ref = ref($_[0]) ? shift : ''; #deprecated
875 $seconds_ref ||= $options{'seconds_ref'};
877 warn "$me order_pkgs called with options ".
878 join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
881 local $SIG{HUP} = 'IGNORE';
882 local $SIG{INT} = 'IGNORE';
883 local $SIG{QUIT} = 'IGNORE';
884 local $SIG{TERM} = 'IGNORE';
885 local $SIG{TSTP} = 'IGNORE';
886 local $SIG{PIPE} = 'IGNORE';
888 my $oldAutoCommit = $FS::UID::AutoCommit;
889 local $FS::UID::AutoCommit = 0;
892 local $FS::svc_Common::noexport_hack = 1 if $options{'noexport'};
894 foreach my $cust_pkg ( keys %$cust_pkgs ) {
896 my $error = $self->order_pkg(
897 'cust_pkg' => $cust_pkg,
898 'svcs' => $cust_pkgs->{$cust_pkg},
899 'seconds_ref' => $seconds_ref,
900 map { $_ => $options{$_} } qw( upbytes_ref downbytes_ref totalbytes_ref
905 $dbh->rollback if $oldAutoCommit;
911 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
915 =item recharge_prepay IDENTIFIER | PREPAY_CREDIT_OBJ [ , AMOUNTREF, SECONDSREF, UPBYTEREF, DOWNBYTEREF ]
917 Recharges this (existing) customer with the specified prepaid card (see
918 L<FS::prepay_credit>), specified either by I<identifier> or as an
919 FS::prepay_credit object. If there is an error, returns the error, otherwise
922 Optionally, five scalar references can be passed as well. They will have their
923 values filled in with the amount, number of seconds, and number of upload,
924 download, and total bytes applied by this prepaid card.
928 #the ref bullshit here should be refactored like get_prepay. MyAccount.pm is
929 #the only place that uses these args
930 sub recharge_prepay {
931 my( $self, $prepay_credit, $amountref, $secondsref,
932 $upbytesref, $downbytesref, $totalbytesref ) = @_;
934 local $SIG{HUP} = 'IGNORE';
935 local $SIG{INT} = 'IGNORE';
936 local $SIG{QUIT} = 'IGNORE';
937 local $SIG{TERM} = 'IGNORE';
938 local $SIG{TSTP} = 'IGNORE';
939 local $SIG{PIPE} = 'IGNORE';
941 my $oldAutoCommit = $FS::UID::AutoCommit;
942 local $FS::UID::AutoCommit = 0;
945 my( $amount, $seconds, $upbytes, $downbytes, $totalbytes) = ( 0, 0, 0, 0, 0 );
947 my $error = $self->get_prepay( $prepay_credit,
948 'amount_ref' => \$amount,
949 'seconds_ref' => \$seconds,
950 'upbytes_ref' => \$upbytes,
951 'downbytes_ref' => \$downbytes,
952 'totalbytes_ref' => \$totalbytes,
954 || $self->increment_seconds($seconds)
955 || $self->increment_upbytes($upbytes)
956 || $self->increment_downbytes($downbytes)
957 || $self->increment_totalbytes($totalbytes)
958 || $self->insert_cust_pay_prepay( $amount,
960 ? $prepay_credit->identifier
965 $dbh->rollback if $oldAutoCommit;
969 if ( defined($amountref) ) { $$amountref = $amount; }
970 if ( defined($secondsref) ) { $$secondsref = $seconds; }
971 if ( defined($upbytesref) ) { $$upbytesref = $upbytes; }
972 if ( defined($downbytesref) ) { $$downbytesref = $downbytes; }
973 if ( defined($totalbytesref) ) { $$totalbytesref = $totalbytes; }
975 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
980 =item get_prepay IDENTIFIER | PREPAY_CREDIT_OBJ [ , OPTION => VALUE ... ]
982 Looks up and deletes a prepaid card (see L<FS::prepay_credit>),
983 specified either by I<identifier> or as an FS::prepay_credit object.
985 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
986 incremented by the values of the prepaid card.
988 If the prepaid card specifies an I<agentnum> (see L<FS::agent>), it is used to
989 check or set this customer's I<agentnum>.
991 If there is an error, returns the error, otherwise returns false.
997 my( $self, $prepay_credit, %opt ) = @_;
999 local $SIG{HUP} = 'IGNORE';
1000 local $SIG{INT} = 'IGNORE';
1001 local $SIG{QUIT} = 'IGNORE';
1002 local $SIG{TERM} = 'IGNORE';
1003 local $SIG{TSTP} = 'IGNORE';
1004 local $SIG{PIPE} = 'IGNORE';
1006 my $oldAutoCommit = $FS::UID::AutoCommit;
1007 local $FS::UID::AutoCommit = 0;
1010 unless ( ref($prepay_credit) ) {
1012 my $identifier = $prepay_credit;
1014 $prepay_credit = qsearchs(
1016 { 'identifier' => $prepay_credit },
1021 unless ( $prepay_credit ) {
1022 $dbh->rollback if $oldAutoCommit;
1023 return "Invalid prepaid card: ". $identifier;
1028 if ( $prepay_credit->agentnum ) {
1029 if ( $self->agentnum && $self->agentnum != $prepay_credit->agentnum ) {
1030 $dbh->rollback if $oldAutoCommit;
1031 return "prepaid card not valid for agent ". $self->agentnum;
1033 $self->agentnum($prepay_credit->agentnum);
1036 my $error = $prepay_credit->delete;
1038 $dbh->rollback if $oldAutoCommit;
1039 return "removing prepay_credit (transaction rolled back): $error";
1042 ${ $opt{$_.'_ref'} } += $prepay_credit->$_()
1043 for grep $opt{$_.'_ref'}, qw( amount seconds upbytes downbytes totalbytes );
1045 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1050 =item increment_upbytes SECONDS
1052 Updates this customer's single or primary account (see L<FS::svc_acct>) by
1053 the specified number of upbytes. If there is an error, returns the error,
1054 otherwise returns false.
1058 sub increment_upbytes {
1059 _increment_column( shift, 'upbytes', @_);
1062 =item increment_downbytes SECONDS
1064 Updates this customer's single or primary account (see L<FS::svc_acct>) by
1065 the specified number of downbytes. If there is an error, returns the error,
1066 otherwise returns false.
1070 sub increment_downbytes {
1071 _increment_column( shift, 'downbytes', @_);
1074 =item increment_totalbytes SECONDS
1076 Updates this customer's single or primary account (see L<FS::svc_acct>) by
1077 the specified number of totalbytes. If there is an error, returns the error,
1078 otherwise returns false.
1082 sub increment_totalbytes {
1083 _increment_column( shift, 'totalbytes', @_);
1086 =item increment_seconds SECONDS
1088 Updates this customer's single or primary account (see L<FS::svc_acct>) by
1089 the specified number of seconds. If there is an error, returns the error,
1090 otherwise returns false.
1094 sub increment_seconds {
1095 _increment_column( shift, 'seconds', @_);
1098 =item _increment_column AMOUNT
1100 Updates this customer's single or primary account (see L<FS::svc_acct>) by
1101 the specified number of seconds or bytes. If there is an error, returns
1102 the error, otherwise returns false.
1106 sub _increment_column {
1107 my( $self, $column, $amount ) = @_;
1108 warn "$me increment_column called: $column, $amount\n"
1111 return '' unless $amount;
1113 my @cust_pkg = grep { $_->part_pkg->svcpart('svc_acct') }
1114 $self->ncancelled_pkgs;
1116 if ( ! @cust_pkg ) {
1117 return 'No packages with primary or single services found'.
1118 ' to apply pre-paid time';
1119 } elsif ( scalar(@cust_pkg) > 1 ) {
1120 #maybe have a way to specify the package/account?
1121 return 'Multiple packages found to apply pre-paid time';
1124 my $cust_pkg = $cust_pkg[0];
1125 warn " found package pkgnum ". $cust_pkg->pkgnum. "\n"
1129 $cust_pkg->cust_svc( $cust_pkg->part_pkg->svcpart('svc_acct') );
1131 if ( ! @cust_svc ) {
1132 return 'No account found to apply pre-paid time';
1133 } elsif ( scalar(@cust_svc) > 1 ) {
1134 return 'Multiple accounts found to apply pre-paid time';
1137 my $svc_acct = $cust_svc[0]->svc_x;
1138 warn " found service svcnum ". $svc_acct->pkgnum.
1139 ' ('. $svc_acct->email. ")\n"
1142 $column = "increment_$column";
1143 $svc_acct->$column($amount);
1147 =item insert_cust_pay_prepay AMOUNT [ PAYINFO ]
1149 Inserts a prepayment in the specified amount for this customer. An optional
1150 second argument can specify the prepayment identifier for tracking purposes.
1151 If there is an error, returns the error, otherwise returns false.
1155 sub insert_cust_pay_prepay {
1156 shift->insert_cust_pay('PREP', @_);
1159 =item insert_cust_pay_cash AMOUNT [ PAYINFO ]
1161 Inserts a cash payment in the specified amount for this customer. An optional
1162 second argument can specify the payment identifier for tracking purposes.
1163 If there is an error, returns the error, otherwise returns false.
1167 sub insert_cust_pay_cash {
1168 shift->insert_cust_pay('CASH', @_);
1171 =item insert_cust_pay_west AMOUNT [ PAYINFO ]
1173 Inserts a Western Union payment in the specified amount for this customer. An
1174 optional second argument can specify the prepayment identifier for tracking
1175 purposes. If there is an error, returns the error, otherwise returns false.
1179 sub insert_cust_pay_west {
1180 shift->insert_cust_pay('WEST', @_);
1183 sub insert_cust_pay {
1184 my( $self, $payby, $amount ) = splice(@_, 0, 3);
1185 my $payinfo = scalar(@_) ? shift : '';
1187 my $cust_pay = new FS::cust_pay {
1188 'custnum' => $self->custnum,
1189 'paid' => sprintf('%.2f', $amount),
1190 #'_date' => #date the prepaid card was purchased???
1192 'payinfo' => $payinfo,
1200 This method is deprecated. See the I<depend_jobnum> option to the insert and
1201 order_pkgs methods for a better way to defer provisioning.
1203 Re-schedules all exports by calling the B<reexport> method of all associated
1204 packages (see L<FS::cust_pkg>). If there is an error, returns the error;
1205 otherwise returns false.
1212 carp "WARNING: FS::cust_main::reexport is deprectated; ".
1213 "use the depend_jobnum option to insert or order_pkgs to delay export";
1215 local $SIG{HUP} = 'IGNORE';
1216 local $SIG{INT} = 'IGNORE';
1217 local $SIG{QUIT} = 'IGNORE';
1218 local $SIG{TERM} = 'IGNORE';
1219 local $SIG{TSTP} = 'IGNORE';
1220 local $SIG{PIPE} = 'IGNORE';
1222 my $oldAutoCommit = $FS::UID::AutoCommit;
1223 local $FS::UID::AutoCommit = 0;
1226 foreach my $cust_pkg ( $self->ncancelled_pkgs ) {
1227 my $error = $cust_pkg->reexport;
1229 $dbh->rollback if $oldAutoCommit;
1234 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1239 =item delete NEW_CUSTNUM
1241 This deletes the customer. If there is an error, returns the error, otherwise
1244 This will completely remove all traces of the customer record. This is not
1245 what you want when a customer cancels service; for that, cancel all of the
1246 customer's packages (see L</cancel>).
1248 If the customer has any uncancelled packages, you need to pass a new (valid)
1249 customer number for those packages to be transferred to. Cancelled packages
1250 will be deleted. Did I mention that this is NOT what you want when a customer
1251 cancels service and that you really should be looking see L<FS::cust_pkg/cancel>?
1253 You can't delete a customer with invoices (see L<FS::cust_bill>),
1254 or credits (see L<FS::cust_credit>), payments (see L<FS::cust_pay>) or
1255 refunds (see L<FS::cust_refund>).
1262 local $SIG{HUP} = 'IGNORE';
1263 local $SIG{INT} = 'IGNORE';
1264 local $SIG{QUIT} = 'IGNORE';
1265 local $SIG{TERM} = 'IGNORE';
1266 local $SIG{TSTP} = 'IGNORE';
1267 local $SIG{PIPE} = 'IGNORE';
1269 my $oldAutoCommit = $FS::UID::AutoCommit;
1270 local $FS::UID::AutoCommit = 0;
1273 if ( $self->cust_bill ) {
1274 $dbh->rollback if $oldAutoCommit;
1275 return "Can't delete a customer with invoices";
1277 if ( $self->cust_credit ) {
1278 $dbh->rollback if $oldAutoCommit;
1279 return "Can't delete a customer with credits";
1281 if ( $self->cust_pay ) {
1282 $dbh->rollback if $oldAutoCommit;
1283 return "Can't delete a customer with payments";
1285 if ( $self->cust_refund ) {
1286 $dbh->rollback if $oldAutoCommit;
1287 return "Can't delete a customer with refunds";
1290 my @cust_pkg = $self->ncancelled_pkgs;
1292 my $new_custnum = shift;
1293 unless ( qsearchs( 'cust_main', { 'custnum' => $new_custnum } ) ) {
1294 $dbh->rollback if $oldAutoCommit;
1295 return "Invalid new customer number: $new_custnum";
1297 foreach my $cust_pkg ( @cust_pkg ) {
1298 my %hash = $cust_pkg->hash;
1299 $hash{'custnum'} = $new_custnum;
1300 my $new_cust_pkg = new FS::cust_pkg ( \%hash );
1301 my $error = $new_cust_pkg->replace($cust_pkg,
1302 options => { $cust_pkg->options },
1305 $dbh->rollback if $oldAutoCommit;
1310 my @cancelled_cust_pkg = $self->all_pkgs;
1311 foreach my $cust_pkg ( @cancelled_cust_pkg ) {
1312 my $error = $cust_pkg->delete;
1314 $dbh->rollback if $oldAutoCommit;
1319 foreach my $cust_main_invoice ( #(email invoice destinations, not invoices)
1320 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } )
1322 my $error = $cust_main_invoice->delete;
1324 $dbh->rollback if $oldAutoCommit;
1329 foreach my $cust_main_exemption (
1330 qsearch( 'cust_main_exemption', { 'custnum' => $self->custnum } )
1332 my $error = $cust_main_exemption->delete;
1334 $dbh->rollback if $oldAutoCommit;
1339 my $error = $self->SUPER::delete;
1341 $dbh->rollback if $oldAutoCommit;
1345 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1350 =item replace [ OLD_RECORD ] [ INVOICING_LIST_ARYREF ] [ , OPTION => VALUE ... ] ]
1353 Replaces the OLD_RECORD with this one in the database. If there is an error,
1354 returns the error, otherwise returns false.
1356 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
1357 be set as the invoicing list (see L<"invoicing_list">). Errors return as
1358 expected and rollback the entire transaction; it is not necessary to call
1359 check_invoicing_list first. Here's an example:
1361 $new_cust_main->replace( $old_cust_main, [ $email, 'POST' ] );
1363 Currently available options are: I<tax_exemption>.
1365 The I<tax_exemption> option can be set to an arrayref of tax names.
1366 FS::cust_main_exemption records will be deleted and inserted as appropriate.
1373 my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
1375 : $self->replace_old;
1379 warn "$me replace called\n"
1382 my $curuser = $FS::CurrentUser::CurrentUser;
1383 if ( $self->payby eq 'COMP'
1384 && $self->payby ne $old->payby
1385 && ! $curuser->access_right('Complimentary customer')
1388 return "You are not permitted to create complimentary accounts.";
1391 local($ignore_expired_card) = 1
1392 if $old->payby =~ /^(CARD|DCRD)$/
1393 && $self->payby =~ /^(CARD|DCRD)$/
1394 && ( $old->payinfo eq $self->payinfo || $old->paymask eq $self->paymask );
1396 local $SIG{HUP} = 'IGNORE';
1397 local $SIG{INT} = 'IGNORE';
1398 local $SIG{QUIT} = 'IGNORE';
1399 local $SIG{TERM} = 'IGNORE';
1400 local $SIG{TSTP} = 'IGNORE';
1401 local $SIG{PIPE} = 'IGNORE';
1403 my $oldAutoCommit = $FS::UID::AutoCommit;
1404 local $FS::UID::AutoCommit = 0;
1407 my $error = $self->SUPER::replace($old);
1410 $dbh->rollback if $oldAutoCommit;
1414 if ( @param && ref($param[0]) eq 'ARRAY' ) { # INVOICING_LIST_ARYREF
1415 my $invoicing_list = shift @param;
1416 $error = $self->check_invoicing_list( $invoicing_list );
1418 $dbh->rollback if $oldAutoCommit;
1421 $self->invoicing_list( $invoicing_list );
1424 my %options = @param;
1426 my $tax_exemption = delete $options{'tax_exemption'};
1427 if ( $tax_exemption ) {
1429 my %cust_main_exemption =
1430 map { $_->taxname => $_ }
1431 qsearch('cust_main_exemption', { 'custnum' => $old->custnum } );
1433 foreach my $taxname ( @$tax_exemption ) {
1435 next if delete $cust_main_exemption{$taxname};
1437 my $cust_main_exemption = new FS::cust_main_exemption {
1438 'custnum' => $self->custnum,
1439 'taxname' => $taxname,
1441 my $error = $cust_main_exemption->insert;
1443 $dbh->rollback if $oldAutoCommit;
1444 return "inserting cust_main_exemption (transaction rolled back): $error";
1448 foreach my $cust_main_exemption ( values %cust_main_exemption ) {
1449 my $error = $cust_main_exemption->delete;
1451 $dbh->rollback if $oldAutoCommit;
1452 return "deleting cust_main_exemption (transaction rolled back): $error";
1458 if ( $self->payby =~ /^(CARD|CHEK|LECB)$/ &&
1459 grep { $self->get($_) ne $old->get($_) } qw(payinfo paydate payname) ) {
1460 # card/check/lec info has changed, want to retry realtime_ invoice events
1461 my $error = $self->retry_realtime;
1463 $dbh->rollback if $oldAutoCommit;
1468 unless ( $import || $skip_fuzzyfiles ) {
1469 $error = $self->queue_fuzzyfiles_update;
1471 $dbh->rollback if $oldAutoCommit;
1472 return "updating fuzzy search cache: $error";
1476 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1481 =item queue_fuzzyfiles_update
1483 Used by insert & replace to update the fuzzy search cache
1487 sub queue_fuzzyfiles_update {
1490 local $SIG{HUP} = 'IGNORE';
1491 local $SIG{INT} = 'IGNORE';
1492 local $SIG{QUIT} = 'IGNORE';
1493 local $SIG{TERM} = 'IGNORE';
1494 local $SIG{TSTP} = 'IGNORE';
1495 local $SIG{PIPE} = 'IGNORE';
1497 my $oldAutoCommit = $FS::UID::AutoCommit;
1498 local $FS::UID::AutoCommit = 0;
1501 my $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
1502 my $error = $queue->insert( map $self->getfield($_), @fuzzyfields );
1504 $dbh->rollback if $oldAutoCommit;
1505 return "queueing job (transaction rolled back): $error";
1508 if ( $self->ship_last ) {
1509 $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
1510 $error = $queue->insert( map $self->getfield("ship_$_"), @fuzzyfields );
1512 $dbh->rollback if $oldAutoCommit;
1513 return "queueing job (transaction rolled back): $error";
1517 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1524 Checks all fields to make sure this is a valid customer record. If there is
1525 an error, returns the error, otherwise returns false. Called by the insert
1526 and replace methods.
1533 warn "$me check BEFORE: \n". $self->_dump
1537 $self->ut_numbern('custnum')
1538 || $self->ut_number('agentnum')
1539 || $self->ut_textn('agent_custid')
1540 || $self->ut_number('refnum')
1541 || $self->ut_foreign_keyn('classnum', 'cust_class', 'classnum')
1542 || $self->ut_textn('custbatch')
1543 || $self->ut_name('last')
1544 || $self->ut_name('first')
1545 || $self->ut_snumbern('birthdate')
1546 || $self->ut_snumbern('signupdate')
1547 || $self->ut_textn('company')
1548 || $self->ut_text('address1')
1549 || $self->ut_textn('address2')
1550 || $self->ut_text('city')
1551 || $self->ut_textn('county')
1552 || $self->ut_textn('state')
1553 || $self->ut_country('country')
1554 || $self->ut_anything('comments')
1555 || $self->ut_numbern('referral_custnum')
1556 || $self->ut_textn('stateid')
1557 || $self->ut_textn('stateid_state')
1558 || $self->ut_textn('invoice_terms')
1559 || $self->ut_alphan('geocode')
1560 || $self->ut_floatn('cdr_termination_percentage')
1563 #barf. need message catalogs. i18n. etc.
1564 $error .= "Please select an advertising source."
1565 if $error =~ /^Illegal or empty \(numeric\) refnum: /;
1566 return $error if $error;
1568 return "Unknown agent"
1569 unless qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
1571 return "Unknown refnum"
1572 unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } );
1574 return "Unknown referring custnum: ". $self->referral_custnum
1575 unless ! $self->referral_custnum
1576 || qsearchs( 'cust_main', { 'custnum' => $self->referral_custnum } );
1578 if ( $self->censustract ne '' ) {
1579 $self->censustract =~ /^\s*(\d{9})\.?(\d{2})\s*$/
1580 or return "Illegal census tract: ". $self->censustract;
1582 $self->censustract("$1.$2");
1585 if ( $self->ss eq '' ) {
1590 $ss =~ /^(\d{3})(\d{2})(\d{4})$/
1591 or return "Illegal social security number: ". $self->ss;
1592 $self->ss("$1-$2-$3");
1596 # bad idea to disable, causes billing to fail because of no tax rates later
1597 # unless ( $import ) {
1598 unless ( qsearch('cust_main_county', {
1599 'country' => $self->country,
1602 return "Unknown state/county/country: ".
1603 $self->state. "/". $self->county. "/". $self->country
1604 unless qsearch('cust_main_county',{
1605 'state' => $self->state,
1606 'county' => $self->county,
1607 'country' => $self->country,
1613 $self->ut_phonen('daytime', $self->country)
1614 || $self->ut_phonen('night', $self->country)
1615 || $self->ut_phonen('fax', $self->country)
1616 || $self->ut_zip('zip', $self->country)
1618 return $error if $error;
1620 if ( $conf->exists('cust_main-require_phone')
1621 && ! length($self->daytime) && ! length($self->night)
1624 my $daytime_label = FS::Msgcat::_gettext('daytime') =~ /^(daytime)?$/
1626 : FS::Msgcat::_gettext('daytime');
1627 my $night_label = FS::Msgcat::_gettext('night') =~ /^(night)?$/
1629 : FS::Msgcat::_gettext('night');
1631 return "$daytime_label or $night_label is required"
1635 if ( $self->has_ship_address
1636 && scalar ( grep { $self->getfield($_) ne $self->getfield("ship_$_") }
1637 $self->addr_fields )
1641 $self->ut_name('ship_last')
1642 || $self->ut_name('ship_first')
1643 || $self->ut_textn('ship_company')
1644 || $self->ut_text('ship_address1')
1645 || $self->ut_textn('ship_address2')
1646 || $self->ut_text('ship_city')
1647 || $self->ut_textn('ship_county')
1648 || $self->ut_textn('ship_state')
1649 || $self->ut_country('ship_country')
1651 return $error if $error;
1653 #false laziness with above
1654 unless ( qsearchs('cust_main_county', {
1655 'country' => $self->ship_country,
1658 return "Unknown ship_state/ship_county/ship_country: ".
1659 $self->ship_state. "/". $self->ship_county. "/". $self->ship_country
1660 unless qsearch('cust_main_county',{
1661 'state' => $self->ship_state,
1662 'county' => $self->ship_county,
1663 'country' => $self->ship_country,
1669 $self->ut_phonen('ship_daytime', $self->ship_country)
1670 || $self->ut_phonen('ship_night', $self->ship_country)
1671 || $self->ut_phonen('ship_fax', $self->ship_country)
1672 || $self->ut_zip('ship_zip', $self->ship_country)
1674 return $error if $error;
1676 return "Unit # is required."
1677 if $self->ship_address2 =~ /^\s*$/
1678 && $conf->exists('cust_main-require_address2');
1680 } else { # ship_ info eq billing info, so don't store dup info in database
1682 $self->setfield("ship_$_", '')
1683 foreach $self->addr_fields;
1685 return "Unit # is required."
1686 if $self->address2 =~ /^\s*$/
1687 && $conf->exists('cust_main-require_address2');
1691 #$self->payby =~ /^(CARD|DCRD|CHEK|DCHK|LECB|BILL|COMP|PREPAY|CASH|WEST|MCRD)$/
1692 # or return "Illegal payby: ". $self->payby;
1694 FS::payby->can_payby($self->table, $self->payby)
1695 or return "Illegal payby: ". $self->payby;
1697 $error = $self->ut_numbern('paystart_month')
1698 || $self->ut_numbern('paystart_year')
1699 || $self->ut_numbern('payissue')
1700 || $self->ut_textn('paytype')
1702 return $error if $error;
1704 if ( $self->payip eq '' ) {
1707 $error = $self->ut_ip('payip');
1708 return $error if $error;
1711 # If it is encrypted and the private key is not availaible then we can't
1712 # check the credit card.
1714 my $check_payinfo = 1;
1716 if ($self->is_encrypted($self->payinfo)) {
1720 if ( $check_payinfo && $self->payby =~ /^(CARD|DCRD)$/ ) {
1722 my $payinfo = $self->payinfo;
1723 $payinfo =~ s/\D//g;
1724 $payinfo =~ /^(\d{13,16})$/
1725 or return gettext('invalid_card'); # . ": ". $self->payinfo;
1727 $self->payinfo($payinfo);
1729 or return gettext('invalid_card'); # . ": ". $self->payinfo;
1731 return gettext('unknown_card_type')
1732 if cardtype($self->payinfo) eq "Unknown";
1734 my $ban = qsearchs('banned_pay', $self->_banned_pay_hashref);
1736 return 'Banned credit card: banned on '.
1737 time2str('%a %h %o at %r', $ban->_date).
1738 ' by '. $ban->otaker.
1739 ' (ban# '. $ban->bannum. ')';
1742 if (length($self->paycvv) && !$self->is_encrypted($self->paycvv)) {
1743 if ( cardtype($self->payinfo) eq 'American Express card' ) {
1744 $self->paycvv =~ /^(\d{4})$/
1745 or return "CVV2 (CID) for American Express cards is four digits.";
1748 $self->paycvv =~ /^(\d{3})$/
1749 or return "CVV2 (CVC2/CID) is three digits.";
1756 my $cardtype = cardtype($payinfo);
1757 if ( $cardtype =~ /^(Switch|Solo)$/i ) {
1759 return "Start date or issue number is required for $cardtype cards"
1760 unless $self->paystart_month && $self->paystart_year or $self->payissue;
1762 return "Start month must be between 1 and 12"
1763 if $self->paystart_month
1764 and $self->paystart_month < 1 || $self->paystart_month > 12;
1766 return "Start year must be 1990 or later"
1767 if $self->paystart_year
1768 and $self->paystart_year < 1990;
1770 return "Issue number must be beween 1 and 99"
1772 and $self->payissue < 1 || $self->payissue > 99;
1775 $self->paystart_month('');
1776 $self->paystart_year('');
1777 $self->payissue('');
1780 } elsif ( $check_payinfo && $self->payby =~ /^(CHEK|DCHK)$/ ) {
1782 my $payinfo = $self->payinfo;
1783 $payinfo =~ s/[^\d\@]//g;
1784 if ( $conf->exists('echeck-nonus') ) {
1785 $payinfo =~ /^(\d+)\@(\d+)$/ or return 'invalid echeck account@aba';
1786 $payinfo = "$1\@$2";
1788 $payinfo =~ /^(\d+)\@(\d{9})$/ or return 'invalid echeck account@aba';
1789 $payinfo = "$1\@$2";
1791 $self->payinfo($payinfo);
1794 my $ban = qsearchs('banned_pay', $self->_banned_pay_hashref);
1796 return 'Banned ACH account: banned on '.
1797 time2str('%a %h %o at %r', $ban->_date).
1798 ' by '. $ban->otaker.
1799 ' (ban# '. $ban->bannum. ')';
1802 } elsif ( $self->payby eq 'LECB' ) {
1804 my $payinfo = $self->payinfo;
1805 $payinfo =~ s/\D//g;
1806 $payinfo =~ /^1?(\d{10})$/ or return 'invalid btn billing telephone number';
1808 $self->payinfo($payinfo);
1811 } elsif ( $self->payby eq 'BILL' ) {
1813 $error = $self->ut_textn('payinfo');
1814 return "Illegal P.O. number: ". $self->payinfo if $error;
1817 } elsif ( $self->payby eq 'COMP' ) {
1819 my $curuser = $FS::CurrentUser::CurrentUser;
1820 if ( ! $self->custnum
1821 && ! $curuser->access_right('Complimentary customer')
1824 return "You are not permitted to create complimentary accounts."
1827 $error = $self->ut_textn('payinfo');
1828 return "Illegal comp account issuer: ". $self->payinfo if $error;
1831 } elsif ( $self->payby eq 'PREPAY' ) {
1833 my $payinfo = $self->payinfo;
1834 $payinfo =~ s/\W//g; #anything else would just confuse things
1835 $self->payinfo($payinfo);
1836 $error = $self->ut_alpha('payinfo');
1837 return "Illegal prepayment identifier: ". $self->payinfo if $error;
1838 return "Unknown prepayment identifier"
1839 unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } );
1844 if ( $self->paydate eq '' || $self->paydate eq '-' ) {
1845 return "Expiration date required"
1846 unless $self->payby =~ /^(BILL|PREPAY|CHEK|DCHK|LECB|CASH|WEST|MCRD)$/;
1850 if ( $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/ ) {
1851 ( $m, $y ) = ( $1, length($2) == 4 ? $2 : "20$2" );
1852 } elsif ( $self->paydate =~ /^19(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) {
1853 ( $m, $y ) = ( $2, "19$1" );
1854 } elsif ( $self->paydate =~ /^(20)?(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) {
1855 ( $m, $y ) = ( $3, "20$2" );
1857 return "Illegal expiration date: ". $self->paydate;
1859 $self->paydate("$y-$m-01");
1860 my($nowm,$nowy)=(localtime(time))[4,5]; $nowm++; $nowy+=1900;
1861 return gettext('expired_card')
1863 && !$ignore_expired_card
1864 && ( $y<$nowy || ( $y==$nowy && $1<$nowm ) );
1867 if ( $self->payname eq '' && $self->payby !~ /^(CHEK|DCHK)$/ &&
1868 ( ! $conf->exists('require_cardname')
1869 || $self->payby !~ /^(CARD|DCRD)$/ )
1871 $self->payname( $self->first. " ". $self->getfield('last') );
1873 $self->payname =~ /^([\w \,\.\-\'\&]+)$/
1874 or return gettext('illegal_name'). " payname: ". $self->payname;
1878 foreach my $flag (qw( tax spool_cdr squelch_cdr archived email_csv_cdr )) {
1879 $self->$flag() =~ /^(Y?)$/ or return "Illegal $flag: ". $self->$flag();
1883 $self->otaker(getotaker) unless $self->otaker;
1885 warn "$me check AFTER: \n". $self->_dump
1888 $self->SUPER::check;
1893 Returns a list of fields which have ship_ duplicates.
1898 qw( last first company
1899 address1 address2 city county state zip country
1904 =item has_ship_address
1906 Returns true if this customer record has a separate shipping address.
1910 sub has_ship_address {
1912 scalar( grep { $self->getfield("ship_$_") ne '' } $self->addr_fields );
1915 =item all_pkgs [ EXTRA_QSEARCH_PARAMS_HASHREF ]
1917 Returns all packages (see L<FS::cust_pkg>) for this customer.
1923 my $extra_qsearch = ref($_[0]) ? shift : {};
1925 return $self->num_pkgs unless wantarray || keys(%$extra_qsearch);
1928 if ( $self->{'_pkgnum'} ) {
1929 @cust_pkg = values %{ $self->{'_pkgnum'}->cache };
1931 @cust_pkg = $self->_cust_pkg($extra_qsearch);
1934 sort sort_packages @cust_pkg;
1939 Synonym for B<all_pkgs>.
1944 shift->all_pkgs(@_);
1949 Returns all locations (see L<FS::cust_location>) for this customer.
1955 qsearch('cust_location', { 'custnum' => $self->custnum } );
1958 =item location_label_short
1960 Returns the short label of the service location (see analog in L<FS::cust_location>) for this customer.
1964 # false laziness with FS::cust_location::line_short
1966 sub location_label_short {
1968 my $cydefault = FS::conf->new->config('countrydefault') || 'US';
1970 my $line = $self->address1;
1971 #$line .= ', '. $self->address2 if $self->address2;
1972 $line .= ', '. $self->city;
1973 $line .= ', '. $self->state if $self->state;
1974 $line .= ' '. $self->zip if $self->zip;
1975 $line .= ' '. code2country($self->country) if $self->country ne $cydefault;
1980 =item ncancelled_pkgs [ EXTRA_QSEARCH_PARAMS_HASHREF ]
1982 Returns all non-cancelled packages (see L<FS::cust_pkg>) for this customer.
1986 sub ncancelled_pkgs {
1988 my $extra_qsearch = ref($_[0]) ? shift : {};
1990 return $self->num_ncancelled_pkgs unless wantarray;
1993 if ( $self->{'_pkgnum'} ) {
1995 warn "$me ncancelled_pkgs: returning cached objects"
1998 @cust_pkg = grep { ! $_->getfield('cancel') }
1999 values %{ $self->{'_pkgnum'}->cache };
2003 warn "$me ncancelled_pkgs: searching for packages with custnum ".
2004 $self->custnum. "\n"
2007 $extra_qsearch->{'extra_sql'} .= ' AND ( cancel IS NULL OR cancel = 0 ) ';
2009 @cust_pkg = $self->_cust_pkg($extra_qsearch);
2013 sort sort_packages @cust_pkg;
2019 my $extra_qsearch = ref($_[0]) ? shift : {};
2021 $extra_qsearch->{'select'} ||= '*';
2022 $extra_qsearch->{'select'} .=
2023 ',( SELECT COUNT(*) FROM cust_svc WHERE cust_pkg.pkgnum = cust_svc.pkgnum )
2027 $_->{'_num_cust_svc'} = $_->get('_num_cust_svc');
2032 'table' => 'cust_pkg',
2033 'hashref' => { 'custnum' => $self->custnum },
2038 # This should be generalized to use config options to determine order.
2041 my $locationsort = $a->locationnum <=> $b->locationnum;
2042 return $locationsort if $locationsort;
2044 if ( $a->get('cancel') xor $b->get('cancel') ) {
2045 return -1 if $b->get('cancel');
2046 return 1 if $a->get('cancel');
2047 #shouldn't get here...
2050 my $a_num_cust_svc = $a->num_cust_svc;
2051 my $b_num_cust_svc = $b->num_cust_svc;
2052 return 0 if !$a_num_cust_svc && !$b_num_cust_svc;
2053 return -1 if $a_num_cust_svc && !$b_num_cust_svc;
2054 return 1 if !$a_num_cust_svc && $b_num_cust_svc;
2055 my @a_cust_svc = $a->cust_svc;
2056 my @b_cust_svc = $b->cust_svc;
2057 $a_cust_svc[0]->svc_x->label cmp $b_cust_svc[0]->svc_x->label;
2062 =item suspended_pkgs
2064 Returns all suspended packages (see L<FS::cust_pkg>) for this customer.
2068 sub suspended_pkgs {
2070 grep { $_->susp } $self->ncancelled_pkgs;
2073 =item unflagged_suspended_pkgs
2075 Returns all unflagged suspended packages (see L<FS::cust_pkg>) for this
2076 customer (thouse packages without the `manual_flag' set).
2080 sub unflagged_suspended_pkgs {
2082 return $self->suspended_pkgs
2083 unless dbdef->table('cust_pkg')->column('manual_flag');
2084 grep { ! $_->manual_flag } $self->suspended_pkgs;
2087 =item unsuspended_pkgs
2089 Returns all unsuspended (and uncancelled) packages (see L<FS::cust_pkg>) for
2094 sub unsuspended_pkgs {
2096 grep { ! $_->susp } $self->ncancelled_pkgs;
2099 =item next_bill_date
2101 Returns the next date this customer will be billed, as a UNIX timestamp, or
2102 undef if no active package has a next bill date.
2106 sub next_bill_date {
2108 min( map $_->get('bill'), grep $_->get('bill'), $self->unsuspended_pkgs );
2111 =item num_cancelled_pkgs
2113 Returns the number of cancelled packages (see L<FS::cust_pkg>) for this
2118 sub num_cancelled_pkgs {
2119 shift->num_pkgs("cust_pkg.cancel IS NOT NULL AND cust_pkg.cancel != 0");
2122 sub num_ncancelled_pkgs {
2123 shift->num_pkgs("( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )");
2127 my( $self ) = shift;
2128 my $sql = scalar(@_) ? shift : '';
2129 $sql = "AND $sql" if $sql && $sql !~ /^\s*$/ && $sql !~ /^\s*AND/i;
2130 my $sth = dbh->prepare(
2131 "SELECT COUNT(*) FROM cust_pkg WHERE custnum = ? $sql"
2132 ) or die dbh->errstr;
2133 $sth->execute($self->custnum) or die $sth->errstr;
2134 $sth->fetchrow_arrayref->[0];
2139 Unsuspends all unflagged suspended packages (see L</unflagged_suspended_pkgs>
2140 and L<FS::cust_pkg>) for this customer. Always returns a list: an empty list
2141 on success or a list of errors.
2147 grep { $_->unsuspend } $self->suspended_pkgs;
2152 Suspends all unsuspended packages (see L<FS::cust_pkg>) for this customer.
2154 Returns a list: an empty list on success or a list of errors.
2160 grep { $_->suspend(@_) } $self->unsuspended_pkgs;
2163 =item suspend_if_pkgpart HASHREF | PKGPART [ , PKGPART ... ]
2165 Suspends all unsuspended packages (see L<FS::cust_pkg>) matching the listed
2166 PKGPARTs (see L<FS::part_pkg>). Preferred usage is to pass a hashref instead
2167 of a list of pkgparts; the hashref has the following keys:
2171 =item pkgparts - listref of pkgparts
2173 =item (other options are passed to the suspend method)
2178 Returns a list: an empty list on success or a list of errors.
2182 sub suspend_if_pkgpart {
2184 my (@pkgparts, %opt);
2185 if (ref($_[0]) eq 'HASH'){
2186 @pkgparts = @{$_[0]{pkgparts}};
2191 grep { $_->suspend(%opt) }
2192 grep { my $pkgpart = $_->pkgpart; grep { $pkgpart eq $_ } @pkgparts }
2193 $self->unsuspended_pkgs;
2196 =item suspend_unless_pkgpart HASHREF | PKGPART [ , PKGPART ... ]
2198 Suspends all unsuspended packages (see L<FS::cust_pkg>) unless they match the
2199 given PKGPARTs (see L<FS::part_pkg>). Preferred usage is to pass a hashref
2200 instead of a list of pkgparts; the hashref has the following keys:
2204 =item pkgparts - listref of pkgparts
2206 =item (other options are passed to the suspend method)
2210 Returns a list: an empty list on success or a list of errors.
2214 sub suspend_unless_pkgpart {
2216 my (@pkgparts, %opt);
2217 if (ref($_[0]) eq 'HASH'){
2218 @pkgparts = @{$_[0]{pkgparts}};
2223 grep { $_->suspend(%opt) }
2224 grep { my $pkgpart = $_->pkgpart; ! grep { $pkgpart eq $_ } @pkgparts }
2225 $self->unsuspended_pkgs;
2228 =item cancel [ OPTION => VALUE ... ]
2230 Cancels all uncancelled packages (see L<FS::cust_pkg>) for this customer.
2232 Available options are:
2236 =item quiet - can be set true to supress email cancellation notices.
2238 =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.
2240 =item ban - can be set true to ban this customer's credit card or ACH information, if present.
2242 =item nobill - can be set true to skip billing if it might otherwise be done.
2246 Always returns a list: an empty list on success or a list of errors.
2250 # nb that dates are not specified as valid options to this method
2253 my( $self, %opt ) = @_;
2255 warn "$me cancel called on customer ". $self->custnum. " with options ".
2256 join(', ', map { "$_: $opt{$_}" } keys %opt ). "\n"
2259 return ( 'access denied' )
2260 unless $FS::CurrentUser::CurrentUser->access_right('Cancel customer');
2262 if ( $opt{'ban'} && $self->payby =~ /^(CARD|DCRD|CHEK|DCHK)$/ ) {
2264 #should try decryption (we might have the private key)
2265 # and if not maybe queue a job for the server that does?
2266 return ( "Can't (yet) ban encrypted credit cards" )
2267 if $self->is_encrypted($self->payinfo);
2269 my $ban = new FS::banned_pay $self->_banned_pay_hashref;
2270 my $error = $ban->insert;
2271 return ( $error ) if $error;
2275 my @pkgs = $self->ncancelled_pkgs;
2277 if ( !$opt{nobill} && $conf->exists('bill_usage_on_cancel') ) {
2279 my $error = $self->bill( pkg_list => [ @pkgs ], cancel => 1 );
2280 warn "Error billing during cancel, custnum ". $self->custnum. ": $error"
2284 warn "$me cancelling ". scalar($self->ncancelled_pkgs). "/".
2285 scalar(@pkgs). " packages for customer ". $self->custnum. "\n"
2288 grep { $_ } map { $_->cancel(%opt) } $self->ncancelled_pkgs;
2291 sub _banned_pay_hashref {
2302 'payby' => $payby2ban{$self->payby},
2303 'payinfo' => md5_base64($self->payinfo),
2304 #don't ever *search* on reason! #'reason' =>
2310 Returns all notes (see L<FS::cust_main_note>) for this customer.
2317 qsearch( 'cust_main_note',
2318 { 'custnum' => $self->custnum },
2320 'ORDER BY _DATE DESC'
2326 Returns the agent (see L<FS::agent>) for this customer.
2332 qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
2337 Returns the customer class, as an FS::cust_class object, or the empty string
2338 if there is no customer class.
2344 if ( $self->classnum ) {
2345 qsearchs('cust_class', { 'classnum' => $self->classnum } );
2353 Returns the customer category name, or the empty string if there is no customer
2360 my $cust_class = $self->cust_class;
2362 ? $cust_class->categoryname
2368 Returns the customer class name, or the empty string if there is no customer
2375 my $cust_class = $self->cust_class;
2377 ? $cust_class->classname
2382 =item bill_and_collect
2384 Cancels and suspends any packages due, generates bills, applies payments and
2387 Warns on errors (Does not currently: If there is an error, returns the error, otherwise returns false.)
2389 Options are passed as name-value pairs. Currently available options are:
2395 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:
2399 $cust_main->bill( 'time' => str2time('April 20th, 2001') );
2403 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.
2407 "1d" for the traditional, daily events (the default), or "1m" for the new monthly events (part_event.check_freq)
2411 If set true, re-charges setup fees.
2415 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)
2419 Options are passed to the B<bill> and B<collect> methods verbatim, so all
2420 options of those methods are also available.
2424 sub bill_and_collect {
2425 my( $self, %options ) = @_;
2427 #$options{actual_time} not $options{time} because freeside-daily -d is for
2428 #pre-printing invoices
2429 $self->cancel_expired_pkgs( $options{actual_time} );
2430 $self->suspend_adjourned_pkgs( $options{actual_time} );
2432 my $error = $self->bill( %options );
2433 warn "Error billing, custnum ". $self->custnum. ": $error" if $error;
2435 $self->apply_payments_and_credits;
2437 unless ( $conf->exists('cancelled_cust-noevents')
2438 && ! $self->num_ncancelled_pkgs
2441 $error = $self->collect( %options );
2442 warn "Error collecting, custnum". $self->custnum. ": $error" if $error;
2448 sub cancel_expired_pkgs {
2449 my ( $self, $time ) = @_;
2451 my @cancel_pkgs = $self->ncancelled_pkgs( {
2452 'extra_sql' => " AND expire IS NOT NULL AND expire > 0 AND expire <= $time "
2455 foreach my $cust_pkg ( @cancel_pkgs ) {
2456 my $cpr = $cust_pkg->last_cust_pkg_reason('expire');
2457 my $error = $cust_pkg->cancel($cpr ? ( 'reason' => $cpr->reasonnum,
2458 'reason_otaker' => $cpr->otaker
2462 warn "Error cancelling expired pkg ". $cust_pkg->pkgnum.
2463 " for custnum ". $self->custnum. ": $error"
2469 sub suspend_adjourned_pkgs {
2470 my ( $self, $time ) = @_;
2472 my @susp_pkgs = $self->ncancelled_pkgs( {
2474 " AND ( susp IS NULL OR susp = 0 )
2475 AND ( ( bill IS NOT NULL AND bill != 0 AND bill < $time )
2476 OR ( adjourn IS NOT NULL AND adjourn != 0 AND adjourn <= $time )
2481 #only because there's no SQL test for is_prepaid :/
2483 grep { ( $_->part_pkg->is_prepaid
2488 && $_->adjourn <= $time
2494 foreach my $cust_pkg ( @susp_pkgs ) {
2495 my $cpr = $cust_pkg->last_cust_pkg_reason('adjourn')
2496 if ($cust_pkg->adjourn && $cust_pkg->adjourn < $^T);
2497 my $error = $cust_pkg->suspend($cpr ? ( 'reason' => $cpr->reasonnum,
2498 'reason_otaker' => $cpr->otaker
2503 warn "Error suspending package ". $cust_pkg->pkgnum.
2504 " for custnum ". $self->custnum. ": $error"
2512 Generates invoices (see L<FS::cust_bill>) for this customer. Usually used in
2513 conjunction with the collect method by calling B<bill_and_collect>.
2515 If there is an error, returns the error, otherwise returns false.
2517 Options are passed as name-value pairs. Currently available options are:
2523 If set true, re-charges setup fees.
2527 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:
2531 $cust_main->bill( 'time' => str2time('April 20th, 2001') );
2535 An array ref of specific packages (objects) to attempt billing, instead trying all of them.
2537 $cust_main->bill( pkg_list => [$pkg1, $pkg2] );
2541 A hashref of pkgparts to exclude from this billing run (can also be specified as a comma-separated scalar).
2545 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.
2549 This boolean value informs the us that the package is being cancelled. This
2550 typically might mean not charging the normal recurring fee but only usage
2551 fees since the last billing. Setup charges may be charged. Not all package
2552 plans support this feature (they tend to charge 0).
2556 Optional terms to be printed on this invoice. Otherwise, customer-specific
2557 terms or the default terms are used.
2564 my( $self, %options ) = @_;
2565 return '' if $self->payby eq 'COMP';
2566 warn "$me bill customer ". $self->custnum. "\n"
2569 my $time = $options{'time'} || time;
2570 my $invoice_time = $options{'invoice_time'} || $time;
2572 $options{'not_pkgpart'} ||= {};
2573 $options{'not_pkgpart'} = { map { $_ => 1 }
2574 split(/\s*,\s*/, $options{'not_pkgpart'})
2576 unless ref($options{'not_pkgpart'});
2578 local $SIG{HUP} = 'IGNORE';
2579 local $SIG{INT} = 'IGNORE';
2580 local $SIG{QUIT} = 'IGNORE';
2581 local $SIG{TERM} = 'IGNORE';
2582 local $SIG{TSTP} = 'IGNORE';
2583 local $SIG{PIPE} = 'IGNORE';
2585 my $oldAutoCommit = $FS::UID::AutoCommit;
2586 local $FS::UID::AutoCommit = 0;
2589 $self->select_for_update; #mutex
2591 my $error = $self->do_cust_event(
2592 'debug' => ( $options{'debug'} || 0 ),
2593 'time' => $invoice_time,
2594 'check_freq' => $options{'check_freq'},
2595 'stage' => 'pre-bill',
2598 $dbh->rollback if $oldAutoCommit;
2602 my @cust_bill_pkg = ();
2605 # find the packages which are due for billing, find out how much they are
2606 # & generate invoice database.
2609 my( $total_setup, $total_recur, $postal_charge ) = ( 0, 0, 0 );
2611 my @precommit_hooks = ();
2613 $options{'pkg_list'} ||= [ $self->ncancelled_pkgs ]; #param checks?
2614 foreach my $cust_pkg ( @{ $options{'pkg_list'} } ) {
2616 next if $options{'not_pkgpart'}->{$cust_pkg->pkgpart};
2618 warn " bill package ". $cust_pkg->pkgnum. "\n" if $DEBUG > 1;
2620 #? to avoid use of uninitialized value errors... ?
2621 $cust_pkg->setfield('bill', '')
2622 unless defined($cust_pkg->bill);
2624 #my $part_pkg = $cust_pkg->part_pkg;
2626 my $real_pkgpart = $cust_pkg->pkgpart;
2627 my %hash = $cust_pkg->hash;
2629 foreach my $part_pkg ( $cust_pkg->part_pkg->self_and_bill_linked ) {
2631 $cust_pkg->set($_, $hash{$_}) foreach qw ( setup last_bill bill );
2634 $self->_make_lines( 'part_pkg' => $part_pkg,
2635 'cust_pkg' => $cust_pkg,
2636 'precommit_hooks' => \@precommit_hooks,
2637 'line_items' => \@cust_bill_pkg,
2638 'setup' => \$total_setup,
2639 'recur' => \$total_recur,
2640 'tax_matrix' => \%taxlisthash,
2642 'real_pkgpart' => $real_pkgpart,
2643 'options' => \%options,
2646 $dbh->rollback if $oldAutoCommit;
2650 } #foreach my $part_pkg
2652 } #foreach my $cust_pkg
2654 unless ( @cust_bill_pkg ) { #don't create an invoice w/o line items
2655 #but do commit any package date cycling that happened
2656 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2660 if ( scalar( grep { $_->recur && $_->recur > 0 } @cust_bill_pkg) ||
2661 !$conf->exists('postal_invoice-recurring_only')
2665 my $postal_pkg = $self->charge_postal_fee();
2666 if ( $postal_pkg && !ref( $postal_pkg ) ) {
2668 $dbh->rollback if $oldAutoCommit;
2669 return "can't charge postal invoice fee for customer ".
2670 $self->custnum. ": $postal_pkg";
2672 } elsif ( $postal_pkg ) {
2674 my $real_pkgpart = $postal_pkg->pkgpart;
2675 foreach my $part_pkg ( $postal_pkg->part_pkg->self_and_bill_linked ) {
2676 my %postal_options = %options;
2677 delete $postal_options{cancel};
2679 $self->_make_lines( 'part_pkg' => $part_pkg,
2680 'cust_pkg' => $postal_pkg,
2681 'precommit_hooks' => \@precommit_hooks,
2682 'line_items' => \@cust_bill_pkg,
2683 'setup' => \$total_setup,
2684 'recur' => \$total_recur,
2685 'tax_matrix' => \%taxlisthash,
2687 'real_pkgpart' => $real_pkgpart,
2688 'options' => \%postal_options,
2691 $dbh->rollback if $oldAutoCommit;
2700 my $listref_or_error =
2701 $self->calculate_taxes( \@cust_bill_pkg, \%taxlisthash, $invoice_time);
2703 unless ( ref( $listref_or_error ) ) {
2704 $dbh->rollback if $oldAutoCommit;
2705 return $listref_or_error;
2708 foreach my $taxline ( @$listref_or_error ) {
2709 $total_setup = sprintf('%.2f', $total_setup+$taxline->setup );
2710 push @cust_bill_pkg, $taxline;
2713 #add tax adjustments
2714 warn "adding tax adjustments...\n" if $DEBUG > 2;
2715 foreach my $cust_tax_adjustment (
2716 qsearch('cust_tax_adjustment', { 'custnum' => $self->custnum,
2722 my $tax = sprintf('%.2f', $cust_tax_adjustment->amount );
2724 my $itemdesc = $cust_tax_adjustment->taxname;
2725 $itemdesc = '' if $itemdesc eq 'Tax';
2727 push @cust_bill_pkg, new FS::cust_bill_pkg {
2733 'itemdesc' => $itemdesc,
2734 'itemcomment' => $cust_tax_adjustment->comment,
2735 'cust_tax_adjustment' => $cust_tax_adjustment,
2736 #'cust_bill_pkg_tax_location' => \@cust_bill_pkg_tax_location,
2741 my $charged = sprintf('%.2f', $total_setup + $total_recur );
2743 my @cust_bill = $self->cust_bill;
2744 my $balance = $self->balance;
2745 my $previous_balance = scalar(@cust_bill)
2746 ? ( $cust_bill[$#cust_bill]->billing_balance || 0 )
2749 $previous_balance += $cust_bill[$#cust_bill]->charged
2750 if scalar(@cust_bill);
2751 #my $balance_adjustments =
2752 # sprintf('%.2f', $balance - $prior_prior_balance - $prior_charged);
2754 #create the new invoice
2755 my $cust_bill = new FS::cust_bill ( {
2756 'custnum' => $self->custnum,
2757 '_date' => ( $invoice_time ),
2758 'charged' => $charged,
2759 'billing_balance' => $balance,
2760 'previous_balance' => $previous_balance,
2761 'invoice_terms' => $options{'invoice_terms'},
2763 $error = $cust_bill->insert;
2765 $dbh->rollback if $oldAutoCommit;
2766 return "can't create invoice for customer #". $self->custnum. ": $error";
2769 foreach my $cust_bill_pkg ( @cust_bill_pkg ) {
2770 $cust_bill_pkg->invnum($cust_bill->invnum);
2771 my $error = $cust_bill_pkg->insert;
2773 $dbh->rollback if $oldAutoCommit;
2774 return "can't create invoice line item: $error";
2779 foreach my $hook ( @precommit_hooks ) {
2781 &{$hook}; #($self) ?
2784 $dbh->rollback if $oldAutoCommit;
2785 return "$@ running precommit hook $hook\n";
2789 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2793 =item calculate_taxes LINEITEMREF TAXHASHREF INVOICE_TIME
2795 This is a weird one. Perhaps it should not even be exposed.
2797 Generates tax line items (see L<FS::cust_bill_pkg>) for this customer.
2798 Usually used internally by bill method B<bill>.
2800 If there is an error, returns the error, otherwise returns reference to a
2801 list of line items suitable for insertion.
2807 An array ref of the line items being billed.
2811 A strange beast. The keys to this hash are internal identifiers consisting
2812 of the name of the tax object type, a space, and its unique identifier ( e.g.
2813 'cust_main_county 23' ). The values of the hash are listrefs. The first
2814 item in the list is the tax object. The remaining items are either line
2815 items or floating point values (currency amounts).
2817 The taxes are calculated on this entity. Calculated exemption records are
2818 transferred to the LINEITEMREF items on the assumption that they are related.
2824 This specifies the date appearing on the associated invoice. Some
2825 jurisdictions (i.e. Texas) have tax exemptions which are date sensitive.
2830 sub calculate_taxes {
2831 my ($self, $cust_bill_pkg, $taxlisthash, $invoice_time) = @_;
2833 my @tax_line_items = ();
2835 warn "having a look at the taxes we found...\n" if $DEBUG > 2;
2837 # keys are tax names (as printed on invoices / itemdesc )
2838 # values are listrefs of taxlisthash keys (internal identifiers)
2841 # keys are taxlisthash keys (internal identifiers)
2842 # values are (cumulative) amounts
2845 # keys are taxlisthash keys (internal identifiers)
2846 # values are listrefs of cust_bill_pkg_tax_location hashrefs
2847 my %tax_location = ();
2849 # keys are taxlisthash keys (internal identifiers)
2850 # values are listrefs of cust_bill_pkg_tax_rate_location hashrefs
2851 my %tax_rate_location = ();
2853 foreach my $tax ( keys %$taxlisthash ) {
2854 my $tax_object = shift @{ $taxlisthash->{$tax} };
2855 warn "found ". $tax_object->taxname. " as $tax\n" if $DEBUG > 2;
2856 warn " ". join('/', @{ $taxlisthash->{$tax} } ). "\n" if $DEBUG > 2;
2857 my $hashref_or_error =
2858 $tax_object->taxline( $taxlisthash->{$tax},
2859 'custnum' => $self->custnum,
2860 'invoice_time' => $invoice_time
2862 return $hashref_or_error unless ref($hashref_or_error);
2864 unshift @{ $taxlisthash->{$tax} }, $tax_object;
2866 my $name = $hashref_or_error->{'name'};
2867 my $amount = $hashref_or_error->{'amount'};
2869 #warn "adding $amount as $name\n";
2870 $taxname{ $name } ||= [];
2871 push @{ $taxname{ $name } }, $tax;
2873 $tax{ $tax } += $amount;
2875 $tax_location{ $tax } ||= [];
2876 if ( $tax_object->get('pkgnum') || $tax_object->get('locationnum') ) {
2877 push @{ $tax_location{ $tax } },
2879 'taxnum' => $tax_object->taxnum,
2880 'taxtype' => ref($tax_object),
2881 'pkgnum' => $tax_object->get('pkgnum'),
2882 'locationnum' => $tax_object->get('locationnum'),
2883 'amount' => sprintf('%.2f', $amount ),
2887 $tax_rate_location{ $tax } ||= [];
2888 if ( ref($tax_object) eq 'FS::tax_rate' ) {
2889 my $taxratelocationnum =
2890 $tax_object->tax_rate_location->taxratelocationnum;
2891 push @{ $tax_rate_location{ $tax } },
2893 'taxnum' => $tax_object->taxnum,
2894 'taxtype' => ref($tax_object),
2895 'amount' => sprintf('%.2f', $amount ),
2896 'locationtaxid' => $tax_object->location,
2897 'taxratelocationnum' => $taxratelocationnum,
2903 #move the cust_tax_exempt_pkg records to the cust_bill_pkgs we will commit
2904 my %packagemap = map { $_->pkgnum => $_ } @$cust_bill_pkg;
2905 foreach my $tax ( keys %$taxlisthash ) {
2906 foreach ( @{ $taxlisthash->{$tax} }[1 ... scalar(@{ $taxlisthash->{$tax} })] ) {
2907 next unless ref($_) eq 'FS::cust_bill_pkg';
2909 push @{ $packagemap{$_->pkgnum}->_cust_tax_exempt_pkg },
2910 splice( @{ $_->_cust_tax_exempt_pkg } );
2914 #consolidate and create tax line items
2915 warn "consolidating and generating...\n" if $DEBUG > 2;
2916 foreach my $taxname ( keys %taxname ) {
2919 my @cust_bill_pkg_tax_location = ();
2920 my @cust_bill_pkg_tax_rate_location = ();
2921 warn "adding $taxname\n" if $DEBUG > 1;
2922 foreach my $taxitem ( @{ $taxname{$taxname} } ) {
2923 next if $seen{$taxitem}++;
2924 warn "adding $tax{$taxitem}\n" if $DEBUG > 1;
2925 $tax += $tax{$taxitem};
2926 push @cust_bill_pkg_tax_location,
2927 map { new FS::cust_bill_pkg_tax_location $_ }
2928 @{ $tax_location{ $taxitem } };
2929 push @cust_bill_pkg_tax_rate_location,
2930 map { new FS::cust_bill_pkg_tax_rate_location $_ }
2931 @{ $tax_rate_location{ $taxitem } };
2935 $tax = sprintf('%.2f', $tax );
2937 my $pkg_category = qsearchs( 'pkg_category', { 'categoryname' => $taxname,
2943 if ( $pkg_category and
2944 $conf->config('invoice_latexsummary') ||
2945 $conf->config('invoice_htmlsummary')
2949 my %hash = ( 'section' => $pkg_category->categoryname );
2950 push @display, new FS::cust_bill_pkg_display { type => 'S', %hash };
2954 push @tax_line_items, new FS::cust_bill_pkg {
2960 'itemdesc' => $taxname,
2961 'display' => \@display,
2962 'cust_bill_pkg_tax_location' => \@cust_bill_pkg_tax_location,
2963 'cust_bill_pkg_tax_rate_location' => \@cust_bill_pkg_tax_rate_location,
2972 my ($self, %params) = @_;
2974 my $part_pkg = $params{part_pkg} or die "no part_pkg specified";
2975 my $cust_pkg = $params{cust_pkg} or die "no cust_pkg specified";
2976 my $precommit_hooks = $params{precommit_hooks} or die "no package specified";
2977 my $cust_bill_pkgs = $params{line_items} or die "no line buffer specified";
2978 my $total_setup = $params{setup} or die "no setup accumulator specified";
2979 my $total_recur = $params{recur} or die "no recur accumulator specified";
2980 my $taxlisthash = $params{tax_matrix} or die "no tax accumulator specified";
2981 my $time = $params{'time'} or die "no time specified";
2982 my (%options) = %{$params{options}};
2985 my $real_pkgpart = $params{real_pkgpart};
2986 my %hash = $cust_pkg->hash;
2987 my $old_cust_pkg = new FS::cust_pkg \%hash;
2993 $cust_pkg->pkgpart($part_pkg->pkgpart);
3001 if ( $options{'resetup'}
3002 || ( ! $cust_pkg->setup
3003 && ( ! $cust_pkg->start_date
3004 || $cust_pkg->start_date <= $time
3006 && ( ! $conf->exists('disable_setup_suspended_pkgs')
3007 || ( $conf->exists('disable_setup_suspended_pkgs') &&
3008 ! $cust_pkg->getfield('susp')
3015 warn " bill setup\n" if $DEBUG > 1;
3018 $setup = eval { $cust_pkg->calc_setup( $time, \@details ) };
3019 return "$@ running calc_setup for $cust_pkg\n"
3022 $unitsetup = $cust_pkg->part_pkg->unit_setup || $setup; #XXX uuh
3024 $cust_pkg->setfield('setup', $time)
3025 unless $cust_pkg->setup;
3026 #do need it, but it won't get written to the db
3027 #|| $cust_pkg->pkgpart != $real_pkgpart;
3029 $cust_pkg->setfield('start_date', '')
3030 if $cust_pkg->start_date;
3035 # bill recurring fee
3038 #XXX unit stuff here too
3042 if ( ! $cust_pkg->get('susp')
3043 and ! $cust_pkg->get('start_date')
3044 and ( $part_pkg->getfield('freq') ne '0'
3045 && ( $cust_pkg->getfield('bill') || 0 ) <= $time
3047 || ( $part_pkg->plan eq 'voip_cdr'
3048 && $part_pkg->option('bill_every_call')
3050 || ( $options{cancel} )
3053 # XXX should this be a package event? probably. events are called
3054 # at collection time at the moment, though...
3055 $part_pkg->reset_usage($cust_pkg, 'debug'=>$DEBUG)
3056 if $part_pkg->can('reset_usage');
3057 #don't want to reset usage just cause we want a line item??
3058 #&& $part_pkg->pkgpart == $real_pkgpart;
3060 warn " bill recur\n" if $DEBUG > 1;
3063 # XXX shared with $recur_prog
3064 $sdate = ( $options{cancel} ? $cust_pkg->last_bill : $cust_pkg->bill )
3068 #over two params! lets at least switch to a hashref for the rest...
3069 my $increment_next_bill = ( $part_pkg->freq ne '0'
3070 && ( $cust_pkg->getfield('bill') || 0 ) <= $time
3071 && !$options{cancel}
3073 my %param = ( 'precommit_hooks' => $precommit_hooks,
3074 'increment_next_bill' => $increment_next_bill,
3077 my $method = $options{cancel} ? 'calc_cancel' : 'calc_recur';
3078 $recur = eval { $cust_pkg->$method( \$sdate, \@details, \%param ) };
3079 return "$@ running $method for $cust_pkg\n"
3082 if ( $increment_next_bill ) {
3084 my $next_bill = $part_pkg->add_freq($sdate);
3085 return "unparsable frequency: ". $part_pkg->freq
3086 if $next_bill == -1;
3088 #pro-rating magic - if $recur_prog fiddled $sdate, want to use that
3089 # only for figuring next bill date, nothing else, so, reset $sdate again
3091 $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
3092 #no need, its in $hash{last_bill}# my $last_bill = $cust_pkg->last_bill;
3093 $cust_pkg->last_bill($sdate);
3095 $cust_pkg->setfield('bill', $next_bill );
3101 warn "\$setup is undefined" unless defined($setup);
3102 warn "\$recur is undefined" unless defined($recur);
3103 warn "\$cust_pkg->bill is undefined" unless defined($cust_pkg->bill);
3106 # If there's line items, create em cust_bill_pkg records
3107 # If $cust_pkg has been modified, update it (if we're a real pkgpart)
3112 if ( $cust_pkg->modified && $cust_pkg->pkgpart == $real_pkgpart ) {
3113 # hmm.. and if just the options are modified in some weird price plan?
3115 warn " package ". $cust_pkg->pkgnum. " modified; updating\n"
3118 my $error = $cust_pkg->replace( $old_cust_pkg,
3119 'options' => { $cust_pkg->options },
3121 return "Error modifying pkgnum ". $cust_pkg->pkgnum. ": $error"
3122 if $error; #just in case
3125 $setup = sprintf( "%.2f", $setup );
3126 $recur = sprintf( "%.2f", $recur );
3127 if ( $setup < 0 && ! $conf->exists('allow_negative_charges') ) {
3128 return "negative setup $setup for pkgnum ". $cust_pkg->pkgnum;
3130 if ( $recur < 0 && ! $conf->exists('allow_negative_charges') ) {
3131 return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum;
3134 if ( $setup != 0 || $recur != 0 ) {
3136 warn " charges (setup=$setup, recur=$recur); adding line items\n"
3139 my @cust_pkg_detail = map { $_->detail } $cust_pkg->cust_pkg_detail('I');
3141 warn " adding customer package invoice detail: $_\n"
3142 foreach @cust_pkg_detail;
3144 push @details, @cust_pkg_detail;
3146 my $cust_bill_pkg = new FS::cust_bill_pkg {
3147 'pkgnum' => $cust_pkg->pkgnum,
3149 'unitsetup' => $unitsetup,
3151 'unitrecur' => $unitrecur,
3152 'quantity' => $cust_pkg->quantity,
3153 'details' => \@details,
3154 'hidden' => $part_pkg->hidden,
3157 if ( $part_pkg->option('recur_temporality', 1) eq 'preceding' ) {
3158 $cust_bill_pkg->sdate( $hash{last_bill} );
3159 $cust_bill_pkg->edate( $sdate - 86399 ); #60s*60m*24h-1
3160 $cust_bill_pkg->edate( $time ) if $options{cancel};
3161 } else { #if ( $part_pkg->option('recur_temporality', 1) eq 'upcoming' ) {
3162 $cust_bill_pkg->sdate( $sdate );
3163 $cust_bill_pkg->edate( $cust_pkg->bill );
3164 #$cust_bill_pkg->edate( $time ) if $options{cancel};
3167 $cust_bill_pkg->pkgpart_override($part_pkg->pkgpart)
3168 unless $part_pkg->pkgpart == $real_pkgpart;
3170 $$total_setup += $setup;
3171 $$total_recur += $recur;
3178 $self->_handle_taxes($part_pkg, $taxlisthash, $cust_bill_pkg, $cust_pkg, $options{invoice_time}, $real_pkgpart, \%options);
3179 return $error if $error;
3181 push @$cust_bill_pkgs, $cust_bill_pkg;
3183 } #if $setup != 0 || $recur != 0
3193 my $part_pkg = shift;
3194 my $taxlisthash = shift;
3195 my $cust_bill_pkg = shift;
3196 my $cust_pkg = shift;
3197 my $invoice_time = shift;
3198 my $real_pkgpart = shift;
3199 my $options = shift;
3201 my %cust_bill_pkg = ();
3205 #push @classes, $cust_bill_pkg->usage_classes if $cust_bill_pkg->type eq 'U';
3206 push @classes, $cust_bill_pkg->usage_classes if $cust_bill_pkg->usage;
3207 push @classes, 'setup' if ($cust_bill_pkg->setup && !$options->{cancel});
3208 push @classes, 'recur' if ($cust_bill_pkg->recur && !$options->{cancel});
3210 if ( $self->tax !~ /Y/i && $self->payby ne 'COMP' ) {
3212 if ( $conf->exists('enable_taxproducts')
3213 && ( scalar($part_pkg->part_pkg_taxoverride)
3214 || $part_pkg->has_taxproduct
3219 if ( $conf->exists('tax-pkg_address') && $cust_pkg->locationnum ) {
3220 return "fatal: Can't (yet) use tax-pkg_address with taxproducts";
3223 foreach my $class (@classes) {
3224 my $err_or_ref = $self->_gather_taxes( $part_pkg, $class );
3225 return $err_or_ref unless ref($err_or_ref);
3226 $taxes{$class} = $err_or_ref;
3229 unless (exists $taxes{''}) {
3230 my $err_or_ref = $self->_gather_taxes( $part_pkg, '' );
3231 return $err_or_ref unless ref($err_or_ref);
3232 $taxes{''} = $err_or_ref;
3237 my @loc_keys = qw( city county state country );
3239 if ( $conf->exists('tax-pkg_address') && $cust_pkg->locationnum ) {
3240 my $cust_location = $cust_pkg->cust_location;
3241 %taxhash = map { $_ => $cust_location->$_() } @loc_keys;
3244 ( $conf->exists('tax-ship_address') && length($self->ship_last) )
3247 %taxhash = map { $_ => $self->get("$prefix$_") } @loc_keys;
3250 $taxhash{'taxclass'} = $part_pkg->taxclass;
3253 my %taxhash_elim = %taxhash;
3254 my @elim = qw( city county state );
3257 #first try a match with taxclass
3258 @taxes = qsearch( 'cust_main_county', \%taxhash_elim );
3260 if ( !scalar(@taxes) && $taxhash_elim{'taxclass'} ) {
3261 #then try a match without taxclass
3262 my %no_taxclass = %taxhash_elim;
3263 $no_taxclass{ 'taxclass' } = '';
3264 @taxes = qsearch( 'cust_main_county', \%no_taxclass );
3267 $taxhash_elim{ shift(@elim) } = '';
3269 } while ( !scalar(@taxes) && scalar(@elim) );
3271 @taxes = grep { ! $_->taxname or ! $self->tax_exemption($_->taxname) }
3273 if $self->cust_main_exemption; #just to be safe
3275 if ( $conf->exists('tax-pkg_address') && $cust_pkg->locationnum ) {
3277 $_->set('pkgnum', $cust_pkg->pkgnum );
3278 $_->set('locationnum', $cust_pkg->locationnum );
3282 $taxes{''} = [ @taxes ];
3283 $taxes{'setup'} = [ @taxes ];
3284 $taxes{'recur'} = [ @taxes ];
3285 $taxes{$_} = [ @taxes ] foreach (@classes);
3287 # # maybe eliminate this entirely, along with all the 0% records
3288 # unless ( @taxes ) {
3290 # "fatal: can't find tax rate for state/county/country/taxclass ".
3291 # join('/', map $taxhash{$_}, qw(state county country taxclass) );
3294 } #if $conf->exists('enable_taxproducts') ...
3299 my $separate = $conf->exists('separate_usage');
3300 my $usage_mandate = $cust_pkg->part_pkg->option('usage_mandate', 'Hush!');
3301 if ( $separate || $cust_bill_pkg->hidden || $usage_mandate ) {
3303 my $temp_pkg = new FS::cust_pkg { pkgpart => $real_pkgpart };
3304 my %hash = $cust_bill_pkg->hidden # maybe for all bill linked?
3305 ? ( 'section' => $temp_pkg->part_pkg->categoryname )
3308 my $section = $cust_pkg->part_pkg->option('usage_section', 'Hush!');
3309 my $summary = $cust_pkg->part_pkg->option('summarize_usage', 'Hush!');
3311 push @display, new FS::cust_bill_pkg_display { type => 'S', %hash };
3312 push @display, new FS::cust_bill_pkg_display { type => 'R', %hash };
3314 push @display, new FS::cust_bill_pkg_display
3317 ( ( $usage_mandate ) ? ( 'summary' => 'Y' ) : () ),
3321 if ($separate && $section && $summary) {
3322 push @display, new FS::cust_bill_pkg_display { type => 'U',
3327 if ($usage_mandate || $section && $summary) {
3328 $hash{post_total} = 'Y';
3331 $hash{section} = $section if ($separate || $usage_mandate);
3332 push @display, new FS::cust_bill_pkg_display { type => 'U', %hash };
3335 $cust_bill_pkg->set('display', \@display);
3337 my %tax_cust_bill_pkg = $cust_bill_pkg->disintegrate;
3338 foreach my $key (keys %tax_cust_bill_pkg) {
3339 my @taxes = @{ $taxes{$key} || [] };
3340 my $tax_cust_bill_pkg = $tax_cust_bill_pkg{$key};
3342 my %localtaxlisthash = ();
3343 foreach my $tax ( @taxes ) {
3345 my $taxname = ref( $tax ). ' '. $tax->taxnum;
3346 # $taxname .= ' pkgnum'. $cust_pkg->pkgnum.
3347 # ' locationnum'. $cust_pkg->locationnum
3348 # if $conf->exists('tax-pkg_address') && $cust_pkg->locationnum;
3350 $taxlisthash->{ $taxname } ||= [ $tax ];
3351 push @{ $taxlisthash->{ $taxname } }, $tax_cust_bill_pkg;
3353 $localtaxlisthash{ $taxname } ||= [ $tax ];
3354 push @{ $localtaxlisthash{ $taxname } }, $tax_cust_bill_pkg;
3358 warn "finding taxed taxes...\n" if $DEBUG > 2;
3359 foreach my $tax ( keys %localtaxlisthash ) {
3360 my $tax_object = shift @{ $localtaxlisthash{$tax} };
3361 warn "found possible taxed tax ". $tax_object->taxname. " we call $tax\n"
3363 next unless $tax_object->can('tax_on_tax');
3365 foreach my $tot ( $tax_object->tax_on_tax( $self ) ) {
3366 my $totname = ref( $tot ). ' '. $tot->taxnum;
3368 warn "checking $totname which we call ". $tot->taxname. " as applicable\n"
3370 next unless exists( $localtaxlisthash{ $totname } ); # only increase
3372 warn "adding $totname to taxed taxes\n" if $DEBUG > 2;
3373 my $hashref_or_error =
3374 $tax_object->taxline( $localtaxlisthash{$tax},
3375 'custnum' => $self->custnum,
3376 'invoice_time' => $invoice_time,
3378 return $hashref_or_error
3379 unless ref($hashref_or_error);
3381 $taxlisthash->{ $totname } ||= [ $tot ];
3382 push @{ $taxlisthash->{ $totname } }, $hashref_or_error->{amount};
3394 my $part_pkg = shift;
3398 my $geocode = $self->geocode('cch');
3400 my @taxclassnums = map { $_->taxclassnum }
3401 $part_pkg->part_pkg_taxoverride($class);
3403 unless (@taxclassnums) {
3404 @taxclassnums = map { $_->taxclassnum }
3405 grep { $_->taxable eq 'Y' }
3406 $part_pkg->part_pkg_taxrate('cch', $geocode, $class);
3408 warn "Found taxclassnum values of ". join(',', @taxclassnums)
3413 join(' OR ', map { "taxclassnum = $_" } @taxclassnums ). ")";
3415 @taxes = qsearch({ 'table' => 'tax_rate',
3416 'hashref' => { 'geocode' => $geocode, },
3417 'extra_sql' => $extra_sql,
3419 if scalar(@taxclassnums);
3421 warn "Found taxes ".
3422 join(',', map{ ref($_). " ". $_->get($_->primary_key) } @taxes). "\n"
3429 =item collect [ HASHREF | OPTION => VALUE ... ]
3431 (Attempt to) collect money for this customer's outstanding invoices (see
3432 L<FS::cust_bill>). Usually used after the bill method.
3434 Actions are now triggered by billing events; see L<FS::part_event> and the
3435 billing events web interface. Old-style invoice events (see
3436 L<FS::part_bill_event>) have been deprecated.
3438 If there is an error, returns the error, otherwise returns false.
3440 Options are passed as name-value pairs.
3442 Currently available options are:
3448 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.
3452 Retry card/echeck/LEC transactions even when not scheduled by invoice events.
3456 "1d" for the traditional, daily events (the default), or "1m" for the new monthly events (part_event.check_freq)
3460 set true to surpress email card/ACH decline notices.
3464 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)
3470 # allows for one time override of normal customer billing method
3475 my( $self, %options ) = @_;
3476 my $invoice_time = $options{'invoice_time'} || time;
3479 local $SIG{HUP} = 'IGNORE';
3480 local $SIG{INT} = 'IGNORE';
3481 local $SIG{QUIT} = 'IGNORE';
3482 local $SIG{TERM} = 'IGNORE';
3483 local $SIG{TSTP} = 'IGNORE';
3484 local $SIG{PIPE} = 'IGNORE';
3486 my $oldAutoCommit = $FS::UID::AutoCommit;
3487 local $FS::UID::AutoCommit = 0;
3490 $self->select_for_update; #mutex
3493 my $balance = $self->balance;
3494 warn "$me collect customer ". $self->custnum. ": balance $balance\n"
3497 if ( exists($options{'retry_card'}) ) {
3498 carp 'retry_card option passed to collect is deprecated; use retry';
3499 $options{'retry'} ||= $options{'retry_card'};
3501 if ( exists($options{'retry'}) && $options{'retry'} ) {
3502 my $error = $self->retry_realtime;
3504 $dbh->rollback if $oldAutoCommit;
3509 my $error = $self->do_cust_event(
3510 'debug' => ( $options{'debug'} || 0 ),
3511 'time' => $invoice_time,
3512 'check_freq' => $options{'check_freq'},
3513 'stage' => 'collect',
3516 $dbh->rollback if $oldAutoCommit;
3520 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3525 =item do_cust_event [ HASHREF | OPTION => VALUE ... ]
3527 Runs billing events; see L<FS::part_event> and the billing events web
3530 If there is an error, returns the error, otherwise returns false.
3532 Options are passed as name-value pairs.
3534 Currently available options are:
3540 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.
3544 "1d" for the traditional, daily events (the default), or "1m" for the new monthly events (part_event.check_freq)
3548 "collect" (the default) or "pre-bill"
3552 set true to surpress email card/ACH decline notices.
3556 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)
3562 # allows for one time override of normal customer billing method
3566 # Retry card/echeck/LEC transactions even when not scheduled by invoice events.
3569 my( $self, %options ) = @_;
3570 my $time = $options{'time'} || time;
3573 local $SIG{HUP} = 'IGNORE';
3574 local $SIG{INT} = 'IGNORE';
3575 local $SIG{QUIT} = 'IGNORE';
3576 local $SIG{TERM} = 'IGNORE';
3577 local $SIG{TSTP} = 'IGNORE';
3578 local $SIG{PIPE} = 'IGNORE';
3580 my $oldAutoCommit = $FS::UID::AutoCommit;
3581 local $FS::UID::AutoCommit = 0;
3584 $self->select_for_update; #mutex
3587 my $balance = $self->balance;
3588 warn "$me do_cust_event customer ". $self->custnum. ": balance $balance\n"
3591 # if ( exists($options{'retry_card'}) ) {
3592 # carp 'retry_card option passed to collect is deprecated; use retry';
3593 # $options{'retry'} ||= $options{'retry_card'};
3595 # if ( exists($options{'retry'}) && $options{'retry'} ) {
3596 # my $error = $self->retry_realtime;
3598 # $dbh->rollback if $oldAutoCommit;
3603 # false laziness w/pay_batch::import_results
3605 my $due_cust_event = $self->due_cust_event(
3606 'debug' => ( $options{'debug'} || 0 ),
3608 'check_freq' => $options{'check_freq'},
3609 'stage' => ( $options{'stage'} || 'collect' ),
3611 unless( ref($due_cust_event) ) {
3612 $dbh->rollback if $oldAutoCommit;
3613 return $due_cust_event;
3616 foreach my $cust_event ( @$due_cust_event ) {
3620 #re-eval event conditions (a previous event could have changed things)
3621 unless ( $cust_event->test_conditions( 'time' => $time ) ) {
3622 #don't leave stray "new/locked" records around
3623 my $error = $cust_event->delete;
3625 #gah, even with transactions
3626 $dbh->commit if $oldAutoCommit; #well.
3633 local $realtime_bop_decline_quiet = 1 if $options{'quiet'};
3634 warn " running cust_event ". $cust_event->eventnum. "\n"
3638 #if ( my $error = $cust_event->do_event(%options) ) { #XXX %options?
3639 if ( my $error = $cust_event->do_event() ) {
3640 #XXX wtf is this? figure out a proper dealio with return value
3642 # gah, even with transactions.
3643 $dbh->commit if $oldAutoCommit; #well.
3650 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3655 =item due_cust_event [ HASHREF | OPTION => VALUE ... ]
3657 Inserts database records for and returns an ordered listref of new events due
3658 for this customer, as FS::cust_event objects (see L<FS::cust_event>). If no
3659 events are due, an empty listref is returned. If there is an error, returns a
3660 scalar error message.
3662 To actually run the events, call each event's test_condition method, and if
3663 still true, call the event's do_event method.
3665 Options are passed as a hashref or as a list of name-value pairs. Available
3672 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.
3676 "collect" (the default) or "pre-bill"
3680 "Current time" for the events.
3684 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)
3688 Only return events for the specified eventtable (by default, events of all eventtables are returned)
3692 Explicitly pass the objects to be tested (typically used with eventtable).
3696 Set to true to return the objects, but not actually insert them into the
3703 sub due_cust_event {
3705 my %opt = ref($_[0]) ? %{ $_[0] } : @_;
3708 #my $DEBUG = $opt{'debug'}
3709 local($DEBUG) = $opt{'debug'}
3710 if defined($opt{'debug'}) && $opt{'debug'} > $DEBUG;
3712 warn "$me due_cust_event called with options ".
3713 join(', ', map { "$_: $opt{$_}" } keys %opt). "\n"
3716 $opt{'time'} ||= time;
3718 local $SIG{HUP} = 'IGNORE';
3719 local $SIG{INT} = 'IGNORE';
3720 local $SIG{QUIT} = 'IGNORE';
3721 local $SIG{TERM} = 'IGNORE';
3722 local $SIG{TSTP} = 'IGNORE';
3723 local $SIG{PIPE} = 'IGNORE';
3725 my $oldAutoCommit = $FS::UID::AutoCommit;
3726 local $FS::UID::AutoCommit = 0;
3729 $self->select_for_update #mutex
3730 unless $opt{testonly};
3733 # find possible events (initial search)
3736 my @cust_event = ();
3738 my @eventtable = $opt{'eventtable'}
3739 ? ( $opt{'eventtable'} )
3740 : FS::part_event->eventtables_runorder;
3742 foreach my $eventtable ( @eventtable ) {
3745 if ( $opt{'objects'} ) {
3747 @objects = @{ $opt{'objects'} };
3751 #my @objects = $self->eventtable(); # sub cust_main { @{ [ $self ] }; }
3752 @objects = ( $eventtable eq 'cust_main' )
3754 : ( $self->$eventtable() );
3758 my @e_cust_event = ();
3760 my $cross = "CROSS JOIN $eventtable";
3761 $cross .= ' LEFT JOIN cust_main USING ( custnum )'
3762 unless $eventtable eq 'cust_main';
3764 foreach my $object ( @objects ) {
3766 #this first search uses the condition_sql magic for optimization.
3767 #the more possible events we can eliminate in this step the better
3769 my $cross_where = '';
3770 my $pkey = $object->primary_key;
3771 $cross_where = "$eventtable.$pkey = ". $object->$pkey();
3773 my $join = FS::part_event_condition->join_conditions_sql( $eventtable );
3775 FS::part_event_condition->where_conditions_sql( $eventtable,
3776 'time'=>$opt{'time'}
3778 my $order = FS::part_event_condition->order_conditions_sql( $eventtable );
3780 $extra_sql = "AND $extra_sql" if $extra_sql;
3782 #here is the agent virtualization
3783 $extra_sql .= " AND ( part_event.agentnum IS NULL
3784 OR part_event.agentnum = ". $self->agentnum. ' )';
3786 $extra_sql .= " $order";
3788 warn "searching for events for $eventtable ". $object->$pkey. "\n"
3789 if $opt{'debug'} > 2;
3790 my @part_event = qsearch( {
3791 'debug' => ( $opt{'debug'} > 3 ? 1 : 0 ),
3792 'select' => 'part_event.*',
3793 'table' => 'part_event',
3794 'addl_from' => "$cross $join",
3795 'hashref' => { 'check_freq' => ( $opt{'check_freq'} || '1d' ),
3796 'eventtable' => $eventtable,
3799 'extra_sql' => "AND $cross_where $extra_sql",
3803 my $pkey = $object->primary_key;
3804 warn " ". scalar(@part_event).
3805 " possible events found for $eventtable ". $object->$pkey(). "\n";
3808 push @e_cust_event, map { $_->new_cust_event($object) } @part_event;
3812 warn " ". scalar(@e_cust_event).
3813 " subtotal possible cust events found for $eventtable\n"
3816 push @cust_event, @e_cust_event;
3820 warn " ". scalar(@cust_event).
3821 " total possible cust events found in initial search\n"
3829 $opt{stage} ||= 'collect';
3831 grep { my $stage = $_->part_event->event_stage;
3832 $opt{stage} eq $stage or ( ! $stage && $opt{stage} eq 'collect' )
3842 @cust_event = grep $_->test_conditions( 'time' => $opt{'time'},
3843 'stats_hashref' => \%unsat ),
3846 warn " ". scalar(@cust_event). " cust events left satisfying conditions\n"
3849 warn " invalid conditions not eliminated with condition_sql:\n".
3850 join('', map " $_: ".$unsat{$_}."\n", keys %unsat )
3857 unless( $opt{testonly} ) {
3858 foreach my $cust_event ( @cust_event ) {
3860 my $error = $cust_event->insert();
3862 $dbh->rollback if $oldAutoCommit;
3869 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3875 warn " returning events: ". Dumper(@cust_event). "\n"
3882 =item retry_realtime
3884 Schedules realtime / batch credit card / electronic check / LEC billing
3885 events for for retry. Useful if card information has changed or manual
3886 retry is desired. The 'collect' method must be called to actually retry
3889 Implementation details: For either this customer, or for each of this
3890 customer's open invoices, changes the status of the first "done" (with
3891 statustext error) realtime processing event to "failed".
3895 sub retry_realtime {
3898 local $SIG{HUP} = 'IGNORE';
3899 local $SIG{INT} = 'IGNORE';
3900 local $SIG{QUIT} = 'IGNORE';
3901 local $SIG{TERM} = 'IGNORE';
3902 local $SIG{TSTP} = 'IGNORE';
3903 local $SIG{PIPE} = 'IGNORE';
3905 my $oldAutoCommit = $FS::UID::AutoCommit;
3906 local $FS::UID::AutoCommit = 0;
3909 #a little false laziness w/due_cust_event (not too bad, really)
3911 my $join = FS::part_event_condition->join_conditions_sql;
3912 my $order = FS::part_event_condition->order_conditions_sql;
3915 . join ( ' OR ' , map {
3916 "( part_event.eventtable = " . dbh->quote($_)
3917 . " AND tablenum IN( SELECT " . dbdef->table($_)->primary_key . " from $_ where custnum = " . dbh->quote( $self->custnum ) . "))" ;
3918 } FS::part_event->eventtables)
3921 #here is the agent virtualization
3922 my $agent_virt = " ( part_event.agentnum IS NULL
3923 OR part_event.agentnum = ". $self->agentnum. ' )';
3925 #XXX this shouldn't be hardcoded, actions should declare it...
3926 my @realtime_events = qw(
3927 cust_bill_realtime_card
3928 cust_bill_realtime_check
3929 cust_bill_realtime_lec
3933 my $is_realtime_event = ' ( '. join(' OR ', map "part_event.action = '$_'",
3938 my @cust_event = qsearchs({
3939 'table' => 'cust_event',
3940 'select' => 'cust_event.*',
3941 'addl_from' => "LEFT JOIN part_event USING ( eventpart ) $join",
3942 'hashref' => { 'status' => 'done' },
3943 'extra_sql' => " AND statustext IS NOT NULL AND statustext != '' ".
3944 " AND $mine AND $is_realtime_event AND $agent_virt $order" # LIMIT 1"
3947 my %seen_invnum = ();
3948 foreach my $cust_event (@cust_event) {
3950 #max one for the customer, one for each open invoice
3951 my $cust_X = $cust_event->cust_X;
3952 next if $seen_invnum{ $cust_event->part_event->eventtable eq 'cust_bill'
3956 or $cust_event->part_event->eventtable eq 'cust_bill'
3959 my $error = $cust_event->retry;
3961 $dbh->rollback if $oldAutoCommit;
3962 return "error scheduling event for retry: $error";
3967 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3972 # some horrid false laziness here to avoid refactor fallout
3973 # eventually realtime realtime_bop and realtime_refund_bop should go
3974 # away and be replaced by _new_realtime_bop and _new_realtime_refund_bop
3976 =item realtime_bop METHOD AMOUNT [ OPTION => VALUE ... ]
3978 Runs a realtime credit card, ACH (electronic check) or phone bill transaction
3979 via a Business::OnlinePayment realtime gateway. See
3980 L<http://420.am/business-onlinepayment> for supported gateways.
3982 Available methods are: I<CC>, I<ECHECK> and I<LEC>
3984 Available options are: I<description>, I<invnum>, I<quiet>, I<paynum_ref>, I<payunique>
3986 The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
3987 I<zip>, I<payinfo> and I<paydate> are also available. Any of these options,
3988 if set, will override the value from the customer record.
3990 I<description> is a free-text field passed to the gateway. It defaults to
3991 the value defined by the business-onlinepayment-description configuration
3992 option, or "Internet services" if that is unset.
3994 If an I<invnum> is specified, this payment (if successful) is applied to the
3995 specified invoice. If you don't specify an I<invnum> you might want to
3996 call the B<apply_payments> method or set the I<apply> option.
3998 I<apply> can be set to true to apply a resulting payment.
4000 I<quiet> can be set true to surpress email decline notices.
4002 I<paynum_ref> can be set to a scalar reference. It will be filled in with the
4003 resulting paynum, if any.
4005 I<payunique> is a unique identifier for this payment.
4007 (moved from cust_bill) (probably should get realtime_{card,ach,lec} here too)
4014 return $self->_new_realtime_bop(@_)
4015 if $self->_new_bop_required();
4017 my($method, $amount);
4019 if (ref($_[0]) eq 'HASH') {
4020 %options = %{$_[0]};
4021 $method = $options{method};
4022 $amount = $options{amount};
4024 ( $method, $amount ) = ( shift, shift );
4028 warn "$me realtime_bop: $method $amount\n";
4029 warn " $_ => $options{$_}\n" foreach keys %options;
4032 unless ( $options{'description'} ) {
4033 if ( $conf->exists('business-onlinepayment-description') ) {
4034 my $dtempl = $conf->config('business-onlinepayment-description');
4036 my $agent = $self->agent->agent;
4038 $options{'description'} = eval qq("$dtempl");
4040 $options{'description'} = 'Internet services';
4044 return $self->fake_bop($method, $amount, %options) if $options{'fake'};
4046 eval "use Business::OnlinePayment";
4049 my $payinfo = exists($options{'payinfo'})
4050 ? $options{'payinfo'}
4053 my %method2payby = (
4060 # check for banned credit card/ACH
4063 my $ban = qsearchs('banned_pay', {
4064 'payby' => $method2payby{$method},
4065 'payinfo' => md5_base64($payinfo),
4067 return "Banned credit card" if $ban;
4070 # set taxclass and trans_is_recur based on invnum if there is one
4074 my $trans_is_recur = 0;
4075 if ( $options{'invnum'} ) {
4077 my $cust_bill = qsearchs('cust_bill', { 'invnum' => $options{'invnum'} } );
4078 die "invnum ". $options{'invnum'}. " not found" unless $cust_bill;
4081 map { $_->part_pkg }
4083 map { $_->cust_pkg }
4084 $cust_bill->cust_bill_pkg;
4086 my @taxclasses = map $_->taxclass, @part_pkg;
4087 $taxclass = $taxclasses[0]
4088 unless grep { $taxclasses[0] ne $_ } @taxclasses; #unless there are
4089 #different taxclasses
4091 if grep { $_->freq ne '0' } @part_pkg;
4099 #look for an agent gateway override first
4101 if ( $method eq 'CC' ) {
4102 $cardtype = cardtype($payinfo);
4103 } elsif ( $method eq 'ECHECK' ) {
4106 $cardtype = $method;
4110 qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
4111 cardtype => $cardtype,
4112 taxclass => $taxclass, } )
4113 || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
4115 taxclass => $taxclass, } )
4116 || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
4117 cardtype => $cardtype,
4119 || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
4121 taxclass => '', } );
4123 my $payment_gateway = '';
4124 my( $processor, $login, $password, $action, @bop_options );
4125 if ( $override ) { #use a payment gateway override
4127 $payment_gateway = $override->payment_gateway;
4129 $processor = $payment_gateway->gateway_module;
4130 $login = $payment_gateway->gateway_username;
4131 $password = $payment_gateway->gateway_password;
4132 $action = $payment_gateway->gateway_action;
4133 @bop_options = $payment_gateway->options;
4135 } else { #use the standard settings from the config
4137 ( $processor, $login, $password, $action, @bop_options ) =
4138 $self->default_payment_gateway($method);
4146 my $address = exists($options{'address1'})
4147 ? $options{'address1'}
4149 my $address2 = exists($options{'address2'})
4150 ? $options{'address2'}
4152 $address .= ", ". $address2 if length($address2);
4154 my $o_payname = exists($options{'payname'})
4155 ? $options{'payname'}
4157 my($payname, $payfirst, $paylast);
4158 if ( $o_payname && $method ne 'ECHECK' ) {
4159 ($payname = $o_payname) =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
4160 or return "Illegal payname $payname";
4161 ($payfirst, $paylast) = ($1, $2);
4163 $payfirst = $self->getfield('first');
4164 $paylast = $self->getfield('last');
4165 $payname = "$payfirst $paylast";
4168 my @invoicing_list = $self->invoicing_list_emailonly;
4169 if ( $conf->exists('emailinvoiceautoalways')
4170 || $conf->exists('emailinvoiceauto') && ! @invoicing_list
4171 || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
4172 push @invoicing_list, $self->all_emails;
4175 my $email = ($conf->exists('business-onlinepayment-email-override'))
4176 ? $conf->config('business-onlinepayment-email-override')
4177 : $invoicing_list[0];
4181 my $payip = exists($options{'payip'})
4184 $content{customer_ip} = $payip
4187 $content{invoice_number} = $options{'invnum'}
4188 if exists($options{'invnum'}) && length($options{'invnum'});
4190 $content{email_customer} =
4191 ( $conf->exists('business-onlinepayment-email_customer')
4192 || $conf->exists('business-onlinepayment-email-override') );
4195 if ( $method eq 'CC' ) {
4197 $content{card_number} = $payinfo;
4198 $paydate = exists($options{'paydate'})
4199 ? $options{'paydate'}
4201 $paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
4202 $content{expiration} = "$2/$1";
4204 my $paycvv = exists($options{'paycvv'})
4205 ? $options{'paycvv'}
4207 $content{cvv2} = $paycvv
4210 my $paystart_month = exists($options{'paystart_month'})
4211 ? $options{'paystart_month'}
4212 : $self->paystart_month;
4214 my $paystart_year = exists($options{'paystart_year'})
4215 ? $options{'paystart_year'}
4216 : $self->paystart_year;
4218 $content{card_start} = "$paystart_month/$paystart_year"
4219 if $paystart_month && $paystart_year;
4221 my $payissue = exists($options{'payissue'})
4222 ? $options{'payissue'}
4224 $content{issue_number} = $payissue if $payissue;
4226 if ( $self->_bop_recurring_billing( 'payinfo' => $payinfo,
4227 'trans_is_recur' => $trans_is_recur,
4231 $content{recurring_billing} = 'YES';
4232 $content{acct_code} = 'rebill'
4233 if $conf->exists('credit_card-recurring_billing_acct_code');
4236 } elsif ( $method eq 'ECHECK' ) {
4237 ( $content{account_number}, $content{routing_code} ) =
4238 split('@', $payinfo);
4239 $content{bank_name} = $o_payname;
4240 $content{bank_state} = exists($options{'paystate'})
4241 ? $options{'paystate'}
4242 : $self->getfield('paystate');
4243 $content{account_type} = exists($options{'paytype'})
4244 ? uc($options{'paytype'}) || 'CHECKING'
4245 : uc($self->getfield('paytype')) || 'CHECKING';
4246 $content{account_name} = $payname;
4247 $content{customer_org} = $self->company ? 'B' : 'I';
4248 $content{state_id} = exists($options{'stateid'})
4249 ? $options{'stateid'}
4250 : $self->getfield('stateid');
4251 $content{state_id_state} = exists($options{'stateid_state'})
4252 ? $options{'stateid_state'}
4253 : $self->getfield('stateid_state');
4254 $content{customer_ssn} = exists($options{'ss'})
4257 } elsif ( $method eq 'LEC' ) {
4258 $content{phone} = $payinfo;
4262 # run transaction(s)
4265 my $balance = exists( $options{'balance'} )
4266 ? $options{'balance'}
4269 $self->select_for_update; #mutex ... just until we get our pending record in
4271 #the checks here are intended to catch concurrent payments
4272 #double-form-submission prevention is taken care of in cust_pay_pending::check
4275 return "The customer's balance has changed; $method transaction aborted."
4276 if $self->balance < $balance;
4277 #&& $self->balance < $amount; #might as well anyway?
4279 #also check and make sure there aren't *other* pending payments for this cust
4281 my @pending = qsearch('cust_pay_pending', {
4282 'custnum' => $self->custnum,
4283 'status' => { op=>'!=', value=>'done' }
4285 return "A payment is already being processed for this customer (".
4286 join(', ', map 'paypendingnum '. $_->paypendingnum, @pending ).
4287 "); $method transaction aborted."
4288 if scalar(@pending);
4290 #okay, good to go, if we're a duplicate, cust_pay_pending will kick us out
4292 my $cust_pay_pending = new FS::cust_pay_pending {
4293 'custnum' => $self->custnum,
4294 #'invnum' => $options{'invnum'},
4297 'payby' => $method2payby{$method},
4298 'payinfo' => $payinfo,
4299 'paydate' => $paydate,
4300 'recurring_billing' => $content{recurring_billing},
4301 'pkgnum' => $options{'pkgnum'},
4303 'gatewaynum' => ( $payment_gateway ? $payment_gateway->gatewaynum : '' ),
4305 $cust_pay_pending->payunique( $options{payunique} )
4306 if defined($options{payunique}) && length($options{payunique});
4307 my $cpp_new_err = $cust_pay_pending->insert; #mutex lost when this is inserted
4308 return $cpp_new_err if $cpp_new_err;
4310 my( $action1, $action2 ) = split(/\s*\,\s*/, $action );
4312 my $transaction = new Business::OnlinePayment( $processor, @bop_options );
4313 $transaction->content(
4316 'password' => $password,
4317 'action' => $action1,
4318 'description' => $options{'description'},
4319 'amount' => $amount,
4320 #'invoice_number' => $options{'invnum'},
4321 'customer_id' => $self->custnum,
4322 'last_name' => $paylast,
4323 'first_name' => $payfirst,
4325 'address' => $address,
4326 'city' => ( exists($options{'city'})
4329 'state' => ( exists($options{'state'})
4332 'zip' => ( exists($options{'zip'})
4335 'country' => ( exists($options{'country'})
4336 ? $options{'country'}
4338 'referer' => 'http://cleanwhisker.420.am/', #XXX fix referer :/
4340 'phone' => $self->daytime || $self->night,
4344 $cust_pay_pending->status('pending');
4345 my $cpp_pending_err = $cust_pay_pending->replace;
4346 return $cpp_pending_err if $cpp_pending_err;
4349 my $BOP_TESTING = 0;
4350 my $BOP_TESTING_SUCCESS = 1;
4352 unless ( $BOP_TESTING ) {
4353 $transaction->submit();
4355 if ( $BOP_TESTING_SUCCESS ) {
4356 $transaction->is_success(1);
4357 $transaction->authorization('fake auth');
4359 $transaction->is_success(0);
4360 $transaction->error_message('fake failure');
4364 if ( $transaction->is_success() && $action2 ) {
4366 $cust_pay_pending->status('authorized');
4367 my $cpp_authorized_err = $cust_pay_pending->replace;
4368 return $cpp_authorized_err if $cpp_authorized_err;
4370 my $auth = $transaction->authorization;
4371 my $ordernum = $transaction->can('order_number')
4372 ? $transaction->order_number
4376 new Business::OnlinePayment( $processor, @bop_options );
4383 password => $password,
4384 order_number => $ordernum,
4386 authorization => $auth,
4387 description => $options{'description'},
4390 foreach my $field (qw( authorization_source_code returned_ACI
4391 transaction_identifier validation_code
4392 transaction_sequence_num local_transaction_date
4393 local_transaction_time AVS_result_code )) {
4394 $capture{$field} = $transaction->$field() if $transaction->can($field);
4397 $capture->content( %capture );
4401 unless ( $capture->is_success ) {
4402 my $e = "Authorization successful but capture failed, custnum #".
4403 $self->custnum. ': '. $capture->result_code.
4404 ": ". $capture->error_message;
4411 $cust_pay_pending->status($transaction->is_success() ? 'captured' : 'declined');
4412 my $cpp_captured_err = $cust_pay_pending->replace;
4413 return $cpp_captured_err if $cpp_captured_err;
4416 # remove paycvv after initial transaction
4419 #false laziness w/misc/process/payment.cgi - check both to make sure working
4421 if ( defined $self->dbdef_table->column('paycvv')
4422 && length($self->paycvv)
4423 && ! grep { $_ eq cardtype($payinfo) } $conf->config('cvv-save')
4425 my $error = $self->remove_cvv;
4427 warn "WARNING: error removing cvv: $error\n";
4435 if ( $transaction->is_success() ) {
4438 if ( $payment_gateway ) { # agent override
4439 $paybatch = $payment_gateway->gatewaynum. '-';
4442 $paybatch .= "$processor:". $transaction->authorization;
4444 $paybatch .= ':'. $transaction->order_number
4445 if $transaction->can('order_number')
4446 && length($transaction->order_number);
4448 my $cust_pay = new FS::cust_pay ( {
4449 'custnum' => $self->custnum,
4450 'invnum' => $options{'invnum'},
4453 'payby' => $method2payby{$method},
4454 'payinfo' => $payinfo,
4455 'paybatch' => $paybatch,
4456 'paydate' => $paydate,
4457 'pkgnum' => $options{'pkgnum'},
4459 #doesn't hurt to know, even though the dup check is in cust_pay_pending now
4460 $cust_pay->payunique( $options{payunique} )
4461 if defined($options{payunique}) && length($options{payunique});
4463 my $oldAutoCommit = $FS::UID::AutoCommit;
4464 local $FS::UID::AutoCommit = 0;
4467 #start a transaction, insert the cust_pay and set cust_pay_pending.status to done in a single transction
4469 my $error = $cust_pay->insert($options{'manual'} ? ( 'manual' => 1 ) : () );
4472 $cust_pay->invnum(''); #try again with no specific invnum
4473 my $error2 = $cust_pay->insert( $options{'manual'} ?
4474 ( 'manual' => 1 ) : ()
4477 # gah. but at least we have a record of the state we had to abort in
4478 # from cust_pay_pending now.
4479 my $e = "WARNING: $method captured but payment not recorded - ".
4480 "error inserting payment ($processor): $error2".
4481 " (previously tried insert with invnum #$options{'invnum'}" .
4482 ": $error ) - pending payment saved as paypendingnum ".
4483 $cust_pay_pending->paypendingnum. "\n";
4489 if ( $options{'paynum_ref'} ) {
4490 ${ $options{'paynum_ref'} } = $cust_pay->paynum;
4493 $cust_pay_pending->status('done');
4494 $cust_pay_pending->statustext('captured');
4495 $cust_pay_pending->paynum($cust_pay->paynum);
4496 my $cpp_done_err = $cust_pay_pending->replace;
4498 if ( $cpp_done_err ) {
4500 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
4501 my $e = "WARNING: $method captured but payment not recorded - ".
4502 "error updating status for paypendingnum ".
4503 $cust_pay_pending->paypendingnum. ": $cpp_done_err \n";
4509 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4511 if ( $options{'apply'} ) {
4512 my $apply_error = $self->apply_payments_and_credits;
4513 if ( $apply_error ) {
4514 warn "WARNING: error applying payment: $apply_error\n";
4515 #but we still should return no error cause the payment otherwise went
4520 return ''; #no error
4526 my $perror = "$processor error: ". $transaction->error_message;
4528 unless ( $transaction->error_message ) {
4531 if ( $transaction->can('response_page') ) {
4533 'page' => ( $transaction->can('response_page')
4534 ? $transaction->response_page
4537 'code' => ( $transaction->can('response_code')
4538 ? $transaction->response_code
4541 'headers' => ( $transaction->can('response_headers')
4542 ? $transaction->response_headers
4548 "No additional debugging information available for $processor";
4551 $perror .= "No error_message returned from $processor -- ".
4552 ( ref($t_response) ? Dumper($t_response) : $t_response );
4556 if ( !$options{'quiet'} && !$realtime_bop_decline_quiet
4557 && $conf->exists('emaildecline')
4558 && grep { $_ ne 'POST' } $self->invoicing_list
4559 && ! grep { $transaction->error_message =~ /$_/ }
4560 $conf->config('emaildecline-exclude')
4562 my @templ = $conf->config('declinetemplate');
4563 my $template = new Text::Template (
4565 SOURCE => [ map "$_\n", @templ ],
4566 ) or return "($perror) can't create template: $Text::Template::ERROR";
4567 $template->compile()
4568 or return "($perror) can't compile template: $Text::Template::ERROR";
4572 scalar( $conf->config('company_name', $self->agentnum ) ),
4573 'company_address' =>
4574 join("\n", $conf->config('company_address', $self->agentnum ) ),
4575 'error' => $transaction->error_message,
4578 my $error = send_email(
4579 'from' => $conf->config('invoice_from', $self->agentnum ),
4580 'to' => [ grep { $_ ne 'POST' } $self->invoicing_list ],
4581 'subject' => 'Your payment could not be processed',
4582 'body' => [ $template->fill_in(HASH => $templ_hash) ],
4585 $perror .= " (also received error sending decline notification: $error)"
4590 $cust_pay_pending->status('done');
4591 $cust_pay_pending->statustext("declined: $perror");
4592 my $cpp_done_err = $cust_pay_pending->replace;
4593 if ( $cpp_done_err ) {
4594 my $e = "WARNING: $method declined but pending payment not resolved - ".
4595 "error updating status for paypendingnum ".
4596 $cust_pay_pending->paypendingnum. ": $cpp_done_err \n";
4598 $perror = "$e ($perror)";
4606 sub _bop_recurring_billing {
4607 my( $self, %opt ) = @_;
4609 my $method = scalar($conf->config('credit_card-recurring_billing_flag'));
4611 if ( defined($method) && $method eq 'transaction_is_recur' ) {
4613 return 1 if $opt{'trans_is_recur'};
4617 my %hash = ( 'custnum' => $self->custnum,
4622 if qsearch('cust_pay', { %hash, 'payinfo' => $opt{'payinfo'} } )
4623 || qsearch('cust_pay', { %hash, 'paymask' => $self->mask_payinfo('CARD',
4634 =item realtime_refund_bop METHOD [ OPTION => VALUE ... ]
4636 Refunds a realtime credit card, ACH (electronic check) or phone bill transaction
4637 via a Business::OnlinePayment realtime gateway. See
4638 L<http://420.am/business-onlinepayment> for supported gateways.
4640 Available methods are: I<CC>, I<ECHECK> and I<LEC>
4642 Available options are: I<amount>, I<reason>, I<paynum>, I<paydate>
4644 Most gateways require a reference to an original payment transaction to refund,
4645 so you probably need to specify a I<paynum>.
4647 I<amount> defaults to the original amount of the payment if not specified.
4649 I<reason> specifies a reason for the refund.
4651 I<paydate> specifies the expiration date for a credit card overriding the
4652 value from the customer record or the payment record. Specified as yyyy-mm-dd
4654 Implementation note: If I<amount> is unspecified or equal to the amount of the
4655 orignal payment, first an attempt is made to "void" the transaction via
4656 the gateway (to cancel a not-yet settled transaction) and then if that fails,
4657 the normal attempt is made to "refund" ("credit") the transaction via the
4658 gateway is attempted.
4660 #The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
4661 #I<zip>, I<payinfo> and I<paydate> are also available. Any of these options,
4662 #if set, will override the value from the customer record.
4664 #If an I<invnum> is specified, this payment (if successful) is applied to the
4665 #specified invoice. If you don't specify an I<invnum> you might want to
4666 #call the B<apply_payments> method.
4670 #some false laziness w/realtime_bop, not enough to make it worth merging
4671 #but some useful small subs should be pulled out
4672 sub realtime_refund_bop {
4675 return $self->_new_realtime_refund_bop(@_)
4676 if $self->_new_bop_required();
4678 my( $method, %options ) = @_;
4680 warn "$me realtime_refund_bop: $method refund\n";
4681 warn " $_ => $options{$_}\n" foreach keys %options;
4684 eval "use Business::OnlinePayment";
4688 # look up the original payment and optionally a gateway for that payment
4692 my $amount = $options{'amount'};
4694 my( $processor, $login, $password, @bop_options ) ;
4695 my( $auth, $order_number ) = ( '', '', '' );
4697 if ( $options{'paynum'} ) {
4699 warn " paynum: $options{paynum}\n" if $DEBUG > 1;
4700 $cust_pay = qsearchs('cust_pay', { paynum=>$options{'paynum'} } )
4701 or return "Unknown paynum $options{'paynum'}";
4702 $amount ||= $cust_pay->paid;
4704 $cust_pay->paybatch =~ /^((\d+)\-)?(\w+):\s*([\w\-\/ ]*)(:([\w\-]+))?$/
4705 or return "Can't parse paybatch for paynum $options{'paynum'}: ".
4706 $cust_pay->paybatch;
4707 my $gatewaynum = '';
4708 ( $gatewaynum, $processor, $auth, $order_number ) = ( $2, $3, $4, $6 );
4710 if ( $gatewaynum ) { #gateway for the payment to be refunded
4712 my $payment_gateway =
4713 qsearchs('payment_gateway', { 'gatewaynum' => $gatewaynum } );
4714 die "payment gateway $gatewaynum not found"
4715 unless $payment_gateway;
4717 $processor = $payment_gateway->gateway_module;
4718 $login = $payment_gateway->gateway_username;
4719 $password = $payment_gateway->gateway_password;
4720 @bop_options = $payment_gateway->options;
4722 } else { #try the default gateway
4724 my( $conf_processor, $unused_action );
4725 ( $conf_processor, $login, $password, $unused_action, @bop_options ) =
4726 $self->default_payment_gateway($method);
4728 return "processor of payment $options{'paynum'} $processor does not".
4729 " match default processor $conf_processor"
4730 unless $processor eq $conf_processor;
4735 } else { # didn't specify a paynum, so look for agent gateway overrides
4736 # like a normal transaction
4739 if ( $method eq 'CC' ) {
4740 $cardtype = cardtype($self->payinfo);
4741 } elsif ( $method eq 'ECHECK' ) {
4744 $cardtype = $method;
4747 qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
4748 cardtype => $cardtype,
4750 || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
4752 taxclass => '', } );
4754 if ( $override ) { #use a payment gateway override
4756 my $payment_gateway = $override->payment_gateway;
4758 $processor = $payment_gateway->gateway_module;
4759 $login = $payment_gateway->gateway_username;
4760 $password = $payment_gateway->gateway_password;
4761 #$action = $payment_gateway->gateway_action;
4762 @bop_options = $payment_gateway->options;
4764 } else { #use the standard settings from the config
4767 ( $processor, $login, $password, $unused_action, @bop_options ) =
4768 $self->default_payment_gateway($method);
4773 return "neither amount nor paynum specified" unless $amount;
4778 'password' => $password,
4779 'order_number' => $order_number,
4780 'amount' => $amount,
4781 'referer' => 'http://cleanwhisker.420.am/', #XXX fix referer :/
4783 $content{authorization} = $auth
4784 if length($auth); #echeck/ACH transactions have an order # but no auth
4785 #(at least with authorize.net)
4787 my $disable_void_after;
4788 if ($conf->exists('disable_void_after')
4789 && $conf->config('disable_void_after') =~ /^(\d+)$/) {
4790 $disable_void_after = $1;
4793 #first try void if applicable
4794 if ( $cust_pay && $cust_pay->paid == $amount
4796 ( not defined($disable_void_after) )
4797 || ( time < ($cust_pay->_date + $disable_void_after ) )
4800 warn " attempting void\n" if $DEBUG > 1;
4801 my $void = new Business::OnlinePayment( $processor, @bop_options );
4802 $content{'card_number'} = $cust_pay->payinfo
4803 if $cust_pay->payby eq 'CARD'
4804 && $void->can('info') && $void->info('CC_void_requires_card');
4805 $void->content( 'action' => 'void', %content );
4807 if ( $void->is_success ) {
4808 my $error = $cust_pay->void($options{'reason'});
4810 # gah, even with transactions.
4811 my $e = 'WARNING: Card/ACH voided but database not updated - '.
4812 "error voiding payment: $error";
4816 warn " void successful\n" if $DEBUG > 1;
4821 warn " void unsuccessful, trying refund\n"
4825 my $address = $self->address1;
4826 $address .= ", ". $self->address2 if $self->address2;
4828 my($payname, $payfirst, $paylast);
4829 if ( $self->payname && $method ne 'ECHECK' ) {
4830 $payname = $self->payname;
4831 $payname =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
4832 or return "Illegal payname $payname";
4833 ($payfirst, $paylast) = ($1, $2);
4835 $payfirst = $self->getfield('first');
4836 $paylast = $self->getfield('last');
4837 $payname = "$payfirst $paylast";
4840 my @invoicing_list = $self->invoicing_list_emailonly;
4841 if ( $conf->exists('emailinvoiceautoalways')
4842 || $conf->exists('emailinvoiceauto') && ! @invoicing_list
4843 || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
4844 push @invoicing_list, $self->all_emails;
4847 my $email = ($conf->exists('business-onlinepayment-email-override'))
4848 ? $conf->config('business-onlinepayment-email-override')
4849 : $invoicing_list[0];
4851 my $payip = exists($options{'payip'})
4854 $content{customer_ip} = $payip
4858 if ( $method eq 'CC' ) {
4861 $content{card_number} = $payinfo = $cust_pay->payinfo;
4862 (exists($options{'paydate'}) ? $options{'paydate'} : $cust_pay->paydate)
4863 =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/ &&
4864 ($content{expiration} = "$2/$1"); # where available
4866 $content{card_number} = $payinfo = $self->payinfo;
4867 (exists($options{'paydate'}) ? $options{'paydate'} : $self->paydate)
4868 =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
4869 $content{expiration} = "$2/$1";
4872 } elsif ( $method eq 'ECHECK' ) {
4875 $payinfo = $cust_pay->payinfo;
4877 $payinfo = $self->payinfo;
4879 ( $content{account_number}, $content{routing_code} )= split('@', $payinfo );
4880 $content{bank_name} = $self->payname;
4881 $content{account_type} = 'CHECKING';
4882 $content{account_name} = $payname;
4883 $content{customer_org} = $self->company ? 'B' : 'I';
4884 $content{customer_ssn} = $self->ss;
4885 } elsif ( $method eq 'LEC' ) {
4886 $content{phone} = $payinfo = $self->payinfo;
4890 my $refund = new Business::OnlinePayment( $processor, @bop_options );
4891 my %sub_content = $refund->content(
4892 'action' => 'credit',
4893 'customer_id' => $self->custnum,
4894 'last_name' => $paylast,
4895 'first_name' => $payfirst,
4897 'address' => $address,
4898 'city' => $self->city,
4899 'state' => $self->state,
4900 'zip' => $self->zip,
4901 'country' => $self->country,
4903 'phone' => $self->daytime || $self->night,
4906 warn join('', map { " $_ => $sub_content{$_}\n" } keys %sub_content )
4910 return "$processor error: ". $refund->error_message
4911 unless $refund->is_success();
4913 my %method2payby = (
4919 my $paybatch = "$processor:". $refund->authorization;
4920 $paybatch .= ':'. $refund->order_number
4921 if $refund->can('order_number') && $refund->order_number;
4923 while ( $cust_pay && $cust_pay->unapplied < $amount ) {
4924 my @cust_bill_pay = $cust_pay->cust_bill_pay;
4925 last unless @cust_bill_pay;
4926 my $cust_bill_pay = pop @cust_bill_pay;
4927 my $error = $cust_bill_pay->delete;
4931 my $cust_refund = new FS::cust_refund ( {
4932 'custnum' => $self->custnum,
4933 'paynum' => $options{'paynum'},
4934 'refund' => $amount,
4936 'payby' => $method2payby{$method},
4937 'payinfo' => $payinfo,
4938 'paybatch' => $paybatch,
4939 'reason' => $options{'reason'} || 'card or ACH refund',
4941 my $error = $cust_refund->insert;
4943 $cust_refund->paynum(''); #try again with no specific paynum
4944 my $error2 = $cust_refund->insert;
4946 # gah, even with transactions.
4947 my $e = 'WARNING: Card/ACH refunded but database not updated - '.
4948 "error inserting refund ($processor): $error2".
4949 " (previously tried insert with paynum #$options{'paynum'}" .
4960 # does the configuration indicate the new bop routines are required?
4962 sub _new_bop_required {
4965 my $botpp = 'Business::OnlineThirdPartyPayment';
4968 if ( $conf->config('business-onlinepayment-namespace') eq $botpp ||
4969 scalar( grep { $_->gateway_namespace eq $botpp }
4970 qsearch( 'payment_gateway', { 'disabled' => '' } )
4978 =item realtime_collect [ OPTION => VALUE ... ]
4980 Runs a realtime credit card, ACH (electronic check) or phone bill transaction
4981 via a Business::OnlinePayment or Business::OnlineThirdPartyPayment realtime
4982 gateway. See L<http://420.am/business-onlinepayment> and
4983 L<http://420.am/business-onlinethirdpartypayment> for supported gateways.
4985 On failure returns an error message.
4987 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.
4989 Available options are: I<method>, I<amount>, I<description>, I<invnum>, I<quiet>, I<paynum_ref>, I<payunique>, I<session_id>, I<pkgnum>
4991 I<method> is one of: I<CC>, I<ECHECK> and I<LEC>. If none is specified
4992 then it is deduced from the customer record.
4994 If no I<amount> is specified, then the customer balance is used.
4996 The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
4997 I<zip>, I<payinfo> and I<paydate> are also available. Any of these options,
4998 if set, will override the value from the customer record.
5000 I<description> is a free-text field passed to the gateway. It defaults to
5001 the value defined by the business-onlinepayment-description configuration
5002 option, or "Internet services" if that is unset.
5004 If an I<invnum> is specified, this payment (if successful) is applied to the
5005 specified invoice. If you don't specify an I<invnum> you might want to
5006 call the B<apply_payments> method or set the I<apply> option.
5008 I<apply> can be set to true to apply a resulting payment.
5010 I<quiet> can be set true to surpress email decline notices.
5012 I<paynum_ref> can be set to a scalar reference. It will be filled in with the
5013 resulting paynum, if any.
5015 I<payunique> is a unique identifier for this payment.
5017 I<session_id> is a session identifier associated with this payment.
5019 I<depend_jobnum> allows payment capture to unlock export jobs
5023 sub realtime_collect {
5024 my( $self, %options ) = @_;
5027 warn "$me realtime_collect:\n";
5028 warn " $_ => $options{$_}\n" foreach keys %options;
5031 $options{amount} = $self->balance unless exists( $options{amount} );
5032 $options{method} = FS::payby->payby2bop($self->payby)
5033 unless exists( $options{method} );
5035 return $self->realtime_bop({%options});
5039 =item _realtime_bop { [ ARG => VALUE ... ] }
5041 Runs a realtime credit card, ACH (electronic check) or phone bill transaction
5042 via a Business::OnlinePayment realtime gateway. See
5043 L<http://420.am/business-onlinepayment> for supported gateways.
5045 Required arguments in the hashref are I<method>, and I<amount>
5047 Available methods are: I<CC>, I<ECHECK> and I<LEC>
5049 Available optional arguments are: I<description>, I<invnum>, I<quiet>, I<paynum_ref>, I<payunique>, I<session_id>
5051 The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
5052 I<zip>, I<payinfo> and I<paydate> are also available. Any of these options,
5053 if set, will override the value from the customer record.
5055 I<description> is a free-text field passed to the gateway. It defaults to
5056 the value defined by the business-onlinepayment-description configuration
5057 option, or "Internet services" if that is unset.
5059 If an I<invnum> is specified, this payment (if successful) is applied to the
5060 specified invoice. If you don't specify an I<invnum> you might want to
5061 call the B<apply_payments> method.
5063 I<quiet> can be set true to surpress email decline notices.
5065 I<paynum_ref> can be set to a scalar reference. It will be filled in with the
5066 resulting paynum, if any.
5068 I<payunique> is a unique identifier for this payment.
5070 I<session_id> is a session identifier associated with this payment.
5072 I<depend_jobnum> allows payment capture to unlock export jobs
5074 (moved from cust_bill) (probably should get realtime_{card,ach,lec} here too)
5078 # some helper routines
5079 sub _payment_gateway {
5080 my ($self, $options) = @_;
5082 $options->{payment_gateway} = $self->agent->payment_gateway( %$options )
5083 unless exists($options->{payment_gateway});
5085 $options->{payment_gateway};
5089 my ($self, $options) = @_;
5092 'login' => $options->{payment_gateway}->gateway_username,
5093 'password' => $options->{payment_gateway}->gateway_password,
5098 my ($self, $options) = @_;
5100 $options->{payment_gateway}->gatewaynum
5101 ? $options->{payment_gateway}->options
5102 : @{ $options->{payment_gateway}->get('options') };
5106 my ($self, $options) = @_;
5108 unless ( $options->{'description'} ) {
5109 if ( $conf->exists('business-onlinepayment-description') ) {
5110 my $dtempl = $conf->config('business-onlinepayment-description');
5112 my $agent = $self->agent->agent;
5114 $options->{'description'} = eval qq("$dtempl");
5116 $options->{'description'} = 'Internet services';
5120 $options->{payinfo} = $self->payinfo unless exists( $options->{payinfo} );
5121 $options->{invnum} ||= '';
5122 $options->{payname} = $self->payname unless exists( $options->{payname} );
5126 my ($self, $options) = @_;
5129 $content{address} = exists($options->{'address1'})
5130 ? $options->{'address1'}
5132 my $address2 = exists($options->{'address2'})
5133 ? $options->{'address2'}
5135 $content{address} .= ", ". $address2 if length($address2);
5137 my $payip = exists($options->{'payip'}) ? $options->{'payip'} : $self->payip;
5138 $content{customer_ip} = $payip if length($payip);
5140 $content{invoice_number} = $options->{'invnum'}
5141 if exists($options->{'invnum'}) && length($options->{'invnum'});
5143 $content{email_customer} =
5144 ( $conf->exists('business-onlinepayment-email_customer')
5145 || $conf->exists('business-onlinepayment-email-override') );
5147 $content{payfirst} = $self->getfield('first');
5148 $content{paylast} = $self->getfield('last');
5150 $content{account_name} = "$content{payfirst} $content{paylast}"
5151 if $options->{method} eq 'ECHECK';
5153 $content{name} = $options->{payname};
5154 $content{name} = $content{account_name} if exists($content{account_name});
5156 $content{city} = exists($options->{city})
5159 $content{state} = exists($options->{state})
5162 $content{zip} = exists($options->{zip})
5165 $content{country} = exists($options->{country})
5166 ? $options->{country}
5168 $content{referer} = 'http://cleanwhisker.420.am/'; #XXX fix referer :/
5169 $content{phone} = $self->daytime || $self->night;
5174 my %bop_method2payby = (
5180 sub _new_realtime_bop {
5184 if (ref($_[0]) eq 'HASH') {
5185 %options = %{$_[0]};
5187 my ( $method, $amount ) = ( shift, shift );
5189 $options{method} = $method;
5190 $options{amount} = $amount;
5194 warn "$me realtime_bop (new): $options{method} $options{amount}\n";
5195 warn " $_ => $options{$_}\n" foreach keys %options;
5198 return $self->fake_bop(%options) if $options{'fake'};
5200 $self->_bop_defaults(\%options);
5203 # set trans_is_recur based on invnum if there is one
5206 my $trans_is_recur = 0;
5207 if ( $options{'invnum'} ) {
5209 my $cust_bill = qsearchs('cust_bill', { 'invnum' => $options{'invnum'} } );
5210 die "invnum ". $options{'invnum'}. " not found" unless $cust_bill;
5213 map { $_->part_pkg }
5215 map { $_->cust_pkg }
5216 $cust_bill->cust_bill_pkg;
5219 if grep { $_->freq ne '0' } @part_pkg;
5227 my $payment_gateway = $self->_payment_gateway( \%options );
5228 my $namespace = $payment_gateway->gateway_namespace;
5230 eval "use $namespace";
5234 # check for banned credit card/ACH
5237 my $ban = qsearchs('banned_pay', {
5238 'payby' => $bop_method2payby{$options{method}},
5239 'payinfo' => md5_base64($options{payinfo}),
5241 return "Banned credit card" if $ban;
5247 my (%bop_content) = $self->_bop_content(\%options);
5249 if ( $options{method} ne 'ECHECK' ) {
5250 $options{payname} =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
5251 or return "Illegal payname $options{payname}";
5252 ($bop_content{payfirst}, $bop_content{paylast}) = ($1, $2);
5255 my @invoicing_list = $self->invoicing_list_emailonly;
5256 if ( $conf->exists('emailinvoiceautoalways')
5257 || $conf->exists('emailinvoiceauto') && ! @invoicing_list
5258 || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
5259 push @invoicing_list, $self->all_emails;
5262 my $email = ($conf->exists('business-onlinepayment-email-override'))
5263 ? $conf->config('business-onlinepayment-email-override')
5264 : $invoicing_list[0];
5268 if ( $namespace eq 'Business::OnlinePayment' && $options{method} eq 'CC' ) {
5270 $content{card_number} = $options{payinfo};
5271 $paydate = exists($options{'paydate'})
5272 ? $options{'paydate'}
5274 $paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
5275 $content{expiration} = "$2/$1";
5277 my $paycvv = exists($options{'paycvv'})
5278 ? $options{'paycvv'}
5280 $content{cvv2} = $paycvv
5283 my $paystart_month = exists($options{'paystart_month'})
5284 ? $options{'paystart_month'}
5285 : $self->paystart_month;
5287 my $paystart_year = exists($options{'paystart_year'})
5288 ? $options{'paystart_year'}
5289 : $self->paystart_year;
5291 $content{card_start} = "$paystart_month/$paystart_year"
5292 if $paystart_month && $paystart_year;
5294 my $payissue = exists($options{'payissue'})
5295 ? $options{'payissue'}
5297 $content{issue_number} = $payissue if $payissue;
5299 if ( $self->_bop_recurring_billing( 'payinfo' => $options{'payinfo'},
5300 'trans_is_recur' => $trans_is_recur,
5304 $content{recurring_billing} = 'YES';
5305 $content{acct_code} = 'rebill'
5306 if $conf->exists('credit_card-recurring_billing_acct_code');
5309 } elsif ( $namespace eq 'Business::OnlinePayment' && $options{method} eq 'ECHECK' ){
5310 ( $content{account_number}, $content{routing_code} ) =
5311 split('@', $options{payinfo});
5312 $content{bank_name} = $options{payname};
5313 $content{bank_state} = exists($options{'paystate'})
5314 ? $options{'paystate'}
5315 : $self->getfield('paystate');
5316 $content{account_type} = exists($options{'paytype'})
5317 ? uc($options{'paytype'}) || 'CHECKING'
5318 : uc($self->getfield('paytype')) || 'CHECKING';
5319 $content{customer_org} = $self->company ? 'B' : 'I';
5320 $content{state_id} = exists($options{'stateid'})
5321 ? $options{'stateid'}
5322 : $self->getfield('stateid');
5323 $content{state_id_state} = exists($options{'stateid_state'})
5324 ? $options{'stateid_state'}
5325 : $self->getfield('stateid_state');
5326 $content{customer_ssn} = exists($options{'ss'})
5329 } elsif ( $namespace eq 'Business::OnlinePayment' && $options{method} eq 'LEC' ) {
5330 $content{phone} = $options{payinfo};
5331 } elsif ( $namespace eq 'Business::OnlineThirdPartyPayment' ) {
5338 # run transaction(s)
5341 my $balance = exists( $options{'balance'} )
5342 ? $options{'balance'}
5345 $self->select_for_update; #mutex ... just until we get our pending record in
5347 #the checks here are intended to catch concurrent payments
5348 #double-form-submission prevention is taken care of in cust_pay_pending::check
5351 return "The customer's balance has changed; $options{method} transaction aborted."
5352 if $self->balance < $balance;
5353 #&& $self->balance < $options{amount}; #might as well anyway?
5355 #also check and make sure there aren't *other* pending payments for this cust
5357 my @pending = qsearch('cust_pay_pending', {
5358 'custnum' => $self->custnum,
5359 'status' => { op=>'!=', value=>'done' }
5361 return "A payment is already being processed for this customer (".
5362 join(', ', map 'paypendingnum '. $_->paypendingnum, @pending ).
5363 "); $options{method} transaction aborted."
5364 if scalar(@pending);
5366 #okay, good to go, if we're a duplicate, cust_pay_pending will kick us out
5368 my $cust_pay_pending = new FS::cust_pay_pending {
5369 'custnum' => $self->custnum,
5370 #'invnum' => $options{'invnum'},
5371 'paid' => $options{amount},
5373 'payby' => $bop_method2payby{$options{method}},
5374 'payinfo' => $options{payinfo},
5375 'paydate' => $paydate,
5376 'recurring_billing' => $content{recurring_billing},
5377 'pkgnum' => $options{'pkgnum'},
5379 'gatewaynum' => $payment_gateway->gatewaynum || '',
5380 'session_id' => $options{session_id} || '',
5381 'jobnum' => $options{depend_jobnum} || '',
5383 $cust_pay_pending->payunique( $options{payunique} )
5384 if defined($options{payunique}) && length($options{payunique});
5385 my $cpp_new_err = $cust_pay_pending->insert; #mutex lost when this is inserted
5386 return $cpp_new_err if $cpp_new_err;
5388 my( $action1, $action2 ) =
5389 split( /\s*\,\s*/, $payment_gateway->gateway_action );
5391 my $transaction = new $namespace( $payment_gateway->gateway_module,
5392 $self->_bop_options(\%options),
5395 $transaction->content(
5396 'type' => $options{method},
5397 $self->_bop_auth(\%options),
5398 'action' => $action1,
5399 'description' => $options{'description'},
5400 'amount' => $options{amount},
5401 #'invoice_number' => $options{'invnum'},
5402 'customer_id' => $self->custnum,
5404 'reference' => $cust_pay_pending->paypendingnum, #for now
5409 $cust_pay_pending->status('pending');
5410 my $cpp_pending_err = $cust_pay_pending->replace;
5411 return $cpp_pending_err if $cpp_pending_err;
5414 my $BOP_TESTING = 0;
5415 my $BOP_TESTING_SUCCESS = 1;
5417 unless ( $BOP_TESTING ) {
5418 $transaction->submit();
5420 if ( $BOP_TESTING_SUCCESS ) {
5421 $transaction->is_success(1);
5422 $transaction->authorization('fake auth');
5424 $transaction->is_success(0);
5425 $transaction->error_message('fake failure');
5429 if ( $transaction->is_success() && $namespace eq 'Business::OnlineThirdPartyPayment' ) {
5431 return { reference => $cust_pay_pending->paypendingnum,
5432 map { $_ => $transaction->$_ } qw ( popup_url collectitems ) };
5434 } elsif ( $transaction->is_success() && $action2 ) {
5436 $cust_pay_pending->status('authorized');
5437 my $cpp_authorized_err = $cust_pay_pending->replace;
5438 return $cpp_authorized_err if $cpp_authorized_err;
5440 my $auth = $transaction->authorization;
5441 my $ordernum = $transaction->can('order_number')
5442 ? $transaction->order_number
5446 new Business::OnlinePayment( $payment_gateway->gateway_module,
5447 $self->_bop_options(\%options),
5452 type => $options{method},
5454 $self->_bop_auth(\%options),
5455 order_number => $ordernum,
5456 amount => $options{amount},
5457 authorization => $auth,
5458 description => $options{'description'},
5461 foreach my $field (qw( authorization_source_code returned_ACI
5462 transaction_identifier validation_code
5463 transaction_sequence_num local_transaction_date
5464 local_transaction_time AVS_result_code )) {
5465 $capture{$field} = $transaction->$field() if $transaction->can($field);
5468 $capture->content( %capture );
5472 unless ( $capture->is_success ) {
5473 my $e = "Authorization successful but capture failed, custnum #".
5474 $self->custnum. ': '. $capture->result_code.
5475 ": ". $capture->error_message;
5483 # remove paycvv after initial transaction
5486 #false laziness w/misc/process/payment.cgi - check both to make sure working
5488 if ( defined $self->dbdef_table->column('paycvv')
5489 && length($self->paycvv)
5490 && ! grep { $_ eq cardtype($options{payinfo}) } $conf->config('cvv-save')
5492 my $error = $self->remove_cvv;
5494 warn "WARNING: error removing cvv: $error\n";
5502 $self->_realtime_bop_result( $cust_pay_pending, $transaction, %options );
5514 if (ref($_[0]) eq 'HASH') {
5515 %options = %{$_[0]};
5517 my ( $method, $amount ) = ( shift, shift );
5519 $options{method} = $method;
5520 $options{amount} = $amount;
5523 if ( $options{'fake_failure'} ) {
5524 return "Error: No error; test failure requested with fake_failure";
5528 #if ( $payment_gateway->gatewaynum ) { # agent override
5529 # $paybatch = $payment_gateway->gatewaynum. '-';
5532 #$paybatch .= "$processor:". $transaction->authorization;
5534 #$paybatch .= ':'. $transaction->order_number
5535 # if $transaction->can('order_number')
5536 # && length($transaction->order_number);
5538 my $paybatch = 'FakeProcessor:54:32';
5540 my $cust_pay = new FS::cust_pay ( {
5541 'custnum' => $self->custnum,
5542 'invnum' => $options{'invnum'},
5543 'paid' => $options{amount},
5545 'payby' => $bop_method2payby{$options{method}},
5546 #'payinfo' => $payinfo,
5547 'payinfo' => '4111111111111111',
5548 'paybatch' => $paybatch,
5549 #'paydate' => $paydate,
5550 'paydate' => '2012-05-01',
5552 $cust_pay->payunique( $options{payunique} ) if length($options{payunique});
5554 my $error = $cust_pay->insert($options{'manual'} ? ( 'manual' => 1 ) : () );
5557 $cust_pay->invnum(''); #try again with no specific invnum
5558 my $error2 = $cust_pay->insert( $options{'manual'} ?
5559 ( 'manual' => 1 ) : ()
5562 # gah, even with transactions.
5563 my $e = 'WARNING: Card/ACH debited but database not updated - '.
5564 "error inserting (fake!) payment: $error2".
5565 " (previously tried insert with invnum #$options{'invnum'}" .
5572 if ( $options{'paynum_ref'} ) {
5573 ${ $options{'paynum_ref'} } = $cust_pay->paynum;
5576 return ''; #no error
5581 # item _realtime_bop_result CUST_PAY_PENDING, BOP_OBJECT [ OPTION => VALUE ... ]
5583 # Wraps up processing of a realtime credit card, ACH (electronic check) or
5584 # phone bill transaction.
5586 sub _realtime_bop_result {
5587 my( $self, $cust_pay_pending, $transaction, %options ) = @_;
5589 warn "$me _realtime_bop_result: pending transaction ".
5590 $cust_pay_pending->paypendingnum. "\n";
5591 warn " $_ => $options{$_}\n" foreach keys %options;
5594 my $payment_gateway = $options{payment_gateway}
5595 or return "no payment gateway in arguments to _realtime_bop_result";
5597 $cust_pay_pending->status($transaction->is_success() ? 'captured' : 'declined');
5598 my $cpp_captured_err = $cust_pay_pending->replace;
5599 return $cpp_captured_err if $cpp_captured_err;
5601 if ( $transaction->is_success() ) {
5604 if ( $payment_gateway->gatewaynum ) { # agent override
5605 $paybatch = $payment_gateway->gatewaynum. '-';
5608 $paybatch .= $payment_gateway->gateway_module. ":".
5609 $transaction->authorization;
5611 $paybatch .= ':'. $transaction->order_number
5612 if $transaction->can('order_number')
5613 && length($transaction->order_number);
5615 my $cust_pay = new FS::cust_pay ( {
5616 'custnum' => $self->custnum,
5617 'invnum' => $options{'invnum'},
5618 'paid' => $cust_pay_pending->paid,
5620 'payby' => $cust_pay_pending->payby,
5621 #'payinfo' => $payinfo,
5622 'paybatch' => $paybatch,
5623 'paydate' => $cust_pay_pending->paydate,
5624 'pkgnum' => $cust_pay_pending->pkgnum,
5626 #doesn't hurt to know, even though the dup check is in cust_pay_pending now
5627 $cust_pay->payunique( $options{payunique} )
5628 if defined($options{payunique}) && length($options{payunique});
5630 my $oldAutoCommit = $FS::UID::AutoCommit;
5631 local $FS::UID::AutoCommit = 0;
5634 #start a transaction, insert the cust_pay and set cust_pay_pending.status to done in a single transction
5636 my $error = $cust_pay->insert($options{'manual'} ? ( 'manual' => 1 ) : () );
5639 $cust_pay->invnum(''); #try again with no specific invnum
5640 my $error2 = $cust_pay->insert( $options{'manual'} ?
5641 ( 'manual' => 1 ) : ()
5644 # gah. but at least we have a record of the state we had to abort in
5645 # from cust_pay_pending now.
5646 my $e = "WARNING: $options{method} captured but payment not recorded -".
5647 " error inserting payment (". $payment_gateway->gateway_module.
5649 " (previously tried insert with invnum #$options{'invnum'}" .
5650 ": $error ) - pending payment saved as paypendingnum ".
5651 $cust_pay_pending->paypendingnum. "\n";
5657 my $jobnum = $cust_pay_pending->jobnum;
5659 my $placeholder = qsearchs( 'queue', { 'jobnum' => $jobnum } );
5661 unless ( $placeholder ) {
5662 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
5663 my $e = "WARNING: $options{method} captured but job $jobnum not ".
5664 "found for paypendingnum ". $cust_pay_pending->paypendingnum. "\n";
5669 $error = $placeholder->delete;
5672 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
5673 my $e = "WARNING: $options{method} captured but could not delete ".
5674 "job $jobnum for paypendingnum ".
5675 $cust_pay_pending->paypendingnum. ": $error\n";
5682 if ( $options{'paynum_ref'} ) {
5683 ${ $options{'paynum_ref'} } = $cust_pay->paynum;
5686 $cust_pay_pending->status('done');
5687 $cust_pay_pending->statustext('captured');
5688 $cust_pay_pending->paynum($cust_pay->paynum);
5689 my $cpp_done_err = $cust_pay_pending->replace;
5691 if ( $cpp_done_err ) {
5693 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
5694 my $e = "WARNING: $options{method} captured but payment not recorded - ".
5695 "error updating status for paypendingnum ".
5696 $cust_pay_pending->paypendingnum. ": $cpp_done_err \n";
5702 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
5704 if ( $options{'apply'} ) {
5705 my $apply_error = $self->apply_payments_and_credits;
5706 if ( $apply_error ) {
5707 warn "WARNING: error applying payment: $apply_error\n";
5708 #but we still should return no error cause the payment otherwise went
5713 return ''; #no error
5719 my $perror = $payment_gateway->gateway_module. " error: ".
5720 $transaction->error_message;
5722 my $jobnum = $cust_pay_pending->jobnum;
5724 my $placeholder = qsearchs( 'queue', { 'jobnum' => $jobnum } );
5726 if ( $placeholder ) {
5727 my $error = $placeholder->depended_delete;
5728 $error ||= $placeholder->delete;
5729 warn "error removing provisioning jobs after declined paypendingnum ".
5730 $cust_pay_pending->paypendingnum. "\n";
5732 my $e = "error finding job $jobnum for declined paypendingnum ".
5733 $cust_pay_pending->paypendingnum. "\n";
5739 unless ( $transaction->error_message ) {
5742 if ( $transaction->can('response_page') ) {
5744 'page' => ( $transaction->can('response_page')
5745 ? $transaction->response_page
5748 'code' => ( $transaction->can('response_code')
5749 ? $transaction->response_code
5752 'headers' => ( $transaction->can('response_headers')
5753 ? $transaction->response_headers
5759 "No additional debugging information available for ".
5760 $payment_gateway->gateway_module;
5763 $perror .= "No error_message returned from ".
5764 $payment_gateway->gateway_module. " -- ".
5765 ( ref($t_response) ? Dumper($t_response) : $t_response );
5769 if ( !$options{'quiet'} && !$realtime_bop_decline_quiet
5770 && $conf->exists('emaildecline')
5771 && grep { $_ ne 'POST' } $self->invoicing_list
5772 && ! grep { $transaction->error_message =~ /$_/ }
5773 $conf->config('emaildecline-exclude')
5775 my @templ = $conf->config('declinetemplate');
5776 my $template = new Text::Template (
5778 SOURCE => [ map "$_\n", @templ ],
5779 ) or return "($perror) can't create template: $Text::Template::ERROR";
5780 $template->compile()
5781 or return "($perror) can't compile template: $Text::Template::ERROR";
5785 scalar( $conf->config('company_name', $self->agentnum ) ),
5786 'company_address' =>
5787 join("\n", $conf->config('company_address', $self->agentnum ) ),
5788 'error' => $transaction->error_message,
5791 my $error = send_email(
5792 'from' => $conf->config('invoice_from', $self->agentnum ),
5793 'to' => [ grep { $_ ne 'POST' } $self->invoicing_list ],
5794 'subject' => 'Your payment could not be processed',
5795 'body' => [ $template->fill_in(HASH => $templ_hash) ],
5798 $perror .= " (also received error sending decline notification: $error)"
5803 $cust_pay_pending->status('done');
5804 $cust_pay_pending->statustext("declined: $perror");
5805 my $cpp_done_err = $cust_pay_pending->replace;
5806 if ( $cpp_done_err ) {
5807 my $e = "WARNING: $options{method} declined but pending payment not ".
5808 "resolved - error updating status for paypendingnum ".
5809 $cust_pay_pending->paypendingnum. ": $cpp_done_err \n";
5811 $perror = "$e ($perror)";
5819 =item realtime_botpp_capture CUST_PAY_PENDING [ OPTION => VALUE ... ]
5821 Verifies successful third party processing of a realtime credit card,
5822 ACH (electronic check) or phone bill transaction via a
5823 Business::OnlineThirdPartyPayment realtime gateway. See
5824 L<http://420.am/business-onlinethirdpartypayment> for supported gateways.
5826 Available options are: I<description>, I<invnum>, I<quiet>, I<paynum_ref>, I<payunique>
5828 The additional options I<payname>, I<city>, I<state>,
5829 I<zip>, I<payinfo> and I<paydate> are also available. Any of these options,
5830 if set, will override the value from the customer record.
5832 I<description> is a free-text field passed to the gateway. It defaults to
5833 "Internet services".
5835 If an I<invnum> is specified, this payment (if successful) is applied to the
5836 specified invoice. If you don't specify an I<invnum> you might want to
5837 call the B<apply_payments> method.
5839 I<quiet> can be set true to surpress email decline notices.
5841 I<paynum_ref> can be set to a scalar reference. It will be filled in with the
5842 resulting paynum, if any.
5844 I<payunique> is a unique identifier for this payment.
5846 Returns a hashref containing elements bill_error (which will be undefined
5847 upon success) and session_id of any associated session.
5851 sub realtime_botpp_capture {
5852 my( $self, $cust_pay_pending, %options ) = @_;
5854 warn "$me realtime_botpp_capture: pending transaction $cust_pay_pending\n";
5855 warn " $_ => $options{$_}\n" foreach keys %options;
5858 eval "use Business::OnlineThirdPartyPayment";
5862 # select the gateway
5865 my $method = FS::payby->payby2bop($cust_pay_pending->payby);
5867 my $payment_gateway = $cust_pay_pending->gatewaynum
5868 ? qsearchs( 'payment_gateway',
5869 { gatewaynum => $cust_pay_pending->gatewaynum }
5871 : $self->agent->payment_gateway( 'method' => $method,
5872 # 'invnum' => $cust_pay_pending->invnum,
5873 # 'payinfo' => $cust_pay_pending->payinfo,
5876 $options{payment_gateway} = $payment_gateway; # for the helper subs
5882 my @invoicing_list = $self->invoicing_list_emailonly;
5883 if ( $conf->exists('emailinvoiceautoalways')
5884 || $conf->exists('emailinvoiceauto') && ! @invoicing_list
5885 || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
5886 push @invoicing_list, $self->all_emails;
5889 my $email = ($conf->exists('business-onlinepayment-email-override'))
5890 ? $conf->config('business-onlinepayment-email-override')
5891 : $invoicing_list[0];
5895 $content{email_customer} =
5896 ( $conf->exists('business-onlinepayment-email_customer')
5897 || $conf->exists('business-onlinepayment-email-override') );
5900 # run transaction(s)
5904 new Business::OnlineThirdPartyPayment( $payment_gateway->gateway_module,
5905 $self->_bop_options(\%options),
5908 $transaction->reference({ %options });
5910 $transaction->content(
5912 $self->_bop_auth(\%options),
5913 'action' => 'Post Authorization',
5914 'description' => $options{'description'},
5915 'amount' => $cust_pay_pending->paid,
5916 #'invoice_number' => $options{'invnum'},
5917 'customer_id' => $self->custnum,
5918 'referer' => 'http://cleanwhisker.420.am/',
5919 'reference' => $cust_pay_pending->paypendingnum,
5921 'phone' => $self->daytime || $self->night,
5923 # plus whatever is required for bogus capture avoidance
5926 $transaction->submit();
5929 $self->_realtime_bop_result( $cust_pay_pending, $transaction, %options );
5932 bill_error => $error,
5933 session_id => $cust_pay_pending->session_id,
5938 =item default_payment_gateway DEPRECATED -- use agent->payment_gateway
5942 sub default_payment_gateway {
5943 my( $self, $method ) = @_;
5945 die "Real-time processing not enabled\n"
5946 unless $conf->exists('business-onlinepayment');
5948 #warn "default_payment_gateway deprecated -- use agent->payment_gateway\n";
5951 my $bop_config = 'business-onlinepayment';
5952 $bop_config .= '-ach'
5953 if $method =~ /^(ECHECK|CHEK)$/ && $conf->exists($bop_config. '-ach');
5954 my ( $processor, $login, $password, $action, @bop_options ) =
5955 $conf->config($bop_config);
5956 $action ||= 'normal authorization';
5957 pop @bop_options if scalar(@bop_options) % 2 && $bop_options[-1] =~ /^\s*$/;
5958 die "No real-time processor is enabled - ".
5959 "did you set the business-onlinepayment configuration value?\n"
5962 ( $processor, $login, $password, $action, @bop_options )
5967 Removes the I<paycvv> field from the database directly.
5969 If there is an error, returns the error, otherwise returns false.
5975 my $sth = dbh->prepare("UPDATE cust_main SET paycvv = '' WHERE custnum = ?")
5976 or return dbh->errstr;
5977 $sth->execute($self->custnum)
5978 or return $sth->errstr;
5983 =item _new_realtime_refund_bop METHOD [ OPTION => VALUE ... ]
5985 Refunds a realtime credit card, ACH (electronic check) or phone bill transaction
5986 via a Business::OnlinePayment realtime gateway. See
5987 L<http://420.am/business-onlinepayment> for supported gateways.
5989 Available methods are: I<CC>, I<ECHECK> and I<LEC>
5991 Available options are: I<amount>, I<reason>, I<paynum>, I<paydate>
5993 Most gateways require a reference to an original payment transaction to refund,
5994 so you probably need to specify a I<paynum>.
5996 I<amount> defaults to the original amount of the payment if not specified.
5998 I<reason> specifies a reason for the refund.
6000 I<paydate> specifies the expiration date for a credit card overriding the
6001 value from the customer record or the payment record. Specified as yyyy-mm-dd
6003 Implementation note: If I<amount> is unspecified or equal to the amount of the
6004 orignal payment, first an attempt is made to "void" the transaction via
6005 the gateway (to cancel a not-yet settled transaction) and then if that fails,
6006 the normal attempt is made to "refund" ("credit") the transaction via the
6007 gateway is attempted.
6009 #The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
6010 #I<zip>, I<payinfo> and I<paydate> are also available. Any of these options,
6011 #if set, will override the value from the customer record.
6013 #If an I<invnum> is specified, this payment (if successful) is applied to the
6014 #specified invoice. If you don't specify an I<invnum> you might want to
6015 #call the B<apply_payments> method.
6019 #some false laziness w/realtime_bop, not enough to make it worth merging
6020 #but some useful small subs should be pulled out
6021 sub _new_realtime_refund_bop {
6025 if (ref($_[0]) ne 'HASH') {
6026 %options = %{$_[0]};
6030 $options{method} = $method;
6034 warn "$me realtime_refund_bop (new): $options{method} refund\n";
6035 warn " $_ => $options{$_}\n" foreach keys %options;
6039 # look up the original payment and optionally a gateway for that payment
6043 my $amount = $options{'amount'};
6045 my( $processor, $login, $password, @bop_options, $namespace ) ;
6046 my( $auth, $order_number ) = ( '', '', '' );
6048 if ( $options{'paynum'} ) {
6050 warn " paynum: $options{paynum}\n" if $DEBUG > 1;
6051 $cust_pay = qsearchs('cust_pay', { paynum=>$options{'paynum'} } )
6052 or return "Unknown paynum $options{'paynum'}";
6053 $amount ||= $cust_pay->paid;
6055 $cust_pay->paybatch =~ /^((\d+)\-)?(\w+):\s*([\w\-\/ ]*)(:([\w\-]+))?$/
6056 or return "Can't parse paybatch for paynum $options{'paynum'}: ".
6057 $cust_pay->paybatch;
6058 my $gatewaynum = '';
6059 ( $gatewaynum, $processor, $auth, $order_number ) = ( $2, $3, $4, $6 );
6061 if ( $gatewaynum ) { #gateway for the payment to be refunded
6063 my $payment_gateway =
6064 qsearchs('payment_gateway', { 'gatewaynum' => $gatewaynum } );
6065 die "payment gateway $gatewaynum not found"
6066 unless $payment_gateway;
6068 $processor = $payment_gateway->gateway_module;
6069 $login = $payment_gateway->gateway_username;
6070 $password = $payment_gateway->gateway_password;
6071 $namespace = $payment_gateway->gateway_namespace;
6072 @bop_options = $payment_gateway->options;
6074 } else { #try the default gateway
6077 my $payment_gateway =
6078 $self->agent->payment_gateway('method' => $options{method});
6080 ( $conf_processor, $login, $password, $namespace ) =
6081 map { my $method = "gateway_$_"; $payment_gateway->$method }
6082 qw( module username password namespace );
6084 @bop_options = $payment_gateway->gatewaynum
6085 ? $payment_gateway->options
6086 : @{ $payment_gateway->get('options') };
6088 return "processor of payment $options{'paynum'} $processor does not".
6089 " match default processor $conf_processor"
6090 unless $processor eq $conf_processor;
6095 } else { # didn't specify a paynum, so look for agent gateway overrides
6096 # like a normal transaction
6098 my $payment_gateway =
6099 $self->agent->payment_gateway( 'method' => $options{method},
6100 #'payinfo' => $payinfo,
6102 my( $processor, $login, $password, $namespace ) =
6103 map { my $method = "gateway_$_"; $payment_gateway->$method }
6104 qw( module username password namespace );
6106 my @bop_options = $payment_gateway->gatewaynum
6107 ? $payment_gateway->options
6108 : @{ $payment_gateway->get('options') };
6111 return "neither amount nor paynum specified" unless $amount;
6113 eval "use $namespace";
6117 'type' => $options{method},
6119 'password' => $password,
6120 'order_number' => $order_number,
6121 'amount' => $amount,
6122 'referer' => 'http://cleanwhisker.420.am/', #XXX fix referer :/
6124 $content{authorization} = $auth
6125 if length($auth); #echeck/ACH transactions have an order # but no auth
6126 #(at least with authorize.net)
6128 my $disable_void_after;
6129 if ($conf->exists('disable_void_after')
6130 && $conf->config('disable_void_after') =~ /^(\d+)$/) {
6131 $disable_void_after = $1;
6134 #first try void if applicable
6135 if ( $cust_pay && $cust_pay->paid == $amount
6137 ( not defined($disable_void_after) )
6138 || ( time < ($cust_pay->_date + $disable_void_after ) )
6141 warn " attempting void\n" if $DEBUG > 1;
6142 my $void = new Business::OnlinePayment( $processor, @bop_options );
6143 $content{'card_number'} = $cust_pay->payinfo
6144 if $cust_pay->payby eq 'CARD'
6145 && $void->can('info') && $void->info('CC_void_requires_card');
6146 $void->content( 'action' => 'void', %content );
6148 if ( $void->is_success ) {
6149 my $error = $cust_pay->void($options{'reason'});
6151 # gah, even with transactions.
6152 my $e = 'WARNING: Card/ACH voided but database not updated - '.
6153 "error voiding payment: $error";
6157 warn " void successful\n" if $DEBUG > 1;
6162 warn " void unsuccessful, trying refund\n"
6166 my $address = $self->address1;
6167 $address .= ", ". $self->address2 if $self->address2;
6169 my($payname, $payfirst, $paylast);
6170 if ( $self->payname && $options{method} ne 'ECHECK' ) {
6171 $payname = $self->payname;
6172 $payname =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
6173 or return "Illegal payname $payname";
6174 ($payfirst, $paylast) = ($1, $2);
6176 $payfirst = $self->getfield('first');
6177 $paylast = $self->getfield('last');
6178 $payname = "$payfirst $paylast";
6181 my @invoicing_list = $self->invoicing_list_emailonly;
6182 if ( $conf->exists('emailinvoiceautoalways')
6183 || $conf->exists('emailinvoiceauto') && ! @invoicing_list
6184 || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
6185 push @invoicing_list, $self->all_emails;
6188 my $email = ($conf->exists('business-onlinepayment-email-override'))
6189 ? $conf->config('business-onlinepayment-email-override')
6190 : $invoicing_list[0];
6192 my $payip = exists($options{'payip'})
6195 $content{customer_ip} = $payip
6199 if ( $options{method} eq 'CC' ) {
6202 $content{card_number} = $payinfo = $cust_pay->payinfo;
6203 (exists($options{'paydate'}) ? $options{'paydate'} : $cust_pay->paydate)
6204 =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/ &&
6205 ($content{expiration} = "$2/$1"); # where available
6207 $content{card_number} = $payinfo = $self->payinfo;
6208 (exists($options{'paydate'}) ? $options{'paydate'} : $self->paydate)
6209 =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
6210 $content{expiration} = "$2/$1";
6213 } elsif ( $options{method} eq 'ECHECK' ) {
6216 $payinfo = $cust_pay->payinfo;
6218 $payinfo = $self->payinfo;
6220 ( $content{account_number}, $content{routing_code} )= split('@', $payinfo );
6221 $content{bank_name} = $self->payname;
6222 $content{account_type} = 'CHECKING';
6223 $content{account_name} = $payname;
6224 $content{customer_org} = $self->company ? 'B' : 'I';
6225 $content{customer_ssn} = $self->ss;
6226 } elsif ( $options{method} eq 'LEC' ) {
6227 $content{phone} = $payinfo = $self->payinfo;
6231 my $refund = new Business::OnlinePayment( $processor, @bop_options );
6232 my %sub_content = $refund->content(
6233 'action' => 'credit',
6234 'customer_id' => $self->custnum,
6235 'last_name' => $paylast,
6236 'first_name' => $payfirst,
6238 'address' => $address,
6239 'city' => $self->city,
6240 'state' => $self->state,
6241 'zip' => $self->zip,
6242 'country' => $self->country,
6244 'phone' => $self->daytime || $self->night,
6247 warn join('', map { " $_ => $sub_content{$_}\n" } keys %sub_content )
6251 return "$processor error: ". $refund->error_message
6252 unless $refund->is_success();
6254 my $paybatch = "$processor:". $refund->authorization;
6255 $paybatch .= ':'. $refund->order_number
6256 if $refund->can('order_number') && $refund->order_number;
6258 while ( $cust_pay && $cust_pay->unapplied < $amount ) {
6259 my @cust_bill_pay = $cust_pay->cust_bill_pay;
6260 last unless @cust_bill_pay;
6261 my $cust_bill_pay = pop @cust_bill_pay;
6262 my $error = $cust_bill_pay->delete;
6266 my $cust_refund = new FS::cust_refund ( {
6267 'custnum' => $self->custnum,
6268 'paynum' => $options{'paynum'},
6269 'refund' => $amount,
6271 'payby' => $bop_method2payby{$options{method}},
6272 'payinfo' => $payinfo,
6273 'paybatch' => $paybatch,
6274 'reason' => $options{'reason'} || 'card or ACH refund',
6276 my $error = $cust_refund->insert;
6278 $cust_refund->paynum(''); #try again with no specific paynum
6279 my $error2 = $cust_refund->insert;
6281 # gah, even with transactions.
6282 my $e = 'WARNING: Card/ACH refunded but database not updated - '.
6283 "error inserting refund ($processor): $error2".
6284 " (previously tried insert with paynum #$options{'paynum'}" .
6295 =item batch_card OPTION => VALUE...
6297 Adds a payment for this invoice to the pending credit card batch (see
6298 L<FS::cust_pay_batch>), or, if the B<realtime> option is set to a true value,
6299 runs the payment using a realtime gateway.
6304 my ($self, %options) = @_;
6307 if (exists($options{amount})) {
6308 $amount = $options{amount};
6310 $amount = sprintf("%.2f", $self->balance - $self->in_transit_payments);
6312 return '' unless $amount > 0;
6314 my $invnum = delete $options{invnum};
6315 my $payby = $options{invnum} || $self->payby; #dubious
6317 if ($options{'realtime'}) {
6318 return $self->realtime_bop( FS::payby->payby2bop($self->payby),
6324 my $oldAutoCommit = $FS::UID::AutoCommit;
6325 local $FS::UID::AutoCommit = 0;
6328 #this needs to handle mysql as well as Pg, like svc_acct.pm
6329 #(make it into a common function if folks need to do batching with mysql)
6330 $dbh->do("LOCK TABLE pay_batch IN SHARE ROW EXCLUSIVE MODE")
6331 or return "Cannot lock pay_batch: " . $dbh->errstr;
6335 'payby' => FS::payby->payby2payment($payby),
6338 my $pay_batch = qsearchs( 'pay_batch', \%pay_batch );
6340 unless ( $pay_batch ) {
6341 $pay_batch = new FS::pay_batch \%pay_batch;
6342 my $error = $pay_batch->insert;
6344 $dbh->rollback if $oldAutoCommit;
6345 die "error creating new batch: $error\n";
6349 my $old_cust_pay_batch = qsearchs('cust_pay_batch', {
6350 'batchnum' => $pay_batch->batchnum,
6351 'custnum' => $self->custnum,
6354 foreach (qw( address1 address2 city state zip country payby payinfo paydate
6356 $options{$_} = '' unless exists($options{$_});
6359 my $cust_pay_batch = new FS::cust_pay_batch ( {
6360 'batchnum' => $pay_batch->batchnum,
6361 'invnum' => $invnum || 0, # is there a better value?
6362 # this field should be
6364 # cust_bill_pay_batch now
6365 'custnum' => $self->custnum,
6366 'last' => $self->getfield('last'),
6367 'first' => $self->getfield('first'),
6368 'address1' => $options{address1} || $self->address1,
6369 'address2' => $options{address2} || $self->address2,
6370 'city' => $options{city} || $self->city,
6371 'state' => $options{state} || $self->state,
6372 'zip' => $options{zip} || $self->zip,
6373 'country' => $options{country} || $self->country,
6374 'payby' => $options{payby} || $self->payby,
6375 'payinfo' => $options{payinfo} || $self->payinfo,
6376 'exp' => $options{paydate} || $self->paydate,
6377 'payname' => $options{payname} || $self->payname,
6378 'amount' => $amount, # consolidating
6381 $cust_pay_batch->paybatchnum($old_cust_pay_batch->paybatchnum)
6382 if $old_cust_pay_batch;
6385 if ($old_cust_pay_batch) {
6386 $error = $cust_pay_batch->replace($old_cust_pay_batch)
6388 $error = $cust_pay_batch->insert;
6392 $dbh->rollback if $oldAutoCommit;
6396 my $unapplied = $self->total_unapplied_credits
6397 + $self->total_unapplied_payments
6398 + $self->in_transit_payments;
6399 foreach my $cust_bill ($self->open_cust_bill) {
6400 #$dbh->commit or die $dbh->errstr if $oldAutoCommit;
6401 my $cust_bill_pay_batch = new FS::cust_bill_pay_batch {
6402 'invnum' => $cust_bill->invnum,
6403 'paybatchnum' => $cust_pay_batch->paybatchnum,
6404 'amount' => $cust_bill->owed,
6407 if ($unapplied >= $cust_bill_pay_batch->amount){
6408 $unapplied -= $cust_bill_pay_batch->amount;
6411 $cust_bill_pay_batch->amount(sprintf ( "%.2f",
6412 $cust_bill_pay_batch->amount - $unapplied )); $unapplied = 0;
6414 $error = $cust_bill_pay_batch->insert;
6416 $dbh->rollback if $oldAutoCommit;
6421 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
6425 =item apply_payments_and_credits [ OPTION => VALUE ... ]
6427 Applies unapplied payments and credits.
6429 In most cases, this new method should be used in place of sequential
6430 apply_payments and apply_credits methods.
6432 A hash of optional arguments may be passed. Currently "manual" is supported.
6433 If true, a payment receipt is sent instead of a statement when
6434 'payment_receipt_email' configuration option is set.
6436 If there is an error, returns the error, otherwise returns false.
6440 sub apply_payments_and_credits {
6441 my( $self, %options ) = @_;
6443 local $SIG{HUP} = 'IGNORE';
6444 local $SIG{INT} = 'IGNORE';
6445 local $SIG{QUIT} = 'IGNORE';
6446 local $SIG{TERM} = 'IGNORE';
6447 local $SIG{TSTP} = 'IGNORE';
6448 local $SIG{PIPE} = 'IGNORE';
6450 my $oldAutoCommit = $FS::UID::AutoCommit;
6451 local $FS::UID::AutoCommit = 0;
6454 $self->select_for_update; #mutex
6456 foreach my $cust_bill ( $self->open_cust_bill ) {
6457 my $error = $cust_bill->apply_payments_and_credits(%options);
6459 $dbh->rollback if $oldAutoCommit;
6460 return "Error applying: $error";
6464 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
6469 =item apply_credits OPTION => VALUE ...
6471 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
6472 to outstanding invoice balances in chronological order (or reverse
6473 chronological order if the I<order> option is set to B<newest>) and returns the
6474 value of any remaining unapplied credits available for refund (see
6475 L<FS::cust_refund>).
6477 Dies if there is an error.
6485 local $SIG{HUP} = 'IGNORE';
6486 local $SIG{INT} = 'IGNORE';
6487 local $SIG{QUIT} = 'IGNORE';
6488 local $SIG{TERM} = 'IGNORE';
6489 local $SIG{TSTP} = 'IGNORE';
6490 local $SIG{PIPE} = 'IGNORE';
6492 my $oldAutoCommit = $FS::UID::AutoCommit;
6493 local $FS::UID::AutoCommit = 0;
6496 $self->select_for_update; #mutex
6498 unless ( $self->total_unapplied_credits ) {
6499 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
6503 my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
6504 qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
6506 my @invoices = $self->open_cust_bill;
6507 @invoices = sort { $b->_date <=> $a->_date } @invoices
6508 if defined($opt{'order'}) && $opt{'order'} eq 'newest';
6510 if ( $conf->exists('pkg-balances') ) {
6511 # limit @credits to those w/ a pkgnum grepped from $self
6513 foreach my $i (@invoices) {
6514 foreach my $li ( $i->cust_bill_pkg ) {
6515 $pkgnums{$li->pkgnum} = 1;
6518 @credits = grep { ! $_->pkgnum || $pkgnums{$_->pkgnum} } @credits;
6523 foreach my $cust_bill ( @invoices ) {
6525 if ( !defined($credit) || $credit->credited == 0) {
6526 $credit = pop @credits or last;
6530 if ( $conf->exists('pkg-balances') && $credit->pkgnum ) {
6531 $owed = $cust_bill->owed_pkgnum($credit->pkgnum);
6533 $owed = $cust_bill->owed;
6535 unless ( $owed > 0 ) {
6536 push @credits, $credit;
6540 my $amount = min( $credit->credited, $owed );
6542 my $cust_credit_bill = new FS::cust_credit_bill ( {
6543 'crednum' => $credit->crednum,
6544 'invnum' => $cust_bill->invnum,
6545 'amount' => $amount,
6547 $cust_credit_bill->pkgnum( $credit->pkgnum )
6548 if $conf->exists('pkg-balances') && $credit->pkgnum;
6549 my $error = $cust_credit_bill->insert;
6551 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
6555 redo if ($cust_bill->owed > 0) && ! $conf->exists('pkg-balances');
6559 my $total_unapplied_credits = $self->total_unapplied_credits;
6561 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
6563 return $total_unapplied_credits;
6566 =item apply_payments [ OPTION => VALUE ... ]
6568 Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
6569 to outstanding invoice balances in chronological order.
6571 #and returns the value of any remaining unapplied payments.
6573 A hash of optional arguments may be passed. Currently "manual" is supported.
6574 If true, a payment receipt is sent instead of a statement when
6575 'payment_receipt_email' configuration option is set.
6577 Dies if there is an error.
6581 sub apply_payments {
6582 my( $self, %options ) = @_;
6584 local $SIG{HUP} = 'IGNORE';
6585 local $SIG{INT} = 'IGNORE';
6586 local $SIG{QUIT} = 'IGNORE';
6587 local $SIG{TERM} = 'IGNORE';
6588 local $SIG{TSTP} = 'IGNORE';
6589 local $SIG{PIPE} = 'IGNORE';
6591 my $oldAutoCommit = $FS::UID::AutoCommit;
6592 local $FS::UID::AutoCommit = 0;
6595 $self->select_for_update; #mutex
6599 my @payments = sort { $b->_date <=> $a->_date }
6600 grep { $_->unapplied > 0 }
6603 my @invoices = sort { $a->_date <=> $b->_date}
6604 grep { $_->owed > 0 }
6607 if ( $conf->exists('pkg-balances') ) {
6608 # limit @payments to those w/ a pkgnum grepped from $self
6610 foreach my $i (@invoices) {
6611 foreach my $li ( $i->cust_bill_pkg ) {
6612 $pkgnums{$li->pkgnum} = 1;
6615 @payments = grep { ! $_->pkgnum || $pkgnums{$_->pkgnum} } @payments;
6620 foreach my $cust_bill ( @invoices ) {
6622 if ( !defined($payment) || $payment->unapplied == 0 ) {
6623 $payment = pop @payments or last;
6627 if ( $conf->exists('pkg-balances') && $payment->pkgnum ) {
6628 $owed = $cust_bill->owed_pkgnum($payment->pkgnum);
6630 $owed = $cust_bill->owed;
6632 unless ( $owed > 0 ) {
6633 push @payments, $payment;
6637 my $amount = min( $payment->unapplied, $owed );
6639 my $cust_bill_pay = new FS::cust_bill_pay ( {
6640 'paynum' => $payment->paynum,
6641 'invnum' => $cust_bill->invnum,
6642 'amount' => $amount,
6644 $cust_bill_pay->pkgnum( $payment->pkgnum )
6645 if $conf->exists('pkg-balances') && $payment->pkgnum;
6646 my $error = $cust_bill_pay->insert(%options);
6648 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
6652 redo if ( $cust_bill->owed > 0) && ! $conf->exists('pkg-balances');
6656 my $total_unapplied_payments = $self->total_unapplied_payments;
6658 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
6660 return $total_unapplied_payments;
6665 Returns the total owed for this customer on all invoices
6666 (see L<FS::cust_bill/owed>).
6672 $self->total_owed_date(2145859200); #12/31/2037
6675 =item total_owed_date TIME
6677 Returns the total owed for this customer on all invoices with date earlier than
6678 TIME. TIME is specified as a UNIX timestamp; see L<perlfunc/"time">). Also
6679 see L<Time::Local> and L<Date::Parse> for conversion functions.
6683 sub total_owed_date {
6687 # my $custnum = $self->custnum;
6689 # my $owed_sql = FS::cust_bill->owed_sql;
6692 # SELECT SUM($owed_sql) FROM cust_bill
6693 # WHERE custnum = $custnum
6694 # AND _date <= $time
6697 # my $sth = dbh->prepare($sql) or die dbh->errstr;
6698 # $sth->execute() or die $sth->errstr;
6700 # return sprintf( '%.2f', $sth->fetchrow_arrayref->[0] );
6703 foreach my $cust_bill (
6704 grep { $_->_date <= $time }
6705 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
6707 $total_bill += $cust_bill->owed;
6709 sprintf( "%.2f", $total_bill );
6713 =item total_owed_pkgnum PKGNUM
6715 Returns the total owed on all invoices for this customer's specific package
6716 when using experimental package balances (see L<FS::cust_bill/owed_pkgnum>).
6720 sub total_owed_pkgnum {
6721 my( $self, $pkgnum ) = @_;
6722 $self->total_owed_date_pkgnum(2145859200, $pkgnum); #12/31/2037
6725 =item total_owed_date_pkgnum TIME PKGNUM
6727 Returns the total owed for this customer's specific package when using
6728 experimental package balances on all invoices with date earlier than
6729 TIME. TIME is specified as a UNIX timestamp; see L<perlfunc/"time">). Also
6730 see L<Time::Local> and L<Date::Parse> for conversion functions.
6734 sub total_owed_date_pkgnum {
6735 my( $self, $time, $pkgnum ) = @_;
6738 foreach my $cust_bill (
6739 grep { $_->_date <= $time }
6740 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
6742 $total_bill += $cust_bill->owed_pkgnum($pkgnum);
6744 sprintf( "%.2f", $total_bill );
6750 Returns the total amount of all payments.
6757 $total += $_->paid foreach $self->cust_pay;
6758 sprintf( "%.2f", $total );
6761 =item total_unapplied_credits
6763 Returns the total outstanding credit (see L<FS::cust_credit>) for this
6764 customer. See L<FS::cust_credit/credited>.
6766 =item total_credited
6768 Old name for total_unapplied_credits. Don't use.
6772 sub total_credited {
6773 #carp "total_credited deprecated, use total_unapplied_credits";
6774 shift->total_unapplied_credits(@_);
6777 sub total_unapplied_credits {
6779 my $total_credit = 0;
6780 $total_credit += $_->credited foreach $self->cust_credit;
6781 sprintf( "%.2f", $total_credit );
6784 =item total_unapplied_credits_pkgnum PKGNUM
6786 Returns the total outstanding credit (see L<FS::cust_credit>) for this
6787 customer. See L<FS::cust_credit/credited>.
6791 sub total_unapplied_credits_pkgnum {
6792 my( $self, $pkgnum ) = @_;
6793 my $total_credit = 0;
6794 $total_credit += $_->credited foreach $self->cust_credit_pkgnum($pkgnum);
6795 sprintf( "%.2f", $total_credit );
6799 =item total_unapplied_payments
6801 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
6802 See L<FS::cust_pay/unapplied>.
6806 sub total_unapplied_payments {
6808 my $total_unapplied = 0;
6809 $total_unapplied += $_->unapplied foreach $self->cust_pay;
6810 sprintf( "%.2f", $total_unapplied );
6813 =item total_unapplied_payments_pkgnum PKGNUM
6815 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer's
6816 specific package when using experimental package balances. See
6817 L<FS::cust_pay/unapplied>.
6821 sub total_unapplied_payments_pkgnum {
6822 my( $self, $pkgnum ) = @_;
6823 my $total_unapplied = 0;
6824 $total_unapplied += $_->unapplied foreach $self->cust_pay_pkgnum($pkgnum);
6825 sprintf( "%.2f", $total_unapplied );
6829 =item total_unapplied_refunds
6831 Returns the total unrefunded refunds (see L<FS::cust_refund>) for this
6832 customer. See L<FS::cust_refund/unapplied>.
6836 sub total_unapplied_refunds {
6838 my $total_unapplied = 0;
6839 $total_unapplied += $_->unapplied foreach $self->cust_refund;
6840 sprintf( "%.2f", $total_unapplied );
6845 Returns the balance for this customer (total_owed plus total_unrefunded, minus
6846 total_unapplied_credits minus total_unapplied_payments).
6854 + $self->total_unapplied_refunds
6855 - $self->total_unapplied_credits
6856 - $self->total_unapplied_payments
6860 =item balance_date TIME
6862 Returns the balance for this customer, only considering invoices with date
6863 earlier than TIME (total_owed_date minus total_credited minus
6864 total_unapplied_payments). TIME is specified as a UNIX timestamp; see
6865 L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion
6874 $self->total_owed_date($time)
6875 + $self->total_unapplied_refunds
6876 - $self->total_unapplied_credits
6877 - $self->total_unapplied_payments
6881 =item balance_date_range START_TIME [ END_TIME [ OPTION => VALUE ... ] ]
6883 Returns the balance for this customer, only considering invoices with date
6884 earlier than START_TIME, and optionally not later than END_TIME
6885 (total_owed_date minus total_unapplied_credits minus total_unapplied_payments).
6887 Times are specified as SQL fragments or numeric
6888 UNIX timestamps; see L<perlfunc/"time">). Also see L<Time::Local> and
6889 L<Date::Parse> for conversion functions. The empty string can be passed
6890 to disable that time constraint completely.
6892 Available options are:
6896 =item unapplied_date
6898 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)
6904 sub balance_date_range {
6906 my $sql = 'SELECT SUM('. $self->balance_date_sql(@_).
6907 ') FROM cust_main WHERE custnum='. $self->custnum;
6908 sprintf( "%.2f", $self->scalar_sql($sql) );
6911 =item balance_pkgnum PKGNUM
6913 Returns the balance for this customer's specific package when using
6914 experimental package balances (total_owed plus total_unrefunded, minus
6915 total_unapplied_credits minus total_unapplied_payments)
6919 sub balance_pkgnum {
6920 my( $self, $pkgnum ) = @_;
6923 $self->total_owed_pkgnum($pkgnum)
6924 # n/a - refunds aren't part of pkg-balances since they don't apply to invoices
6925 # + $self->total_unapplied_refunds_pkgnum($pkgnum)
6926 - $self->total_unapplied_credits_pkgnum($pkgnum)
6927 - $self->total_unapplied_payments_pkgnum($pkgnum)
6931 =item in_transit_payments
6933 Returns the total of requests for payments for this customer pending in
6934 batches in transit to the bank. See L<FS::pay_batch> and L<FS::cust_pay_batch>
6938 sub in_transit_payments {
6940 my $in_transit_payments = 0;
6941 foreach my $pay_batch ( qsearch('pay_batch', {
6944 foreach my $cust_pay_batch ( qsearch('cust_pay_batch', {
6945 'batchnum' => $pay_batch->batchnum,
6946 'custnum' => $self->custnum,
6948 $in_transit_payments += $cust_pay_batch->amount;
6951 sprintf( "%.2f", $in_transit_payments );
6956 Returns a hash of useful information for making a payment.
6966 'CARD' (credit card - automatic), 'DCRD' (credit card - on-demand),
6967 'CHEK' (electronic check - automatic), 'DCHK' (electronic check - on-demand),
6968 'LECB' (Phone bill billing), 'BILL' (billing), or 'COMP' (free).
6972 For credit card transactions:
6984 For electronic check transactions:
6999 $return{balance} = $self->balance;
7001 $return{payname} = $self->payname
7002 || ( $self->first. ' '. $self->get('last') );
7004 $return{$_} = $self->get($_) for qw(address1 address2 city state zip);
7006 $return{payby} = $self->payby;
7007 $return{stateid_state} = $self->stateid_state;
7009 if ( $self->payby =~ /^(CARD|DCRD)$/ ) {
7010 $return{card_type} = cardtype($self->payinfo);
7011 $return{payinfo} = $self->paymask;
7013 @return{'month', 'year'} = $self->paydate_monthyear;
7017 if ( $self->payby =~ /^(CHEK|DCHK)$/ ) {
7018 my ($payinfo1, $payinfo2) = split '@', $self->paymask;
7019 $return{payinfo1} = $payinfo1;
7020 $return{payinfo2} = $payinfo2;
7021 $return{paytype} = $self->paytype;
7022 $return{paystate} = $self->paystate;
7026 #doubleclick protection
7028 $return{paybatch} = "webui-MyAccount-$_date-$$-". rand() * 2**32;
7034 =item paydate_monthyear
7036 Returns a two-element list consisting of the month and year of this customer's
7037 paydate (credit card expiration date for CARD customers)
7041 sub paydate_monthyear {
7043 if ( $self->paydate =~ /^(\d{4})-(\d{1,2})-\d{1,2}$/ ) { #Pg date format
7045 } elsif ( $self->paydate =~ /^(\d{1,2})-(\d{1,2}-)?(\d{4}$)/ ) {
7052 =item tax_exemption TAXNAME
7057 my( $self, $taxname ) = @_;
7059 qsearchs( 'cust_main_exemption', { 'custnum' => $self->custnum,
7060 'taxname' => $taxname,
7065 =item cust_main_exemption
7069 sub cust_main_exemption {
7071 qsearch( 'cust_main_exemption', { 'custnum' => $self->custnum } );
7074 =item invoicing_list [ ARRAYREF ]
7076 If an arguement is given, sets these email addresses as invoice recipients
7077 (see L<FS::cust_main_invoice>). Errors are not fatal and are not reported
7078 (except as warnings), so use check_invoicing_list first.
7080 Returns a list of email addresses (with svcnum entries expanded).
7082 Note: You can clear the invoicing list by passing an empty ARRAYREF. You can
7083 check it without disturbing anything by passing nothing.
7085 This interface may change in the future.
7089 sub invoicing_list {
7090 my( $self, $arrayref ) = @_;
7093 my @cust_main_invoice;
7094 if ( $self->custnum ) {
7095 @cust_main_invoice =
7096 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
7098 @cust_main_invoice = ();
7100 foreach my $cust_main_invoice ( @cust_main_invoice ) {
7101 #warn $cust_main_invoice->destnum;
7102 unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
7103 #warn $cust_main_invoice->destnum;
7104 my $error = $cust_main_invoice->delete;
7105 warn $error if $error;
7108 if ( $self->custnum ) {
7109 @cust_main_invoice =
7110 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
7112 @cust_main_invoice = ();
7114 my %seen = map { $_->address => 1 } @cust_main_invoice;
7115 foreach my $address ( @{$arrayref} ) {
7116 next if exists $seen{$address} && $seen{$address};
7117 $seen{$address} = 1;
7118 my $cust_main_invoice = new FS::cust_main_invoice ( {
7119 'custnum' => $self->custnum,
7122 my $error = $cust_main_invoice->insert;
7123 warn $error if $error;
7127 if ( $self->custnum ) {
7129 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
7136 =item check_invoicing_list ARRAYREF
7138 Checks these arguements as valid input for the invoicing_list method. If there
7139 is an error, returns the error, otherwise returns false.
7143 sub check_invoicing_list {
7144 my( $self, $arrayref ) = @_;
7146 foreach my $address ( @$arrayref ) {
7148 if ($address eq 'FAX' and $self->getfield('fax') eq '') {
7149 return 'Can\'t add FAX invoice destination with a blank FAX number.';
7152 my $cust_main_invoice = new FS::cust_main_invoice ( {
7153 'custnum' => $self->custnum,
7156 my $error = $self->custnum
7157 ? $cust_main_invoice->check
7158 : $cust_main_invoice->checkdest
7160 return $error if $error;
7164 return "Email address required"
7165 if $conf->exists('cust_main-require_invoicing_list_email')
7166 && ! grep { $_ !~ /^([A-Z]+)$/ } @$arrayref;
7171 =item set_default_invoicing_list
7173 Sets the invoicing list to all accounts associated with this customer,
7174 overwriting any previous invoicing list.
7178 sub set_default_invoicing_list {
7180 $self->invoicing_list($self->all_emails);
7185 Returns the email addresses of all accounts provisioned for this customer.
7192 foreach my $cust_pkg ( $self->all_pkgs ) {
7193 my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
7195 map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
7196 grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
7198 $list{$_}=1 foreach map { $_->email } @svc_acct;
7203 =item invoicing_list_addpost
7205 Adds postal invoicing to this customer. If this customer is already configured
7206 to receive postal invoices, does nothing.
7210 sub invoicing_list_addpost {
7212 return if grep { $_ eq 'POST' } $self->invoicing_list;
7213 my @invoicing_list = $self->invoicing_list;
7214 push @invoicing_list, 'POST';
7215 $self->invoicing_list(\@invoicing_list);
7218 =item invoicing_list_emailonly
7220 Returns the list of email invoice recipients (invoicing_list without non-email
7221 destinations such as POST and FAX).
7225 sub invoicing_list_emailonly {
7227 warn "$me invoicing_list_emailonly called"
7229 grep { $_ !~ /^([A-Z]+)$/ } $self->invoicing_list;
7232 =item invoicing_list_emailonly_scalar
7234 Returns the list of email invoice recipients (invoicing_list without non-email
7235 destinations such as POST and FAX) as a comma-separated scalar.
7239 sub invoicing_list_emailonly_scalar {
7241 warn "$me invoicing_list_emailonly_scalar called"
7243 join(', ', $self->invoicing_list_emailonly);
7246 =item referral_custnum_cust_main
7248 Returns the customer who referred this customer (or the empty string, if
7249 this customer was not referred).
7251 Note the difference with referral_cust_main method: This method,
7252 referral_custnum_cust_main returns the single customer (if any) who referred
7253 this customer, while referral_cust_main returns an array of customers referred
7258 sub referral_custnum_cust_main {
7260 return '' unless $self->referral_custnum;
7261 qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
7264 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
7266 Returns an array of customers referred by this customer (referral_custnum set
7267 to this custnum). If DEPTH is given, recurses up to the given depth, returning
7268 customers referred by customers referred by this customer and so on, inclusive.
7269 The default behavior is DEPTH 1 (no recursion).
7271 Note the difference with referral_custnum_cust_main method: This method,
7272 referral_cust_main, returns an array of customers referred BY this customer,
7273 while referral_custnum_cust_main returns the single customer (if any) who
7274 referred this customer.
7278 sub referral_cust_main {
7280 my $depth = @_ ? shift : 1;
7281 my $exclude = @_ ? shift : {};
7284 map { $exclude->{$_->custnum}++; $_; }
7285 grep { ! $exclude->{ $_->custnum } }
7286 qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
7290 map { $_->referral_cust_main($depth-1, $exclude) }
7297 =item referral_cust_main_ncancelled
7299 Same as referral_cust_main, except only returns customers with uncancelled
7304 sub referral_cust_main_ncancelled {
7306 grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
7309 =item referral_cust_pkg [ DEPTH ]
7311 Like referral_cust_main, except returns a flat list of all unsuspended (and
7312 uncancelled) packages for each customer. The number of items in this list may
7313 be useful for comission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
7317 sub referral_cust_pkg {
7319 my $depth = @_ ? shift : 1;
7321 map { $_->unsuspended_pkgs }
7322 grep { $_->unsuspended_pkgs }
7323 $self->referral_cust_main($depth);
7326 =item referring_cust_main
7328 Returns the single cust_main record for the customer who referred this customer
7329 (referral_custnum), or false.
7333 sub referring_cust_main {
7335 return '' unless $self->referral_custnum;
7336 qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
7339 =item credit AMOUNT, REASON [ , OPTION => VALUE ... ]
7341 Applies a credit to this customer. If there is an error, returns the error,
7342 otherwise returns false.
7344 REASON can be a text string, an FS::reason object, or a scalar reference to
7345 a reasonnum. If a text string, it will be automatically inserted as a new
7346 reason, and a 'reason_type' option must be passed to indicate the
7347 FS::reason_type for the new reason.
7349 An I<addlinfo> option may be passed to set the credit's I<addlinfo> field.
7351 Any other options are passed to FS::cust_credit::insert.
7356 my( $self, $amount, $reason, %options ) = @_;
7358 my $cust_credit = new FS::cust_credit {
7359 'custnum' => $self->custnum,
7360 'amount' => $amount,
7363 if ( ref($reason) ) {
7365 if ( ref($reason) eq 'SCALAR' ) {
7366 $cust_credit->reasonnum( $$reason );
7368 $cust_credit->reasonnum( $reason->reasonnum );
7372 $cust_credit->set('reason', $reason)
7375 $cust_credit->addlinfo( delete $options{'addlinfo'} )
7376 if exists($options{'addlinfo'});
7378 $cust_credit->insert(%options);
7382 =item charge HASHREF || AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
7384 Creates a one-time charge for this customer. If there is an error, returns
7385 the error, otherwise returns false.
7387 New-style, with a hashref of options:
7389 my $error = $cust_main->charge(
7393 'start_date' => str2time('7/4/2009'),
7394 'pkg' => 'Description',
7395 'comment' => 'Comment',
7396 'additional' => [], #extra invoice detail
7397 'classnum' => 1, #pkg_class
7399 'setuptax' => '', # or 'Y' for tax exempt
7402 'taxclass' => 'Tax class',
7405 'taxproduct' => 2, #part_pkg_taxproduct
7406 'override' => {}, #XXX describe
7408 #will be filled in with the new object
7409 'cust_pkg_ref' => \$cust_pkg,
7411 #generate an invoice immediately
7413 'invoice_terms' => '', #with these terms
7419 my $error = $cust_main->charge( 54.32, 'Description', 'Comment', 'Tax class' );
7425 my ( $amount, $quantity, $start_date, $classnum );
7426 my ( $pkg, $comment, $additional );
7427 my ( $setuptax, $taxclass ); #internal taxes
7428 my ( $taxproduct, $override ); #vendor (CCH) taxes
7429 my $cust_pkg_ref = '';
7430 my ( $bill_now, $invoice_terms ) = ( 0, '' );
7431 if ( ref( $_[0] ) ) {
7432 $amount = $_[0]->{amount};
7433 $quantity = exists($_[0]->{quantity}) ? $_[0]->{quantity} : 1;
7434 $start_date = exists($_[0]->{start_date}) ? $_[0]->{start_date} : '';
7435 $pkg = exists($_[0]->{pkg}) ? $_[0]->{pkg} : 'One-time charge';
7436 $comment = exists($_[0]->{comment}) ? $_[0]->{comment}
7437 : '$'. sprintf("%.2f",$amount);
7438 $setuptax = exists($_[0]->{setuptax}) ? $_[0]->{setuptax} : '';
7439 $taxclass = exists($_[0]->{taxclass}) ? $_[0]->{taxclass} : '';
7440 $classnum = exists($_[0]->{classnum}) ? $_[0]->{classnum} : '';
7441 $additional = $_[0]->{additional} || [];
7442 $taxproduct = $_[0]->{taxproductnum};
7443 $override = { '' => $_[0]->{tax_override} };
7444 $cust_pkg_ref = exists($_[0]->{cust_pkg_ref}) ? $_[0]->{cust_pkg_ref} : '';
7445 $bill_now = exists($_[0]->{bill_now}) ? $_[0]->{bill_now} : '';
7446 $invoice_terms = exists($_[0]->{invoice_terms}) ? $_[0]->{invoice_terms} : '';
7451 $pkg = @_ ? shift : 'One-time charge';
7452 $comment = @_ ? shift : '$'. sprintf("%.2f",$amount);
7454 $taxclass = @_ ? shift : '';
7458 local $SIG{HUP} = 'IGNORE';
7459 local $SIG{INT} = 'IGNORE';
7460 local $SIG{QUIT} = 'IGNORE';
7461 local $SIG{TERM} = 'IGNORE';
7462 local $SIG{TSTP} = 'IGNORE';
7463 local $SIG{PIPE} = 'IGNORE';
7465 my $oldAutoCommit = $FS::UID::AutoCommit;
7466 local $FS::UID::AutoCommit = 0;
7469 my $part_pkg = new FS::part_pkg ( {
7471 'comment' => $comment,
7475 'classnum' => ( $classnum ? $classnum : '' ),
7476 'setuptax' => $setuptax,
7477 'taxclass' => $taxclass,
7478 'taxproductnum' => $taxproduct,
7481 my %options = ( ( map { ("additional_info$_" => $additional->[$_] ) }
7482 ( 0 .. @$additional - 1 )
7484 'additional_count' => scalar(@$additional),
7485 'setup_fee' => $amount,
7488 my $error = $part_pkg->insert( options => \%options,
7489 tax_overrides => $override,
7492 $dbh->rollback if $oldAutoCommit;
7496 my $pkgpart = $part_pkg->pkgpart;
7497 my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
7498 unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
7499 my $type_pkgs = new FS::type_pkgs \%type_pkgs;
7500 $error = $type_pkgs->insert;
7502 $dbh->rollback if $oldAutoCommit;
7507 my $cust_pkg = new FS::cust_pkg ( {
7508 'custnum' => $self->custnum,
7509 'pkgpart' => $pkgpart,
7510 'quantity' => $quantity,
7511 'start_date' => $start_date,
7514 $error = $cust_pkg->insert;
7516 $dbh->rollback if $oldAutoCommit;
7518 } elsif ( $cust_pkg_ref ) {
7519 ${$cust_pkg_ref} = $cust_pkg;
7523 my $error = $self->bill( 'invoice_terms' => $invoice_terms,
7524 'pkg_list' => [ $cust_pkg ],
7527 $dbh->rollback if $oldAutoCommit;
7532 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
7537 #=item charge_postal_fee
7539 #Applies a one time charge this customer. If there is an error,
7540 #returns the error, returns the cust_pkg charge object or false
7541 #if there was no charge.
7545 # This should be a customer event. For that to work requires that bill
7546 # also be a customer event.
7548 sub charge_postal_fee {
7551 my $pkgpart = $conf->config('postal_invoice-fee_pkgpart');
7552 return '' unless ($pkgpart && grep { $_ eq 'POST' } $self->invoicing_list);
7554 my $cust_pkg = new FS::cust_pkg ( {
7555 'custnum' => $self->custnum,
7556 'pkgpart' => $pkgpart,
7560 my $error = $cust_pkg->insert;
7561 $error ? $error : $cust_pkg;
7566 Returns all the invoices (see L<FS::cust_bill>) for this customer.
7572 map { $_ } #return $self->num_cust_bill unless wantarray;
7573 sort { $a->_date <=> $b->_date }
7574 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
7577 =item open_cust_bill
7579 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
7584 sub open_cust_bill {
7588 'table' => 'cust_bill',
7589 'hashref' => { 'custnum' => $self->custnum, },
7590 'extra_sql' => ' AND '. FS::cust_bill->owed_sql. ' > 0',
7591 'order_by' => 'ORDER BY _date ASC',
7596 =item cust_statements
7598 Returns all the statements (see L<FS::cust_statement>) for this customer.
7602 sub cust_statement {
7604 map { $_ } #return $self->num_cust_statement unless wantarray;
7605 sort { $a->_date <=> $b->_date }
7606 qsearch('cust_statement', { 'custnum' => $self->custnum, } )
7611 Returns all the credits (see L<FS::cust_credit>) for this customer.
7617 map { $_ } #return $self->num_cust_credit unless wantarray;
7618 sort { $a->_date <=> $b->_date }
7619 qsearch( 'cust_credit', { 'custnum' => $self->custnum } )
7622 =item cust_credit_pkgnum
7624 Returns all the credits (see L<FS::cust_credit>) for this customer's specific
7625 package when using experimental package balances.
7629 sub cust_credit_pkgnum {
7630 my( $self, $pkgnum ) = @_;
7631 map { $_ } #return $self->num_cust_credit_pkgnum($pkgnum) unless wantarray;
7632 sort { $a->_date <=> $b->_date }
7633 qsearch( 'cust_credit', { 'custnum' => $self->custnum,
7634 'pkgnum' => $pkgnum,
7641 Returns all the payments (see L<FS::cust_pay>) for this customer.
7647 return $self->num_cust_pay unless wantarray;
7648 sort { $a->_date <=> $b->_date }
7649 qsearch( 'cust_pay', { 'custnum' => $self->custnum } )
7654 Returns the number of payments (see L<FS::cust_pay>) for this customer. Also
7655 called automatically when the cust_pay method is used in a scalar context.
7661 my $sql = "SELECT COUNT(*) FROM cust_pay WHERE custnum = ?";
7662 my $sth = dbh->prepare($sql) or die dbh->errstr;
7663 $sth->execute($self->custnum) or die $sth->errstr;
7664 $sth->fetchrow_arrayref->[0];
7667 =item cust_pay_pkgnum
7669 Returns all the payments (see L<FS::cust_pay>) for this customer's specific
7670 package when using experimental package balances.
7674 sub cust_pay_pkgnum {
7675 my( $self, $pkgnum ) = @_;
7676 map { $_ } #return $self->num_cust_pay_pkgnum($pkgnum) unless wantarray;
7677 sort { $a->_date <=> $b->_date }
7678 qsearch( 'cust_pay', { 'custnum' => $self->custnum,
7679 'pkgnum' => $pkgnum,
7686 Returns all voided payments (see L<FS::cust_pay_void>) for this customer.
7692 map { $_ } #return $self->num_cust_pay_void unless wantarray;
7693 sort { $a->_date <=> $b->_date }
7694 qsearch( 'cust_pay_void', { 'custnum' => $self->custnum } )
7697 =item cust_pay_batch
7699 Returns all batched payments (see L<FS::cust_pay_void>) for this customer.
7703 sub cust_pay_batch {
7705 map { $_ } #return $self->num_cust_pay_batch unless wantarray;
7706 sort { $a->paybatchnum <=> $b->paybatchnum }
7707 qsearch( 'cust_pay_batch', { 'custnum' => $self->custnum } )
7710 =item cust_pay_pending
7712 Returns all pending payments (see L<FS::cust_pay_pending>) for this customer
7713 (without status "done").
7717 sub cust_pay_pending {
7719 return $self->num_cust_pay_pending unless wantarray;
7720 sort { $a->_date <=> $b->_date }
7721 qsearch( 'cust_pay_pending', {
7722 'custnum' => $self->custnum,
7723 'status' => { op=>'!=', value=>'done' },
7728 =item num_cust_pay_pending
7730 Returns the number of pending payments (see L<FS::cust_pay_pending>) for this
7731 customer (without status "done"). Also called automatically when the
7732 cust_pay_pending method is used in a scalar context.
7736 sub num_cust_pay_pending {
7738 my $sql = " SELECT COUNT(*) FROM cust_pay_pending ".
7739 " WHERE custnum = ? AND status != 'done' ";
7740 my $sth = dbh->prepare($sql) or die dbh->errstr;
7741 $sth->execute($self->custnum) or die $sth->errstr;
7742 $sth->fetchrow_arrayref->[0];
7747 Returns all the refunds (see L<FS::cust_refund>) for this customer.
7753 map { $_ } #return $self->num_cust_refund unless wantarray;
7754 sort { $a->_date <=> $b->_date }
7755 qsearch( 'cust_refund', { 'custnum' => $self->custnum } )
7758 =item display_custnum
7760 Returns the displayed customer number for this customer: agent_custid if
7761 cust_main-default_agent_custid is set and it has a value, custnum otherwise.
7765 sub display_custnum {
7767 if ( $conf->exists('cust_main-default_agent_custid') && $self->agent_custid ){
7768 return $self->agent_custid;
7770 return $self->custnum;
7776 Returns a name string for this customer, either "Company (Last, First)" or
7783 my $name = $self->contact;
7784 $name = $self->company. " ($name)" if $self->company;
7790 Returns a name string for this (service/shipping) contact, either
7791 "Company (Last, First)" or "Last, First".
7797 if ( $self->get('ship_last') ) {
7798 my $name = $self->ship_contact;
7799 $name = $self->ship_company. " ($name)" if $self->ship_company;
7808 Returns a name string for this customer, either "Company" or "First Last".
7814 $self->company !~ /^\s*$/ ? $self->company : $self->contact_firstlast;
7817 =item ship_name_short
7819 Returns a name string for this (service/shipping) contact, either "Company"
7824 sub ship_name_short {
7826 if ( $self->get('ship_last') ) {
7827 $self->ship_company !~ /^\s*$/
7828 ? $self->ship_company
7829 : $self->ship_contact_firstlast;
7831 $self->name_company_or_firstlast;
7837 Returns this customer's full (billing) contact name only, "Last, First"
7843 $self->get('last'). ', '. $self->first;
7848 Returns this customer's full (shipping) contact name only, "Last, First"
7854 $self->get('ship_last')
7855 ? $self->get('ship_last'). ', '. $self->ship_first
7859 =item contact_firstlast
7861 Returns this customers full (billing) contact name only, "First Last".
7865 sub contact_firstlast {
7867 $self->first. ' '. $self->get('last');
7870 =item ship_contact_firstlast
7872 Returns this customer's full (shipping) contact name only, "First Last".
7876 sub ship_contact_firstlast {
7878 $self->get('ship_last')
7879 ? $self->first. ' '. $self->get('ship_last')
7880 : $self->contact_firstlast;
7885 Returns this customer's full country name
7891 code2country($self->country);
7894 =item geocode DATA_VENDOR
7896 Returns a value for the customer location as encoded by DATA_VENDOR.
7897 Currently this only makes sense for "CCH" as DATA_VENDOR.
7902 my ($self, $data_vendor) = (shift, shift); #always cch for now
7904 my $geocode = $self->get('geocode'); #XXX only one data_vendor for geocode
7905 return $geocode if $geocode;
7907 my $prefix = ( $conf->exists('tax-ship_address') && length($self->ship_last) )
7911 my ($zip,$plus4) = split /-/, $self->get("${prefix}zip")
7912 if $self->country eq 'US';
7914 #CCH specific location stuff
7915 my $extra_sql = "AND plus4lo <= '$plus4' AND plus4hi >= '$plus4'";
7917 my @cust_tax_location =
7919 'table' => 'cust_tax_location',
7920 'hashref' => { 'zip' => $zip, 'data_vendor' => $data_vendor },
7921 'extra_sql' => $extra_sql,
7922 'order_by' => 'ORDER BY plus4hi',#overlapping with distinct ends
7925 $geocode = $cust_tax_location[0]->geocode
7926 if scalar(@cust_tax_location);
7935 Returns a status string for this customer, currently:
7939 =item prospect - No packages have ever been ordered
7941 =item active - One or more recurring packages is active
7943 =item inactive - No active recurring packages, but otherwise unsuspended/uncancelled (the inactive status is new - previously inactive customers were mis-identified as cancelled)
7945 =item suspended - All non-cancelled recurring packages are suspended
7947 =item cancelled - All recurring packages are cancelled
7953 sub status { shift->cust_status(@_); }
7957 for my $status (qw( prospect active inactive suspended cancelled )) {
7958 my $method = $status.'_sql';
7959 my $numnum = ( my $sql = $self->$method() ) =~ s/cust_main\.custnum/?/g;
7960 my $sth = dbh->prepare("SELECT $sql") or die dbh->errstr;
7961 $sth->execute( ($self->custnum) x $numnum )
7962 or die "Error executing 'SELECT $sql': ". $sth->errstr;
7963 return $status if $sth->fetchrow_arrayref->[0];
7967 =item ucfirst_cust_status
7969 =item ucfirst_status
7971 Returns the status with the first character capitalized.
7975 sub ucfirst_status { shift->ucfirst_cust_status(@_); }
7977 sub ucfirst_cust_status {
7979 ucfirst($self->cust_status);
7984 Returns a hex triplet color string for this customer's status.
7988 use vars qw(%statuscolor);
7989 tie %statuscolor, 'Tie::IxHash',
7990 'prospect' => '7e0079', #'000000', #black? naw, purple
7991 'active' => '00CC00', #green
7992 'inactive' => '0000CC', #blue
7993 'suspended' => 'FF9900', #yellow
7994 'cancelled' => 'FF0000', #red
7997 sub statuscolor { shift->cust_statuscolor(@_); }
7999 sub cust_statuscolor {
8001 $statuscolor{$self->cust_status};
8006 Returns an array of hashes representing the customer's RT tickets.
8013 my $num = $conf->config('cust_main-max_tickets') || 10;
8016 if ( $conf->config('ticket_system') ) {
8017 unless ( $conf->config('ticket_system-custom_priority_field') ) {
8019 @tickets = @{ FS::TicketSystem->customer_tickets($self->custnum, $num) };
8023 foreach my $priority (
8024 $conf->config('ticket_system-custom_priority_field-values'), ''
8026 last if scalar(@tickets) >= $num;
8028 @{ FS::TicketSystem->customer_tickets( $self->custnum,
8029 $num - scalar(@tickets),
8039 # Return services representing svc_accts in customer support packages
8040 sub support_services {
8042 my %packages = map { $_ => 1 } $conf->config('support_packages');
8044 grep { $_->pkg_svc && $_->pkg_svc->primary_svc eq 'Y' }
8045 grep { $_->part_svc->svcdb eq 'svc_acct' }
8046 map { $_->cust_svc }
8047 grep { exists $packages{ $_->pkgpart } }
8048 $self->ncancelled_pkgs;
8052 # Return a list of latitude/longitude for one of the services (if any)
8053 sub service_coordinates {
8057 grep { $_->latitude && $_->longitude }
8059 map { $_->cust_svc }
8060 $self->ncancelled_pkgs;
8062 scalar(@svc_X) ? ( $svc_X[0]->latitude, $svc_X[0]->longitude ) : ()
8067 =head1 CLASS METHODS
8073 Class method that returns the list of possible status strings for customers
8074 (see L<the status method|/status>). For example:
8076 @statuses = FS::cust_main->statuses();
8081 #my $self = shift; #could be class...
8087 Returns an SQL expression identifying prospective cust_main records (customers
8088 with no packages ever ordered)
8092 use vars qw($select_count_pkgs);
8093 $select_count_pkgs =
8094 "SELECT COUNT(*) FROM cust_pkg
8095 WHERE cust_pkg.custnum = cust_main.custnum";
8097 sub select_count_pkgs_sql {
8101 sub prospect_sql { "
8102 0 = ( $select_count_pkgs )
8107 Returns an SQL expression identifying active cust_main records (customers with
8108 active recurring packages).
8113 0 < ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. "
8119 Returns an SQL expression identifying inactive cust_main records (customers with
8120 no active recurring packages, but otherwise unsuspended/uncancelled).
8124 sub inactive_sql { "
8125 0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " )
8127 0 < ( $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " )
8133 Returns an SQL expression identifying suspended cust_main records.
8138 sub suspended_sql { susp_sql(@_); }
8140 0 < ( $select_count_pkgs AND ". FS::cust_pkg->suspended_sql. " )
8142 0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " )
8148 Returns an SQL expression identifying cancelled cust_main records.
8152 sub cancelled_sql { cancel_sql(@_); }
8155 my $recurring_sql = FS::cust_pkg->recurring_sql;
8156 my $cancelled_sql = FS::cust_pkg->cancelled_sql;
8159 0 < ( $select_count_pkgs )
8160 AND 0 < ( $select_count_pkgs AND $recurring_sql AND $cancelled_sql )
8161 AND 0 = ( $select_count_pkgs AND $recurring_sql
8162 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
8164 AND 0 = ( $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " )
8170 =item uncancelled_sql
8172 Returns an SQL expression identifying un-cancelled cust_main records.
8176 sub uncancelled_sql { uncancel_sql(@_); }
8177 sub uncancel_sql { "
8178 ( 0 < ( $select_count_pkgs
8179 AND ( cust_pkg.cancel IS NULL
8180 OR cust_pkg.cancel = 0
8183 OR 0 = ( $select_count_pkgs )
8189 Returns an SQL fragment to retreive the balance.
8194 ( SELECT COALESCE( SUM(charged), 0 ) FROM cust_bill
8195 WHERE cust_bill.custnum = cust_main.custnum )
8196 - ( SELECT COALESCE( SUM(paid), 0 ) FROM cust_pay
8197 WHERE cust_pay.custnum = cust_main.custnum )
8198 - ( SELECT COALESCE( SUM(amount), 0 ) FROM cust_credit
8199 WHERE cust_credit.custnum = cust_main.custnum )
8200 + ( SELECT COALESCE( SUM(refund), 0 ) FROM cust_refund
8201 WHERE cust_refund.custnum = cust_main.custnum )
8204 =item balance_date_sql START_TIME [ END_TIME [ OPTION => VALUE ... ] ]
8206 Returns an SQL fragment to retreive the balance for this customer, only
8207 considering invoices with date earlier than START_TIME, and optionally not
8208 later than END_TIME (total_owed_date minus total_unapplied_credits minus
8209 total_unapplied_payments).
8211 Times are specified as SQL fragments or numeric
8212 UNIX timestamps; see L<perlfunc/"time">). Also see L<Time::Local> and
8213 L<Date::Parse> for conversion functions. The empty string can be passed
8214 to disable that time constraint completely.
8216 Available options are:
8220 =item unapplied_date
8222 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)
8227 set to true to remove all customer comparison clauses, for totals
8232 WHERE clause hashref (elements "AND"ed together) (typically used with the total option)
8237 JOIN clause (typically used with the total option)
8243 sub balance_date_sql {
8244 my( $class, $start, $end, %opt ) = @_;
8246 my $owed = FS::cust_bill->owed_sql;
8247 my $unapp_refund = FS::cust_refund->unapplied_sql;
8248 my $unapp_credit = FS::cust_credit->unapplied_sql;
8249 my $unapp_pay = FS::cust_pay->unapplied_sql;
8251 my $j = $opt{'join'} || '';
8253 my $owed_wh = $class->_money_table_where( 'cust_bill', $start,$end,%opt );
8254 my $refund_wh = $class->_money_table_where( 'cust_refund', $start,$end,%opt );
8255 my $credit_wh = $class->_money_table_where( 'cust_credit', $start,$end,%opt );
8256 my $pay_wh = $class->_money_table_where( 'cust_pay', $start,$end,%opt );
8258 " ( SELECT COALESCE(SUM($owed), 0) FROM cust_bill $j $owed_wh )
8259 + ( SELECT COALESCE(SUM($unapp_refund), 0) FROM cust_refund $j $refund_wh )
8260 - ( SELECT COALESCE(SUM($unapp_credit), 0) FROM cust_credit $j $credit_wh )
8261 - ( SELECT COALESCE(SUM($unapp_pay), 0) FROM cust_pay $j $pay_wh )
8266 =item unapplied_payments_date_sql START_TIME [ END_TIME ]
8268 Returns an SQL fragment to retreive the total unapplied payments for this
8269 customer, only considering invoices with date earlier than START_TIME, and
8270 optionally not later than END_TIME.
8272 Times are specified as SQL fragments or numeric
8273 UNIX timestamps; see L<perlfunc/"time">). Also see L<Time::Local> and
8274 L<Date::Parse> for conversion functions. The empty string can be passed
8275 to disable that time constraint completely.
8277 Available options are:
8281 sub unapplied_payments_date_sql {
8282 my( $class, $start, $end, ) = @_;
8284 my $unapp_pay = FS::cust_pay->unapplied_sql;
8286 my $pay_where = $class->_money_table_where( 'cust_pay', $start, $end,
8287 'unapplied_date'=>1 );
8289 " ( SELECT COALESCE(SUM($unapp_pay), 0) FROM cust_pay $pay_where ) ";
8292 =item _money_table_where TABLE START_TIME [ END_TIME [ OPTION => VALUE ... ] ]
8294 Helper method for balance_date_sql; name (and usage) subject to change
8295 (suggestions welcome).
8297 Returns a WHERE clause for the specified monetary TABLE (cust_bill,
8298 cust_refund, cust_credit or cust_pay).
8300 If TABLE is "cust_bill" or the unapplied_date option is true, only
8301 considers records with date earlier than START_TIME, and optionally not
8302 later than END_TIME .
8306 sub _money_table_where {
8307 my( $class, $table, $start, $end, %opt ) = @_;
8310 push @where, "cust_main.custnum = $table.custnum" unless $opt{'total'};
8311 if ( $table eq 'cust_bill' || $opt{'unapplied_date'} ) {
8312 push @where, "$table._date <= $start" if defined($start) && length($start);
8313 push @where, "$table._date > $end" if defined($end) && length($end);
8315 push @where, @{$opt{'where'}} if $opt{'where'};
8316 my $where = scalar(@where) ? 'WHERE '. join(' AND ', @where ) : '';
8322 =item search HASHREF
8326 Returns a qsearch hash expression to search for parameters specified in HREF.
8327 Valid parameters are
8335 =item cancelled_pkgs
8341 listref of start date, end date
8351 =item current_balance
8353 listref (list returned by FS::UI::Web::parse_lt_gt($cgi, 'current_balance'))
8357 =item flattened_pkgs
8366 my ($class, $params) = @_;
8377 if ( $params->{'agentnum'} =~ /^(\d+)$/ and $1 ) {
8379 "cust_main.agentnum = $1";
8386 #prospect active inactive suspended cancelled
8387 if ( grep { $params->{'status'} eq $_ } FS::cust_main->statuses() ) {
8388 my $method = $params->{'status'}. '_sql';
8389 #push @where, $class->$method();
8390 push @where, FS::cust_main->$method();
8394 # parse cancelled package checkbox
8399 $pkgwhere .= "AND (cancel = 0 or cancel is null)"
8400 unless $params->{'cancelled_pkgs'};
8403 # parse without census tract checkbox
8406 push @where, "(censustract = '' or censustract is null)"
8407 if $params->{'no_censustract'};
8413 foreach my $field (qw( signupdate )) {
8415 next unless exists($params->{$field});
8417 my($beginning, $ending) = @{$params->{$field}};
8420 "cust_main.$field IS NOT NULL",
8421 "cust_main.$field >= $beginning",
8422 "cust_main.$field <= $ending";
8424 $orderby ||= "ORDER BY cust_main.$field";
8432 if ( $params->{'classnum'} ) {
8434 my @classnum = ref( $params->{'classnum'} )
8435 ? @{ $params->{'classnum'} }
8436 : ( $params->{'classnum'} );
8438 @classnum = grep /^(\d*)$/, @classnum;
8441 push @where, '( '. join(' OR ', map {
8442 $_ ? "cust_main.classnum = $_"
8443 : "cust_main.classnum IS NULL"
8456 if ( $params->{'payby'} ) {
8458 my @payby = ref( $params->{'payby'} )
8459 ? @{ $params->{'payby'} }
8460 : ( $params->{'payby'} );
8462 @payby = grep /^([A-Z]{4})$/, @{ $params->{'payby'} };
8464 push @where, '( '. join(' OR ', map "cust_main.payby = '$_'", @payby). ' )'
8470 # paydate_year / paydate_month
8473 if ( $params->{'paydate_year'} =~ /^(\d{4})$/ ) {
8475 $params->{'paydate_month'} =~ /^(\d\d?)$/
8476 or die "paydate_year without paydate_month?";
8480 'paydate IS NOT NULL',
8482 "CAST(paydate AS timestamp) < CAST('$year-$month-01' AS timestamp )"
8490 if ( $params->{'invoice_terms'} =~ /^([\w ]+)$/ ) {
8492 if ( $1 eq 'NULL' ) {
8494 "( cust_main.invoice_terms IS NULL OR cust_main.invoice_terms = '' )";
8497 "cust_main.invoice_terms IS NOT NULL",
8498 "cust_main.invoice_terms = '$1'";
8506 if ( $params->{'current_balance'} ) {
8508 #my $balance_sql = $class->balance_sql();
8509 my $balance_sql = FS::cust_main->balance_sql();
8511 my @current_balance =
8512 ref( $params->{'current_balance'} )
8513 ? @{ $params->{'current_balance'} }
8514 : ( $params->{'current_balance'} );
8516 push @where, map { s/current_balance/$balance_sql/; $_ }
8525 if ( $params->{'custbatch'} =~ /^([\w\/\-\:\.]+)$/ and $1 ) {
8527 "cust_main.custbatch = '$1'";
8531 # setup queries, subs, etc. for the search
8534 $orderby ||= 'ORDER BY custnum';
8536 # here is the agent virtualization
8537 push @where, $FS::CurrentUser::CurrentUser->agentnums_sql;
8539 my $extra_sql = scalar(@where) ? ' WHERE '. join(' AND ', @where) : '';
8541 my $addl_from = 'LEFT JOIN cust_pkg USING ( custnum ) ';
8543 my $count_query = "SELECT COUNT(*) FROM cust_main $extra_sql";
8545 my $select = join(', ',
8546 'cust_main.custnum',
8547 FS::UI::Web::cust_sql_fields($params->{'cust_fields'}),
8550 my(@extra_headers) = ();
8551 my(@extra_fields) = ();
8553 if ($params->{'flattened_pkgs'}) {
8555 if ($dbh->{Driver}->{Name} eq 'Pg') {
8557 $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";
8559 }elsif ($dbh->{Driver}->{Name} =~ /^mysql/i) {
8560 $select .= ", GROUP_CONCAT(pkg SEPARATOR '|') as magic";
8561 $addl_from .= " LEFT JOIN part_pkg using ( pkgpart )";
8563 warn "warning: unknown database type ". $dbh->{Driver}->{Name}.
8564 "omitting packing information from report.";
8567 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";
8569 my $sth = dbh->prepare($header_query) or die dbh->errstr;
8570 $sth->execute() or die $sth->errstr;
8571 my $headerrow = $sth->fetchrow_arrayref;
8572 my $headercount = $headerrow ? $headerrow->[0] : 0;
8573 while($headercount) {
8574 unshift @extra_headers, "Package ". $headercount;
8575 unshift @extra_fields, eval q!sub {my $c = shift;
8576 my @a = split '\|', $c->magic;
8577 my $p = $a[!.--$headercount. q!];
8585 'table' => 'cust_main',
8586 'select' => $select,
8588 'extra_sql' => $extra_sql,
8589 'order_by' => $orderby,
8590 'count_query' => $count_query,
8591 'extra_headers' => \@extra_headers,
8592 'extra_fields' => \@extra_fields,
8597 =item email_search_result HASHREF
8601 Emails a notice to the specified customers.
8603 Valid parameters are those of the L<search> method, plus the following:
8625 Optional job queue job for status updates.
8629 Returns an error message, or false for success.
8631 If an error occurs during any email, stops the enture send and returns that
8632 error. Presumably if you're getting SMTP errors aborting is better than
8633 retrying everything.
8637 sub email_search_result {
8638 my($class, $params) = @_;
8640 my $from = delete $params->{from};
8641 my $subject = delete $params->{subject};
8642 my $html_body = delete $params->{html_body};
8643 my $text_body = delete $params->{text_body};
8645 my $job = delete $params->{'job'};
8647 $params->{'payby'} = [ split(/\0/, $params->{'payby'}) ]
8648 unless ref($params->{'payby'});
8650 my $sql_query = $class->search($params);
8652 my $count_query = delete($sql_query->{'count_query'});
8653 my $count_sth = dbh->prepare($count_query)
8654 or die "Error preparing $count_query: ". dbh->errstr;
8656 or die "Error executing $count_query: ". $count_sth->errstr;
8657 my $count_arrayref = $count_sth->fetchrow_arrayref;
8658 my $num_cust = $count_arrayref->[0];
8660 #my @extra_headers = @{ delete($sql_query->{'extra_headers'}) };
8661 #my @extra_fields = @{ delete($sql_query->{'extra_fields'}) };
8664 my( $num, $last, $min_sec ) = (0, time, 5); #progresbar foo
8666 #eventually order+limit magic to reduce memory use?
8667 foreach my $cust_main ( qsearch($sql_query) ) {
8669 my $to = $cust_main->invoicing_list_emailonly_scalar;
8672 my $error = send_email(
8676 'subject' => $subject,
8677 'html_body' => $html_body,
8678 'text_body' => $text_body,
8681 return $error if $error;
8683 if ( $job ) { #progressbar foo
8685 if ( time - $min_sec > $last ) {
8686 my $error = $job->update_statustext(
8687 int( 100 * $num / $num_cust )
8689 die $error if $error;
8699 use Storable qw(thaw);
8702 sub process_email_search_result {
8704 #warn "$me process_re_X $method for job $job\n" if $DEBUG;
8706 my $param = thaw(decode_base64(shift));
8707 warn Dumper($param) if $DEBUG;
8709 $param->{'job'} = $job;
8711 $param->{'payby'} = [ split(/\0/, $param->{'payby'}) ]
8712 unless ref($param->{'payby'});
8714 my $error = FS::cust_main->email_search_result( $param );
8715 die $error if $error;
8719 =item fuzzy_search FUZZY_HASHREF [ HASHREF, SELECT, EXTRA_SQL, CACHE_OBJ ]
8721 Performs a fuzzy (approximate) search and returns the matching FS::cust_main
8722 records. Currently, I<first>, I<last>, I<company> and/or I<address1> may be
8723 specified (the appropriate ship_ field is also searched).
8725 Additional options are the same as FS::Record::qsearch
8730 my( $self, $fuzzy, $hash, @opt) = @_;
8735 check_and_rebuild_fuzzyfiles();
8736 foreach my $field ( keys %$fuzzy ) {
8738 my $all = $self->all_X($field);
8739 next unless scalar(@$all);
8742 $match{$_}=1 foreach ( amatch( $fuzzy->{$field}, ['i'], @$all ) );
8745 foreach ( keys %match ) {
8746 push @fcust, qsearch('cust_main', { %$hash, $field=>$_}, @opt);
8747 push @fcust, qsearch('cust_main', { %$hash, "ship_$field"=>$_}, @opt);
8750 push @cust_main, grep { ! $fsaw{$_->custnum}++ } @fcust;
8753 # we want the components of $fuzzy ANDed, not ORed, but still don't want dupes
8755 @cust_main = grep { ++$saw{$_->custnum} == scalar(keys %$fuzzy) } @cust_main;
8763 Returns a masked version of the named field
8768 my ($self,$field) = @_;
8772 'x'x(length($self->getfield($field))-4).
8773 substr($self->getfield($field), (length($self->getfield($field))-4));
8783 =item smart_search OPTION => VALUE ...
8785 Accepts the following options: I<search>, the string to search for. The string
8786 will be searched for as a customer number, phone number, name or company name,
8787 as an exact, or, in some cases, a substring or fuzzy match (see the source code
8788 for the exact heuristics used); I<no_fuzzy_on_exact>, causes smart_search to
8789 skip fuzzy matching when an exact match is found.
8791 Any additional options are treated as an additional qualifier on the search
8794 Returns a (possibly empty) array of FS::cust_main objects.
8801 #here is the agent virtualization
8802 my $agentnums_sql = $FS::CurrentUser::CurrentUser->agentnums_sql;
8806 my $skip_fuzzy = delete $options{'no_fuzzy_on_exact'};
8807 my $search = delete $options{'search'};
8808 ( my $alphanum_search = $search ) =~ s/\W//g;
8810 if ( $alphanum_search =~ /^1?(\d{3})(\d{3})(\d{4})(\d*)$/ ) { #phone# search
8812 #false laziness w/Record::ut_phone
8813 my $phonen = "$1-$2-$3";
8814 $phonen .= " x$4" if $4;
8816 push @cust_main, qsearch( {
8817 'table' => 'cust_main',
8818 'hashref' => { %options },
8819 'extra_sql' => ( scalar(keys %options) ? ' AND ' : ' WHERE ' ).
8821 join(' OR ', map "$_ = '$phonen'",
8822 qw( daytime night fax
8823 ship_daytime ship_night ship_fax )
8826 " AND $agentnums_sql", #agent virtualization
8829 unless ( @cust_main || $phonen =~ /x\d+$/ ) { #no exact match
8830 #try looking for matches with extensions unless one was specified
8832 push @cust_main, qsearch( {
8833 'table' => 'cust_main',
8834 'hashref' => { %options },
8835 'extra_sql' => ( scalar(keys %options) ? ' AND ' : ' WHERE ' ).
8837 join(' OR ', map "$_ LIKE '$phonen\%'",
8839 ship_daytime ship_night )
8842 " AND $agentnums_sql", #agent virtualization
8847 # custnum search (also try agent_custid), with some tweaking options if your
8848 # legacy cust "numbers" have letters
8851 if ( $search =~ /^\s*(\d+)\s*$/
8852 || ( $conf->config('cust_main-agent_custid-format') eq 'ww?d+'
8853 && $search =~ /^\s*(\w\w?\d+)\s*$/
8855 || ( $conf->exists('address1-search' )
8856 && $search =~ /^\s*(\d+\-?\w*)\s*$/ #i.e. 1234A or 9432-D
8863 if ( $num =~ /^(\d+)$/ && $num <= 2147483647 ) { #need a bigint custnum? wow
8864 push @cust_main, qsearch( {
8865 'table' => 'cust_main',
8866 'hashref' => { 'custnum' => $num, %options },
8867 'extra_sql' => " AND $agentnums_sql", #agent virtualization
8871 push @cust_main, qsearch( {
8872 'table' => 'cust_main',
8873 'hashref' => { 'agent_custid' => $num, %options },
8874 'extra_sql' => " AND $agentnums_sql", #agent virtualization
8877 if ( $conf->exists('address1-search') ) {
8878 my $len = length($num);
8880 foreach my $prefix ( '', 'ship_' ) {
8881 push @cust_main, qsearch( {
8882 'table' => 'cust_main',
8883 'hashref' => { %options, },
8885 ( keys(%options) ? ' AND ' : ' WHERE ' ).
8886 " LOWER(SUBSTRING(${prefix}address1 FROM 1 FOR $len)) = '$num' ".
8887 " AND $agentnums_sql",
8892 } elsif ( $search =~ /^\s*(\S.*\S)\s+\((.+), ([^,]+)\)\s*$/ ) {
8894 my($company, $last, $first) = ( $1, $2, $3 );
8896 # "Company (Last, First)"
8897 #this is probably something a browser remembered,
8898 #so just do an exact search (but case-insensitive, so USPS standardization
8899 #doesn't throw a wrench in the works)
8901 foreach my $prefix ( '', 'ship_' ) {
8902 push @cust_main, qsearch( {
8903 'table' => 'cust_main',
8904 'hashref' => { %options },
8906 ( keys(%options) ? ' AND ' : ' WHERE ' ).
8908 " LOWER(${prefix}first) = ". dbh->quote(lc($first)),
8909 " LOWER(${prefix}last) = ". dbh->quote(lc($last)),
8910 " LOWER(${prefix}company) = ". dbh->quote(lc($company)),
8916 } elsif ( $search =~ /^\s*(\S.*\S)\s*$/ ) { # value search
8917 # try (ship_){last,company}
8921 # # remove "(Last, First)" in "Company (Last, First)", otherwise the
8922 # # full strings the browser remembers won't work
8923 # $value =~ s/\([\w \,\.\-\']*\)$//; #false laziness w/Record::ut_name
8925 use Lingua::EN::NameParse;
8926 my $NameParse = new Lingua::EN::NameParse(
8928 allow_reversed => 1,
8931 my($last, $first) = ( '', '' );
8932 #maybe disable this too and just rely on NameParse?
8933 if ( $value =~ /^(.+),\s*([^,]+)$/ ) { # Last, First
8935 ($last, $first) = ( $1, $2 );
8937 #} elsif ( $value =~ /^(.+)\s+(.+)$/ ) {
8938 } elsif ( ! $NameParse->parse($value) ) {
8940 my %name = $NameParse->components;
8941 $first = $name{'given_name_1'};
8942 $last = $name{'surname_1'};
8946 if ( $first && $last ) {
8948 my($q_last, $q_first) = ( dbh->quote($last), dbh->quote($first) );
8951 my $sql = scalar(keys %options) ? ' AND ' : ' WHERE ';
8953 ( ( LOWER(last) = $q_last AND LOWER(first) = $q_first )
8954 OR ( LOWER(ship_last) = $q_last AND LOWER(ship_first) = $q_first )
8957 push @cust_main, qsearch( {
8958 'table' => 'cust_main',
8959 'hashref' => \%options,
8960 'extra_sql' => "$sql AND $agentnums_sql", #agent virtualization
8963 # or it just be something that was typed in... (try that in a sec)
8967 my $q_value = dbh->quote($value);
8970 my $sql = scalar(keys %options) ? ' AND ' : ' WHERE ';
8971 $sql .= " ( LOWER(last) = $q_value
8972 OR LOWER(company) = $q_value
8973 OR LOWER(ship_last) = $q_value
8974 OR LOWER(ship_company) = $q_value
8976 $sql .= " OR LOWER(address1) = $q_value
8977 OR LOWER(ship_address1) = $q_value
8979 if $conf->exists('address1-search');
8982 push @cust_main, qsearch( {
8983 'table' => 'cust_main',
8984 'hashref' => \%options,
8985 'extra_sql' => "$sql AND $agentnums_sql", #agent virtualization
8988 #no exact match, trying substring/fuzzy
8989 #always do substring & fuzzy (unless they're explicity config'ed off)
8990 #getting complaints searches are not returning enough
8991 unless ( @cust_main && $skip_fuzzy || $conf->exists('disable-fuzzy') ) {
8993 #still some false laziness w/search (was search/cust_main.cgi)
8998 { 'company' => { op=>'ILIKE', value=>"%$value%" }, },
8999 { 'ship_company' => { op=>'ILIKE', value=>"%$value%" }, },
9002 if ( $first && $last ) {
9005 { 'first' => { op=>'ILIKE', value=>"%$first%" },
9006 'last' => { op=>'ILIKE', value=>"%$last%" },
9008 { 'ship_first' => { op=>'ILIKE', value=>"%$first%" },
9009 'ship_last' => { op=>'ILIKE', value=>"%$last%" },
9016 { 'last' => { op=>'ILIKE', value=>"%$value%" }, },
9017 { 'ship_last' => { op=>'ILIKE', value=>"%$value%" }, },
9021 if ( $conf->exists('address1-search') ) {
9023 { 'address1' => { op=>'ILIKE', value=>"%$value%" }, },
9024 { 'ship_address1' => { op=>'ILIKE', value=>"%$value%" }, },
9028 foreach my $hashref ( @hashrefs ) {
9030 push @cust_main, qsearch( {
9031 'table' => 'cust_main',
9032 'hashref' => { %$hashref,
9035 'extra_sql' => " AND $agentnums_sql", #agent virtualizaiton
9044 " AND $agentnums_sql", #extra_sql #agent virtualization
9047 if ( $first && $last ) {
9048 push @cust_main, FS::cust_main->fuzzy_search(
9049 { 'last' => $last, #fuzzy hashref
9050 'first' => $first }, #
9054 foreach my $field ( 'last', 'company' ) {
9056 FS::cust_main->fuzzy_search( { $field => $value }, @fuzopts );
9058 if ( $conf->exists('address1-search') ) {
9060 FS::cust_main->fuzzy_search( { 'address1' => $value }, @fuzopts );
9067 #eliminate duplicates
9069 @cust_main = grep { !$saw{$_->custnum}++ } @cust_main;
9077 Accepts the following options: I<email>, the email address to search for. The
9078 email address will be searched for as an email invoice destination and as an
9081 #Any additional options are treated as an additional qualifier on the search
9082 #(i.e. I<agentnum>).
9084 Returns a (possibly empty) array of FS::cust_main objects (but usually just
9094 my $email = delete $options{'email'};
9096 #we're only being used by RT at the moment... no agent virtualization yet
9097 #my $agentnums_sql = $FS::CurrentUser::CurrentUser->agentnums_sql;
9101 if ( $email =~ /([^@]+)\@([^@]+)/ ) {
9103 my ( $user, $domain ) = ( $1, $2 );
9105 warn "$me smart_search: searching for $user in domain $domain"
9111 'table' => 'cust_main_invoice',
9112 'hashref' => { 'dest' => $email },
9119 map $_->cust_svc->cust_pkg,
9121 'table' => 'svc_acct',
9122 'hashref' => { 'username' => $user, },
9124 'AND ( SELECT domain FROM svc_domain
9125 WHERE svc_acct.domsvc = svc_domain.svcnum
9126 ) = '. dbh->quote($domain),
9132 @cust_main = grep { !$saw{$_->custnum}++ } @cust_main;
9134 warn "$me smart_search: found ". scalar(@cust_main). " unique customers"
9141 =item check_and_rebuild_fuzzyfiles
9145 sub check_and_rebuild_fuzzyfiles {
9146 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
9147 rebuild_fuzzyfiles() if grep { ! -e "$dir/cust_main.$_" } @fuzzyfields
9150 =item rebuild_fuzzyfiles
9154 sub rebuild_fuzzyfiles {
9156 use Fcntl qw(:flock);
9158 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
9159 mkdir $dir, 0700 unless -d $dir;
9161 foreach my $fuzzy ( @fuzzyfields ) {
9163 open(LOCK,">>$dir/cust_main.$fuzzy")
9164 or die "can't open $dir/cust_main.$fuzzy: $!";
9166 or die "can't lock $dir/cust_main.$fuzzy: $!";
9168 open (CACHE,">$dir/cust_main.$fuzzy.tmp")
9169 or die "can't open $dir/cust_main.$fuzzy.tmp: $!";
9171 foreach my $field ( $fuzzy, "ship_$fuzzy" ) {
9172 my $sth = dbh->prepare("SELECT $field FROM cust_main".
9173 " WHERE $field != '' AND $field IS NOT NULL");
9174 $sth->execute or die $sth->errstr;
9176 while ( my $row = $sth->fetchrow_arrayref ) {
9177 print CACHE $row->[0]. "\n";
9182 close CACHE or die "can't close $dir/cust_main.$fuzzy.tmp: $!";
9184 rename "$dir/cust_main.$fuzzy.tmp", "$dir/cust_main.$fuzzy";
9195 my( $self, $field ) = @_;
9196 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
9197 open(CACHE,"<$dir/cust_main.$field")
9198 or die "can't open $dir/cust_main.$field: $!";
9199 my @array = map { chomp; $_; } <CACHE>;
9204 =item append_fuzzyfiles FIRSTNAME LASTNAME COMPANY ADDRESS1
9208 sub append_fuzzyfiles {
9209 #my( $first, $last, $company ) = @_;
9211 &check_and_rebuild_fuzzyfiles;
9213 use Fcntl qw(:flock);
9215 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
9217 foreach my $field (@fuzzyfields) {
9222 open(CACHE,">>$dir/cust_main.$field")
9223 or die "can't open $dir/cust_main.$field: $!";
9224 flock(CACHE,LOCK_EX)
9225 or die "can't lock $dir/cust_main.$field: $!";
9227 print CACHE "$value\n";
9229 flock(CACHE,LOCK_UN)
9230 or die "can't unlock $dir/cust_main.$field: $!";
9245 #warn join('-',keys %$param);
9246 my $fh = $param->{filehandle};
9247 my @fields = @{$param->{fields}};
9249 eval "use Text::CSV_XS;";
9252 my $csv = new Text::CSV_XS;
9259 local $SIG{HUP} = 'IGNORE';
9260 local $SIG{INT} = 'IGNORE';
9261 local $SIG{QUIT} = 'IGNORE';
9262 local $SIG{TERM} = 'IGNORE';
9263 local $SIG{TSTP} = 'IGNORE';
9264 local $SIG{PIPE} = 'IGNORE';
9266 my $oldAutoCommit = $FS::UID::AutoCommit;
9267 local $FS::UID::AutoCommit = 0;
9270 #while ( $columns = $csv->getline($fh) ) {
9272 while ( defined($line=<$fh>) ) {
9274 $csv->parse($line) or do {
9275 $dbh->rollback if $oldAutoCommit;
9276 return "can't parse: ". $csv->error_input();
9279 my @columns = $csv->fields();
9280 #warn join('-',@columns);
9283 foreach my $field ( @fields ) {
9284 $row{$field} = shift @columns;
9287 my $cust_main = qsearchs('cust_main', { 'custnum' => $row{'custnum'} } );
9288 unless ( $cust_main ) {
9289 $dbh->rollback if $oldAutoCommit;
9290 return "unknown custnum $row{'custnum'}";
9293 if ( $row{'amount'} > 0 ) {
9294 my $error = $cust_main->charge($row{'amount'}, $row{'pkg'});
9296 $dbh->rollback if $oldAutoCommit;
9300 } elsif ( $row{'amount'} < 0 ) {
9301 my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ),
9304 $dbh->rollback if $oldAutoCommit;
9314 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
9316 return "Empty file!" unless $imported;
9322 =item notify CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
9324 Sends a templated email notification to the customer (see L<Text::Template>).
9326 OPTIONS is a hash and may include
9328 I<from> - the email sender (default is invoice_from)
9330 I<to> - comma-separated scalar or arrayref of recipients
9331 (default is invoicing_list)
9333 I<subject> - The subject line of the sent email notification
9334 (default is "Notice from company_name")
9336 I<extra_fields> - a hashref of name/value pairs which will be substituted
9339 The following variables are vavailable in the template.
9341 I<$first> - the customer first name
9342 I<$last> - the customer last name
9343 I<$company> - the customer company
9344 I<$payby> - a description of the method of payment for the customer
9345 # would be nice to use FS::payby::shortname
9346 I<$payinfo> - the account information used to collect for this customer
9347 I<$expdate> - the expiration of the customer payment in seconds from epoch
9352 my ($self, $template, %options) = @_;
9354 return unless $conf->exists($template);
9356 my $from = $conf->config('invoice_from', $self->agentnum)
9357 if $conf->exists('invoice_from', $self->agentnum);
9358 $from = $options{from} if exists($options{from});
9360 my $to = join(',', $self->invoicing_list_emailonly);
9361 $to = $options{to} if exists($options{to});
9363 my $subject = "Notice from " . $conf->config('company_name', $self->agentnum)
9364 if $conf->exists('company_name', $self->agentnum);
9365 $subject = $options{subject} if exists($options{subject});
9367 my $notify_template = new Text::Template (TYPE => 'ARRAY',
9368 SOURCE => [ map "$_\n",
9369 $conf->config($template)]
9371 or die "can't create new Text::Template object: Text::Template::ERROR";
9372 $notify_template->compile()
9373 or die "can't compile template: Text::Template::ERROR";
9375 $FS::notify_template::_template::company_name =
9376 $conf->config('company_name', $self->agentnum);
9377 $FS::notify_template::_template::company_address =
9378 join("\n", $conf->config('company_address', $self->agentnum) ). "\n";
9380 my $paydate = $self->paydate || '2037-12-31';
9381 $FS::notify_template::_template::first = $self->first;
9382 $FS::notify_template::_template::last = $self->last;
9383 $FS::notify_template::_template::company = $self->company;
9384 $FS::notify_template::_template::payinfo = $self->mask_payinfo;
9385 my $payby = $self->payby;
9386 my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
9387 my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
9389 #credit cards expire at the end of the month/year of their exp date
9390 if ($payby eq 'CARD' || $payby eq 'DCRD') {
9391 $FS::notify_template::_template::payby = 'credit card';
9392 ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
9393 $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
9395 }elsif ($payby eq 'COMP') {
9396 $FS::notify_template::_template::payby = 'complimentary account';
9398 $FS::notify_template::_template::payby = 'current method';
9400 $FS::notify_template::_template::expdate = $expire_time;
9402 for (keys %{$options{extra_fields}}){
9404 ${"FS::notify_template::_template::$_"} = $options{extra_fields}->{$_};
9407 send_email(from => $from,
9409 subject => $subject,
9410 body => $notify_template->fill_in( PACKAGE =>
9411 'FS::notify_template::_template' ),
9416 =item generate_letter CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
9418 Generates a templated notification to the customer (see L<Text::Template>).
9420 OPTIONS is a hash and may include
9422 I<extra_fields> - a hashref of name/value pairs which will be substituted
9423 into the template. These values may override values mentioned below
9424 and those from the customer record.
9426 The following variables are available in the template instead of or in addition
9427 to the fields of the customer record.
9429 I<$payby> - a description of the method of payment for the customer
9430 # would be nice to use FS::payby::shortname
9431 I<$payinfo> - the masked account information used to collect for this customer
9432 I<$expdate> - the expiration of the customer payment method in seconds from epoch
9433 I<$returnaddress> - the return address defaults to invoice_latexreturnaddress or company_address
9437 sub generate_letter {
9438 my ($self, $template, %options) = @_;
9440 return unless $conf->exists($template);
9442 my $letter_template = new Text::Template
9444 SOURCE => [ map "$_\n", $conf->config($template)],
9445 DELIMITERS => [ '[@--', '--@]' ],
9447 or die "can't create new Text::Template object: Text::Template::ERROR";
9449 $letter_template->compile()
9450 or die "can't compile template: Text::Template::ERROR";
9452 my %letter_data = map { $_ => $self->$_ } $self->fields;
9453 $letter_data{payinfo} = $self->mask_payinfo;
9455 #my $paydate = $self->paydate || '2037-12-31';
9456 my $paydate = $self->paydate =~ /^\S+$/ ? $self->paydate : '2037-12-31';
9458 my $payby = $self->payby;
9459 my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
9460 my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
9462 #credit cards expire at the end of the month/year of their exp date
9463 if ($payby eq 'CARD' || $payby eq 'DCRD') {
9464 $letter_data{payby} = 'credit card';
9465 ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
9466 $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
9468 }elsif ($payby eq 'COMP') {
9469 $letter_data{payby} = 'complimentary account';
9471 $letter_data{payby} = 'current method';
9473 $letter_data{expdate} = $expire_time;
9475 for (keys %{$options{extra_fields}}){
9476 $letter_data{$_} = $options{extra_fields}->{$_};
9479 unless(exists($letter_data{returnaddress})){
9480 my $retadd = join("\n", $conf->config_orbase( 'invoice_latexreturnaddress',
9481 $self->agent_template)
9483 if ( length($retadd) ) {
9484 $letter_data{returnaddress} = $retadd;
9485 } elsif ( grep /\S/, $conf->config('company_address', $self->agentnum) ) {
9486 $letter_data{returnaddress} =
9487 join( '\\*'."\n", map s/( {2,})/'~' x length($1)/eg,
9488 $conf->config('company_address', $self->agentnum)
9491 $letter_data{returnaddress} = '~';
9495 $letter_data{conf_dir} = "$FS::UID::conf_dir/conf.$FS::UID::datasrc";
9497 $letter_data{company_name} = $conf->config('company_name', $self->agentnum);
9499 my $dir = $FS::UID::conf_dir."/cache.". $FS::UID::datasrc;
9500 my $fh = new File::Temp( TEMPLATE => 'letter.'. $self->custnum. '.XXXXXXXX',
9504 ) or die "can't open temp file: $!\n";
9506 $letter_template->fill_in( OUTPUT => $fh, HASH => \%letter_data );
9508 $fh->filename =~ /^(.*).tex$/ or die "unparsable filename: ". $fh->filename;
9512 =item print_ps TEMPLATE
9514 Returns an postscript letter filled in from TEMPLATE, as a scalar.
9520 my $file = $self->generate_letter(@_);
9521 FS::Misc::generate_ps($file);
9524 =item print TEMPLATE
9526 Prints the filled in template.
9528 TEMPLATE is the name of a L<Text::Template> to fill in and print.
9532 sub queueable_print {
9535 my $self = qsearchs('cust_main', { 'custnum' => $opt{custnum} } )
9536 or die "invalid customer number: " . $opt{custvnum};
9538 my $error = $self->print( $opt{template} );
9539 die $error if $error;
9543 my ($self, $template) = (shift, shift);
9544 do_print [ $self->print_ps($template) ];
9547 #these three subs should just go away once agent stuff is all config overrides
9549 sub agent_template {
9551 $self->_agent_plandata('agent_templatename');
9554 sub agent_invoice_from {
9556 $self->_agent_plandata('agent_invoice_from');
9559 sub _agent_plandata {
9560 my( $self, $option ) = @_;
9562 #yuck. this whole thing needs to be reconciled better with 1.9's idea of
9563 #agent-specific Conf
9565 use FS::part_event::Condition;
9567 my $agentnum = $self->agentnum;
9570 if ( driver_name =~ /^Pg/i ) {
9572 } elsif ( driver_name =~ /^mysql/i ) {
9575 die "don't know how to use regular expressions in ". driver_name. " databases";
9578 my $part_event_option =
9580 'select' => 'part_event_option.*',
9581 'table' => 'part_event_option',
9583 LEFT JOIN part_event USING ( eventpart )
9584 LEFT JOIN part_event_option AS peo_agentnum
9585 ON ( part_event.eventpart = peo_agentnum.eventpart
9586 AND peo_agentnum.optionname = 'agentnum'
9587 AND peo_agentnum.optionvalue }. $regexp. q{ '(^|,)}. $agentnum. q{(,|$)'
9589 LEFT JOIN part_event_condition
9590 ON ( part_event.eventpart = part_event_condition.eventpart
9591 AND part_event_condition.conditionname = 'cust_bill_age'
9593 LEFT JOIN part_event_condition_option
9594 ON ( part_event_condition.eventconditionnum = part_event_condition_option.eventconditionnum
9595 AND part_event_condition_option.optionname = 'age'
9598 #'hashref' => { 'optionname' => $option },
9599 #'hashref' => { 'part_event_option.optionname' => $option },
9601 " WHERE part_event_option.optionname = ". dbh->quote($option).
9602 " AND action = 'cust_bill_send_agent' ".
9603 " AND ( disabled IS NULL OR disabled != 'Y' ) ".
9604 " AND peo_agentnum.optionname = 'agentnum' ".
9605 " AND ( agentnum IS NULL OR agentnum = $agentnum ) ".
9607 CASE WHEN part_event_condition_option.optionname IS NULL
9609 ELSE ". FS::part_event::Condition->age2seconds_sql('part_event_condition_option.optionvalue').
9611 , part_event.weight".
9615 unless ( $part_event_option ) {
9616 return $self->agent->invoice_template || ''
9617 if $option eq 'agent_templatename';
9621 $part_event_option->optionvalue;
9626 ## actual sub, not a method, designed to be called from the queue.
9627 ## sets up the customer, and calls the bill_and_collect
9628 my (%args) = @_; #, ($time, $invoice_time, $check_freq, $resetup) = @_;
9629 my $cust_main = qsearchs( 'cust_main', { custnum => $args{'custnum'} } );
9630 $cust_main->bill_and_collect(
9635 sub _upgrade_data { #class method
9636 my ($class, %opts) = @_;
9638 my $sql = 'UPDATE h_cust_main SET paycvv = NULL WHERE paycvv IS NOT NULL';
9639 my $sth = dbh->prepare($sql) or die dbh->errstr;
9640 $sth->execute or die $sth->errstr;
9650 The delete method should possibly take an FS::cust_main object reference
9651 instead of a scalar customer number.
9653 Bill and collect options should probably be passed as references instead of a
9656 There should probably be a configuration file with a list of allowed credit
9659 No multiple currency support (probably a larger project than just this module).
9661 payinfo_masked false laziness with cust_pay.pm and cust_refund.pm
9663 Birthdates rely on negative epoch values.
9665 The payby for card/check batches is broken. With mixed batching, bad
9668 B<collect> I<invoice_time> should be renamed I<time>, like B<bill>.
9672 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
9673 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
9674 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.