5 use vars qw( @ISA @EXPORT_OK $DEBUG $me $conf @encrypted_fields
6 $import $skip_fuzzyfiles $ignore_expired_card @paytypes);
7 use vars qw( $realtime_bop_decline_quiet ); #ugh
11 use Scalar::Util qw( blessed );
12 use List::Util qw( min );
13 use Time::Local qw(timelocal);
16 use Digest::MD5 qw(md5_base64);
19 use File::Temp qw( tempfile );
20 use String::Approx qw(amatch);
21 use Business::CreditCard 0.28;
23 use FS::UID qw( getotaker dbh driver_name );
24 use FS::Record qw( qsearchs qsearch dbdef );
25 use FS::Misc qw( generate_email send_email generate_ps do_print );
26 use FS::Msgcat qw(gettext);
31 use FS::cust_bill_pkg;
32 use FS::cust_bill_pkg_display;
33 use FS::cust_bill_pkg_tax_location;
34 use FS::cust_bill_pkg_tax_rate_location;
36 use FS::cust_pay_pending;
37 use FS::cust_pay_void;
38 use FS::cust_pay_batch;
41 use FS::part_referral;
42 use FS::cust_main_county;
43 use FS::cust_location;
44 use FS::cust_main_exemption;
45 use FS::cust_tax_adjustment;
47 use FS::tax_rate_location;
48 use FS::cust_tax_location;
49 use FS::part_pkg_taxrate;
51 use FS::cust_main_invoice;
52 use FS::cust_credit_bill;
53 use FS::cust_bill_pay;
54 use FS::prepay_credit;
58 use FS::part_event_condition;
61 use FS::payment_gateway;
62 use FS::agent_payment_gateway;
64 use FS::payinfo_Mixin;
67 @ISA = qw( FS::payinfo_Mixin FS::Record );
69 @EXPORT_OK = qw( smart_search );
71 $realtime_bop_decline_quiet = 0;
73 # 1 is mostly method/subroutine entry and options
74 # 2 traces progress of some operations
75 # 3 is even more information including possibly sensitive data
77 $me = '[FS::cust_main]';
81 $ignore_expired_card = 0;
83 @encrypted_fields = ('payinfo', 'paycvv');
84 sub nohistory_fields { ('paycvv'); }
86 @paytypes = ('', 'Personal checking', 'Personal savings', 'Business checking', 'Business savings');
88 #ask FS::UID to run this stuff for us later
89 #$FS::UID::callback{'FS::cust_main'} = sub {
90 install_callback FS::UID sub {
92 #yes, need it for stuff below (prolly should be cached)
97 my ( $hashref, $cache ) = @_;
98 if ( exists $hashref->{'pkgnum'} ) {
99 #@{ $self->{'_pkgnum'} } = ();
100 my $subcache = $cache->subcache( 'pkgnum', 'cust_pkg', $hashref->{custnum});
101 $self->{'_pkgnum'} = $subcache;
102 #push @{ $self->{'_pkgnum'} },
103 FS::cust_pkg->new_or_cached($hashref, $subcache) if $hashref->{pkgnum};
109 FS::cust_main - Object methods for cust_main records
115 $record = new FS::cust_main \%hash;
116 $record = new FS::cust_main { 'column' => 'value' };
118 $error = $record->insert;
120 $error = $new_record->replace($old_record);
122 $error = $record->delete;
124 $error = $record->check;
126 @cust_pkg = $record->all_pkgs;
128 @cust_pkg = $record->ncancelled_pkgs;
130 @cust_pkg = $record->suspended_pkgs;
132 $error = $record->bill;
133 $error = $record->bill %options;
134 $error = $record->bill 'time' => $time;
136 $error = $record->collect;
137 $error = $record->collect %options;
138 $error = $record->collect 'invoice_time' => $time,
143 An FS::cust_main object represents a customer. FS::cust_main inherits from
144 FS::Record. The following fields are currently supported:
150 Primary key (assigned automatically for new customers)
154 Agent (see L<FS::agent>)
158 Advertising source (see L<FS::part_referral>)
170 Cocial security number (optional)
186 (optional, see L<FS::cust_main_county>)
190 (see L<FS::cust_main_county>)
196 (see L<FS::cust_main_county>)
232 (optional, see L<FS::cust_main_county>)
236 (see L<FS::cust_main_county>)
242 (see L<FS::cust_main_county>)
258 Payment Type (See L<FS::payinfo_Mixin> for valid payby values)
262 Payment Information (See L<FS::payinfo_Mixin> for data format)
266 Masked payinfo (See L<FS::payinfo_Mixin> for how this works)
270 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
274 Expiration date, mm/yyyy, m/yyyy, mm/yy or m/yy
278 Start date month (maestro/solo cards only)
282 Start date year (maestro/solo cards only)
286 Issue number (maestro/solo cards only)
290 Name on card or billing name
294 IP address from which payment information was received
298 Tax exempt, empty or `Y'
302 Order taker (assigned automatically, see L<FS::UID>)
308 =item referral_custnum
310 Referring customer number
314 Enable individual CDR spooling, empty or `Y'
318 A suggestion to events (see L<FS::part_bill_event">) to delay until this unix timestamp
322 Discourage individual CDR printing, empty or `Y'
332 Creates a new customer. To add the customer to the database, see L<"insert">.
334 Note that this stores the hash reference, not a distinct copy of the hash it
335 points to. You can ask the object for a copy with the I<hash> method.
339 sub table { 'cust_main'; }
341 =item insert [ CUST_PKG_HASHREF [ , INVOICING_LIST_ARYREF ] [ , OPTION => VALUE ... ] ]
343 Adds this customer to the database. If there is an error, returns the error,
344 otherwise returns false.
346 CUST_PKG_HASHREF: If you pass a Tie::RefHash data structure to the insert
347 method containing FS::cust_pkg and FS::svc_I<tablename> objects, all records
348 are inserted atomicly, or the transaction is rolled back. Passing an empty
349 hash reference is equivalent to not supplying this parameter. There should be
350 a better explanation of this, but until then, here's an example:
353 tie %hash, 'Tie::RefHash'; #this part is important
355 $cust_pkg => [ $svc_acct ],
358 $cust_main->insert( \%hash );
360 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
361 be set as the invoicing list (see L<"invoicing_list">). Errors return as
362 expected and rollback the entire transaction; it is not necessary to call
363 check_invoicing_list first. The invoicing_list is set after the records in the
364 CUST_PKG_HASHREF above are inserted, so it is now possible to set an
365 invoicing_list destination to the newly-created svc_acct. Here's an example:
367 $cust_main->insert( {}, [ $email, 'POST' ] );
369 Currently available options are: I<depend_jobnum>, I<noexport> and I<tax_exemption>.
371 If I<depend_jobnum> is set, all provisioning jobs will have a dependancy
372 on the supplied jobnum (they will not run until the specific job completes).
373 This can be used to defer provisioning until some action completes (such
374 as running the customer's credit card successfully).
376 The I<noexport> option is deprecated. If I<noexport> is set true, no
377 provisioning jobs (exports) are scheduled. (You can schedule them later with
378 the B<reexport> method.)
380 The I<tax_exemption> option can be set to an arrayref of tax names.
381 FS::cust_main_exemption records will be created and inserted.
387 my $cust_pkgs = @_ ? shift : {};
388 my $invoicing_list = @_ ? shift : '';
390 warn "$me insert called with options ".
391 join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
394 local $SIG{HUP} = 'IGNORE';
395 local $SIG{INT} = 'IGNORE';
396 local $SIG{QUIT} = 'IGNORE';
397 local $SIG{TERM} = 'IGNORE';
398 local $SIG{TSTP} = 'IGNORE';
399 local $SIG{PIPE} = 'IGNORE';
401 my $oldAutoCommit = $FS::UID::AutoCommit;
402 local $FS::UID::AutoCommit = 0;
405 my $prepay_identifier = '';
406 my( $amount, $seconds, $upbytes, $downbytes, $totalbytes ) = (0, 0, 0, 0, 0);
408 if ( $self->payby eq 'PREPAY' ) {
410 $self->payby('BILL');
411 $prepay_identifier = $self->payinfo;
414 warn " looking up prepaid card $prepay_identifier\n"
417 my $error = $self->get_prepay( $prepay_identifier,
418 'amount_ref' => \$amount,
419 'seconds_ref' => \$seconds,
420 'upbytes_ref' => \$upbytes,
421 'downbytes_ref' => \$downbytes,
422 'totalbytes_ref' => \$totalbytes,
425 $dbh->rollback if $oldAutoCommit;
426 #return "error applying prepaid card (transaction rolled back): $error";
430 $payby = 'PREP' if $amount;
432 } elsif ( $self->payby =~ /^(CASH|WEST|MCRD)$/ ) {
435 $self->payby('BILL');
436 $amount = $self->paid;
440 warn " inserting $self\n"
443 $self->signupdate(time) unless $self->signupdate;
445 $self->auto_agent_custid()
446 if $conf->config('cust_main-auto_agent_custid') && ! $self->agent_custid;
448 my $error = $self->SUPER::insert;
450 $dbh->rollback if $oldAutoCommit;
451 #return "inserting cust_main record (transaction rolled back): $error";
455 warn " setting invoicing list\n"
458 if ( $invoicing_list ) {
459 $error = $self->check_invoicing_list( $invoicing_list );
461 $dbh->rollback if $oldAutoCommit;
462 #return "checking invoicing_list (transaction rolled back): $error";
465 $self->invoicing_list( $invoicing_list );
468 warn " setting cust_main_exemption\n"
471 my $tax_exemption = delete $options{'tax_exemption'};
472 if ( $tax_exemption ) {
473 foreach my $taxname ( @$tax_exemption ) {
474 my $cust_main_exemption = new FS::cust_main_exemption {
475 'custnum' => $self->custnum,
476 'taxname' => $taxname,
478 my $error = $cust_main_exemption->insert;
480 $dbh->rollback if $oldAutoCommit;
481 return "inserting cust_main_exemption (transaction rolled back): $error";
486 if ( $conf->config('cust_main-skeleton_tables')
487 && $conf->config('cust_main-skeleton_custnum') ) {
489 warn " inserting skeleton records\n"
492 my $error = $self->start_copy_skel;
494 $dbh->rollback if $oldAutoCommit;
500 warn " ordering packages\n"
503 $error = $self->order_pkgs( $cust_pkgs,
505 'seconds_ref' => \$seconds,
506 'upbytes_ref' => \$upbytes,
507 'downbytes_ref' => \$downbytes,
508 'totalbytes_ref' => \$totalbytes,
511 $dbh->rollback if $oldAutoCommit;
516 $dbh->rollback if $oldAutoCommit;
517 return "No svc_acct record to apply pre-paid time";
519 if ( $upbytes || $downbytes || $totalbytes ) {
520 $dbh->rollback if $oldAutoCommit;
521 return "No svc_acct record to apply pre-paid data";
525 warn " inserting initial $payby payment of $amount\n"
527 $error = $self->insert_cust_pay($payby, $amount, $prepay_identifier);
529 $dbh->rollback if $oldAutoCommit;
530 return "inserting payment (transaction rolled back): $error";
534 unless ( $import || $skip_fuzzyfiles ) {
535 warn " queueing fuzzyfiles update\n"
537 $error = $self->queue_fuzzyfiles_update;
539 $dbh->rollback if $oldAutoCommit;
540 return "updating fuzzy search cache: $error";
544 warn " insert complete; committing transaction\n"
547 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
552 use File::CounterFile;
553 sub auto_agent_custid {
556 my $format = $conf->config('cust_main-auto_agent_custid');
558 if ( $format eq '1YMMXXXXXXXX' ) {
560 my $counter = new File::CounterFile 'cust_main.agent_custid';
563 my $ym = 100000000000 + time2str('%y%m00000000', time);
564 if ( $ym > $counter->value ) {
565 $counter->{'value'} = $agent_custid = $ym;
566 $counter->{'updated'} = 1;
568 $agent_custid = $counter->inc;
574 die "Unknown cust_main-auto_agent_custid format: $format";
577 $self->agent_custid($agent_custid);
581 sub start_copy_skel {
584 #'mg_user_preference' => {},
585 #'mg_user_indicator_profile.user_indicator_profile_id' => { 'mg_profile_indicator.profile_indicator_id' => { 'mg_profile_details.profile_detail_id' }, },
586 #'mg_watchlist_header.watchlist_header_id' => { 'mg_watchlist_details.watchlist_details_id' },
587 #'mg_user_grid_header.grid_header_id' => { 'mg_user_grid_details.user_grid_details_id' },
588 #'mg_portfolio_header.portfolio_header_id' => { 'mg_portfolio_trades.portfolio_trades_id' => { 'mg_portfolio_trades_positions.portfolio_trades_positions_id' } },
589 my @tables = eval(join('\n',$conf->config('cust_main-skeleton_tables')));
592 _copy_skel( 'cust_main', #tablename
593 $conf->config('cust_main-skeleton_custnum'), #sourceid
594 $self->custnum, #destid
595 @tables, #child tables
599 #recursive subroutine, not a method
601 my( $table, $sourceid, $destid, %child_tables ) = @_;
604 if ( $table =~ /^(\w+)\.(\w+)$/ ) {
605 ( $table, $primary_key ) = ( $1, $2 );
607 my $dbdef_table = dbdef->table($table);
608 $primary_key = $dbdef_table->primary_key
609 or return "$table has no primary key".
610 " (or do you need to run dbdef-create?)";
613 warn " _copy_skel: $table.$primary_key $sourceid to $destid for ".
614 join (', ', keys %child_tables). "\n"
617 foreach my $child_table_def ( keys %child_tables ) {
621 if ( $child_table_def =~ /^(\w+)\.(\w+)$/ ) {
622 ( $child_table, $child_pkey ) = ( $1, $2 );
624 $child_table = $child_table_def;
626 $child_pkey = dbdef->table($child_table)->primary_key;
627 # or return "$table has no primary key".
628 # " (or do you need to run dbdef-create?)\n";
632 if ( keys %{ $child_tables{$child_table_def} } ) {
634 return "$child_table has no primary key".
635 " (run dbdef-create or try specifying it?)\n"
638 #false laziness w/Record::insert and only works on Pg
639 #refactor the proper last-inserted-id stuff out of Record::insert if this
640 # ever gets use for anything besides a quick kludge for one customer
641 my $default = dbdef->table($child_table)->column($child_pkey)->default;
642 $default =~ /^nextval\(\(?'"?([\w\.]+)"?'/i
643 or return "can't parse $child_table.$child_pkey default value ".
644 " for sequence name: $default";
649 my @sel_columns = grep { $_ ne $primary_key }
650 dbdef->table($child_table)->columns;
651 my $sel_columns = join(', ', @sel_columns );
653 my @ins_columns = grep { $_ ne $child_pkey } @sel_columns;
654 my $ins_columns = ' ( '. join(', ', $primary_key, @ins_columns ). ' ) ';
655 my $placeholders = ' ( ?, '. join(', ', map '?', @ins_columns ). ' ) ';
657 my $sel_st = "SELECT $sel_columns FROM $child_table".
658 " WHERE $primary_key = $sourceid";
661 my $sel_sth = dbh->prepare( $sel_st )
662 or return dbh->errstr;
664 $sel_sth->execute or return $sel_sth->errstr;
666 while ( my $row = $sel_sth->fetchrow_hashref ) {
668 warn " selected row: ".
669 join(', ', map { "$_=".$row->{$_} } keys %$row ). "\n"
673 "INSERT INTO $child_table $ins_columns VALUES $placeholders";
674 my $ins_sth =dbh->prepare($statement)
675 or return dbh->errstr;
676 my @param = ( $destid, map $row->{$_}, @ins_columns );
677 warn " $statement: [ ". join(', ', @param). " ]\n"
679 $ins_sth->execute( @param )
680 or return $ins_sth->errstr;
682 #next unless keys %{ $child_tables{$child_table} };
683 next unless $sequence;
685 #another section of that laziness
686 my $seq_sql = "SELECT currval('$sequence')";
687 my $seq_sth = dbh->prepare($seq_sql) or return dbh->errstr;
688 $seq_sth->execute or return $seq_sth->errstr;
689 my $insertid = $seq_sth->fetchrow_arrayref->[0];
691 # don't drink soap! recurse! recurse! okay!
693 _copy_skel( $child_table_def,
694 $row->{$child_pkey}, #sourceid
696 %{ $child_tables{$child_table_def} },
698 return $error if $error;
708 =item order_pkg HASHREF | OPTION => VALUE ...
710 Orders a single package.
712 Options may be passed as a list of key/value pairs or as a hash reference.
723 Optional FS::cust_location object
727 Optional arryaref of FS::svc_* service objects.
731 If this option is set to a job queue jobnum (see L<FS::queue>), all provisioning
732 jobs will have a dependancy on the supplied job (they will not run until the
733 specific job completes). This can be used to defer provisioning until some
734 action completes (such as running the customer's credit card successfully).
738 Optional subject for a ticket created and attached to this customer
742 Optional queue name for ticket additions
750 my $opt = ref($_[0]) ? shift : { @_ };
752 warn "$me order_pkg called with options ".
753 join(', ', map { "$_: $opt->{$_}" } keys %$opt ). "\n"
756 my $cust_pkg = $opt->{'cust_pkg'};
757 my $svcs = $opt->{'svcs'} || [];
759 my %svc_options = ();
760 $svc_options{'depend_jobnum'} = $opt->{'depend_jobnum'}
761 if exists($opt->{'depend_jobnum'}) && $opt->{'depend_jobnum'};
763 my %insert_params = map { $opt->{$_} ? ( $_ => $opt->{$_} ) : () }
764 qw( ticket_subject ticket_queue );
766 local $SIG{HUP} = 'IGNORE';
767 local $SIG{INT} = 'IGNORE';
768 local $SIG{QUIT} = 'IGNORE';
769 local $SIG{TERM} = 'IGNORE';
770 local $SIG{TSTP} = 'IGNORE';
771 local $SIG{PIPE} = 'IGNORE';
773 my $oldAutoCommit = $FS::UID::AutoCommit;
774 local $FS::UID::AutoCommit = 0;
777 if ( $opt->{'cust_location'} &&
778 ( ! $cust_pkg->locationnum || $cust_pkg->locationnum == -1 ) ) {
779 my $error = $opt->{'cust_location'}->insert;
781 $dbh->rollback if $oldAutoCommit;
782 return "inserting cust_location (transaction rolled back): $error";
784 $cust_pkg->locationnum($opt->{'cust_location'}->locationnum);
787 $cust_pkg->custnum( $self->custnum );
789 my $error = $cust_pkg->insert( %insert_params );
791 $dbh->rollback if $oldAutoCommit;
792 return "inserting cust_pkg (transaction rolled back): $error";
795 foreach my $svc_something ( @{ $opt->{'svcs'} } ) {
796 if ( $svc_something->svcnum ) {
797 my $old_cust_svc = $svc_something->cust_svc;
798 my $new_cust_svc = new FS::cust_svc { $old_cust_svc->hash };
799 $new_cust_svc->pkgnum( $cust_pkg->pkgnum);
800 $error = $new_cust_svc->replace($old_cust_svc);
802 $svc_something->pkgnum( $cust_pkg->pkgnum );
803 if ( $svc_something->isa('FS::svc_acct') ) {
804 foreach ( grep { $opt->{$_.'_ref'} && ${ $opt->{$_.'_ref'} } }
805 qw( seconds upbytes downbytes totalbytes ) ) {
806 $svc_something->$_( $svc_something->$_() + ${ $opt->{$_.'_ref'} } );
807 ${ $opt->{$_.'_ref'} } = 0;
810 $error = $svc_something->insert(%svc_options);
813 $dbh->rollback if $oldAutoCommit;
814 return "inserting svc_ (transaction rolled back): $error";
818 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
823 #deprecated #=item order_pkgs HASHREF [ , SECONDSREF ] [ , OPTION => VALUE ... ]
824 =item order_pkgs HASHREF [ , OPTION => VALUE ... ]
826 Like the insert method on an existing record, this method orders multiple
827 packages and included services atomicaly. Pass a Tie::RefHash data structure
828 to this method containing FS::cust_pkg and FS::svc_I<tablename> objects.
829 There should be a better explanation of this, but until then, here's an
833 tie %hash, 'Tie::RefHash'; #this part is important
835 $cust_pkg => [ $svc_acct ],
838 $cust_main->order_pkgs( \%hash, 'noexport'=>1 );
840 Services can be new, in which case they are inserted, or existing unaudited
841 services, in which case they are linked to the newly-created package.
843 Currently available options are: I<depend_jobnum>, I<noexport>, I<seconds_ref>,
844 I<upbytes_ref>, I<downbytes_ref>, and I<totalbytes_ref>.
846 If I<depend_jobnum> is set, all provisioning jobs will have a dependancy
847 on the supplied jobnum (they will not run until the specific job completes).
848 This can be used to defer provisioning until some action completes (such
849 as running the customer's credit card successfully).
851 The I<noexport> option is deprecated. If I<noexport> is set true, no
852 provisioning jobs (exports) are scheduled. (You can schedule them later with
853 the B<reexport> method for each cust_pkg object. Using the B<reexport> method
854 on the cust_main object is not recommended, as existing services will also be
857 If I<seconds_ref>, I<upbytes_ref>, I<downbytes_ref>, or I<totalbytes_ref> is
858 provided, the scalars (provided by references) will be incremented by the
859 values of the prepaid card.`
865 my $cust_pkgs = shift;
866 my $seconds_ref = ref($_[0]) ? shift : ''; #deprecated
868 $seconds_ref ||= $options{'seconds_ref'};
870 warn "$me order_pkgs called with options ".
871 join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
874 local $SIG{HUP} = 'IGNORE';
875 local $SIG{INT} = 'IGNORE';
876 local $SIG{QUIT} = 'IGNORE';
877 local $SIG{TERM} = 'IGNORE';
878 local $SIG{TSTP} = 'IGNORE';
879 local $SIG{PIPE} = 'IGNORE';
881 my $oldAutoCommit = $FS::UID::AutoCommit;
882 local $FS::UID::AutoCommit = 0;
885 local $FS::svc_Common::noexport_hack = 1 if $options{'noexport'};
887 foreach my $cust_pkg ( keys %$cust_pkgs ) {
889 my $error = $self->order_pkg(
890 'cust_pkg' => $cust_pkg,
891 'svcs' => $cust_pkgs->{$cust_pkg},
892 'seconds_ref' => $seconds_ref,
893 map { $_ => $options{$_} } qw( upbytes_ref downbytes_ref totalbytes_ref
898 $dbh->rollback if $oldAutoCommit;
904 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
908 =item recharge_prepay IDENTIFIER | PREPAY_CREDIT_OBJ [ , AMOUNTREF, SECONDSREF, UPBYTEREF, DOWNBYTEREF ]
910 Recharges this (existing) customer with the specified prepaid card (see
911 L<FS::prepay_credit>), specified either by I<identifier> or as an
912 FS::prepay_credit object. If there is an error, returns the error, otherwise
915 Optionally, five scalar references can be passed as well. They will have their
916 values filled in with the amount, number of seconds, and number of upload,
917 download, and total bytes applied by this prepaid card.
921 #the ref bullshit here should be refactored like get_prepay. MyAccount.pm is
922 #the only place that uses these args
923 sub recharge_prepay {
924 my( $self, $prepay_credit, $amountref, $secondsref,
925 $upbytesref, $downbytesref, $totalbytesref ) = @_;
927 local $SIG{HUP} = 'IGNORE';
928 local $SIG{INT} = 'IGNORE';
929 local $SIG{QUIT} = 'IGNORE';
930 local $SIG{TERM} = 'IGNORE';
931 local $SIG{TSTP} = 'IGNORE';
932 local $SIG{PIPE} = 'IGNORE';
934 my $oldAutoCommit = $FS::UID::AutoCommit;
935 local $FS::UID::AutoCommit = 0;
938 my( $amount, $seconds, $upbytes, $downbytes, $totalbytes) = ( 0, 0, 0, 0, 0 );
940 my $error = $self->get_prepay( $prepay_credit,
941 'amount_ref' => \$amount,
942 'seconds_ref' => \$seconds,
943 'upbytes_ref' => \$upbytes,
944 'downbytes_ref' => \$downbytes,
945 'totalbytes_ref' => \$totalbytes,
947 || $self->increment_seconds($seconds)
948 || $self->increment_upbytes($upbytes)
949 || $self->increment_downbytes($downbytes)
950 || $self->increment_totalbytes($totalbytes)
951 || $self->insert_cust_pay_prepay( $amount,
953 ? $prepay_credit->identifier
958 $dbh->rollback if $oldAutoCommit;
962 if ( defined($amountref) ) { $$amountref = $amount; }
963 if ( defined($secondsref) ) { $$secondsref = $seconds; }
964 if ( defined($upbytesref) ) { $$upbytesref = $upbytes; }
965 if ( defined($downbytesref) ) { $$downbytesref = $downbytes; }
966 if ( defined($totalbytesref) ) { $$totalbytesref = $totalbytes; }
968 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
973 =item get_prepay IDENTIFIER | PREPAY_CREDIT_OBJ [ , OPTION => VALUE ... ]
975 Looks up and deletes a prepaid card (see L<FS::prepay_credit>),
976 specified either by I<identifier> or as an FS::prepay_credit object.
978 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
979 incremented by the values of the prepaid card.
981 If the prepaid card specifies an I<agentnum> (see L<FS::agent>), it is used to
982 check or set this customer's I<agentnum>.
984 If there is an error, returns the error, otherwise returns false.
990 my( $self, $prepay_credit, %opt ) = @_;
992 local $SIG{HUP} = 'IGNORE';
993 local $SIG{INT} = 'IGNORE';
994 local $SIG{QUIT} = 'IGNORE';
995 local $SIG{TERM} = 'IGNORE';
996 local $SIG{TSTP} = 'IGNORE';
997 local $SIG{PIPE} = 'IGNORE';
999 my $oldAutoCommit = $FS::UID::AutoCommit;
1000 local $FS::UID::AutoCommit = 0;
1003 unless ( ref($prepay_credit) ) {
1005 my $identifier = $prepay_credit;
1007 $prepay_credit = qsearchs(
1009 { 'identifier' => $prepay_credit },
1014 unless ( $prepay_credit ) {
1015 $dbh->rollback if $oldAutoCommit;
1016 return "Invalid prepaid card: ". $identifier;
1021 if ( $prepay_credit->agentnum ) {
1022 if ( $self->agentnum && $self->agentnum != $prepay_credit->agentnum ) {
1023 $dbh->rollback if $oldAutoCommit;
1024 return "prepaid card not valid for agent ". $self->agentnum;
1026 $self->agentnum($prepay_credit->agentnum);
1029 my $error = $prepay_credit->delete;
1031 $dbh->rollback if $oldAutoCommit;
1032 return "removing prepay_credit (transaction rolled back): $error";
1035 ${ $opt{$_.'_ref'} } += $prepay_credit->$_()
1036 for grep $opt{$_.'_ref'}, qw( amount seconds upbytes downbytes totalbytes );
1038 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1043 =item increment_upbytes SECONDS
1045 Updates this customer's single or primary account (see L<FS::svc_acct>) by
1046 the specified number of upbytes. If there is an error, returns the error,
1047 otherwise returns false.
1051 sub increment_upbytes {
1052 _increment_column( shift, 'upbytes', @_);
1055 =item increment_downbytes SECONDS
1057 Updates this customer's single or primary account (see L<FS::svc_acct>) by
1058 the specified number of downbytes. If there is an error, returns the error,
1059 otherwise returns false.
1063 sub increment_downbytes {
1064 _increment_column( shift, 'downbytes', @_);
1067 =item increment_totalbytes SECONDS
1069 Updates this customer's single or primary account (see L<FS::svc_acct>) by
1070 the specified number of totalbytes. If there is an error, returns the error,
1071 otherwise returns false.
1075 sub increment_totalbytes {
1076 _increment_column( shift, 'totalbytes', @_);
1079 =item increment_seconds SECONDS
1081 Updates this customer's single or primary account (see L<FS::svc_acct>) by
1082 the specified number of seconds. If there is an error, returns the error,
1083 otherwise returns false.
1087 sub increment_seconds {
1088 _increment_column( shift, 'seconds', @_);
1091 =item _increment_column AMOUNT
1093 Updates this customer's single or primary account (see L<FS::svc_acct>) by
1094 the specified number of seconds or bytes. If there is an error, returns
1095 the error, otherwise returns false.
1099 sub _increment_column {
1100 my( $self, $column, $amount ) = @_;
1101 warn "$me increment_column called: $column, $amount\n"
1104 return '' unless $amount;
1106 my @cust_pkg = grep { $_->part_pkg->svcpart('svc_acct') }
1107 $self->ncancelled_pkgs;
1109 if ( ! @cust_pkg ) {
1110 return 'No packages with primary or single services found'.
1111 ' to apply pre-paid time';
1112 } elsif ( scalar(@cust_pkg) > 1 ) {
1113 #maybe have a way to specify the package/account?
1114 return 'Multiple packages found to apply pre-paid time';
1117 my $cust_pkg = $cust_pkg[0];
1118 warn " found package pkgnum ". $cust_pkg->pkgnum. "\n"
1122 $cust_pkg->cust_svc( $cust_pkg->part_pkg->svcpart('svc_acct') );
1124 if ( ! @cust_svc ) {
1125 return 'No account found to apply pre-paid time';
1126 } elsif ( scalar(@cust_svc) > 1 ) {
1127 return 'Multiple accounts found to apply pre-paid time';
1130 my $svc_acct = $cust_svc[0]->svc_x;
1131 warn " found service svcnum ". $svc_acct->pkgnum.
1132 ' ('. $svc_acct->email. ")\n"
1135 $column = "increment_$column";
1136 $svc_acct->$column($amount);
1140 =item insert_cust_pay_prepay AMOUNT [ PAYINFO ]
1142 Inserts a prepayment in the specified amount for this customer. An optional
1143 second argument can specify the prepayment identifier for tracking purposes.
1144 If there is an error, returns the error, otherwise returns false.
1148 sub insert_cust_pay_prepay {
1149 shift->insert_cust_pay('PREP', @_);
1152 =item insert_cust_pay_cash AMOUNT [ PAYINFO ]
1154 Inserts a cash payment in the specified amount for this customer. An optional
1155 second argument can specify the payment identifier for tracking purposes.
1156 If there is an error, returns the error, otherwise returns false.
1160 sub insert_cust_pay_cash {
1161 shift->insert_cust_pay('CASH', @_);
1164 =item insert_cust_pay_west AMOUNT [ PAYINFO ]
1166 Inserts a Western Union payment in the specified amount for this customer. An
1167 optional second argument can specify the prepayment identifier for tracking
1168 purposes. If there is an error, returns the error, otherwise returns false.
1172 sub insert_cust_pay_west {
1173 shift->insert_cust_pay('WEST', @_);
1176 sub insert_cust_pay {
1177 my( $self, $payby, $amount ) = splice(@_, 0, 3);
1178 my $payinfo = scalar(@_) ? shift : '';
1180 my $cust_pay = new FS::cust_pay {
1181 'custnum' => $self->custnum,
1182 'paid' => sprintf('%.2f', $amount),
1183 #'_date' => #date the prepaid card was purchased???
1185 'payinfo' => $payinfo,
1193 This method is deprecated. See the I<depend_jobnum> option to the insert and
1194 order_pkgs methods for a better way to defer provisioning.
1196 Re-schedules all exports by calling the B<reexport> method of all associated
1197 packages (see L<FS::cust_pkg>). If there is an error, returns the error;
1198 otherwise returns false.
1205 carp "WARNING: FS::cust_main::reexport is deprectated; ".
1206 "use the depend_jobnum option to insert or order_pkgs to delay export";
1208 local $SIG{HUP} = 'IGNORE';
1209 local $SIG{INT} = 'IGNORE';
1210 local $SIG{QUIT} = 'IGNORE';
1211 local $SIG{TERM} = 'IGNORE';
1212 local $SIG{TSTP} = 'IGNORE';
1213 local $SIG{PIPE} = 'IGNORE';
1215 my $oldAutoCommit = $FS::UID::AutoCommit;
1216 local $FS::UID::AutoCommit = 0;
1219 foreach my $cust_pkg ( $self->ncancelled_pkgs ) {
1220 my $error = $cust_pkg->reexport;
1222 $dbh->rollback if $oldAutoCommit;
1227 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1232 =item delete NEW_CUSTNUM
1234 This deletes the customer. If there is an error, returns the error, otherwise
1237 This will completely remove all traces of the customer record. This is not
1238 what you want when a customer cancels service; for that, cancel all of the
1239 customer's packages (see L</cancel>).
1241 If the customer has any uncancelled packages, you need to pass a new (valid)
1242 customer number for those packages to be transferred to. Cancelled packages
1243 will be deleted. Did I mention that this is NOT what you want when a customer
1244 cancels service and that you really should be looking see L<FS::cust_pkg/cancel>?
1246 You can't delete a customer with invoices (see L<FS::cust_bill>),
1247 or credits (see L<FS::cust_credit>), payments (see L<FS::cust_pay>) or
1248 refunds (see L<FS::cust_refund>).
1255 local $SIG{HUP} = 'IGNORE';
1256 local $SIG{INT} = 'IGNORE';
1257 local $SIG{QUIT} = 'IGNORE';
1258 local $SIG{TERM} = 'IGNORE';
1259 local $SIG{TSTP} = 'IGNORE';
1260 local $SIG{PIPE} = 'IGNORE';
1262 my $oldAutoCommit = $FS::UID::AutoCommit;
1263 local $FS::UID::AutoCommit = 0;
1266 if ( $self->cust_bill ) {
1267 $dbh->rollback if $oldAutoCommit;
1268 return "Can't delete a customer with invoices";
1270 if ( $self->cust_credit ) {
1271 $dbh->rollback if $oldAutoCommit;
1272 return "Can't delete a customer with credits";
1274 if ( $self->cust_pay ) {
1275 $dbh->rollback if $oldAutoCommit;
1276 return "Can't delete a customer with payments";
1278 if ( $self->cust_refund ) {
1279 $dbh->rollback if $oldAutoCommit;
1280 return "Can't delete a customer with refunds";
1283 my @cust_pkg = $self->ncancelled_pkgs;
1285 my $new_custnum = shift;
1286 unless ( qsearchs( 'cust_main', { 'custnum' => $new_custnum } ) ) {
1287 $dbh->rollback if $oldAutoCommit;
1288 return "Invalid new customer number: $new_custnum";
1290 foreach my $cust_pkg ( @cust_pkg ) {
1291 my %hash = $cust_pkg->hash;
1292 $hash{'custnum'} = $new_custnum;
1293 my $new_cust_pkg = new FS::cust_pkg ( \%hash );
1294 my $error = $new_cust_pkg->replace($cust_pkg,
1295 options => { $cust_pkg->options },
1298 $dbh->rollback if $oldAutoCommit;
1303 my @cancelled_cust_pkg = $self->all_pkgs;
1304 foreach my $cust_pkg ( @cancelled_cust_pkg ) {
1305 my $error = $cust_pkg->delete;
1307 $dbh->rollback if $oldAutoCommit;
1312 foreach my $cust_main_invoice ( #(email invoice destinations, not invoices)
1313 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } )
1315 my $error = $cust_main_invoice->delete;
1317 $dbh->rollback if $oldAutoCommit;
1322 foreach my $cust_main_exemption (
1323 qsearch( 'cust_main_exemption', { 'custnum' => $self->custnum } )
1325 my $error = $cust_main_exemption->delete;
1327 $dbh->rollback if $oldAutoCommit;
1332 my $error = $self->SUPER::delete;
1334 $dbh->rollback if $oldAutoCommit;
1338 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1343 =item replace [ OLD_RECORD ] [ INVOICING_LIST_ARYREF ] [ , OPTION => VALUE ... ] ]
1346 Replaces the OLD_RECORD with this one in the database. If there is an error,
1347 returns the error, otherwise returns false.
1349 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
1350 be set as the invoicing list (see L<"invoicing_list">). Errors return as
1351 expected and rollback the entire transaction; it is not necessary to call
1352 check_invoicing_list first. Here's an example:
1354 $new_cust_main->replace( $old_cust_main, [ $email, 'POST' ] );
1356 Currently available options are: I<tax_exemption>.
1358 The I<tax_exemption> option can be set to an arrayref of tax names.
1359 FS::cust_main_exemption records will be deleted and inserted as appropriate.
1366 my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
1368 : $self->replace_old;
1372 warn "$me replace called\n"
1375 my $curuser = $FS::CurrentUser::CurrentUser;
1376 if ( $self->payby eq 'COMP'
1377 && $self->payby ne $old->payby
1378 && ! $curuser->access_right('Complimentary customer')
1381 return "You are not permitted to create complimentary accounts.";
1384 local($ignore_expired_card) = 1
1385 if $old->payby =~ /^(CARD|DCRD)$/
1386 && $self->payby =~ /^(CARD|DCRD)$/
1387 && ( $old->payinfo eq $self->payinfo || $old->paymask eq $self->paymask );
1389 local $SIG{HUP} = 'IGNORE';
1390 local $SIG{INT} = 'IGNORE';
1391 local $SIG{QUIT} = 'IGNORE';
1392 local $SIG{TERM} = 'IGNORE';
1393 local $SIG{TSTP} = 'IGNORE';
1394 local $SIG{PIPE} = 'IGNORE';
1396 my $oldAutoCommit = $FS::UID::AutoCommit;
1397 local $FS::UID::AutoCommit = 0;
1400 my $error = $self->SUPER::replace($old);
1403 $dbh->rollback if $oldAutoCommit;
1407 if ( @param && ref($param[0]) eq 'ARRAY' ) { # INVOICING_LIST_ARYREF
1408 my $invoicing_list = shift @param;
1409 $error = $self->check_invoicing_list( $invoicing_list );
1411 $dbh->rollback if $oldAutoCommit;
1414 $self->invoicing_list( $invoicing_list );
1417 my %options = @param;
1419 my $tax_exemption = delete $options{'tax_exemption'};
1420 if ( $tax_exemption ) {
1422 my %cust_main_exemption =
1423 map { $_->taxname => $_ }
1424 qsearch('cust_main_exemption', { 'custnum' => $old->custnum } );
1426 foreach my $taxname ( @$tax_exemption ) {
1428 next if delete $cust_main_exemption{$taxname};
1430 my $cust_main_exemption = new FS::cust_main_exemption {
1431 'custnum' => $self->custnum,
1432 'taxname' => $taxname,
1434 my $error = $cust_main_exemption->insert;
1436 $dbh->rollback if $oldAutoCommit;
1437 return "inserting cust_main_exemption (transaction rolled back): $error";
1441 foreach my $cust_main_exemption ( values %cust_main_exemption ) {
1442 my $error = $cust_main_exemption->delete;
1444 $dbh->rollback if $oldAutoCommit;
1445 return "deleting cust_main_exemption (transaction rolled back): $error";
1451 if ( $self->payby =~ /^(CARD|CHEK|LECB)$/ &&
1452 grep { $self->get($_) ne $old->get($_) } qw(payinfo paydate payname) ) {
1453 # card/check/lec info has changed, want to retry realtime_ invoice events
1454 my $error = $self->retry_realtime;
1456 $dbh->rollback if $oldAutoCommit;
1461 unless ( $import || $skip_fuzzyfiles ) {
1462 $error = $self->queue_fuzzyfiles_update;
1464 $dbh->rollback if $oldAutoCommit;
1465 return "updating fuzzy search cache: $error";
1469 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1474 =item queue_fuzzyfiles_update
1476 Used by insert & replace to update the fuzzy search cache
1480 sub queue_fuzzyfiles_update {
1483 local $SIG{HUP} = 'IGNORE';
1484 local $SIG{INT} = 'IGNORE';
1485 local $SIG{QUIT} = 'IGNORE';
1486 local $SIG{TERM} = 'IGNORE';
1487 local $SIG{TSTP} = 'IGNORE';
1488 local $SIG{PIPE} = 'IGNORE';
1490 my $oldAutoCommit = $FS::UID::AutoCommit;
1491 local $FS::UID::AutoCommit = 0;
1494 my $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
1495 my $error = $queue->insert( map $self->getfield($_),
1496 qw(first last company)
1499 $dbh->rollback if $oldAutoCommit;
1500 return "queueing job (transaction rolled back): $error";
1503 if ( $self->ship_last ) {
1504 $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
1505 $error = $queue->insert( map $self->getfield("ship_$_"),
1506 qw(first last company)
1509 $dbh->rollback if $oldAutoCommit;
1510 return "queueing job (transaction rolled back): $error";
1514 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1521 Checks all fields to make sure this is a valid customer record. If there is
1522 an error, returns the error, otherwise returns false. Called by the insert
1523 and replace methods.
1530 warn "$me check BEFORE: \n". $self->_dump
1534 $self->ut_numbern('custnum')
1535 || $self->ut_number('agentnum')
1536 || $self->ut_textn('agent_custid')
1537 || $self->ut_number('refnum')
1538 || $self->ut_textn('custbatch')
1539 || $self->ut_name('last')
1540 || $self->ut_name('first')
1541 || $self->ut_snumbern('birthdate')
1542 || $self->ut_snumbern('signupdate')
1543 || $self->ut_textn('company')
1544 || $self->ut_text('address1')
1545 || $self->ut_textn('address2')
1546 || $self->ut_text('city')
1547 || $self->ut_textn('county')
1548 || $self->ut_textn('state')
1549 || $self->ut_country('country')
1550 || $self->ut_anything('comments')
1551 || $self->ut_numbern('referral_custnum')
1552 || $self->ut_textn('stateid')
1553 || $self->ut_textn('stateid_state')
1554 || $self->ut_textn('invoice_terms')
1555 || $self->ut_alphan('geocode')
1556 || $self->ut_floatn('cdr_termination_percentage')
1559 #barf. need message catalogs. i18n. etc.
1560 $error .= "Please select an advertising source."
1561 if $error =~ /^Illegal or empty \(numeric\) refnum: /;
1562 return $error if $error;
1564 return "Unknown agent"
1565 unless qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
1567 return "Unknown refnum"
1568 unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } );
1570 return "Unknown referring custnum: ". $self->referral_custnum
1571 unless ! $self->referral_custnum
1572 || qsearchs( 'cust_main', { 'custnum' => $self->referral_custnum } );
1574 if ( $self->ss eq '' ) {
1579 $ss =~ /^(\d{3})(\d{2})(\d{4})$/
1580 or return "Illegal social security number: ". $self->ss;
1581 $self->ss("$1-$2-$3");
1585 # bad idea to disable, causes billing to fail because of no tax rates later
1586 # unless ( $import ) {
1587 unless ( qsearch('cust_main_county', {
1588 'country' => $self->country,
1591 return "Unknown state/county/country: ".
1592 $self->state. "/". $self->county. "/". $self->country
1593 unless qsearch('cust_main_county',{
1594 'state' => $self->state,
1595 'county' => $self->county,
1596 'country' => $self->country,
1602 $self->ut_phonen('daytime', $self->country)
1603 || $self->ut_phonen('night', $self->country)
1604 || $self->ut_phonen('fax', $self->country)
1605 || $self->ut_zip('zip', $self->country)
1607 return $error if $error;
1609 if ( $conf->exists('cust_main-require_phone')
1610 && ! length($self->daytime) && ! length($self->night)
1613 my $daytime_label = FS::Msgcat::_gettext('daytime') =~ /^(daytime)?$/
1615 : FS::Msgcat::_gettext('daytime');
1616 my $night_label = FS::Msgcat::_gettext('night') =~ /^(night)?$/
1618 : FS::Msgcat::_gettext('night');
1620 return "$daytime_label or $night_label is required"
1624 if ( $self->has_ship_address
1625 && scalar ( grep { $self->getfield($_) ne $self->getfield("ship_$_") }
1626 $self->addr_fields )
1630 $self->ut_name('ship_last')
1631 || $self->ut_name('ship_first')
1632 || $self->ut_textn('ship_company')
1633 || $self->ut_text('ship_address1')
1634 || $self->ut_textn('ship_address2')
1635 || $self->ut_text('ship_city')
1636 || $self->ut_textn('ship_county')
1637 || $self->ut_textn('ship_state')
1638 || $self->ut_country('ship_country')
1640 return $error if $error;
1642 #false laziness with above
1643 unless ( qsearchs('cust_main_county', {
1644 'country' => $self->ship_country,
1647 return "Unknown ship_state/ship_county/ship_country: ".
1648 $self->ship_state. "/". $self->ship_county. "/". $self->ship_country
1649 unless qsearch('cust_main_county',{
1650 'state' => $self->ship_state,
1651 'county' => $self->ship_county,
1652 'country' => $self->ship_country,
1658 $self->ut_phonen('ship_daytime', $self->ship_country)
1659 || $self->ut_phonen('ship_night', $self->ship_country)
1660 || $self->ut_phonen('ship_fax', $self->ship_country)
1661 || $self->ut_zip('ship_zip', $self->ship_country)
1663 return $error if $error;
1665 return "Unit # is required."
1666 if $self->ship_address2 =~ /^\s*$/
1667 && $conf->exists('cust_main-require_address2');
1669 } else { # ship_ info eq billing info, so don't store dup info in database
1671 $self->setfield("ship_$_", '')
1672 foreach $self->addr_fields;
1674 return "Unit # is required."
1675 if $self->address2 =~ /^\s*$/
1676 && $conf->exists('cust_main-require_address2');
1680 #$self->payby =~ /^(CARD|DCRD|CHEK|DCHK|LECB|BILL|COMP|PREPAY|CASH|WEST|MCRD)$/
1681 # or return "Illegal payby: ". $self->payby;
1683 FS::payby->can_payby($self->table, $self->payby)
1684 or return "Illegal payby: ". $self->payby;
1686 $error = $self->ut_numbern('paystart_month')
1687 || $self->ut_numbern('paystart_year')
1688 || $self->ut_numbern('payissue')
1689 || $self->ut_textn('paytype')
1691 return $error if $error;
1693 if ( $self->payip eq '' ) {
1696 $error = $self->ut_ip('payip');
1697 return $error if $error;
1700 # If it is encrypted and the private key is not availaible then we can't
1701 # check the credit card.
1703 my $check_payinfo = 1;
1705 if ($self->is_encrypted($self->payinfo)) {
1709 if ( $check_payinfo && $self->payby =~ /^(CARD|DCRD)$/ ) {
1711 my $payinfo = $self->payinfo;
1712 $payinfo =~ s/\D//g;
1713 $payinfo =~ /^(\d{13,16})$/
1714 or return gettext('invalid_card'); # . ": ". $self->payinfo;
1716 $self->payinfo($payinfo);
1718 or return gettext('invalid_card'); # . ": ". $self->payinfo;
1720 return gettext('unknown_card_type')
1721 if cardtype($self->payinfo) eq "Unknown";
1723 my $ban = qsearchs('banned_pay', $self->_banned_pay_hashref);
1725 return 'Banned credit card: banned on '.
1726 time2str('%a %h %o at %r', $ban->_date).
1727 ' by '. $ban->otaker.
1728 ' (ban# '. $ban->bannum. ')';
1731 if (length($self->paycvv) && !$self->is_encrypted($self->paycvv)) {
1732 if ( cardtype($self->payinfo) eq 'American Express card' ) {
1733 $self->paycvv =~ /^(\d{4})$/
1734 or return "CVV2 (CID) for American Express cards is four digits.";
1737 $self->paycvv =~ /^(\d{3})$/
1738 or return "CVV2 (CVC2/CID) is three digits.";
1745 my $cardtype = cardtype($payinfo);
1746 if ( $cardtype =~ /^(Switch|Solo)$/i ) {
1748 return "Start date or issue number is required for $cardtype cards"
1749 unless $self->paystart_month && $self->paystart_year or $self->payissue;
1751 return "Start month must be between 1 and 12"
1752 if $self->paystart_month
1753 and $self->paystart_month < 1 || $self->paystart_month > 12;
1755 return "Start year must be 1990 or later"
1756 if $self->paystart_year
1757 and $self->paystart_year < 1990;
1759 return "Issue number must be beween 1 and 99"
1761 and $self->payissue < 1 || $self->payissue > 99;
1764 $self->paystart_month('');
1765 $self->paystart_year('');
1766 $self->payissue('');
1769 } elsif ( $check_payinfo && $self->payby =~ /^(CHEK|DCHK)$/ ) {
1771 my $payinfo = $self->payinfo;
1772 $payinfo =~ s/[^\d\@]//g;
1773 if ( $conf->exists('echeck-nonus') ) {
1774 $payinfo =~ /^(\d+)\@(\d+)$/ or return 'invalid echeck account@aba';
1775 $payinfo = "$1\@$2";
1777 $payinfo =~ /^(\d+)\@(\d{9})$/ or return 'invalid echeck account@aba';
1778 $payinfo = "$1\@$2";
1780 $self->payinfo($payinfo);
1783 my $ban = qsearchs('banned_pay', $self->_banned_pay_hashref);
1785 return 'Banned ACH account: banned on '.
1786 time2str('%a %h %o at %r', $ban->_date).
1787 ' by '. $ban->otaker.
1788 ' (ban# '. $ban->bannum. ')';
1791 } elsif ( $self->payby eq 'LECB' ) {
1793 my $payinfo = $self->payinfo;
1794 $payinfo =~ s/\D//g;
1795 $payinfo =~ /^1?(\d{10})$/ or return 'invalid btn billing telephone number';
1797 $self->payinfo($payinfo);
1800 } elsif ( $self->payby eq 'BILL' ) {
1802 $error = $self->ut_textn('payinfo');
1803 return "Illegal P.O. number: ". $self->payinfo if $error;
1806 } elsif ( $self->payby eq 'COMP' ) {
1808 my $curuser = $FS::CurrentUser::CurrentUser;
1809 if ( ! $self->custnum
1810 && ! $curuser->access_right('Complimentary customer')
1813 return "You are not permitted to create complimentary accounts."
1816 $error = $self->ut_textn('payinfo');
1817 return "Illegal comp account issuer: ". $self->payinfo if $error;
1820 } elsif ( $self->payby eq 'PREPAY' ) {
1822 my $payinfo = $self->payinfo;
1823 $payinfo =~ s/\W//g; #anything else would just confuse things
1824 $self->payinfo($payinfo);
1825 $error = $self->ut_alpha('payinfo');
1826 return "Illegal prepayment identifier: ". $self->payinfo if $error;
1827 return "Unknown prepayment identifier"
1828 unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } );
1833 if ( $self->paydate eq '' || $self->paydate eq '-' ) {
1834 return "Expiration date required"
1835 unless $self->payby =~ /^(BILL|PREPAY|CHEK|DCHK|LECB|CASH|WEST|MCRD)$/;
1839 if ( $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/ ) {
1840 ( $m, $y ) = ( $1, length($2) == 4 ? $2 : "20$2" );
1841 } elsif ( $self->paydate =~ /^(20)?(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) {
1842 ( $m, $y ) = ( $3, "20$2" );
1844 return "Illegal expiration date: ". $self->paydate;
1846 $self->paydate("$y-$m-01");
1847 my($nowm,$nowy)=(localtime(time))[4,5]; $nowm++; $nowy+=1900;
1848 return gettext('expired_card')
1850 && !$ignore_expired_card
1851 && ( $y<$nowy || ( $y==$nowy && $1<$nowm ) );
1854 if ( $self->payname eq '' && $self->payby !~ /^(CHEK|DCHK)$/ &&
1855 ( ! $conf->exists('require_cardname')
1856 || $self->payby !~ /^(CARD|DCRD)$/ )
1858 $self->payname( $self->first. " ". $self->getfield('last') );
1860 $self->payname =~ /^([\w \,\.\-\'\&]+)$/
1861 or return gettext('illegal_name'). " payname: ". $self->payname;
1865 foreach my $flag (qw( tax spool_cdr squelch_cdr archived )) {
1866 $self->$flag() =~ /^(Y?)$/ or return "Illegal $flag: ". $self->$flag();
1870 $self->otaker(getotaker) unless $self->otaker;
1872 warn "$me check AFTER: \n". $self->_dump
1875 $self->SUPER::check;
1880 Returns a list of fields which have ship_ duplicates.
1885 qw( last first company
1886 address1 address2 city county state zip country
1891 =item has_ship_address
1893 Returns true if this customer record has a separate shipping address.
1897 sub has_ship_address {
1899 scalar( grep { $self->getfield("ship_$_") ne '' } $self->addr_fields );
1902 =item all_pkgs [ EXTRA_QSEARCH_PARAMS_HASHREF ]
1904 Returns all packages (see L<FS::cust_pkg>) for this customer.
1910 my $extra_qsearch = ref($_[0]) ? shift : {};
1912 return $self->num_pkgs unless wantarray || keys(%$extra_qsearch);
1915 if ( $self->{'_pkgnum'} ) {
1916 @cust_pkg = values %{ $self->{'_pkgnum'}->cache };
1918 @cust_pkg = $self->_cust_pkg($extra_qsearch);
1921 sort sort_packages @cust_pkg;
1926 Synonym for B<all_pkgs>.
1931 shift->all_pkgs(@_);
1936 Returns all locations (see L<FS::cust_location>) for this customer.
1942 qsearch('cust_location', { 'custnum' => $self->custnum } );
1945 =item ncancelled_pkgs [ EXTRA_QSEARCH_PARAMS_HASHREF ]
1947 Returns all non-cancelled packages (see L<FS::cust_pkg>) for this customer.
1951 sub ncancelled_pkgs {
1953 my $extra_qsearch = ref($_[0]) ? shift : {};
1955 return $self->num_ncancelled_pkgs unless wantarray;
1958 if ( $self->{'_pkgnum'} ) {
1960 warn "$me ncancelled_pkgs: returning cached objects"
1963 @cust_pkg = grep { ! $_->getfield('cancel') }
1964 values %{ $self->{'_pkgnum'}->cache };
1968 warn "$me ncancelled_pkgs: searching for packages with custnum ".
1969 $self->custnum. "\n"
1972 $extra_qsearch->{'extra_sql'} .= ' AND ( cancel IS NULL OR cancel = 0 ) ';
1974 @cust_pkg = $self->_cust_pkg($extra_qsearch);
1978 sort sort_packages @cust_pkg;
1984 my $extra_qsearch = ref($_[0]) ? shift : {};
1986 $extra_qsearch->{'select'} ||= '*';
1987 $extra_qsearch->{'select'} .=
1988 ',( SELECT COUNT(*) FROM cust_svc WHERE cust_pkg.pkgnum = cust_svc.pkgnum )
1992 $_->{'_num_cust_svc'} = $_->get('_num_cust_svc');
1997 'table' => 'cust_pkg',
1998 'hashref' => { 'custnum' => $self->custnum },
2003 # This should be generalized to use config options to determine order.
2006 if ( $a->get('cancel') xor $b->get('cancel') ) {
2007 return -1 if $b->get('cancel');
2008 return 1 if $a->get('cancel');
2009 #shouldn't get here...
2012 my $a_num_cust_svc = $a->num_cust_svc;
2013 my $b_num_cust_svc = $b->num_cust_svc;
2014 return 0 if !$a_num_cust_svc && !$b_num_cust_svc;
2015 return -1 if $a_num_cust_svc && !$b_num_cust_svc;
2016 return 1 if !$a_num_cust_svc && $b_num_cust_svc;
2017 my @a_cust_svc = $a->cust_svc;
2018 my @b_cust_svc = $b->cust_svc;
2019 $a_cust_svc[0]->svc_x->label cmp $b_cust_svc[0]->svc_x->label;
2024 =item suspended_pkgs
2026 Returns all suspended packages (see L<FS::cust_pkg>) for this customer.
2030 sub suspended_pkgs {
2032 grep { $_->susp } $self->ncancelled_pkgs;
2035 =item unflagged_suspended_pkgs
2037 Returns all unflagged suspended packages (see L<FS::cust_pkg>) for this
2038 customer (thouse packages without the `manual_flag' set).
2042 sub unflagged_suspended_pkgs {
2044 return $self->suspended_pkgs
2045 unless dbdef->table('cust_pkg')->column('manual_flag');
2046 grep { ! $_->manual_flag } $self->suspended_pkgs;
2049 =item unsuspended_pkgs
2051 Returns all unsuspended (and uncancelled) packages (see L<FS::cust_pkg>) for
2056 sub unsuspended_pkgs {
2058 grep { ! $_->susp } $self->ncancelled_pkgs;
2061 =item next_bill_date
2063 Returns the next date this customer will be billed, as a UNIX timestamp, or
2064 undef if no active package has a next bill date.
2068 sub next_bill_date {
2070 min( map $_->get('bill'), grep $_->get('bill'), $self->unsuspended_pkgs );
2073 =item num_cancelled_pkgs
2075 Returns the number of cancelled packages (see L<FS::cust_pkg>) for this
2080 sub num_cancelled_pkgs {
2081 shift->num_pkgs("cust_pkg.cancel IS NOT NULL AND cust_pkg.cancel != 0");
2084 sub num_ncancelled_pkgs {
2085 shift->num_pkgs("( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )");
2089 my( $self ) = shift;
2090 my $sql = scalar(@_) ? shift : '';
2091 $sql = "AND $sql" if $sql && $sql !~ /^\s*$/ && $sql !~ /^\s*AND/i;
2092 my $sth = dbh->prepare(
2093 "SELECT COUNT(*) FROM cust_pkg WHERE custnum = ? $sql"
2094 ) or die dbh->errstr;
2095 $sth->execute($self->custnum) or die $sth->errstr;
2096 $sth->fetchrow_arrayref->[0];
2101 Unsuspends all unflagged suspended packages (see L</unflagged_suspended_pkgs>
2102 and L<FS::cust_pkg>) for this customer. Always returns a list: an empty list
2103 on success or a list of errors.
2109 grep { $_->unsuspend } $self->suspended_pkgs;
2114 Suspends all unsuspended packages (see L<FS::cust_pkg>) for this customer.
2116 Returns a list: an empty list on success or a list of errors.
2122 grep { $_->suspend(@_) } $self->unsuspended_pkgs;
2125 =item suspend_if_pkgpart HASHREF | PKGPART [ , PKGPART ... ]
2127 Suspends all unsuspended packages (see L<FS::cust_pkg>) matching the listed
2128 PKGPARTs (see L<FS::part_pkg>). Preferred usage is to pass a hashref instead
2129 of a list of pkgparts; the hashref has the following keys:
2133 =item pkgparts - listref of pkgparts
2135 =item (other options are passed to the suspend method)
2140 Returns a list: an empty list on success or a list of errors.
2144 sub suspend_if_pkgpart {
2146 my (@pkgparts, %opt);
2147 if (ref($_[0]) eq 'HASH'){
2148 @pkgparts = @{$_[0]{pkgparts}};
2153 grep { $_->suspend(%opt) }
2154 grep { my $pkgpart = $_->pkgpart; grep { $pkgpart eq $_ } @pkgparts }
2155 $self->unsuspended_pkgs;
2158 =item suspend_unless_pkgpart HASHREF | PKGPART [ , PKGPART ... ]
2160 Suspends all unsuspended packages (see L<FS::cust_pkg>) unless they match the
2161 given PKGPARTs (see L<FS::part_pkg>). Preferred usage is to pass a hashref
2162 instead of a list of pkgparts; the hashref has the following keys:
2166 =item pkgparts - listref of pkgparts
2168 =item (other options are passed to the suspend method)
2172 Returns a list: an empty list on success or a list of errors.
2176 sub suspend_unless_pkgpart {
2178 my (@pkgparts, %opt);
2179 if (ref($_[0]) eq 'HASH'){
2180 @pkgparts = @{$_[0]{pkgparts}};
2185 grep { $_->suspend(%opt) }
2186 grep { my $pkgpart = $_->pkgpart; ! grep { $pkgpart eq $_ } @pkgparts }
2187 $self->unsuspended_pkgs;
2190 =item cancel [ OPTION => VALUE ... ]
2192 Cancels all uncancelled packages (see L<FS::cust_pkg>) for this customer.
2194 Available options are:
2198 =item quiet - can be set true to supress email cancellation notices.
2200 =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.
2202 =item ban - can be set true to ban this customer's credit card or ACH information, if present.
2204 =item nobill - can be set true to skip billing if it might otherwise be done.
2208 Always returns a list: an empty list on success or a list of errors.
2212 # nb that dates are not specified as valid options to this method
2215 my( $self, %opt ) = @_;
2217 warn "$me cancel called on customer ". $self->custnum. " with options ".
2218 join(', ', map { "$_: $opt{$_}" } keys %opt ). "\n"
2221 return ( 'access denied' )
2222 unless $FS::CurrentUser::CurrentUser->access_right('Cancel customer');
2224 if ( $opt{'ban'} && $self->payby =~ /^(CARD|DCRD|CHEK|DCHK)$/ ) {
2226 #should try decryption (we might have the private key)
2227 # and if not maybe queue a job for the server that does?
2228 return ( "Can't (yet) ban encrypted credit cards" )
2229 if $self->is_encrypted($self->payinfo);
2231 my $ban = new FS::banned_pay $self->_banned_pay_hashref;
2232 my $error = $ban->insert;
2233 return ( $error ) if $error;
2237 my @pkgs = $self->ncancelled_pkgs;
2239 if ( !$opt{nobill} && $conf->exists('bill_usage_on_cancel') ) {
2241 my $error = $self->bill( pkg_list => [ @pkgs ], cancel => 1 );
2242 warn "Error billing during cancel, custnum ". $self->custnum. ": $error"
2246 warn "$me cancelling ". scalar($self->ncancelled_pkgs). "/".
2247 scalar(@pkgs). " packages for customer ". $self->custnum. "\n"
2250 grep { $_ } map { $_->cancel(%opt) } $self->ncancelled_pkgs;
2253 sub _banned_pay_hashref {
2264 'payby' => $payby2ban{$self->payby},
2265 'payinfo' => md5_base64($self->payinfo),
2266 #don't ever *search* on reason! #'reason' =>
2272 Returns all notes (see L<FS::cust_main_note>) for this customer.
2279 qsearch( 'cust_main_note',
2280 { 'custnum' => $self->custnum },
2282 'ORDER BY _DATE DESC'
2288 Returns the agent (see L<FS::agent>) for this customer.
2294 qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
2297 =item bill_and_collect
2299 Cancels and suspends any packages due, generates bills, applies payments and
2302 Warns on errors (Does not currently: If there is an error, returns the error, otherwise returns false.)
2304 Options are passed as name-value pairs. Currently available options are:
2310 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:
2314 $cust_main->bill( 'time' => str2time('April 20th, 2001') );
2318 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.
2322 "1d" for the traditional, daily events (the default), or "1m" for the new monthly events (part_event.check_freq)
2326 If set true, re-charges setup fees.
2330 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)
2336 sub bill_and_collect {
2337 my( $self, %options ) = @_;
2339 #$options{actual_time} not $options{time} because freeside-daily -d is for
2340 #pre-printing invoices
2341 $self->cancel_expired_pkgs( $options{actual_time} );
2342 $self->suspend_adjourned_pkgs( $options{actual_time} );
2344 my $error = $self->bill( %options );
2345 warn "Error billing, custnum ". $self->custnum. ": $error" if $error;
2347 $self->apply_payments_and_credits;
2349 unless ( $conf->exists('cancelled_cust-noevents')
2350 && ! $self->num_ncancelled_pkgs
2353 $error = $self->collect( %options );
2354 warn "Error collecting, custnum". $self->custnum. ": $error" if $error;
2360 sub cancel_expired_pkgs {
2361 my ( $self, $time ) = @_;
2363 my @cancel_pkgs = $self->ncancelled_pkgs( {
2364 'extra_sql' => " AND expire IS NOT NULL AND expire > 0 AND expire <= $time "
2367 foreach my $cust_pkg ( @cancel_pkgs ) {
2368 my $cpr = $cust_pkg->last_cust_pkg_reason('expire');
2369 my $error = $cust_pkg->cancel($cpr ? ( 'reason' => $cpr->reasonnum,
2370 'reason_otaker' => $cpr->otaker
2374 warn "Error cancelling expired pkg ". $cust_pkg->pkgnum.
2375 " for custnum ". $self->custnum. ": $error"
2381 sub suspend_adjourned_pkgs {
2382 my ( $self, $time ) = @_;
2384 my @susp_pkgs = $self->ncancelled_pkgs( {
2386 " AND ( susp IS NULL OR susp = 0 )
2387 AND ( ( bill IS NOT NULL AND bill != 0 AND bill < $time )
2388 OR ( adjourn IS NOT NULL AND adjourn != 0 AND adjourn <= $time )
2393 #only because there's no SQL test for is_prepaid :/
2395 grep { ( $_->part_pkg->is_prepaid
2400 && $_->adjourn <= $time
2406 foreach my $cust_pkg ( @susp_pkgs ) {
2407 my $cpr = $cust_pkg->last_cust_pkg_reason('adjourn')
2408 if ($cust_pkg->adjourn && $cust_pkg->adjourn < $^T);
2409 my $error = $cust_pkg->suspend($cpr ? ( 'reason' => $cpr->reasonnum,
2410 'reason_otaker' => $cpr->otaker
2415 warn "Error suspending package ". $cust_pkg->pkgnum.
2416 " for custnum ". $self->custnum. ": $error"
2424 Generates invoices (see L<FS::cust_bill>) for this customer. Usually used in
2425 conjunction with the collect method by calling B<bill_and_collect>.
2427 If there is an error, returns the error, otherwise returns false.
2429 Options are passed as name-value pairs. Currently available options are:
2435 If set true, re-charges setup fees.
2439 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:
2443 $cust_main->bill( 'time' => str2time('April 20th, 2001') );
2447 An array ref of specific packages (objects) to attempt billing, instead trying all of them.
2449 $cust_main->bill( pkg_list => [$pkg1, $pkg2] );
2453 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.
2457 This boolean value informs the us that the package is being cancelled. This
2458 typically might mean not charging the normal recurring fee but only usage
2459 fees since the last billing. Setup charges may be charged. Not all package
2460 plans support this feature (they tend to charge 0).
2467 my( $self, %options ) = @_;
2468 return '' if $self->payby eq 'COMP';
2469 warn "$me bill customer ". $self->custnum. "\n"
2472 my $time = $options{'time'} || time;
2473 my $invoice_time = $options{'invoice_time'} || $time;
2476 local $SIG{HUP} = 'IGNORE';
2477 local $SIG{INT} = 'IGNORE';
2478 local $SIG{QUIT} = 'IGNORE';
2479 local $SIG{TERM} = 'IGNORE';
2480 local $SIG{TSTP} = 'IGNORE';
2481 local $SIG{PIPE} = 'IGNORE';
2483 my $oldAutoCommit = $FS::UID::AutoCommit;
2484 local $FS::UID::AutoCommit = 0;
2487 $self->select_for_update; #mutex
2489 my @cust_bill_pkg = ();
2492 # find the packages which are due for billing, find out how much they are
2493 # & generate invoice database.
2496 my( $total_setup, $total_recur, $postal_charge ) = ( 0, 0, 0 );
2498 my @precommit_hooks = ();
2500 $options{ pkg_list } ||= [ $self->ncancelled_pkgs ]; #param checks?
2501 foreach my $cust_pkg ( @{ $options{ pkg_list } } ) {
2503 warn " bill package ". $cust_pkg->pkgnum. "\n" if $DEBUG > 1;
2505 #? to avoid use of uninitialized value errors... ?
2506 $cust_pkg->setfield('bill', '')
2507 unless defined($cust_pkg->bill);
2509 #my $part_pkg = $cust_pkg->part_pkg;
2511 my $real_pkgpart = $cust_pkg->pkgpart;
2512 my %hash = $cust_pkg->hash;
2514 foreach my $part_pkg ( $cust_pkg->part_pkg->self_and_bill_linked ) {
2516 $cust_pkg->set($_, $hash{$_}) foreach qw ( setup last_bill bill );
2519 $self->_make_lines( 'part_pkg' => $part_pkg,
2520 'cust_pkg' => $cust_pkg,
2521 'precommit_hooks' => \@precommit_hooks,
2522 'line_items' => \@cust_bill_pkg,
2523 'setup' => \$total_setup,
2524 'recur' => \$total_recur,
2525 'tax_matrix' => \%taxlisthash,
2527 'options' => \%options,
2530 $dbh->rollback if $oldAutoCommit;
2534 } #foreach my $part_pkg
2536 } #foreach my $cust_pkg
2538 unless ( @cust_bill_pkg ) { #don't create an invoice w/o line items
2539 #but do commit any package date cycling that happened
2540 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2544 if ( scalar( grep { $_->recur && $_->recur > 0 } @cust_bill_pkg) ||
2545 !$conf->exists('postal_invoice-recurring_only')
2549 my $postal_pkg = $self->charge_postal_fee();
2550 if ( $postal_pkg && !ref( $postal_pkg ) ) {
2552 $dbh->rollback if $oldAutoCommit;
2553 return "can't charge postal invoice fee for customer ".
2554 $self->custnum. ": $postal_pkg";
2556 } elsif ( $postal_pkg ) {
2558 foreach my $part_pkg ( $postal_pkg->part_pkg->self_and_bill_linked ) {
2559 my %postal_options = %options;
2560 delete $postal_options{cancel};
2562 $self->_make_lines( 'part_pkg' => $part_pkg,
2563 'cust_pkg' => $postal_pkg,
2564 'precommit_hooks' => \@precommit_hooks,
2565 'line_items' => \@cust_bill_pkg,
2566 'setup' => \$total_setup,
2567 'recur' => \$total_recur,
2568 'tax_matrix' => \%taxlisthash,
2570 'options' => \%postal_options,
2573 $dbh->rollback if $oldAutoCommit;
2582 warn "having a look at the taxes we found...\n" if $DEBUG > 2;
2584 # keys are tax names (as printed on invoices / itemdesc )
2585 # values are listrefs of taxlisthash keys (internal identifiers)
2588 # keys are taxlisthash keys (internal identifiers)
2589 # values are (cumulative) amounts
2592 # keys are taxlisthash keys (internal identifiers)
2593 # values are listrefs of cust_bill_pkg_tax_location hashrefs
2594 my %tax_location = ();
2596 # keys are taxlisthash keys (internal identifiers)
2597 # values are listrefs of cust_bill_pkg_tax_rate_location hashrefs
2598 my %tax_rate_location = ();
2600 foreach my $tax ( keys %taxlisthash ) {
2601 my $tax_object = shift @{ $taxlisthash{$tax} };
2602 warn "found ". $tax_object->taxname. " as $tax\n" if $DEBUG > 2;
2603 warn " ". join('/', @{ $taxlisthash{$tax} } ). "\n" if $DEBUG > 2;
2604 my $hashref_or_error =
2605 $tax_object->taxline( $taxlisthash{$tax},
2606 'custnum' => $self->custnum,
2607 'invoice_time' => $invoice_time
2609 unless ( ref($hashref_or_error) ) {
2610 $dbh->rollback if $oldAutoCommit;
2611 return $hashref_or_error;
2613 unshift @{ $taxlisthash{$tax} }, $tax_object;
2615 my $name = $hashref_or_error->{'name'};
2616 my $amount = $hashref_or_error->{'amount'};
2618 #warn "adding $amount as $name\n";
2619 $taxname{ $name } ||= [];
2620 push @{ $taxname{ $name } }, $tax;
2622 $tax{ $tax } += $amount;
2624 $tax_location{ $tax } ||= [];
2625 if ( $tax_object->get('pkgnum') || $tax_object->get('locationnum') ) {
2626 push @{ $tax_location{ $tax } },
2628 'taxnum' => $tax_object->taxnum,
2629 'taxtype' => ref($tax_object),
2630 'pkgnum' => $tax_object->get('pkgnum'),
2631 'locationnum' => $tax_object->get('locationnum'),
2632 'amount' => sprintf('%.2f', $amount ),
2636 $tax_rate_location{ $tax } ||= [];
2637 if ( ref($tax_object) eq 'FS::tax_rate' ) {
2638 my $taxratelocationnum =
2639 $tax_object->tax_rate_location->taxratelocationnum;
2640 push @{ $tax_rate_location{ $tax } },
2642 'taxnum' => $tax_object->taxnum,
2643 'taxtype' => ref($tax_object),
2644 'amount' => sprintf('%.2f', $amount ),
2645 'locationtaxid' => $tax_object->location,
2646 'taxratelocationnum' => $taxratelocationnum,
2652 #move the cust_tax_exempt_pkg records to the cust_bill_pkgs we will commit
2653 my %packagemap = map { $_->pkgnum => $_ } @cust_bill_pkg;
2654 foreach my $tax ( keys %taxlisthash ) {
2655 foreach ( @{ $taxlisthash{$tax} }[1 ... scalar(@{ $taxlisthash{$tax} })] ) {
2656 next unless ref($_) eq 'FS::cust_bill_pkg';
2658 push @{ $packagemap{$_->pkgnum}->_cust_tax_exempt_pkg },
2659 splice( @{ $_->_cust_tax_exempt_pkg } );
2663 #consolidate and create tax line items
2664 warn "consolidating and generating...\n" if $DEBUG > 2;
2665 foreach my $taxname ( keys %taxname ) {
2668 my @cust_bill_pkg_tax_location = ();
2669 my @cust_bill_pkg_tax_rate_location = ();
2670 warn "adding $taxname\n" if $DEBUG > 1;
2671 foreach my $taxitem ( @{ $taxname{$taxname} } ) {
2672 next if $seen{$taxitem}++;
2673 warn "adding $tax{$taxitem}\n" if $DEBUG > 1;
2674 $tax += $tax{$taxitem};
2675 push @cust_bill_pkg_tax_location,
2676 map { new FS::cust_bill_pkg_tax_location $_ }
2677 @{ $tax_location{ $taxitem } };
2678 push @cust_bill_pkg_tax_rate_location,
2679 map { new FS::cust_bill_pkg_tax_rate_location $_ }
2680 @{ $tax_rate_location{ $taxitem } };
2684 $tax = sprintf('%.2f', $tax );
2685 $total_setup = sprintf('%.2f', $total_setup+$tax );
2687 push @cust_bill_pkg, new FS::cust_bill_pkg {
2693 'itemdesc' => $taxname,
2694 'cust_bill_pkg_tax_location' => \@cust_bill_pkg_tax_location,
2695 'cust_bill_pkg_tax_rate_location' => \@cust_bill_pkg_tax_rate_location,
2700 #add tax adjustments
2701 warn "adding tax adjustments...\n" if $DEBUG > 2;
2702 foreach my $cust_tax_adjustment (
2703 qsearch('cust_tax_adjustment', { 'custnum' => $self->custnum,
2709 my $tax = sprintf('%.2f', $cust_tax_adjustment->amount );
2710 $total_setup = sprintf('%.2f', $total_setup+$tax );
2712 my $itemdesc = $cust_tax_adjustment->taxname;
2713 $itemdesc = '' if $itemdesc eq 'Tax';
2715 push @cust_bill_pkg, new FS::cust_bill_pkg {
2721 'itemdesc' => $itemdesc,
2722 'itemcomment' => $cust_tax_adjustment->comment,
2723 'cust_tax_adjustment' => $cust_tax_adjustment,
2724 #'cust_bill_pkg_tax_location' => \@cust_bill_pkg_tax_location,
2729 my $charged = sprintf('%.2f', $total_setup + $total_recur );
2731 #create the new invoice
2732 my $cust_bill = new FS::cust_bill ( {
2733 'custnum' => $self->custnum,
2734 '_date' => ( $invoice_time ),
2735 'charged' => $charged,
2737 my $error = $cust_bill->insert;
2739 $dbh->rollback if $oldAutoCommit;
2740 return "can't create invoice for customer #". $self->custnum. ": $error";
2743 foreach my $cust_bill_pkg ( @cust_bill_pkg ) {
2744 $cust_bill_pkg->invnum($cust_bill->invnum);
2745 my $error = $cust_bill_pkg->insert;
2747 $dbh->rollback if $oldAutoCommit;
2748 return "can't create invoice line item: $error";
2753 foreach my $hook ( @precommit_hooks ) {
2755 &{$hook}; #($self) ?
2758 $dbh->rollback if $oldAutoCommit;
2759 return "$@ running precommit hook $hook\n";
2763 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2769 my ($self, %params) = @_;
2771 my $part_pkg = $params{part_pkg} or die "no part_pkg specified";
2772 my $cust_pkg = $params{cust_pkg} or die "no cust_pkg specified";
2773 my $precommit_hooks = $params{precommit_hooks} or die "no package specified";
2774 my $cust_bill_pkgs = $params{line_items} or die "no line buffer specified";
2775 my $total_setup = $params{setup} or die "no setup accumulator specified";
2776 my $total_recur = $params{recur} or die "no recur accumulator specified";
2777 my $taxlisthash = $params{tax_matrix} or die "no tax accumulator specified";
2778 my $time = $params{'time'} or die "no time specified";
2779 my (%options) = %{$params{options}};
2782 my $real_pkgpart = $cust_pkg->pkgpart;
2783 my %hash = $cust_pkg->hash;
2784 my $old_cust_pkg = new FS::cust_pkg \%hash;
2790 $cust_pkg->pkgpart($part_pkg->pkgpart);
2798 if ( $options{'resetup'}
2799 || ( ! $cust_pkg->setup
2800 && ( ! $cust_pkg->start_date
2801 || $cust_pkg->start_date <= $time
2803 && ( ! $conf->exists('disable_setup_suspended_pkgs')
2804 || ( $conf->exists('disable_setup_suspended_pkgs') &&
2805 ! $cust_pkg->getfield('susp')
2812 warn " bill setup\n" if $DEBUG > 1;
2815 $setup = eval { $cust_pkg->calc_setup( $time, \@details ) };
2816 return "$@ running calc_setup for $cust_pkg\n"
2819 $unitsetup = $cust_pkg->part_pkg->unit_setup || $setup; #XXX uuh
2821 $cust_pkg->setfield('setup', $time)
2822 unless $cust_pkg->setup;
2823 #do need it, but it won't get written to the db
2824 #|| $cust_pkg->pkgpart != $real_pkgpart;
2826 $cust_pkg->setfield('start_date', '')
2827 if $cust_pkg->start_date;
2832 # bill recurring fee
2835 #XXX unit stuff here too
2839 if ( ! $cust_pkg->getfield('susp') and
2840 ( $part_pkg->getfield('freq') ne '0' &&
2841 ( $cust_pkg->getfield('bill') || 0 ) <= $time
2843 || ( $part_pkg->plan eq 'voip_cdr'
2844 && $part_pkg->option('bill_every_call')
2846 || ( $options{cancel} )
2849 # XXX should this be a package event? probably. events are called
2850 # at collection time at the moment, though...
2851 $part_pkg->reset_usage($cust_pkg, 'debug'=>$DEBUG)
2852 if $part_pkg->can('reset_usage');
2853 #don't want to reset usage just cause we want a line item??
2854 #&& $part_pkg->pkgpart == $real_pkgpart;
2856 warn " bill recur\n" if $DEBUG > 1;
2859 # XXX shared with $recur_prog
2860 $sdate = ( $options{cancel} ? $cust_pkg->last_bill : $cust_pkg->bill )
2864 #over two params! lets at least switch to a hashref for the rest...
2865 my $increment_next_bill = ( $part_pkg->freq ne '0'
2866 && ( $cust_pkg->getfield('bill') || 0 ) <= $time
2867 && !$options{cancel}
2869 my %param = ( 'precommit_hooks' => $precommit_hooks,
2870 'increment_next_bill' => $increment_next_bill,
2873 my $method = $options{cancel} ? 'calc_cancel' : 'calc_recur';
2874 $recur = eval { $cust_pkg->$method( \$sdate, \@details, \%param ) };
2875 return "$@ running $method for $cust_pkg\n"
2878 if ( $increment_next_bill ) {
2880 my $next_bill = $part_pkg->add_freq($sdate);
2881 return "unparsable frequency: ". $part_pkg->freq
2882 if $next_bill == -1;
2884 #pro-rating magic - if $recur_prog fiddled $sdate, want to use that
2885 # only for figuring next bill date, nothing else, so, reset $sdate again
2887 $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
2888 #no need, its in $hash{last_bill}# my $last_bill = $cust_pkg->last_bill;
2889 $cust_pkg->last_bill($sdate);
2891 $cust_pkg->setfield('bill', $next_bill );
2897 warn "\$setup is undefined" unless defined($setup);
2898 warn "\$recur is undefined" unless defined($recur);
2899 warn "\$cust_pkg->bill is undefined" unless defined($cust_pkg->bill);
2902 # If there's line items, create em cust_bill_pkg records
2903 # If $cust_pkg has been modified, update it (if we're a real pkgpart)
2908 if ( $cust_pkg->modified && $cust_pkg->pkgpart == $real_pkgpart ) {
2909 # hmm.. and if just the options are modified in some weird price plan?
2911 warn " package ". $cust_pkg->pkgnum. " modified; updating\n"
2914 my $error = $cust_pkg->replace( $old_cust_pkg,
2915 'options' => { $cust_pkg->options },
2917 return "Error modifying pkgnum ". $cust_pkg->pkgnum. ": $error"
2918 if $error; #just in case
2921 $setup = sprintf( "%.2f", $setup );
2922 $recur = sprintf( "%.2f", $recur );
2923 if ( $setup < 0 && ! $conf->exists('allow_negative_charges') ) {
2924 return "negative setup $setup for pkgnum ". $cust_pkg->pkgnum;
2926 if ( $recur < 0 && ! $conf->exists('allow_negative_charges') ) {
2927 return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum;
2930 if ( $setup != 0 || $recur != 0 ) {
2932 warn " charges (setup=$setup, recur=$recur); adding line items\n"
2935 my @cust_pkg_detail = map { $_->detail } $cust_pkg->cust_pkg_detail('I');
2937 warn " adding customer package invoice detail: $_\n"
2938 foreach @cust_pkg_detail;
2940 push @details, @cust_pkg_detail;
2942 my $cust_bill_pkg = new FS::cust_bill_pkg {
2943 'pkgnum' => $cust_pkg->pkgnum,
2945 'unitsetup' => $unitsetup,
2947 'unitrecur' => $unitrecur,
2948 'quantity' => $cust_pkg->quantity,
2949 'details' => \@details,
2952 if ( $part_pkg->option('recur_temporality', 1) eq 'preceding' ) {
2953 $cust_bill_pkg->sdate( $hash{last_bill} );
2954 $cust_bill_pkg->edate( $sdate - 86399 ); #60s*60m*24h-1
2955 $cust_bill_pkg->edate( $time ) if $options{cancel};
2956 } else { #if ( $part_pkg->option('recur_temporality', 1) eq 'upcoming' ) {
2957 $cust_bill_pkg->sdate( $sdate );
2958 $cust_bill_pkg->edate( $cust_pkg->bill );
2959 #$cust_bill_pkg->edate( $time ) if $options{cancel};
2962 $cust_bill_pkg->pkgpart_override($part_pkg->pkgpart)
2963 unless $part_pkg->pkgpart == $real_pkgpart;
2965 $$total_setup += $setup;
2966 $$total_recur += $recur;
2973 $self->_handle_taxes($part_pkg, $taxlisthash, $cust_bill_pkg, $cust_pkg, $options{invoice_time});
2974 return $error if $error;
2976 push @$cust_bill_pkgs, $cust_bill_pkg;
2978 } #if $setup != 0 || $recur != 0
2988 my $part_pkg = shift;
2989 my $taxlisthash = shift;
2990 my $cust_bill_pkg = shift;
2991 my $cust_pkg = shift;
2992 my $invoice_time = shift;
2994 my %cust_bill_pkg = ();
2998 #push @classes, $cust_bill_pkg->usage_classes if $cust_bill_pkg->type eq 'U';
2999 push @classes, $cust_bill_pkg->usage_classes if $cust_bill_pkg->usage;
3000 push @classes, 'setup' if $cust_bill_pkg->setup;
3001 push @classes, 'recur' if $cust_bill_pkg->recur;
3003 if ( $self->tax !~ /Y/i && $self->payby ne 'COMP' ) {
3005 if ( $conf->exists('enable_taxproducts')
3006 && ( scalar($part_pkg->part_pkg_taxoverride)
3007 || $part_pkg->has_taxproduct
3012 if ( $conf->exists('tax-pkg_address') && $cust_pkg->locationnum ) {
3013 return "fatal: Can't (yet) use tax-pkg_address with taxproducts";
3016 foreach my $class (@classes) {
3017 my $err_or_ref = $self->_gather_taxes( $part_pkg, $class );
3018 return $err_or_ref unless ref($err_or_ref);
3019 $taxes{$class} = $err_or_ref;
3022 unless (exists $taxes{''}) {
3023 my $err_or_ref = $self->_gather_taxes( $part_pkg, '' );
3024 return $err_or_ref unless ref($err_or_ref);
3025 $taxes{''} = $err_or_ref;
3030 my @loc_keys = qw( state county country );
3032 if ( $conf->exists('tax-pkg_address') && $cust_pkg->locationnum ) {
3033 my $cust_location = $cust_pkg->cust_location;
3034 %taxhash = map { $_ => $cust_location->$_() } @loc_keys;
3037 ( $conf->exists('tax-ship_address') && length($self->ship_last) )
3040 %taxhash = map { $_ => $self->get("$prefix$_") } @loc_keys;
3043 $taxhash{'taxclass'} = $part_pkg->taxclass;
3045 my @taxes = qsearch( 'cust_main_county', \%taxhash );
3047 my %taxhash_elim = %taxhash;
3049 my @elim = qw( taxclass county state );
3050 while ( !scalar(@taxes) && scalar(@elim) ) {
3051 $taxhash_elim{ shift(@elim) } = '';
3052 @taxes = qsearch( 'cust_main_county', \%taxhash_elim );
3055 @taxes = grep { ! $_->taxname or ! $self->tax_exemption($_->taxname) }
3057 if $self->cust_main_exemption; #just to be safe
3059 if ( $conf->exists('tax-pkg_address') && $cust_pkg->locationnum ) {
3061 $_->set('pkgnum', $cust_pkg->pkgnum );
3062 $_->set('locationnum', $cust_pkg->locationnum );
3066 $taxes{''} = [ @taxes ];
3067 $taxes{'setup'} = [ @taxes ];
3068 $taxes{'recur'} = [ @taxes ];
3069 $taxes{$_} = [ @taxes ] foreach (@classes);
3071 # # maybe eliminate this entirely, along with all the 0% records
3072 # unless ( @taxes ) {
3074 # "fatal: can't find tax rate for state/county/country/taxclass ".
3075 # join('/', map $taxhash{$_}, qw(state county country taxclass) );
3078 } #if $conf->exists('enable_taxproducts') ...
3083 if ( $conf->exists('separate_usage') ) {
3084 my $section = $cust_pkg->part_pkg->option('usage_section', 'Hush!');
3085 my $summary = $cust_pkg->part_pkg->option('summarize_usage', 'Hush!');
3086 push @display, new FS::cust_bill_pkg_display { type => 'S' };
3087 push @display, new FS::cust_bill_pkg_display { type => 'R' };
3088 push @display, new FS::cust_bill_pkg_display { type => 'U',
3091 if ($section && $summary) {
3092 $display[2]->post_total('Y');
3093 push @display, new FS::cust_bill_pkg_display { type => 'U',
3098 $cust_bill_pkg->set('display', \@display);
3100 my %tax_cust_bill_pkg = $cust_bill_pkg->disintegrate;
3101 foreach my $key (keys %tax_cust_bill_pkg) {
3102 my @taxes = @{ $taxes{$key} || [] };
3103 my $tax_cust_bill_pkg = $tax_cust_bill_pkg{$key};
3105 my %localtaxlisthash = ();
3106 foreach my $tax ( @taxes ) {
3108 my $taxname = ref( $tax ). ' '. $tax->taxnum;
3109 # $taxname .= ' pkgnum'. $cust_pkg->pkgnum.
3110 # ' locationnum'. $cust_pkg->locationnum
3111 # if $conf->exists('tax-pkg_address') && $cust_pkg->locationnum;
3113 $taxlisthash->{ $taxname } ||= [ $tax ];
3114 push @{ $taxlisthash->{ $taxname } }, $tax_cust_bill_pkg;
3116 $localtaxlisthash{ $taxname } ||= [ $tax ];
3117 push @{ $localtaxlisthash{ $taxname } }, $tax_cust_bill_pkg;
3121 warn "finding taxed taxes...\n" if $DEBUG > 2;
3122 foreach my $tax ( keys %localtaxlisthash ) {
3123 my $tax_object = shift @{ $localtaxlisthash{$tax} };
3124 warn "found possible taxed tax ". $tax_object->taxname. " we call $tax\n"
3126 next unless $tax_object->can('tax_on_tax');
3128 foreach my $tot ( $tax_object->tax_on_tax( $self ) ) {
3129 my $totname = ref( $tot ). ' '. $tot->taxnum;
3131 warn "checking $totname which we call ". $tot->taxname. " as applicable\n"
3133 next unless exists( $localtaxlisthash{ $totname } ); # only increase
3135 warn "adding $totname to taxed taxes\n" if $DEBUG > 2;
3136 my $hashref_or_error =
3137 $tax_object->taxline( $localtaxlisthash{$tax},
3138 'custnum' => $self->custnum,
3139 'invoice_time' => $invoice_time,
3141 return $hashref_or_error
3142 unless ref($hashref_or_error);
3144 $taxlisthash->{ $totname } ||= [ $tot ];
3145 push @{ $taxlisthash->{ $totname } }, $hashref_or_error->{amount};
3157 my $part_pkg = shift;
3161 my $geocode = $self->geocode('cch');
3163 my @taxclassnums = map { $_->taxclassnum }
3164 $part_pkg->part_pkg_taxoverride($class);
3166 unless (@taxclassnums) {
3167 @taxclassnums = map { $_->taxclassnum }
3168 grep { $_->taxable eq 'Y' }
3169 $part_pkg->part_pkg_taxrate('cch', $geocode, $class);
3171 warn "Found taxclassnum values of ". join(',', @taxclassnums)
3176 join(' OR ', map { "taxclassnum = $_" } @taxclassnums ). ")";
3178 @taxes = qsearch({ 'table' => 'tax_rate',
3179 'hashref' => { 'geocode' => $geocode, },
3180 'extra_sql' => $extra_sql,
3182 if scalar(@taxclassnums);
3184 warn "Found taxes ".
3185 join(',', map{ ref($_). " ". $_->get($_->primary_key) } @taxes). "\n"
3192 =item collect OPTIONS
3194 (Attempt to) collect money for this customer's outstanding invoices (see
3195 L<FS::cust_bill>). Usually used after the bill method.
3197 Actions are now triggered by billing events; see L<FS::part_event> and the
3198 billing events web interface. Old-style invoice events (see
3199 L<FS::part_bill_event>) have been deprecated.
3201 If there is an error, returns the error, otherwise returns false.
3203 Options are passed as name-value pairs.
3205 Currently available options are:
3211 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.
3215 Retry card/echeck/LEC transactions even when not scheduled by invoice events.
3219 set true to surpress email card/ACH decline notices.
3223 "1d" for the traditional, daily events (the default), or "1m" for the new monthly events (part_event.check_freq)
3227 allows for one time override of normal customer billing method
3231 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)
3239 my( $self, %options ) = @_;
3240 my $invoice_time = $options{'invoice_time'} || time;
3243 local $SIG{HUP} = 'IGNORE';
3244 local $SIG{INT} = 'IGNORE';
3245 local $SIG{QUIT} = 'IGNORE';
3246 local $SIG{TERM} = 'IGNORE';
3247 local $SIG{TSTP} = 'IGNORE';
3248 local $SIG{PIPE} = 'IGNORE';
3250 my $oldAutoCommit = $FS::UID::AutoCommit;
3251 local $FS::UID::AutoCommit = 0;
3254 $self->select_for_update; #mutex
3257 my $balance = $self->balance;
3258 warn "$me collect customer ". $self->custnum. ": balance $balance\n"
3261 if ( exists($options{'retry_card'}) ) {
3262 carp 'retry_card option passed to collect is deprecated; use retry';
3263 $options{'retry'} ||= $options{'retry_card'};
3265 if ( exists($options{'retry'}) && $options{'retry'} ) {
3266 my $error = $self->retry_realtime;
3268 $dbh->rollback if $oldAutoCommit;
3273 # false laziness w/pay_batch::import_results
3275 my $due_cust_event = $self->due_cust_event(
3276 'debug' => ( $options{'debug'} || 0 ),
3277 'time' => $invoice_time,
3278 'check_freq' => $options{'check_freq'},
3280 unless( ref($due_cust_event) ) {
3281 $dbh->rollback if $oldAutoCommit;
3282 return $due_cust_event;
3285 foreach my $cust_event ( @$due_cust_event ) {
3289 #re-eval event conditions (a previous event could have changed things)
3290 unless ( $cust_event->test_conditions( 'time' => $invoice_time ) ) {
3291 #don't leave stray "new/locked" records around
3292 my $error = $cust_event->delete;
3294 #gah, even with transactions
3295 $dbh->commit if $oldAutoCommit; #well.
3302 local $realtime_bop_decline_quiet = 1 if $options{'quiet'};
3303 warn " running cust_event ". $cust_event->eventnum. "\n"
3307 #if ( my $error = $cust_event->do_event(%options) ) { #XXX %options?
3308 if ( my $error = $cust_event->do_event() ) {
3309 #XXX wtf is this? figure out a proper dealio with return value
3311 # gah, even with transactions.
3312 $dbh->commit if $oldAutoCommit; #well.
3319 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3324 =item due_cust_event [ HASHREF | OPTION => VALUE ... ]
3326 Inserts database records for and returns an ordered listref of new events due
3327 for this customer, as FS::cust_event objects (see L<FS::cust_event>). If no
3328 events are due, an empty listref is returned. If there is an error, returns a
3329 scalar error message.
3331 To actually run the events, call each event's test_condition method, and if
3332 still true, call the event's do_event method.
3334 Options are passed as a hashref or as a list of name-value pairs. Available
3341 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.
3345 "Current time" for the events.
3349 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)
3353 Only return events for the specified eventtable (by default, events of all eventtables are returned)
3357 Explicitly pass the objects to be tested (typically used with eventtable).
3361 Set to true to return the objects, but not actually insert them into the
3368 sub due_cust_event {
3370 my %opt = ref($_[0]) ? %{ $_[0] } : @_;
3373 #my $DEBUG = $opt{'debug'}
3374 local($DEBUG) = $opt{'debug'}
3375 if defined($opt{'debug'}) && $opt{'debug'} > $DEBUG;
3377 warn "$me due_cust_event called with options ".
3378 join(', ', map { "$_: $opt{$_}" } keys %opt). "\n"
3381 $opt{'time'} ||= time;
3383 local $SIG{HUP} = 'IGNORE';
3384 local $SIG{INT} = 'IGNORE';
3385 local $SIG{QUIT} = 'IGNORE';
3386 local $SIG{TERM} = 'IGNORE';
3387 local $SIG{TSTP} = 'IGNORE';
3388 local $SIG{PIPE} = 'IGNORE';
3390 my $oldAutoCommit = $FS::UID::AutoCommit;
3391 local $FS::UID::AutoCommit = 0;
3394 $self->select_for_update #mutex
3395 unless $opt{testonly};
3398 # 1: find possible events (initial search)
3401 my @cust_event = ();
3403 my @eventtable = $opt{'eventtable'}
3404 ? ( $opt{'eventtable'} )
3405 : FS::part_event->eventtables_runorder;
3407 foreach my $eventtable ( @eventtable ) {
3410 if ( $opt{'objects'} ) {
3412 @objects = @{ $opt{'objects'} };
3416 #my @objects = $self->eventtable(); # sub cust_main { @{ [ $self ] }; }
3417 @objects = ( $eventtable eq 'cust_main' )
3419 : ( $self->$eventtable() );
3423 my @e_cust_event = ();
3425 my $cross = "CROSS JOIN $eventtable";
3426 $cross .= ' LEFT JOIN cust_main USING ( custnum )'
3427 unless $eventtable eq 'cust_main';
3429 foreach my $object ( @objects ) {
3431 #this first search uses the condition_sql magic for optimization.
3432 #the more possible events we can eliminate in this step the better
3434 my $cross_where = '';
3435 my $pkey = $object->primary_key;
3436 $cross_where = "$eventtable.$pkey = ". $object->$pkey();
3438 my $join = FS::part_event_condition->join_conditions_sql( $eventtable );
3440 FS::part_event_condition->where_conditions_sql( $eventtable,
3441 'time'=>$opt{'time'}
3443 my $order = FS::part_event_condition->order_conditions_sql( $eventtable );
3445 $extra_sql = "AND $extra_sql" if $extra_sql;
3447 #here is the agent virtualization
3448 $extra_sql .= " AND ( part_event.agentnum IS NULL
3449 OR part_event.agentnum = ". $self->agentnum. ' )';
3451 $extra_sql .= " $order";
3453 warn "searching for events for $eventtable ". $object->$pkey. "\n"
3454 if $opt{'debug'} > 2;
3455 my @part_event = qsearch( {
3456 'debug' => ( $opt{'debug'} > 3 ? 1 : 0 ),
3457 'select' => 'part_event.*',
3458 'table' => 'part_event',
3459 'addl_from' => "$cross $join",
3460 'hashref' => { 'check_freq' => ( $opt{'check_freq'} || '1d' ),
3461 'eventtable' => $eventtable,
3464 'extra_sql' => "AND $cross_where $extra_sql",
3468 my $pkey = $object->primary_key;
3469 warn " ". scalar(@part_event).
3470 " possible events found for $eventtable ". $object->$pkey(). "\n";
3473 push @e_cust_event, map { $_->new_cust_event($object) } @part_event;
3477 warn " ". scalar(@e_cust_event).
3478 " subtotal possible cust events found for $eventtable\n"
3481 push @cust_event, @e_cust_event;
3485 warn " ". scalar(@cust_event).
3486 " total possible cust events found in initial search\n"
3490 # 2: test conditions
3495 @cust_event = grep $_->test_conditions( 'time' => $opt{'time'},
3496 'stats_hashref' => \%unsat ),
3499 warn " ". scalar(@cust_event). " cust events left satisfying conditions\n"
3502 warn " invalid conditions not eliminated with condition_sql:\n".
3503 join('', map " $_: ".$unsat{$_}."\n", keys %unsat )
3510 unless( $opt{testonly} ) {
3511 foreach my $cust_event ( @cust_event ) {
3513 my $error = $cust_event->insert();
3515 $dbh->rollback if $oldAutoCommit;
3522 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3528 warn " returning events: ". Dumper(@cust_event). "\n"
3535 =item retry_realtime
3537 Schedules realtime / batch credit card / electronic check / LEC billing
3538 events for for retry. Useful if card information has changed or manual
3539 retry is desired. The 'collect' method must be called to actually retry
3542 Implementation details: For either this customer, or for each of this
3543 customer's open invoices, changes the status of the first "done" (with
3544 statustext error) realtime processing event to "failed".
3548 sub retry_realtime {
3551 local $SIG{HUP} = 'IGNORE';
3552 local $SIG{INT} = 'IGNORE';
3553 local $SIG{QUIT} = 'IGNORE';
3554 local $SIG{TERM} = 'IGNORE';
3555 local $SIG{TSTP} = 'IGNORE';
3556 local $SIG{PIPE} = 'IGNORE';
3558 my $oldAutoCommit = $FS::UID::AutoCommit;
3559 local $FS::UID::AutoCommit = 0;
3562 #a little false laziness w/due_cust_event (not too bad, really)
3564 my $join = FS::part_event_condition->join_conditions_sql;
3565 my $order = FS::part_event_condition->order_conditions_sql;
3568 . join ( ' OR ' , map {
3569 "( part_event.eventtable = " . dbh->quote($_)
3570 . " AND tablenum IN( SELECT " . dbdef->table($_)->primary_key . " from $_ where custnum = " . dbh->quote( $self->custnum ) . "))" ;
3571 } FS::part_event->eventtables)
3574 #here is the agent virtualization
3575 my $agent_virt = " ( part_event.agentnum IS NULL
3576 OR part_event.agentnum = ". $self->agentnum. ' )';
3578 #XXX this shouldn't be hardcoded, actions should declare it...
3579 my @realtime_events = qw(
3580 cust_bill_realtime_card
3581 cust_bill_realtime_check
3582 cust_bill_realtime_lec
3586 my $is_realtime_event = ' ( '. join(' OR ', map "part_event.action = '$_'",
3591 my @cust_event = qsearchs({
3592 'table' => 'cust_event',
3593 'select' => 'cust_event.*',
3594 'addl_from' => "LEFT JOIN part_event USING ( eventpart ) $join",
3595 'hashref' => { 'status' => 'done' },
3596 'extra_sql' => " AND statustext IS NOT NULL AND statustext != '' ".
3597 " AND $mine AND $is_realtime_event AND $agent_virt $order" # LIMIT 1"
3600 my %seen_invnum = ();
3601 foreach my $cust_event (@cust_event) {
3603 #max one for the customer, one for each open invoice
3604 my $cust_X = $cust_event->cust_X;
3605 next if $seen_invnum{ $cust_event->part_event->eventtable eq 'cust_bill'
3609 or $cust_event->part_event->eventtable eq 'cust_bill'
3612 my $error = $cust_event->retry;
3614 $dbh->rollback if $oldAutoCommit;
3615 return "error scheduling event for retry: $error";
3620 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3625 # some horrid false laziness here to avoid refactor fallout
3626 # eventually realtime realtime_bop and realtime_refund_bop should go
3627 # away and be replaced by _new_realtime_bop and _new_realtime_refund_bop
3629 =item realtime_bop METHOD AMOUNT [ OPTION => VALUE ... ]
3631 Runs a realtime credit card, ACH (electronic check) or phone bill transaction
3632 via a Business::OnlinePayment realtime gateway. See
3633 L<http://420.am/business-onlinepayment> for supported gateways.
3635 Available methods are: I<CC>, I<ECHECK> and I<LEC>
3637 Available options are: I<description>, I<invnum>, I<quiet>, I<paynum_ref>, I<payunique>
3639 The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
3640 I<zip>, I<payinfo> and I<paydate> are also available. Any of these options,
3641 if set, will override the value from the customer record.
3643 I<description> is a free-text field passed to the gateway. It defaults to
3644 "Internet services".
3646 If an I<invnum> is specified, this payment (if successful) is applied to the
3647 specified invoice. If you don't specify an I<invnum> you might want to
3648 call the B<apply_payments> method.
3650 I<quiet> can be set true to surpress email decline notices.
3652 I<paynum_ref> can be set to a scalar reference. It will be filled in with the
3653 resulting paynum, if any.
3655 I<payunique> is a unique identifier for this payment.
3657 (moved from cust_bill) (probably should get realtime_{card,ach,lec} here too)
3664 return $self->_new_realtime_bop(@_)
3665 if $self->_new_bop_required();
3667 my( $method, $amount, %options ) = @_;
3669 warn "$me realtime_bop: $method $amount\n";
3670 warn " $_ => $options{$_}\n" foreach keys %options;
3673 $options{'description'} ||= 'Internet services';
3675 return $self->fake_bop($method, $amount, %options) if $options{'fake'};
3677 eval "use Business::OnlinePayment";
3680 my $payinfo = exists($options{'payinfo'})
3681 ? $options{'payinfo'}
3684 my %method2payby = (
3691 # check for banned credit card/ACH
3694 my $ban = qsearchs('banned_pay', {
3695 'payby' => $method2payby{$method},
3696 'payinfo' => md5_base64($payinfo),
3698 return "Banned credit card" if $ban;
3701 # set taxclass and trans_is_recur based on invnum if there is one
3705 my $trans_is_recur = 0;
3706 if ( $options{'invnum'} ) {
3708 my $cust_bill = qsearchs('cust_bill', { 'invnum' => $options{'invnum'} } );
3709 die "invnum ". $options{'invnum'}. " not found" unless $cust_bill;
3712 map { $_->part_pkg }
3714 map { $_->cust_pkg }
3715 $cust_bill->cust_bill_pkg;
3717 my @taxclasses = map $_->taxclass, @part_pkg;
3718 $taxclass = $taxclasses[0]
3719 unless grep { $taxclasses[0] ne $_ } @taxclasses; #unless there are
3720 #different taxclasses
3722 if grep { $_->freq ne '0' } @part_pkg;
3730 #look for an agent gateway override first
3732 if ( $method eq 'CC' ) {
3733 $cardtype = cardtype($payinfo);
3734 } elsif ( $method eq 'ECHECK' ) {
3737 $cardtype = $method;
3741 qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
3742 cardtype => $cardtype,
3743 taxclass => $taxclass, } )
3744 || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
3746 taxclass => $taxclass, } )
3747 || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
3748 cardtype => $cardtype,
3750 || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
3752 taxclass => '', } );
3754 my $payment_gateway = '';
3755 my( $processor, $login, $password, $action, @bop_options );
3756 if ( $override ) { #use a payment gateway override
3758 $payment_gateway = $override->payment_gateway;
3760 $processor = $payment_gateway->gateway_module;
3761 $login = $payment_gateway->gateway_username;
3762 $password = $payment_gateway->gateway_password;
3763 $action = $payment_gateway->gateway_action;
3764 @bop_options = $payment_gateway->options;
3766 } else { #use the standard settings from the config
3768 ( $processor, $login, $password, $action, @bop_options ) =
3769 $self->default_payment_gateway($method);
3777 my $address = exists($options{'address1'})
3778 ? $options{'address1'}
3780 my $address2 = exists($options{'address2'})
3781 ? $options{'address2'}
3783 $address .= ", ". $address2 if length($address2);
3785 my $o_payname = exists($options{'payname'})
3786 ? $options{'payname'}
3788 my($payname, $payfirst, $paylast);
3789 if ( $o_payname && $method ne 'ECHECK' ) {
3790 ($payname = $o_payname) =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
3791 or return "Illegal payname $payname";
3792 ($payfirst, $paylast) = ($1, $2);
3794 $payfirst = $self->getfield('first');
3795 $paylast = $self->getfield('last');
3796 $payname = "$payfirst $paylast";
3799 my @invoicing_list = $self->invoicing_list_emailonly;
3800 if ( $conf->exists('emailinvoiceautoalways')
3801 || $conf->exists('emailinvoiceauto') && ! @invoicing_list
3802 || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
3803 push @invoicing_list, $self->all_emails;
3806 my $email = ($conf->exists('business-onlinepayment-email-override'))
3807 ? $conf->config('business-onlinepayment-email-override')
3808 : $invoicing_list[0];
3812 my $payip = exists($options{'payip'})
3815 $content{customer_ip} = $payip
3818 $content{invoice_number} = $options{'invnum'}
3819 if exists($options{'invnum'}) && length($options{'invnum'});
3821 $content{email_customer} =
3822 ( $conf->exists('business-onlinepayment-email_customer')
3823 || $conf->exists('business-onlinepayment-email-override') );
3826 if ( $method eq 'CC' ) {
3828 $content{card_number} = $payinfo;
3829 $paydate = exists($options{'paydate'})
3830 ? $options{'paydate'}
3832 $paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
3833 $content{expiration} = "$2/$1";
3835 my $paycvv = exists($options{'paycvv'})
3836 ? $options{'paycvv'}
3838 $content{cvv2} = $paycvv
3841 my $paystart_month = exists($options{'paystart_month'})
3842 ? $options{'paystart_month'}
3843 : $self->paystart_month;
3845 my $paystart_year = exists($options{'paystart_year'})
3846 ? $options{'paystart_year'}
3847 : $self->paystart_year;
3849 $content{card_start} = "$paystart_month/$paystart_year"
3850 if $paystart_month && $paystart_year;
3852 my $payissue = exists($options{'payissue'})
3853 ? $options{'payissue'}
3855 $content{issue_number} = $payissue if $payissue;
3857 if ( $self->_bop_recurring_billing( 'payinfo' => $payinfo,
3858 'trans_is_recur' => $trans_is_recur,
3862 $content{recurring_billing} = 'YES';
3863 $content{acct_code} = 'rebill'
3864 if $conf->exists('credit_card-recurring_billing_acct_code');
3867 } elsif ( $method eq 'ECHECK' ) {
3868 ( $content{account_number}, $content{routing_code} ) =
3869 split('@', $payinfo);
3870 $content{bank_name} = $o_payname;
3871 $content{bank_state} = exists($options{'paystate'})
3872 ? $options{'paystate'}
3873 : $self->getfield('paystate');
3874 $content{account_type} = exists($options{'paytype'})
3875 ? uc($options{'paytype'}) || 'CHECKING'
3876 : uc($self->getfield('paytype')) || 'CHECKING';
3877 $content{account_name} = $payname;
3878 $content{customer_org} = $self->company ? 'B' : 'I';
3879 $content{state_id} = exists($options{'stateid'})
3880 ? $options{'stateid'}
3881 : $self->getfield('stateid');
3882 $content{state_id_state} = exists($options{'stateid_state'})
3883 ? $options{'stateid_state'}
3884 : $self->getfield('stateid_state');
3885 $content{customer_ssn} = exists($options{'ss'})
3888 } elsif ( $method eq 'LEC' ) {
3889 $content{phone} = $payinfo;
3893 # run transaction(s)
3896 my $balance = exists( $options{'balance'} )
3897 ? $options{'balance'}
3900 $self->select_for_update; #mutex ... just until we get our pending record in
3902 #the checks here are intended to catch concurrent payments
3903 #double-form-submission prevention is taken care of in cust_pay_pending::check
3906 return "The customer's balance has changed; $method transaction aborted."
3907 if $self->balance < $balance;
3908 #&& $self->balance < $amount; #might as well anyway?
3910 #also check and make sure there aren't *other* pending payments for this cust
3912 my @pending = qsearch('cust_pay_pending', {
3913 'custnum' => $self->custnum,
3914 'status' => { op=>'!=', value=>'done' }
3916 return "A payment is already being processed for this customer (".
3917 join(', ', map 'paypendingnum '. $_->paypendingnum, @pending ).
3918 "); $method transaction aborted."
3919 if scalar(@pending);
3921 #okay, good to go, if we're a duplicate, cust_pay_pending will kick us out
3923 my $cust_pay_pending = new FS::cust_pay_pending {
3924 'custnum' => $self->custnum,
3925 #'invnum' => $options{'invnum'},
3928 'payby' => $method2payby{$method},
3929 'payinfo' => $payinfo,
3930 'paydate' => $paydate,
3931 'recurring_billing' => $content{recurring_billing},
3933 'gatewaynum' => ( $payment_gateway ? $payment_gateway->gatewaynum : '' ),
3935 $cust_pay_pending->payunique( $options{payunique} )
3936 if defined($options{payunique}) && length($options{payunique});
3937 my $cpp_new_err = $cust_pay_pending->insert; #mutex lost when this is inserted
3938 return $cpp_new_err if $cpp_new_err;
3940 my( $action1, $action2 ) = split(/\s*\,\s*/, $action );
3942 my $transaction = new Business::OnlinePayment( $processor, @bop_options );
3943 $transaction->content(
3946 'password' => $password,
3947 'action' => $action1,
3948 'description' => $options{'description'},
3949 'amount' => $amount,
3950 #'invoice_number' => $options{'invnum'},
3951 'customer_id' => $self->custnum,
3952 'last_name' => $paylast,
3953 'first_name' => $payfirst,
3955 'address' => $address,
3956 'city' => ( exists($options{'city'})
3959 'state' => ( exists($options{'state'})
3962 'zip' => ( exists($options{'zip'})
3965 'country' => ( exists($options{'country'})
3966 ? $options{'country'}
3968 'referer' => 'http://cleanwhisker.420.am/', #XXX fix referer :/
3970 'phone' => $self->daytime || $self->night,
3974 $cust_pay_pending->status('pending');
3975 my $cpp_pending_err = $cust_pay_pending->replace;
3976 return $cpp_pending_err if $cpp_pending_err;
3979 my $BOP_TESTING = 0;
3980 my $BOP_TESTING_SUCCESS = 1;
3982 unless ( $BOP_TESTING ) {
3983 $transaction->submit();
3985 if ( $BOP_TESTING_SUCCESS ) {
3986 $transaction->is_success(1);
3987 $transaction->authorization('fake auth');
3989 $transaction->is_success(0);
3990 $transaction->error_message('fake failure');
3994 if ( $transaction->is_success() && $action2 ) {
3996 $cust_pay_pending->status('authorized');
3997 my $cpp_authorized_err = $cust_pay_pending->replace;
3998 return $cpp_authorized_err if $cpp_authorized_err;
4000 my $auth = $transaction->authorization;
4001 my $ordernum = $transaction->can('order_number')
4002 ? $transaction->order_number
4006 new Business::OnlinePayment( $processor, @bop_options );
4013 password => $password,
4014 order_number => $ordernum,
4016 authorization => $auth,
4017 description => $options{'description'},
4020 foreach my $field (qw( authorization_source_code returned_ACI
4021 transaction_identifier validation_code
4022 transaction_sequence_num local_transaction_date
4023 local_transaction_time AVS_result_code )) {
4024 $capture{$field} = $transaction->$field() if $transaction->can($field);
4027 $capture->content( %capture );
4031 unless ( $capture->is_success ) {
4032 my $e = "Authorization successful but capture failed, custnum #".
4033 $self->custnum. ': '. $capture->result_code.
4034 ": ". $capture->error_message;
4041 $cust_pay_pending->status($transaction->is_success() ? 'captured' : 'declined');
4042 my $cpp_captured_err = $cust_pay_pending->replace;
4043 return $cpp_captured_err if $cpp_captured_err;
4046 # remove paycvv after initial transaction
4049 #false laziness w/misc/process/payment.cgi - check both to make sure working
4051 if ( defined $self->dbdef_table->column('paycvv')
4052 && length($self->paycvv)
4053 && ! grep { $_ eq cardtype($payinfo) } $conf->config('cvv-save')
4055 my $error = $self->remove_cvv;
4057 warn "WARNING: error removing cvv: $error\n";
4065 if ( $transaction->is_success() ) {
4068 if ( $payment_gateway ) { # agent override
4069 $paybatch = $payment_gateway->gatewaynum. '-';
4072 $paybatch .= "$processor:". $transaction->authorization;
4074 $paybatch .= ':'. $transaction->order_number
4075 if $transaction->can('order_number')
4076 && length($transaction->order_number);
4078 my $cust_pay = new FS::cust_pay ( {
4079 'custnum' => $self->custnum,
4080 'invnum' => $options{'invnum'},
4083 'payby' => $method2payby{$method},
4084 'payinfo' => $payinfo,
4085 'paybatch' => $paybatch,
4086 'paydate' => $paydate,
4088 #doesn't hurt to know, even though the dup check is in cust_pay_pending now
4089 $cust_pay->payunique( $options{payunique} )
4090 if defined($options{payunique}) && length($options{payunique});
4092 my $oldAutoCommit = $FS::UID::AutoCommit;
4093 local $FS::UID::AutoCommit = 0;
4096 #start a transaction, insert the cust_pay and set cust_pay_pending.status to done in a single transction
4098 my $error = $cust_pay->insert($options{'manual'} ? ( 'manual' => 1 ) : () );
4101 $cust_pay->invnum(''); #try again with no specific invnum
4102 my $error2 = $cust_pay->insert( $options{'manual'} ?
4103 ( 'manual' => 1 ) : ()
4106 # gah. but at least we have a record of the state we had to abort in
4107 # from cust_pay_pending now.
4108 my $e = "WARNING: $method captured but payment not recorded - ".
4109 "error inserting payment ($processor): $error2".
4110 " (previously tried insert with invnum #$options{'invnum'}" .
4111 ": $error ) - pending payment saved as paypendingnum ".
4112 $cust_pay_pending->paypendingnum. "\n";
4118 if ( $options{'paynum_ref'} ) {
4119 ${ $options{'paynum_ref'} } = $cust_pay->paynum;
4122 $cust_pay_pending->status('done');
4123 $cust_pay_pending->statustext('captured');
4124 $cust_pay_pending->paynum($cust_pay->paynum);
4125 my $cpp_done_err = $cust_pay_pending->replace;
4127 if ( $cpp_done_err ) {
4129 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
4130 my $e = "WARNING: $method captured but payment not recorded - ".
4131 "error updating status for paypendingnum ".
4132 $cust_pay_pending->paypendingnum. ": $cpp_done_err \n";
4138 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4139 return ''; #no error
4145 my $perror = "$processor error: ". $transaction->error_message;
4147 unless ( $transaction->error_message ) {
4150 if ( $transaction->can('response_page') ) {
4152 'page' => ( $transaction->can('response_page')
4153 ? $transaction->response_page
4156 'code' => ( $transaction->can('response_code')
4157 ? $transaction->response_code
4160 'headers' => ( $transaction->can('response_headers')
4161 ? $transaction->response_headers
4167 "No additional debugging information available for $processor";
4170 $perror .= "No error_message returned from $processor -- ".
4171 ( ref($t_response) ? Dumper($t_response) : $t_response );
4175 if ( !$options{'quiet'} && !$realtime_bop_decline_quiet
4176 && $conf->exists('emaildecline')
4177 && grep { $_ ne 'POST' } $self->invoicing_list
4178 && ! grep { $transaction->error_message =~ /$_/ }
4179 $conf->config('emaildecline-exclude')
4181 my @templ = $conf->config('declinetemplate');
4182 my $template = new Text::Template (
4184 SOURCE => [ map "$_\n", @templ ],
4185 ) or return "($perror) can't create template: $Text::Template::ERROR";
4186 $template->compile()
4187 or return "($perror) can't compile template: $Text::Template::ERROR";
4189 my $templ_hash = { error => $transaction->error_message };
4191 my $error = send_email(
4192 'from' => $conf->config('invoice_from', $self->agentnum ),
4193 'to' => [ grep { $_ ne 'POST' } $self->invoicing_list ],
4194 'subject' => 'Your payment could not be processed',
4195 'body' => [ $template->fill_in(HASH => $templ_hash) ],
4198 $perror .= " (also received error sending decline notification: $error)"
4203 $cust_pay_pending->status('done');
4204 $cust_pay_pending->statustext("declined: $perror");
4205 my $cpp_done_err = $cust_pay_pending->replace;
4206 if ( $cpp_done_err ) {
4207 my $e = "WARNING: $method declined but pending payment not resolved - ".
4208 "error updating status for paypendingnum ".
4209 $cust_pay_pending->paypendingnum. ": $cpp_done_err \n";
4211 $perror = "$e ($perror)";
4219 sub _bop_recurring_billing {
4220 my( $self, %opt ) = @_;
4222 my $method = $conf->config('credit_card-recurring_billing_flag');
4224 if ( $method eq 'transaction_is_recur' ) {
4226 return 1 if $opt{'trans_is_recur'};
4230 my %hash = ( 'custnum' => $self->custnum,
4235 if qsearch('cust_pay', { %hash, 'payinfo' => $opt{'payinfo'} } )
4236 || qsearch('cust_pay', { %hash, 'paymask' => $self->mask_payinfo('CARD',
4247 =item realtime_refund_bop METHOD [ OPTION => VALUE ... ]
4249 Refunds a realtime credit card, ACH (electronic check) or phone bill transaction
4250 via a Business::OnlinePayment realtime gateway. See
4251 L<http://420.am/business-onlinepayment> for supported gateways.
4253 Available methods are: I<CC>, I<ECHECK> and I<LEC>
4255 Available options are: I<amount>, I<reason>, I<paynum>, I<paydate>
4257 Most gateways require a reference to an original payment transaction to refund,
4258 so you probably need to specify a I<paynum>.
4260 I<amount> defaults to the original amount of the payment if not specified.
4262 I<reason> specifies a reason for the refund.
4264 I<paydate> specifies the expiration date for a credit card overriding the
4265 value from the customer record or the payment record. Specified as yyyy-mm-dd
4267 Implementation note: If I<amount> is unspecified or equal to the amount of the
4268 orignal payment, first an attempt is made to "void" the transaction via
4269 the gateway (to cancel a not-yet settled transaction) and then if that fails,
4270 the normal attempt is made to "refund" ("credit") the transaction via the
4271 gateway is attempted.
4273 #The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
4274 #I<zip>, I<payinfo> and I<paydate> are also available. Any of these options,
4275 #if set, will override the value from the customer record.
4277 #If an I<invnum> is specified, this payment (if successful) is applied to the
4278 #specified invoice. If you don't specify an I<invnum> you might want to
4279 #call the B<apply_payments> method.
4283 #some false laziness w/realtime_bop, not enough to make it worth merging
4284 #but some useful small subs should be pulled out
4285 sub realtime_refund_bop {
4288 return $self->_new_realtime_refund_bop(@_)
4289 if $self->_new_bop_required();
4291 my( $method, %options ) = @_;
4293 warn "$me realtime_refund_bop: $method refund\n";
4294 warn " $_ => $options{$_}\n" foreach keys %options;
4297 eval "use Business::OnlinePayment";
4301 # look up the original payment and optionally a gateway for that payment
4305 my $amount = $options{'amount'};
4307 my( $processor, $login, $password, @bop_options ) ;
4308 my( $auth, $order_number ) = ( '', '', '' );
4310 if ( $options{'paynum'} ) {
4312 warn " paynum: $options{paynum}\n" if $DEBUG > 1;
4313 $cust_pay = qsearchs('cust_pay', { paynum=>$options{'paynum'} } )
4314 or return "Unknown paynum $options{'paynum'}";
4315 $amount ||= $cust_pay->paid;
4317 $cust_pay->paybatch =~ /^((\d+)\-)?(\w+):\s*([\w\-\/ ]*)(:([\w\-]+))?$/
4318 or return "Can't parse paybatch for paynum $options{'paynum'}: ".
4319 $cust_pay->paybatch;
4320 my $gatewaynum = '';
4321 ( $gatewaynum, $processor, $auth, $order_number ) = ( $2, $3, $4, $6 );
4323 if ( $gatewaynum ) { #gateway for the payment to be refunded
4325 my $payment_gateway =
4326 qsearchs('payment_gateway', { 'gatewaynum' => $gatewaynum } );
4327 die "payment gateway $gatewaynum not found"
4328 unless $payment_gateway;
4330 $processor = $payment_gateway->gateway_module;
4331 $login = $payment_gateway->gateway_username;
4332 $password = $payment_gateway->gateway_password;
4333 @bop_options = $payment_gateway->options;
4335 } else { #try the default gateway
4337 my( $conf_processor, $unused_action );
4338 ( $conf_processor, $login, $password, $unused_action, @bop_options ) =
4339 $self->default_payment_gateway($method);
4341 return "processor of payment $options{'paynum'} $processor does not".
4342 " match default processor $conf_processor"
4343 unless $processor eq $conf_processor;
4348 } else { # didn't specify a paynum, so look for agent gateway overrides
4349 # like a normal transaction
4352 if ( $method eq 'CC' ) {
4353 $cardtype = cardtype($self->payinfo);
4354 } elsif ( $method eq 'ECHECK' ) {
4357 $cardtype = $method;
4360 qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
4361 cardtype => $cardtype,
4363 || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
4365 taxclass => '', } );
4367 if ( $override ) { #use a payment gateway override
4369 my $payment_gateway = $override->payment_gateway;
4371 $processor = $payment_gateway->gateway_module;
4372 $login = $payment_gateway->gateway_username;
4373 $password = $payment_gateway->gateway_password;
4374 #$action = $payment_gateway->gateway_action;
4375 @bop_options = $payment_gateway->options;
4377 } else { #use the standard settings from the config
4380 ( $processor, $login, $password, $unused_action, @bop_options ) =
4381 $self->default_payment_gateway($method);
4386 return "neither amount nor paynum specified" unless $amount;
4391 'password' => $password,
4392 'order_number' => $order_number,
4393 'amount' => $amount,
4394 'referer' => 'http://cleanwhisker.420.am/', #XXX fix referer :/
4396 $content{authorization} = $auth
4397 if length($auth); #echeck/ACH transactions have an order # but no auth
4398 #(at least with authorize.net)
4400 my $disable_void_after;
4401 if ($conf->exists('disable_void_after')
4402 && $conf->config('disable_void_after') =~ /^(\d+)$/) {
4403 $disable_void_after = $1;
4406 #first try void if applicable
4407 if ( $cust_pay && $cust_pay->paid == $amount
4409 ( not defined($disable_void_after) )
4410 || ( time < ($cust_pay->_date + $disable_void_after ) )
4413 warn " attempting void\n" if $DEBUG > 1;
4414 my $void = new Business::OnlinePayment( $processor, @bop_options );
4415 $void->content( 'action' => 'void', %content );
4417 if ( $void->is_success ) {
4418 my $error = $cust_pay->void($options{'reason'});
4420 # gah, even with transactions.
4421 my $e = 'WARNING: Card/ACH voided but database not updated - '.
4422 "error voiding payment: $error";
4426 warn " void successful\n" if $DEBUG > 1;
4431 warn " void unsuccessful, trying refund\n"
4435 my $address = $self->address1;
4436 $address .= ", ". $self->address2 if $self->address2;
4438 my($payname, $payfirst, $paylast);
4439 if ( $self->payname && $method ne 'ECHECK' ) {
4440 $payname = $self->payname;
4441 $payname =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
4442 or return "Illegal payname $payname";
4443 ($payfirst, $paylast) = ($1, $2);
4445 $payfirst = $self->getfield('first');
4446 $paylast = $self->getfield('last');
4447 $payname = "$payfirst $paylast";
4450 my @invoicing_list = $self->invoicing_list_emailonly;
4451 if ( $conf->exists('emailinvoiceautoalways')
4452 || $conf->exists('emailinvoiceauto') && ! @invoicing_list
4453 || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
4454 push @invoicing_list, $self->all_emails;
4457 my $email = ($conf->exists('business-onlinepayment-email-override'))
4458 ? $conf->config('business-onlinepayment-email-override')
4459 : $invoicing_list[0];
4461 my $payip = exists($options{'payip'})
4464 $content{customer_ip} = $payip
4468 if ( $method eq 'CC' ) {
4471 $content{card_number} = $payinfo = $cust_pay->payinfo;
4472 (exists($options{'paydate'}) ? $options{'paydate'} : $cust_pay->paydate)
4473 =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/ &&
4474 ($content{expiration} = "$2/$1"); # where available
4476 $content{card_number} = $payinfo = $self->payinfo;
4477 (exists($options{'paydate'}) ? $options{'paydate'} : $self->paydate)
4478 =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
4479 $content{expiration} = "$2/$1";
4482 } elsif ( $method eq 'ECHECK' ) {
4485 $payinfo = $cust_pay->payinfo;
4487 $payinfo = $self->payinfo;
4489 ( $content{account_number}, $content{routing_code} )= split('@', $payinfo );
4490 $content{bank_name} = $self->payname;
4491 $content{account_type} = 'CHECKING';
4492 $content{account_name} = $payname;
4493 $content{customer_org} = $self->company ? 'B' : 'I';
4494 $content{customer_ssn} = $self->ss;
4495 } elsif ( $method eq 'LEC' ) {
4496 $content{phone} = $payinfo = $self->payinfo;
4500 my $refund = new Business::OnlinePayment( $processor, @bop_options );
4501 my %sub_content = $refund->content(
4502 'action' => 'credit',
4503 'customer_id' => $self->custnum,
4504 'last_name' => $paylast,
4505 'first_name' => $payfirst,
4507 'address' => $address,
4508 'city' => $self->city,
4509 'state' => $self->state,
4510 'zip' => $self->zip,
4511 'country' => $self->country,
4513 'phone' => $self->daytime || $self->night,
4516 warn join('', map { " $_ => $sub_content{$_}\n" } keys %sub_content )
4520 return "$processor error: ". $refund->error_message
4521 unless $refund->is_success();
4523 my %method2payby = (
4529 my $paybatch = "$processor:". $refund->authorization;
4530 $paybatch .= ':'. $refund->order_number
4531 if $refund->can('order_number') && $refund->order_number;
4533 while ( $cust_pay && $cust_pay->unapplied < $amount ) {
4534 my @cust_bill_pay = $cust_pay->cust_bill_pay;
4535 last unless @cust_bill_pay;
4536 my $cust_bill_pay = pop @cust_bill_pay;
4537 my $error = $cust_bill_pay->delete;
4541 my $cust_refund = new FS::cust_refund ( {
4542 'custnum' => $self->custnum,
4543 'paynum' => $options{'paynum'},
4544 'refund' => $amount,
4546 'payby' => $method2payby{$method},
4547 'payinfo' => $payinfo,
4548 'paybatch' => $paybatch,
4549 'reason' => $options{'reason'} || 'card or ACH refund',
4551 my $error = $cust_refund->insert;
4553 $cust_refund->paynum(''); #try again with no specific paynum
4554 my $error2 = $cust_refund->insert;
4556 # gah, even with transactions.
4557 my $e = 'WARNING: Card/ACH refunded but database not updated - '.
4558 "error inserting refund ($processor): $error2".
4559 " (previously tried insert with paynum #$options{'paynum'}" .
4570 # does the configuration indicate the new bop routines are required?
4572 sub _new_bop_required {
4575 my $botpp = 'Business::OnlineThirdPartyPayment';
4578 if ( $conf->config('business-onlinepayment-namespace') eq $botpp ||
4579 scalar( grep { $_->gateway_namespace eq $botpp }
4580 qsearch( 'payment_gateway', { 'disabled' => '' } )
4589 =item realtime_collect [ OPTION => VALUE ... ]
4591 Runs a realtime credit card, ACH (electronic check) or phone bill transaction
4592 via a Business::OnlinePayment or Business::OnlineThirdPartyPayment realtime
4593 gateway. See L<http://420.am/business-onlinepayment> and
4594 L<http://420.am/business-onlinethirdpartypayment> for supported gateways.
4596 On failure returns an error message.
4598 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.
4600 Available options are: I<method>, I<amount>, I<description>, I<invnum>, I<quiet>, I<paynum_ref>, I<payunique>, I<session_id>
4602 I<method> is one of: I<CC>, I<ECHECK> and I<LEC>. If none is specified
4603 then it is deduced from the customer record.
4605 If no I<amount> is specified, then the customer balance is used.
4607 The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
4608 I<zip>, I<payinfo> and I<paydate> are also available. Any of these options,
4609 if set, will override the value from the customer record.
4611 I<description> is a free-text field passed to the gateway. It defaults to
4612 "Internet services".
4614 If an I<invnum> is specified, this payment (if successful) is applied to the
4615 specified invoice. If you don't specify an I<invnum> you might want to
4616 call the B<apply_payments> method.
4618 I<quiet> can be set true to surpress email decline notices.
4620 I<paynum_ref> can be set to a scalar reference. It will be filled in with the
4621 resulting paynum, if any.
4623 I<payunique> is a unique identifier for this payment.
4625 I<session_id> is a session identifier associated with this payment.
4627 I<depend_jobnum> allows payment capture to unlock export jobs
4631 sub realtime_collect {
4632 my( $self, %options ) = @_;
4635 warn "$me realtime_collect:\n";
4636 warn " $_ => $options{$_}\n" foreach keys %options;
4639 $options{amount} = $self->balance unless exists( $options{amount} );
4640 $options{method} = FS::payby->payby2bop($self->payby)
4641 unless exists( $options{method} );
4643 return $self->realtime_bop({%options});
4647 =item _realtime_bop { [ ARG => VALUE ... ] }
4649 Runs a realtime credit card, ACH (electronic check) or phone bill transaction
4650 via a Business::OnlinePayment realtime gateway. See
4651 L<http://420.am/business-onlinepayment> for supported gateways.
4653 Required arguments in the hashref are I<method>, and I<amount>
4655 Available methods are: I<CC>, I<ECHECK> and I<LEC>
4657 Available optional arguments are: I<description>, I<invnum>, I<quiet>, I<paynum_ref>, I<payunique>, I<session_id>
4659 The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
4660 I<zip>, I<payinfo> and I<paydate> are also available. Any of these options,
4661 if set, will override the value from the customer record.
4663 I<description> is a free-text field passed to the gateway. It defaults to
4664 "Internet services".
4666 If an I<invnum> is specified, this payment (if successful) is applied to the
4667 specified invoice. If you don't specify an I<invnum> you might want to
4668 call the B<apply_payments> method.
4670 I<quiet> can be set true to surpress email decline notices.
4672 I<paynum_ref> can be set to a scalar reference. It will be filled in with the
4673 resulting paynum, if any.
4675 I<payunique> is a unique identifier for this payment.
4677 I<session_id> is a session identifier associated with this payment.
4679 I<depend_jobnum> allows payment capture to unlock export jobs
4681 (moved from cust_bill) (probably should get realtime_{card,ach,lec} here too)
4685 # some helper routines
4686 sub _payment_gateway {
4687 my ($self, $options) = @_;
4689 $options->{payment_gateway} = $self->agent->payment_gateway( %$options )
4690 unless exists($options->{payment_gateway});
4692 $options->{payment_gateway};
4696 my ($self, $options) = @_;
4699 'login' => $options->{payment_gateway}->gateway_username,
4700 'password' => $options->{payment_gateway}->gateway_password,
4705 my ($self, $options) = @_;
4707 $options->{payment_gateway}->gatewaynum
4708 ? $options->{payment_gateway}->options
4709 : @{ $options->{payment_gateway}->get('options') };
4713 my ($self, $options) = @_;
4715 $options->{description} ||= 'Internet services';
4716 $options->{payinfo} = $self->payinfo unless exists( $options->{payinfo} );
4717 $options->{invnum} ||= '';
4718 $options->{payname} = $self->payname unless exists( $options->{payname} );
4722 my ($self, $options) = @_;
4725 $content{address} = exists($options->{'address1'})
4726 ? $options->{'address1'}
4728 my $address2 = exists($options->{'address2'})
4729 ? $options->{'address2'}
4731 $content{address} .= ", ". $address2 if length($address2);
4733 my $payip = exists($options->{'payip'}) ? $options->{'payip'} : $self->payip;
4734 $content{customer_ip} = $payip if length($payip);
4736 $content{invoice_number} = $options->{'invnum'}
4737 if exists($options->{'invnum'}) && length($options->{'invnum'});
4739 $content{email_customer} =
4740 ( $conf->exists('business-onlinepayment-email_customer')
4741 || $conf->exists('business-onlinepayment-email-override') );
4743 $content{payfirst} = $self->getfield('first');
4744 $content{paylast} = $self->getfield('last');
4746 $content{account_name} = "$content{payfirst} $content{paylast}"
4747 if $options->{method} eq 'ECHECK';
4749 $content{name} = $options->{payname};
4750 $content{name} = $content{account_name} if exists($content{account_name});
4752 $content{city} = exists($options->{city})
4755 $content{state} = exists($options->{state})
4758 $content{zip} = exists($options->{zip})
4761 $content{country} = exists($options->{country})
4762 ? $options->{country}
4764 $content{referer} = 'http://cleanwhisker.420.am/'; #XXX fix referer :/
4765 $content{phone} = $self->daytime || $self->night;
4770 my %bop_method2payby = (
4776 sub _new_realtime_bop {
4780 if (ref($_[0]) eq 'HASH') {
4781 %options = %{$_[0]};
4783 my ( $method, $amount ) = ( shift, shift );
4785 $options{method} = $method;
4786 $options{amount} = $amount;
4790 warn "$me realtime_bop (new): $options{method} $options{amount}\n";
4791 warn " $_ => $options{$_}\n" foreach keys %options;
4794 return $self->fake_bop(%options) if $options{'fake'};
4796 $self->_bop_defaults(\%options);
4799 # set trans_is_recur based on invnum if there is one
4802 my $trans_is_recur = 0;
4803 if ( $options{'invnum'} ) {
4805 my $cust_bill = qsearchs('cust_bill', { 'invnum' => $options{'invnum'} } );
4806 die "invnum ". $options{'invnum'}. " not found" unless $cust_bill;
4809 map { $_->part_pkg }
4811 map { $_->cust_pkg }
4812 $cust_bill->cust_bill_pkg;
4815 if grep { $_->freq ne '0' } @part_pkg;
4823 my $payment_gateway = $self->_payment_gateway( \%options );
4824 my $namespace = $payment_gateway->gateway_namespace;
4826 eval "use $namespace";
4830 # check for banned credit card/ACH
4833 my $ban = qsearchs('banned_pay', {
4834 'payby' => $bop_method2payby{$options{method}},
4835 'payinfo' => md5_base64($options{payinfo}),
4837 return "Banned credit card" if $ban;
4843 my (%bop_content) = $self->_bop_content(\%options);
4845 if ( $options{method} ne 'ECHECK' ) {
4846 $options{payname} =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
4847 or return "Illegal payname $options{payname}";
4848 ($bop_content{payfirst}, $bop_content{paylast}) = ($1, $2);
4851 my @invoicing_list = $self->invoicing_list_emailonly;
4852 if ( $conf->exists('emailinvoiceautoalways')
4853 || $conf->exists('emailinvoiceauto') && ! @invoicing_list
4854 || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
4855 push @invoicing_list, $self->all_emails;
4858 my $email = ($conf->exists('business-onlinepayment-email-override'))
4859 ? $conf->config('business-onlinepayment-email-override')
4860 : $invoicing_list[0];
4864 if ( $namespace eq 'Business::OnlinePayment' && $options{method} eq 'CC' ) {
4866 $content{card_number} = $options{payinfo};
4867 $paydate = exists($options{'paydate'})
4868 ? $options{'paydate'}
4870 $paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
4871 $content{expiration} = "$2/$1";
4873 my $paycvv = exists($options{'paycvv'})
4874 ? $options{'paycvv'}
4876 $content{cvv2} = $paycvv
4879 my $paystart_month = exists($options{'paystart_month'})
4880 ? $options{'paystart_month'}
4881 : $self->paystart_month;
4883 my $paystart_year = exists($options{'paystart_year'})
4884 ? $options{'paystart_year'}
4885 : $self->paystart_year;
4887 $content{card_start} = "$paystart_month/$paystart_year"
4888 if $paystart_month && $paystart_year;
4890 my $payissue = exists($options{'payissue'})
4891 ? $options{'payissue'}
4893 $content{issue_number} = $payissue if $payissue;
4895 if ( $self->_bop_recurring_billing( 'payinfo' => $options{'payinfo'},
4896 'trans_is_recur' => $trans_is_recur,
4900 $content{recurring_billing} = 'YES';
4901 $content{acct_code} = 'rebill'
4902 if $conf->exists('credit_card-recurring_billing_acct_code');
4905 } elsif ( $namespace eq 'Business::OnlinePayment' && $options{method} eq 'ECHECK' ){
4906 ( $content{account_number}, $content{routing_code} ) =
4907 split('@', $options{payinfo});
4908 $content{bank_name} = $options{payname};
4909 $content{bank_state} = exists($options{'paystate'})
4910 ? $options{'paystate'}
4911 : $self->getfield('paystate');
4912 $content{account_type} = exists($options{'paytype'})
4913 ? uc($options{'paytype'}) || 'CHECKING'
4914 : uc($self->getfield('paytype')) || 'CHECKING';
4915 $content{customer_org} = $self->company ? 'B' : 'I';
4916 $content{state_id} = exists($options{'stateid'})
4917 ? $options{'stateid'}
4918 : $self->getfield('stateid');
4919 $content{state_id_state} = exists($options{'stateid_state'})
4920 ? $options{'stateid_state'}
4921 : $self->getfield('stateid_state');
4922 $content{customer_ssn} = exists($options{'ss'})
4925 } elsif ( $namespace eq 'Business::OnlinePayment' && $options{method} eq 'LEC' ) {
4926 $content{phone} = $options{payinfo};
4927 } elsif ( $namespace eq 'Business::OnlineThirdPartyPayment' ) {
4934 # run transaction(s)
4937 my $balance = exists( $options{'balance'} )
4938 ? $options{'balance'}
4941 $self->select_for_update; #mutex ... just until we get our pending record in
4943 #the checks here are intended to catch concurrent payments
4944 #double-form-submission prevention is taken care of in cust_pay_pending::check
4947 return "The customer's balance has changed; $options{method} transaction aborted."
4948 if $self->balance < $balance;
4949 #&& $self->balance < $options{amount}; #might as well anyway?
4951 #also check and make sure there aren't *other* pending payments for this cust
4953 my @pending = qsearch('cust_pay_pending', {
4954 'custnum' => $self->custnum,
4955 'status' => { op=>'!=', value=>'done' }
4957 return "A payment is already being processed for this customer (".
4958 join(', ', map 'paypendingnum '. $_->paypendingnum, @pending ).
4959 "); $options{method} transaction aborted."
4960 if scalar(@pending);
4962 #okay, good to go, if we're a duplicate, cust_pay_pending will kick us out
4964 my $cust_pay_pending = new FS::cust_pay_pending {
4965 'custnum' => $self->custnum,
4966 #'invnum' => $options{'invnum'},
4967 'paid' => $options{amount},
4969 'payby' => $bop_method2payby{$options{method}},
4970 'payinfo' => $options{payinfo},
4971 'paydate' => $paydate,
4972 'recurring_billing' => $content{recurring_billing},
4974 'gatewaynum' => $payment_gateway->gatewaynum || '',
4975 'session_id' => $options{session_id} || '',
4976 'jobnum' => $options{depend_jobnum} || '',
4978 $cust_pay_pending->payunique( $options{payunique} )
4979 if defined($options{payunique}) && length($options{payunique});
4980 my $cpp_new_err = $cust_pay_pending->insert; #mutex lost when this is inserted
4981 return $cpp_new_err if $cpp_new_err;
4983 my( $action1, $action2 ) =
4984 split( /\s*\,\s*/, $payment_gateway->gateway_action );
4986 my $transaction = new $namespace( $payment_gateway->gateway_module,
4987 $self->_bop_options(\%options),
4990 $transaction->content(
4991 'type' => $options{method},
4992 $self->_bop_auth(\%options),
4993 'action' => $action1,
4994 'description' => $options{'description'},
4995 'amount' => $options{amount},
4996 #'invoice_number' => $options{'invnum'},
4997 'customer_id' => $self->custnum,
4999 'reference' => $cust_pay_pending->paypendingnum, #for now
5004 $cust_pay_pending->status('pending');
5005 my $cpp_pending_err = $cust_pay_pending->replace;
5006 return $cpp_pending_err if $cpp_pending_err;
5009 my $BOP_TESTING = 0;
5010 my $BOP_TESTING_SUCCESS = 1;
5012 unless ( $BOP_TESTING ) {
5013 $transaction->submit();
5015 if ( $BOP_TESTING_SUCCESS ) {
5016 $transaction->is_success(1);
5017 $transaction->authorization('fake auth');
5019 $transaction->is_success(0);
5020 $transaction->error_message('fake failure');
5024 if ( $transaction->is_success() && $namespace eq 'Business::OnlineThirdPartyPayment' ) {
5026 return { reference => $cust_pay_pending->paypendingnum,
5027 map { $_ => $transaction->$_ } qw ( popup_url collectitems ) };
5029 } elsif ( $transaction->is_success() && $action2 ) {
5031 $cust_pay_pending->status('authorized');
5032 my $cpp_authorized_err = $cust_pay_pending->replace;
5033 return $cpp_authorized_err if $cpp_authorized_err;
5035 my $auth = $transaction->authorization;
5036 my $ordernum = $transaction->can('order_number')
5037 ? $transaction->order_number
5041 new Business::OnlinePayment( $payment_gateway->gateway_module,
5042 $self->_bop_options(\%options),
5047 type => $options{method},
5049 $self->_bop_auth(\%options),
5050 order_number => $ordernum,
5051 amount => $options{amount},
5052 authorization => $auth,
5053 description => $options{'description'},
5056 foreach my $field (qw( authorization_source_code returned_ACI
5057 transaction_identifier validation_code
5058 transaction_sequence_num local_transaction_date
5059 local_transaction_time AVS_result_code )) {
5060 $capture{$field} = $transaction->$field() if $transaction->can($field);
5063 $capture->content( %capture );
5067 unless ( $capture->is_success ) {
5068 my $e = "Authorization successful but capture failed, custnum #".
5069 $self->custnum. ': '. $capture->result_code.
5070 ": ". $capture->error_message;
5078 # remove paycvv after initial transaction
5081 #false laziness w/misc/process/payment.cgi - check both to make sure working
5083 if ( defined $self->dbdef_table->column('paycvv')
5084 && length($self->paycvv)
5085 && ! grep { $_ eq cardtype($options{payinfo}) } $conf->config('cvv-save')
5087 my $error = $self->remove_cvv;
5089 warn "WARNING: error removing cvv: $error\n";
5097 $self->_realtime_bop_result( $cust_pay_pending, $transaction, %options );
5109 if (ref($_[0]) eq 'HASH') {
5110 %options = %{$_[0]};
5112 my ( $method, $amount ) = ( shift, shift );
5114 $options{method} = $method;
5115 $options{amount} = $amount;
5118 if ( $options{'fake_failure'} ) {
5119 return "Error: No error; test failure requested with fake_failure";
5123 #if ( $payment_gateway->gatewaynum ) { # agent override
5124 # $paybatch = $payment_gateway->gatewaynum. '-';
5127 #$paybatch .= "$processor:". $transaction->authorization;
5129 #$paybatch .= ':'. $transaction->order_number
5130 # if $transaction->can('order_number')
5131 # && length($transaction->order_number);
5133 my $paybatch = 'FakeProcessor:54:32';
5135 my $cust_pay = new FS::cust_pay ( {
5136 'custnum' => $self->custnum,
5137 'invnum' => $options{'invnum'},
5138 'paid' => $options{amount},
5140 'payby' => $bop_method2payby{$options{method}},
5141 #'payinfo' => $payinfo,
5142 'payinfo' => '4111111111111111',
5143 'paybatch' => $paybatch,
5144 #'paydate' => $paydate,
5145 'paydate' => '2012-05-01',
5147 $cust_pay->payunique( $options{payunique} ) if length($options{payunique});
5149 my $error = $cust_pay->insert($options{'manual'} ? ( 'manual' => 1 ) : () );
5152 $cust_pay->invnum(''); #try again with no specific invnum
5153 my $error2 = $cust_pay->insert( $options{'manual'} ?
5154 ( 'manual' => 1 ) : ()
5157 # gah, even with transactions.
5158 my $e = 'WARNING: Card/ACH debited but database not updated - '.
5159 "error inserting (fake!) payment: $error2".
5160 " (previously tried insert with invnum #$options{'invnum'}" .
5167 if ( $options{'paynum_ref'} ) {
5168 ${ $options{'paynum_ref'} } = $cust_pay->paynum;
5171 return ''; #no error
5176 # item _realtime_bop_result CUST_PAY_PENDING, BOP_OBJECT [ OPTION => VALUE ... ]
5178 # Wraps up processing of a realtime credit card, ACH (electronic check) or
5179 # phone bill transaction.
5181 sub _realtime_bop_result {
5182 my( $self, $cust_pay_pending, $transaction, %options ) = @_;
5184 warn "$me _realtime_bop_result: pending transaction ".
5185 $cust_pay_pending->paypendingnum. "\n";
5186 warn " $_ => $options{$_}\n" foreach keys %options;
5189 my $payment_gateway = $options{payment_gateway}
5190 or return "no payment gateway in arguments to _realtime_bop_result";
5192 $cust_pay_pending->status($transaction->is_success() ? 'captured' : 'declined');
5193 my $cpp_captured_err = $cust_pay_pending->replace;
5194 return $cpp_captured_err if $cpp_captured_err;
5196 if ( $transaction->is_success() ) {
5199 if ( $payment_gateway->gatewaynum ) { # agent override
5200 $paybatch = $payment_gateway->gatewaynum. '-';
5203 $paybatch .= $payment_gateway->gateway_module. ":".
5204 $transaction->authorization;
5206 $paybatch .= ':'. $transaction->order_number
5207 if $transaction->can('order_number')
5208 && length($transaction->order_number);
5210 my $cust_pay = new FS::cust_pay ( {
5211 'custnum' => $self->custnum,
5212 'invnum' => $options{'invnum'},
5213 'paid' => $cust_pay_pending->paid,
5215 'payby' => $cust_pay_pending->payby,
5216 #'payinfo' => $payinfo,
5217 'paybatch' => $paybatch,
5218 'paydate' => $cust_pay_pending->paydate,
5220 #doesn't hurt to know, even though the dup check is in cust_pay_pending now
5221 $cust_pay->payunique( $options{payunique} )
5222 if defined($options{payunique}) && length($options{payunique});
5224 my $oldAutoCommit = $FS::UID::AutoCommit;
5225 local $FS::UID::AutoCommit = 0;
5228 #start a transaction, insert the cust_pay and set cust_pay_pending.status to done in a single transction
5230 my $error = $cust_pay->insert($options{'manual'} ? ( 'manual' => 1 ) : () );
5233 $cust_pay->invnum(''); #try again with no specific invnum
5234 my $error2 = $cust_pay->insert( $options{'manual'} ?
5235 ( 'manual' => 1 ) : ()
5238 # gah. but at least we have a record of the state we had to abort in
5239 # from cust_pay_pending now.
5240 my $e = "WARNING: $options{method} captured but payment not recorded -".
5241 " error inserting payment (". $payment_gateway->gateway_module.
5243 " (previously tried insert with invnum #$options{'invnum'}" .
5244 ": $error ) - pending payment saved as paypendingnum ".
5245 $cust_pay_pending->paypendingnum. "\n";
5251 my $jobnum = $cust_pay_pending->jobnum;
5253 my $placeholder = qsearchs( 'queue', { 'jobnum' => $jobnum } );
5255 unless ( $placeholder ) {
5256 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
5257 my $e = "WARNING: $options{method} captured but job $jobnum not ".
5258 "found for paypendingnum ". $cust_pay_pending->paypendingnum. "\n";
5263 $error = $placeholder->delete;
5266 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
5267 my $e = "WARNING: $options{method} captured but could not delete ".
5268 "job $jobnum for paypendingnum ".
5269 $cust_pay_pending->paypendingnum. ": $error\n";
5276 if ( $options{'paynum_ref'} ) {
5277 ${ $options{'paynum_ref'} } = $cust_pay->paynum;
5280 $cust_pay_pending->status('done');
5281 $cust_pay_pending->statustext('captured');
5282 $cust_pay_pending->paynum($cust_pay->paynum);
5283 my $cpp_done_err = $cust_pay_pending->replace;
5285 if ( $cpp_done_err ) {
5287 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
5288 my $e = "WARNING: $options{method} captured but payment not recorded - ".
5289 "error updating status for paypendingnum ".
5290 $cust_pay_pending->paypendingnum. ": $cpp_done_err \n";
5296 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
5297 return ''; #no error
5303 my $perror = $payment_gateway->gateway_module. " error: ".
5304 $transaction->error_message;
5306 my $jobnum = $cust_pay_pending->jobnum;
5308 my $placeholder = qsearchs( 'queue', { 'jobnum' => $jobnum } );
5310 if ( $placeholder ) {
5311 my $error = $placeholder->depended_delete;
5312 $error ||= $placeholder->delete;
5313 warn "error removing provisioning jobs after declined paypendingnum ".
5314 $cust_pay_pending->paypendingnum. "\n";
5316 my $e = "error finding job $jobnum for declined paypendingnum ".
5317 $cust_pay_pending->paypendingnum. "\n";
5323 unless ( $transaction->error_message ) {
5326 if ( $transaction->can('response_page') ) {
5328 'page' => ( $transaction->can('response_page')
5329 ? $transaction->response_page
5332 'code' => ( $transaction->can('response_code')
5333 ? $transaction->response_code
5336 'headers' => ( $transaction->can('response_headers')
5337 ? $transaction->response_headers
5343 "No additional debugging information available for ".
5344 $payment_gateway->gateway_module;
5347 $perror .= "No error_message returned from ".
5348 $payment_gateway->gateway_module. " -- ".
5349 ( ref($t_response) ? Dumper($t_response) : $t_response );
5353 if ( !$options{'quiet'} && !$realtime_bop_decline_quiet
5354 && $conf->exists('emaildecline')
5355 && grep { $_ ne 'POST' } $self->invoicing_list
5356 && ! grep { $transaction->error_message =~ /$_/ }
5357 $conf->config('emaildecline-exclude')
5359 my @templ = $conf->config('declinetemplate');
5360 my $template = new Text::Template (
5362 SOURCE => [ map "$_\n", @templ ],
5363 ) or return "($perror) can't create template: $Text::Template::ERROR";
5364 $template->compile()
5365 or return "($perror) can't compile template: $Text::Template::ERROR";
5367 my $templ_hash = { error => $transaction->error_message };
5369 my $error = send_email(
5370 'from' => $conf->config('invoice_from', $self->agentnum ),
5371 'to' => [ grep { $_ ne 'POST' } $self->invoicing_list ],
5372 'subject' => 'Your payment could not be processed',
5373 'body' => [ $template->fill_in(HASH => $templ_hash) ],
5376 $perror .= " (also received error sending decline notification: $error)"
5381 $cust_pay_pending->status('done');
5382 $cust_pay_pending->statustext("declined: $perror");
5383 my $cpp_done_err = $cust_pay_pending->replace;
5384 if ( $cpp_done_err ) {
5385 my $e = "WARNING: $options{method} declined but pending payment not ".
5386 "resolved - error updating status for paypendingnum ".
5387 $cust_pay_pending->paypendingnum. ": $cpp_done_err \n";
5389 $perror = "$e ($perror)";
5397 =item realtime_botpp_capture CUST_PAY_PENDING [ OPTION => VALUE ... ]
5399 Verifies successful third party processing of a realtime credit card,
5400 ACH (electronic check) or phone bill transaction via a
5401 Business::OnlineThirdPartyPayment realtime gateway. See
5402 L<http://420.am/business-onlinethirdpartypayment> for supported gateways.
5404 Available options are: I<description>, I<invnum>, I<quiet>, I<paynum_ref>, I<payunique>
5406 The additional options I<payname>, I<city>, I<state>,
5407 I<zip>, I<payinfo> and I<paydate> are also available. Any of these options,
5408 if set, will override the value from the customer record.
5410 I<description> is a free-text field passed to the gateway. It defaults to
5411 "Internet services".
5413 If an I<invnum> is specified, this payment (if successful) is applied to the
5414 specified invoice. If you don't specify an I<invnum> you might want to
5415 call the B<apply_payments> method.
5417 I<quiet> can be set true to surpress email decline notices.
5419 I<paynum_ref> can be set to a scalar reference. It will be filled in with the
5420 resulting paynum, if any.
5422 I<payunique> is a unique identifier for this payment.
5424 Returns a hashref containing elements bill_error (which will be undefined
5425 upon success) and session_id of any associated session.
5429 sub realtime_botpp_capture {
5430 my( $self, $cust_pay_pending, %options ) = @_;
5432 warn "$me realtime_botpp_capture: pending transaction $cust_pay_pending\n";
5433 warn " $_ => $options{$_}\n" foreach keys %options;
5436 eval "use Business::OnlineThirdPartyPayment";
5440 # select the gateway
5443 my $method = FS::payby->payby2bop($cust_pay_pending->payby);
5445 my $payment_gateway = $cust_pay_pending->gatewaynum
5446 ? qsearchs( 'payment_gateway',
5447 { gatewaynum => $cust_pay_pending->gatewaynum }
5449 : $self->agent->payment_gateway( 'method' => $method,
5450 # 'invnum' => $cust_pay_pending->invnum,
5451 # 'payinfo' => $cust_pay_pending->payinfo,
5454 $options{payment_gateway} = $payment_gateway; # for the helper subs
5460 my @invoicing_list = $self->invoicing_list_emailonly;
5461 if ( $conf->exists('emailinvoiceautoalways')
5462 || $conf->exists('emailinvoiceauto') && ! @invoicing_list
5463 || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
5464 push @invoicing_list, $self->all_emails;
5467 my $email = ($conf->exists('business-onlinepayment-email-override'))
5468 ? $conf->config('business-onlinepayment-email-override')
5469 : $invoicing_list[0];
5473 $content{email_customer} =
5474 ( $conf->exists('business-onlinepayment-email_customer')
5475 || $conf->exists('business-onlinepayment-email-override') );
5478 # run transaction(s)
5482 new Business::OnlineThirdPartyPayment( $payment_gateway->gateway_module,
5483 $self->_bop_options(\%options),
5486 $transaction->reference({ %options });
5488 $transaction->content(
5490 $self->_bop_auth(\%options),
5491 'action' => 'Post Authorization',
5492 'description' => $options{'description'},
5493 'amount' => $cust_pay_pending->paid,
5494 #'invoice_number' => $options{'invnum'},
5495 'customer_id' => $self->custnum,
5496 'referer' => 'http://cleanwhisker.420.am/',
5497 'reference' => $cust_pay_pending->paypendingnum,
5499 'phone' => $self->daytime || $self->night,
5501 # plus whatever is required for bogus capture avoidance
5504 $transaction->submit();
5507 $self->_realtime_bop_result( $cust_pay_pending, $transaction, %options );
5510 bill_error => $error,
5511 session_id => $cust_pay_pending->session_id,
5516 =item default_payment_gateway DEPRECATED -- use agent->payment_gateway
5520 sub default_payment_gateway {
5521 my( $self, $method ) = @_;
5523 die "Real-time processing not enabled\n"
5524 unless $conf->exists('business-onlinepayment');
5526 #warn "default_payment_gateway deprecated -- use agent->payment_gateway\n";
5529 my $bop_config = 'business-onlinepayment';
5530 $bop_config .= '-ach'
5531 if $method =~ /^(ECHECK|CHEK)$/ && $conf->exists($bop_config. '-ach');
5532 my ( $processor, $login, $password, $action, @bop_options ) =
5533 $conf->config($bop_config);
5534 $action ||= 'normal authorization';
5535 pop @bop_options if scalar(@bop_options) % 2 && $bop_options[-1] =~ /^\s*$/;
5536 die "No real-time processor is enabled - ".
5537 "did you set the business-onlinepayment configuration value?\n"
5540 ( $processor, $login, $password, $action, @bop_options )
5545 Removes the I<paycvv> field from the database directly.
5547 If there is an error, returns the error, otherwise returns false.
5553 my $sth = dbh->prepare("UPDATE cust_main SET paycvv = '' WHERE custnum = ?")
5554 or return dbh->errstr;
5555 $sth->execute($self->custnum)
5556 or return $sth->errstr;
5561 =item _new_realtime_refund_bop METHOD [ OPTION => VALUE ... ]
5563 Refunds a realtime credit card, ACH (electronic check) or phone bill transaction
5564 via a Business::OnlinePayment realtime gateway. See
5565 L<http://420.am/business-onlinepayment> for supported gateways.
5567 Available methods are: I<CC>, I<ECHECK> and I<LEC>
5569 Available options are: I<amount>, I<reason>, I<paynum>, I<paydate>
5571 Most gateways require a reference to an original payment transaction to refund,
5572 so you probably need to specify a I<paynum>.
5574 I<amount> defaults to the original amount of the payment if not specified.
5576 I<reason> specifies a reason for the refund.
5578 I<paydate> specifies the expiration date for a credit card overriding the
5579 value from the customer record or the payment record. Specified as yyyy-mm-dd
5581 Implementation note: If I<amount> is unspecified or equal to the amount of the
5582 orignal payment, first an attempt is made to "void" the transaction via
5583 the gateway (to cancel a not-yet settled transaction) and then if that fails,
5584 the normal attempt is made to "refund" ("credit") the transaction via the
5585 gateway is attempted.
5587 #The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
5588 #I<zip>, I<payinfo> and I<paydate> are also available. Any of these options,
5589 #if set, will override the value from the customer record.
5591 #If an I<invnum> is specified, this payment (if successful) is applied to the
5592 #specified invoice. If you don't specify an I<invnum> you might want to
5593 #call the B<apply_payments> method.
5597 #some false laziness w/realtime_bop, not enough to make it worth merging
5598 #but some useful small subs should be pulled out
5599 sub _new_realtime_refund_bop {
5603 if (ref($_[0]) ne 'HASH') {
5604 %options = %{$_[0]};
5608 $options{method} = $method;
5612 warn "$me realtime_refund_bop (new): $options{method} refund\n";
5613 warn " $_ => $options{$_}\n" foreach keys %options;
5617 # look up the original payment and optionally a gateway for that payment
5621 my $amount = $options{'amount'};
5623 my( $processor, $login, $password, @bop_options, $namespace ) ;
5624 my( $auth, $order_number ) = ( '', '', '' );
5626 if ( $options{'paynum'} ) {
5628 warn " paynum: $options{paynum}\n" if $DEBUG > 1;
5629 $cust_pay = qsearchs('cust_pay', { paynum=>$options{'paynum'} } )
5630 or return "Unknown paynum $options{'paynum'}";
5631 $amount ||= $cust_pay->paid;
5633 $cust_pay->paybatch =~ /^((\d+)\-)?(\w+):\s*([\w\-\/ ]*)(:([\w\-]+))?$/
5634 or return "Can't parse paybatch for paynum $options{'paynum'}: ".
5635 $cust_pay->paybatch;
5636 my $gatewaynum = '';
5637 ( $gatewaynum, $processor, $auth, $order_number ) = ( $2, $3, $4, $6 );
5639 if ( $gatewaynum ) { #gateway for the payment to be refunded
5641 my $payment_gateway =
5642 qsearchs('payment_gateway', { 'gatewaynum' => $gatewaynum } );
5643 die "payment gateway $gatewaynum not found"
5644 unless $payment_gateway;
5646 $processor = $payment_gateway->gateway_module;
5647 $login = $payment_gateway->gateway_username;
5648 $password = $payment_gateway->gateway_password;
5649 $namespace = $payment_gateway->gateway_namespace;
5650 @bop_options = $payment_gateway->options;
5652 } else { #try the default gateway
5655 my $payment_gateway =
5656 $self->agent->payment_gateway('method' => $options{method});
5658 ( $conf_processor, $login, $password, $namespace ) =
5659 map { my $method = "gateway_$_"; $payment_gateway->$method }
5660 qw( module username password namespace );
5662 @bop_options = $payment_gateway->gatewaynum
5663 ? $payment_gateway->options
5664 : @{ $payment_gateway->get('options') };
5666 return "processor of payment $options{'paynum'} $processor does not".
5667 " match default processor $conf_processor"
5668 unless $processor eq $conf_processor;
5673 } else { # didn't specify a paynum, so look for agent gateway overrides
5674 # like a normal transaction
5676 my $payment_gateway =
5677 $self->agent->payment_gateway( 'method' => $options{method},
5678 #'payinfo' => $payinfo,
5680 my( $processor, $login, $password, $namespace ) =
5681 map { my $method = "gateway_$_"; $payment_gateway->$method }
5682 qw( module username password namespace );
5684 my @bop_options = $payment_gateway->gatewaynum
5685 ? $payment_gateway->options
5686 : @{ $payment_gateway->get('options') };
5689 return "neither amount nor paynum specified" unless $amount;
5691 eval "use $namespace";
5695 'type' => $options{method},
5697 'password' => $password,
5698 'order_number' => $order_number,
5699 'amount' => $amount,
5700 'referer' => 'http://cleanwhisker.420.am/', #XXX fix referer :/
5702 $content{authorization} = $auth
5703 if length($auth); #echeck/ACH transactions have an order # but no auth
5704 #(at least with authorize.net)
5706 my $disable_void_after;
5707 if ($conf->exists('disable_void_after')
5708 && $conf->config('disable_void_after') =~ /^(\d+)$/) {
5709 $disable_void_after = $1;
5712 #first try void if applicable
5713 if ( $cust_pay && $cust_pay->paid == $amount
5715 ( not defined($disable_void_after) )
5716 || ( time < ($cust_pay->_date + $disable_void_after ) )
5719 warn " attempting void\n" if $DEBUG > 1;
5720 my $void = new Business::OnlinePayment( $processor, @bop_options );
5721 $void->content( 'action' => 'void', %content );
5723 if ( $void->is_success ) {
5724 my $error = $cust_pay->void($options{'reason'});
5726 # gah, even with transactions.
5727 my $e = 'WARNING: Card/ACH voided but database not updated - '.
5728 "error voiding payment: $error";
5732 warn " void successful\n" if $DEBUG > 1;
5737 warn " void unsuccessful, trying refund\n"
5741 my $address = $self->address1;
5742 $address .= ", ". $self->address2 if $self->address2;
5744 my($payname, $payfirst, $paylast);
5745 if ( $self->payname && $options{method} ne 'ECHECK' ) {
5746 $payname = $self->payname;
5747 $payname =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
5748 or return "Illegal payname $payname";
5749 ($payfirst, $paylast) = ($1, $2);
5751 $payfirst = $self->getfield('first');
5752 $paylast = $self->getfield('last');
5753 $payname = "$payfirst $paylast";
5756 my @invoicing_list = $self->invoicing_list_emailonly;
5757 if ( $conf->exists('emailinvoiceautoalways')
5758 || $conf->exists('emailinvoiceauto') && ! @invoicing_list
5759 || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
5760 push @invoicing_list, $self->all_emails;
5763 my $email = ($conf->exists('business-onlinepayment-email-override'))
5764 ? $conf->config('business-onlinepayment-email-override')
5765 : $invoicing_list[0];
5767 my $payip = exists($options{'payip'})
5770 $content{customer_ip} = $payip
5774 if ( $options{method} eq 'CC' ) {
5777 $content{card_number} = $payinfo = $cust_pay->payinfo;
5778 (exists($options{'paydate'}) ? $options{'paydate'} : $cust_pay->paydate)
5779 =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/ &&
5780 ($content{expiration} = "$2/$1"); # where available
5782 $content{card_number} = $payinfo = $self->payinfo;
5783 (exists($options{'paydate'}) ? $options{'paydate'} : $self->paydate)
5784 =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
5785 $content{expiration} = "$2/$1";
5788 } elsif ( $options{method} eq 'ECHECK' ) {
5791 $payinfo = $cust_pay->payinfo;
5793 $payinfo = $self->payinfo;
5795 ( $content{account_number}, $content{routing_code} )= split('@', $payinfo );
5796 $content{bank_name} = $self->payname;
5797 $content{account_type} = 'CHECKING';
5798 $content{account_name} = $payname;
5799 $content{customer_org} = $self->company ? 'B' : 'I';
5800 $content{customer_ssn} = $self->ss;
5801 } elsif ( $options{method} eq 'LEC' ) {
5802 $content{phone} = $payinfo = $self->payinfo;
5806 my $refund = new Business::OnlinePayment( $processor, @bop_options );
5807 my %sub_content = $refund->content(
5808 'action' => 'credit',
5809 'customer_id' => $self->custnum,
5810 'last_name' => $paylast,
5811 'first_name' => $payfirst,
5813 'address' => $address,
5814 'city' => $self->city,
5815 'state' => $self->state,
5816 'zip' => $self->zip,
5817 'country' => $self->country,
5819 'phone' => $self->daytime || $self->night,
5822 warn join('', map { " $_ => $sub_content{$_}\n" } keys %sub_content )
5826 return "$processor error: ". $refund->error_message
5827 unless $refund->is_success();
5829 my $paybatch = "$processor:". $refund->authorization;
5830 $paybatch .= ':'. $refund->order_number
5831 if $refund->can('order_number') && $refund->order_number;
5833 while ( $cust_pay && $cust_pay->unapplied < $amount ) {
5834 my @cust_bill_pay = $cust_pay->cust_bill_pay;
5835 last unless @cust_bill_pay;
5836 my $cust_bill_pay = pop @cust_bill_pay;
5837 my $error = $cust_bill_pay->delete;
5841 my $cust_refund = new FS::cust_refund ( {
5842 'custnum' => $self->custnum,
5843 'paynum' => $options{'paynum'},
5844 'refund' => $amount,
5846 'payby' => $bop_method2payby{$options{method}},
5847 'payinfo' => $payinfo,
5848 'paybatch' => $paybatch,
5849 'reason' => $options{'reason'} || 'card or ACH refund',
5851 my $error = $cust_refund->insert;
5853 $cust_refund->paynum(''); #try again with no specific paynum
5854 my $error2 = $cust_refund->insert;
5856 # gah, even with transactions.
5857 my $e = 'WARNING: Card/ACH refunded but database not updated - '.
5858 "error inserting refund ($processor): $error2".
5859 " (previously tried insert with paynum #$options{'paynum'}" .
5870 =item batch_card OPTION => VALUE...
5872 Adds a payment for this invoice to the pending credit card batch (see
5873 L<FS::cust_pay_batch>), or, if the B<realtime> option is set to a true value,
5874 runs the payment using a realtime gateway.
5879 my ($self, %options) = @_;
5882 if (exists($options{amount})) {
5883 $amount = $options{amount};
5885 $amount = sprintf("%.2f", $self->balance - $self->in_transit_payments);
5887 return '' unless $amount > 0;
5889 my $invnum = delete $options{invnum};
5890 my $payby = $options{invnum} || $self->payby; #dubious
5892 if ($options{'realtime'}) {
5893 return $self->realtime_bop( FS::payby->payby2bop($self->payby),
5899 my $oldAutoCommit = $FS::UID::AutoCommit;
5900 local $FS::UID::AutoCommit = 0;
5903 #this needs to handle mysql as well as Pg, like svc_acct.pm
5904 #(make it into a common function if folks need to do batching with mysql)
5905 $dbh->do("LOCK TABLE pay_batch IN SHARE ROW EXCLUSIVE MODE")
5906 or return "Cannot lock pay_batch: " . $dbh->errstr;
5910 'payby' => FS::payby->payby2payment($payby),
5913 my $pay_batch = qsearchs( 'pay_batch', \%pay_batch );
5915 unless ( $pay_batch ) {
5916 $pay_batch = new FS::pay_batch \%pay_batch;
5917 my $error = $pay_batch->insert;
5919 $dbh->rollback if $oldAutoCommit;
5920 die "error creating new batch: $error\n";
5924 my $old_cust_pay_batch = qsearchs('cust_pay_batch', {
5925 'batchnum' => $pay_batch->batchnum,
5926 'custnum' => $self->custnum,
5929 foreach (qw( address1 address2 city state zip country payby payinfo paydate
5931 $options{$_} = '' unless exists($options{$_});
5934 my $cust_pay_batch = new FS::cust_pay_batch ( {
5935 'batchnum' => $pay_batch->batchnum,
5936 'invnum' => $invnum || 0, # is there a better value?
5937 # this field should be
5939 # cust_bill_pay_batch now
5940 'custnum' => $self->custnum,
5941 'last' => $self->getfield('last'),
5942 'first' => $self->getfield('first'),
5943 'address1' => $options{address1} || $self->address1,
5944 'address2' => $options{address2} || $self->address2,
5945 'city' => $options{city} || $self->city,
5946 'state' => $options{state} || $self->state,
5947 'zip' => $options{zip} || $self->zip,
5948 'country' => $options{country} || $self->country,
5949 'payby' => $options{payby} || $self->payby,
5950 'payinfo' => $options{payinfo} || $self->payinfo,
5951 'exp' => $options{paydate} || $self->paydate,
5952 'payname' => $options{payname} || $self->payname,
5953 'amount' => $amount, # consolidating
5956 $cust_pay_batch->paybatchnum($old_cust_pay_batch->paybatchnum)
5957 if $old_cust_pay_batch;
5960 if ($old_cust_pay_batch) {
5961 $error = $cust_pay_batch->replace($old_cust_pay_batch)
5963 $error = $cust_pay_batch->insert;
5967 $dbh->rollback if $oldAutoCommit;
5971 my $unapplied = $self->total_unapplied_credits
5972 + $self->total_unapplied_payments
5973 + $self->in_transit_payments;
5974 foreach my $cust_bill ($self->open_cust_bill) {
5975 #$dbh->commit or die $dbh->errstr if $oldAutoCommit;
5976 my $cust_bill_pay_batch = new FS::cust_bill_pay_batch {
5977 'invnum' => $cust_bill->invnum,
5978 'paybatchnum' => $cust_pay_batch->paybatchnum,
5979 'amount' => $cust_bill->owed,
5982 if ($unapplied >= $cust_bill_pay_batch->amount){
5983 $unapplied -= $cust_bill_pay_batch->amount;
5986 $cust_bill_pay_batch->amount(sprintf ( "%.2f",
5987 $cust_bill_pay_batch->amount - $unapplied )); $unapplied = 0;
5989 $error = $cust_bill_pay_batch->insert;
5991 $dbh->rollback if $oldAutoCommit;
5996 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
6000 =item apply_payments_and_credits
6002 Applies unapplied payments and credits.
6004 In most cases, this new method should be used in place of sequential
6005 apply_payments and apply_credits methods.
6007 If there is an error, returns the error, otherwise returns false.
6011 sub apply_payments_and_credits {
6014 local $SIG{HUP} = 'IGNORE';
6015 local $SIG{INT} = 'IGNORE';
6016 local $SIG{QUIT} = 'IGNORE';
6017 local $SIG{TERM} = 'IGNORE';
6018 local $SIG{TSTP} = 'IGNORE';
6019 local $SIG{PIPE} = 'IGNORE';
6021 my $oldAutoCommit = $FS::UID::AutoCommit;
6022 local $FS::UID::AutoCommit = 0;
6025 $self->select_for_update; #mutex
6027 foreach my $cust_bill ( $self->open_cust_bill ) {
6028 my $error = $cust_bill->apply_payments_and_credits;
6030 $dbh->rollback if $oldAutoCommit;
6031 return "Error applying: $error";
6035 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
6040 =item apply_credits OPTION => VALUE ...
6042 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
6043 to outstanding invoice balances in chronological order (or reverse
6044 chronological order if the I<order> option is set to B<newest>) and returns the
6045 value of any remaining unapplied credits available for refund (see
6046 L<FS::cust_refund>).
6048 Dies if there is an error.
6056 local $SIG{HUP} = 'IGNORE';
6057 local $SIG{INT} = 'IGNORE';
6058 local $SIG{QUIT} = 'IGNORE';
6059 local $SIG{TERM} = 'IGNORE';
6060 local $SIG{TSTP} = 'IGNORE';
6061 local $SIG{PIPE} = 'IGNORE';
6063 my $oldAutoCommit = $FS::UID::AutoCommit;
6064 local $FS::UID::AutoCommit = 0;
6067 $self->select_for_update; #mutex
6069 unless ( $self->total_unapplied_credits ) {
6070 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
6074 my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
6075 qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
6077 my @invoices = $self->open_cust_bill;
6078 @invoices = sort { $b->_date <=> $a->_date } @invoices
6079 if defined($opt{'order'}) && $opt{'order'} eq 'newest';
6082 foreach my $cust_bill ( @invoices ) {
6085 if ( !defined($credit) || $credit->credited == 0) {
6086 $credit = pop @credits or last;
6089 if ($cust_bill->owed >= $credit->credited) {
6090 $amount=$credit->credited;
6092 $amount=$cust_bill->owed;
6095 my $cust_credit_bill = new FS::cust_credit_bill ( {
6096 'crednum' => $credit->crednum,
6097 'invnum' => $cust_bill->invnum,
6098 'amount' => $amount,
6100 my $error = $cust_credit_bill->insert;
6102 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
6106 redo if ($cust_bill->owed > 0);
6110 my $total_unapplied_credits = $self->total_unapplied_credits;
6112 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
6114 return $total_unapplied_credits;
6117 =item apply_payments
6119 Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
6120 to outstanding invoice balances in chronological order.
6122 #and returns the value of any remaining unapplied payments.
6124 Dies if there is an error.
6128 sub apply_payments {
6131 local $SIG{HUP} = 'IGNORE';
6132 local $SIG{INT} = 'IGNORE';
6133 local $SIG{QUIT} = 'IGNORE';
6134 local $SIG{TERM} = 'IGNORE';
6135 local $SIG{TSTP} = 'IGNORE';
6136 local $SIG{PIPE} = 'IGNORE';
6138 my $oldAutoCommit = $FS::UID::AutoCommit;
6139 local $FS::UID::AutoCommit = 0;
6142 $self->select_for_update; #mutex
6146 my @payments = sort { $b->_date <=> $a->_date }
6147 grep { $_->unapplied > 0 }
6150 my @invoices = sort { $a->_date <=> $b->_date}
6151 grep { $_->owed > 0 }
6156 foreach my $cust_bill ( @invoices ) {
6159 if ( !defined($payment) || $payment->unapplied == 0 ) {
6160 $payment = pop @payments or last;
6163 if ( $cust_bill->owed >= $payment->unapplied ) {
6164 $amount = $payment->unapplied;
6166 $amount = $cust_bill->owed;
6169 my $cust_bill_pay = new FS::cust_bill_pay ( {
6170 'paynum' => $payment->paynum,
6171 'invnum' => $cust_bill->invnum,
6172 'amount' => $amount,
6174 my $error = $cust_bill_pay->insert;
6176 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
6180 redo if ( $cust_bill->owed > 0);
6184 my $total_unapplied_payments = $self->total_unapplied_payments;
6186 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
6188 return $total_unapplied_payments;
6193 Returns the total owed for this customer on all invoices
6194 (see L<FS::cust_bill/owed>).
6200 $self->total_owed_date(2145859200); #12/31/2037
6203 =item total_owed_date TIME
6205 Returns the total owed for this customer on all invoices with date earlier than
6206 TIME. TIME is specified as a UNIX timestamp; see L<perlfunc/"time">). Also
6207 see L<Time::Local> and L<Date::Parse> for conversion functions.
6211 sub total_owed_date {
6215 # my $custnum = $self->custnum;
6217 # my $owed_sql = FS::cust_bill->owed_sql;
6220 # SELECT SUM($owed_sql) FROM cust_bill
6221 # WHERE custnum = $custnum
6222 # AND _date <= $time
6225 # my $sth = dbh->prepare($sql) or die dbh->errstr;
6226 # $sth->execute() or die $sth->errstr;
6228 # return sprintf( '%.2f', $sth->fetchrow_arrayref->[0] );
6231 foreach my $cust_bill (
6232 grep { $_->_date <= $time }
6233 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
6235 $total_bill += $cust_bill->owed;
6237 sprintf( "%.2f", $total_bill );
6243 Returns the total amount of all payments.
6250 $total += $_->paid foreach $self->cust_pay;
6251 sprintf( "%.2f", $total );
6254 =item total_unapplied_credits
6256 Returns the total outstanding credit (see L<FS::cust_credit>) for this
6257 customer. See L<FS::cust_credit/credited>.
6259 =item total_credited
6261 Old name for total_unapplied_credits. Don't use.
6265 sub total_credited {
6266 #carp "total_credited deprecated, use total_unapplied_credits";
6267 shift->total_unapplied_credits(@_);
6270 sub total_unapplied_credits {
6272 my $total_credit = 0;
6273 $total_credit += $_->credited foreach $self->cust_credit;
6274 sprintf( "%.2f", $total_credit );
6277 =item total_unapplied_payments
6279 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
6280 See L<FS::cust_pay/unapplied>.
6284 sub total_unapplied_payments {
6286 my $total_unapplied = 0;
6287 $total_unapplied += $_->unapplied foreach $self->cust_pay;
6288 sprintf( "%.2f", $total_unapplied );
6291 =item total_unapplied_refunds
6293 Returns the total unrefunded refunds (see L<FS::cust_refund>) for this
6294 customer. See L<FS::cust_refund/unapplied>.
6298 sub total_unapplied_refunds {
6300 my $total_unapplied = 0;
6301 $total_unapplied += $_->unapplied foreach $self->cust_refund;
6302 sprintf( "%.2f", $total_unapplied );
6307 Returns the balance for this customer (total_owed plus total_unrefunded, minus
6308 total_unapplied_credits minus total_unapplied_payments).
6316 + $self->total_unapplied_refunds
6317 - $self->total_unapplied_credits
6318 - $self->total_unapplied_payments
6322 =item balance_date TIME
6324 Returns the balance for this customer, only considering invoices with date
6325 earlier than TIME (total_owed_date minus total_credited minus
6326 total_unapplied_payments). TIME is specified as a UNIX timestamp; see
6327 L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion
6336 $self->total_owed_date($time)
6337 + $self->total_unapplied_refunds
6338 - $self->total_unapplied_credits
6339 - $self->total_unapplied_payments
6343 =item in_transit_payments
6345 Returns the total of requests for payments for this customer pending in
6346 batches in transit to the bank. See L<FS::pay_batch> and L<FS::cust_pay_batch>
6350 sub in_transit_payments {
6352 my $in_transit_payments = 0;
6353 foreach my $pay_batch ( qsearch('pay_batch', {
6356 foreach my $cust_pay_batch ( qsearch('cust_pay_batch', {
6357 'batchnum' => $pay_batch->batchnum,
6358 'custnum' => $self->custnum,
6360 $in_transit_payments += $cust_pay_batch->amount;
6363 sprintf( "%.2f", $in_transit_payments );
6368 Returns a hash of useful information for making a payment.
6378 'CARD' (credit card - automatic), 'DCRD' (credit card - on-demand),
6379 'CHEK' (electronic check - automatic), 'DCHK' (electronic check - on-demand),
6380 'LECB' (Phone bill billing), 'BILL' (billing), or 'COMP' (free).
6384 For credit card transactions:
6396 For electronic check transactions:
6411 $return{balance} = $self->balance;
6413 $return{payname} = $self->payname
6414 || ( $self->first. ' '. $self->get('last') );
6416 $return{$_} = $self->get($_) for qw(address1 address2 city state zip);
6418 $return{payby} = $self->payby;
6419 $return{stateid_state} = $self->stateid_state;
6421 if ( $self->payby =~ /^(CARD|DCRD)$/ ) {
6422 $return{card_type} = cardtype($self->payinfo);
6423 $return{payinfo} = $self->paymask;
6425 @return{'month', 'year'} = $self->paydate_monthyear;
6429 if ( $self->payby =~ /^(CHEK|DCHK)$/ ) {
6430 my ($payinfo1, $payinfo2) = split '@', $self->paymask;
6431 $return{payinfo1} = $payinfo1;
6432 $return{payinfo2} = $payinfo2;
6433 $return{paytype} = $self->paytype;
6434 $return{paystate} = $self->paystate;
6438 #doubleclick protection
6440 $return{paybatch} = "webui-MyAccount-$_date-$$-". rand() * 2**32;
6446 =item paydate_monthyear
6448 Returns a two-element list consisting of the month and year of this customer's
6449 paydate (credit card expiration date for CARD customers)
6453 sub paydate_monthyear {
6455 if ( $self->paydate =~ /^(\d{4})-(\d{1,2})-\d{1,2}$/ ) { #Pg date format
6457 } elsif ( $self->paydate =~ /^(\d{1,2})-(\d{1,2}-)?(\d{4}$)/ ) {
6464 =item tax_exemption TAXNAME
6469 my( $self, $taxname ) = @_;
6471 qsearchs( 'cust_main_exemption', { 'custnum' => $self->custnum,
6472 'taxname' => $taxname,
6477 =item cust_main_exemption
6481 sub cust_main_exemption {
6483 qsearch( 'cust_main_exemption', { 'custnum' => $self->custnum } );
6486 =item invoicing_list [ ARRAYREF ]
6488 If an arguement is given, sets these email addresses as invoice recipients
6489 (see L<FS::cust_main_invoice>). Errors are not fatal and are not reported
6490 (except as warnings), so use check_invoicing_list first.
6492 Returns a list of email addresses (with svcnum entries expanded).
6494 Note: You can clear the invoicing list by passing an empty ARRAYREF. You can
6495 check it without disturbing anything by passing nothing.
6497 This interface may change in the future.
6501 sub invoicing_list {
6502 my( $self, $arrayref ) = @_;
6505 my @cust_main_invoice;
6506 if ( $self->custnum ) {
6507 @cust_main_invoice =
6508 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
6510 @cust_main_invoice = ();
6512 foreach my $cust_main_invoice ( @cust_main_invoice ) {
6513 #warn $cust_main_invoice->destnum;
6514 unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
6515 #warn $cust_main_invoice->destnum;
6516 my $error = $cust_main_invoice->delete;
6517 warn $error if $error;
6520 if ( $self->custnum ) {
6521 @cust_main_invoice =
6522 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
6524 @cust_main_invoice = ();
6526 my %seen = map { $_->address => 1 } @cust_main_invoice;
6527 foreach my $address ( @{$arrayref} ) {
6528 next if exists $seen{$address} && $seen{$address};
6529 $seen{$address} = 1;
6530 my $cust_main_invoice = new FS::cust_main_invoice ( {
6531 'custnum' => $self->custnum,
6534 my $error = $cust_main_invoice->insert;
6535 warn $error if $error;
6539 if ( $self->custnum ) {
6541 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
6548 =item check_invoicing_list ARRAYREF
6550 Checks these arguements as valid input for the invoicing_list method. If there
6551 is an error, returns the error, otherwise returns false.
6555 sub check_invoicing_list {
6556 my( $self, $arrayref ) = @_;
6558 foreach my $address ( @$arrayref ) {
6560 if ($address eq 'FAX' and $self->getfield('fax') eq '') {
6561 return 'Can\'t add FAX invoice destination with a blank FAX number.';
6564 my $cust_main_invoice = new FS::cust_main_invoice ( {
6565 'custnum' => $self->custnum,
6568 my $error = $self->custnum
6569 ? $cust_main_invoice->check
6570 : $cust_main_invoice->checkdest
6572 return $error if $error;
6576 return "Email address required"
6577 if $conf->exists('cust_main-require_invoicing_list_email')
6578 && ! grep { $_ !~ /^([A-Z]+)$/ } @$arrayref;
6583 =item set_default_invoicing_list
6585 Sets the invoicing list to all accounts associated with this customer,
6586 overwriting any previous invoicing list.
6590 sub set_default_invoicing_list {
6592 $self->invoicing_list($self->all_emails);
6597 Returns the email addresses of all accounts provisioned for this customer.
6604 foreach my $cust_pkg ( $self->all_pkgs ) {
6605 my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
6607 map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
6608 grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
6610 $list{$_}=1 foreach map { $_->email } @svc_acct;
6615 =item invoicing_list_addpost
6617 Adds postal invoicing to this customer. If this customer is already configured
6618 to receive postal invoices, does nothing.
6622 sub invoicing_list_addpost {
6624 return if grep { $_ eq 'POST' } $self->invoicing_list;
6625 my @invoicing_list = $self->invoicing_list;
6626 push @invoicing_list, 'POST';
6627 $self->invoicing_list(\@invoicing_list);
6630 =item invoicing_list_emailonly
6632 Returns the list of email invoice recipients (invoicing_list without non-email
6633 destinations such as POST and FAX).
6637 sub invoicing_list_emailonly {
6639 warn "$me invoicing_list_emailonly called"
6641 grep { $_ !~ /^([A-Z]+)$/ } $self->invoicing_list;
6644 =item invoicing_list_emailonly_scalar
6646 Returns the list of email invoice recipients (invoicing_list without non-email
6647 destinations such as POST and FAX) as a comma-separated scalar.
6651 sub invoicing_list_emailonly_scalar {
6653 warn "$me invoicing_list_emailonly_scalar called"
6655 join(', ', $self->invoicing_list_emailonly);
6658 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
6660 Returns an array of customers referred by this customer (referral_custnum set
6661 to this custnum). If DEPTH is given, recurses up to the given depth, returning
6662 customers referred by customers referred by this customer and so on, inclusive.
6663 The default behavior is DEPTH 1 (no recursion).
6667 sub referral_cust_main {
6669 my $depth = @_ ? shift : 1;
6670 my $exclude = @_ ? shift : {};
6673 map { $exclude->{$_->custnum}++; $_; }
6674 grep { ! $exclude->{ $_->custnum } }
6675 qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
6679 map { $_->referral_cust_main($depth-1, $exclude) }
6686 =item referral_cust_main_ncancelled
6688 Same as referral_cust_main, except only returns customers with uncancelled
6693 sub referral_cust_main_ncancelled {
6695 grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
6698 =item referral_cust_pkg [ DEPTH ]
6700 Like referral_cust_main, except returns a flat list of all unsuspended (and
6701 uncancelled) packages for each customer. The number of items in this list may
6702 be useful for comission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
6706 sub referral_cust_pkg {
6708 my $depth = @_ ? shift : 1;
6710 map { $_->unsuspended_pkgs }
6711 grep { $_->unsuspended_pkgs }
6712 $self->referral_cust_main($depth);
6715 =item referring_cust_main
6717 Returns the single cust_main record for the customer who referred this customer
6718 (referral_custnum), or false.
6722 sub referring_cust_main {
6724 return '' unless $self->referral_custnum;
6725 qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
6728 =item credit AMOUNT, REASON [ , OPTION => VALUE ... ]
6730 Applies a credit to this customer. If there is an error, returns the error,
6731 otherwise returns false.
6733 REASON can be a text string, an FS::reason object, or a scalar reference to
6734 a reasonnum. If a text string, it will be automatically inserted as a new
6735 reason, and a 'reason_type' option must be passed to indicate the
6736 FS::reason_type for the new reason.
6738 An I<addlinfo> option may be passed to set the credit's I<addlinfo> field.
6740 Any other options are passed to FS::cust_credit::insert.
6745 my( $self, $amount, $reason, %options ) = @_;
6747 my $cust_credit = new FS::cust_credit {
6748 'custnum' => $self->custnum,
6749 'amount' => $amount,
6752 if ( ref($reason) ) {
6754 if ( ref($reason) eq 'SCALAR' ) {
6755 $cust_credit->reasonnum( $$reason );
6757 $cust_credit->reasonnum( $reason->reasonnum );
6761 $cust_credit->set('reason', $reason)
6764 $cust_credit->addlinfo( delete $options{'addlinfo'} )
6765 if exists($options{'addlinfo'});
6767 $cust_credit->insert(%options);
6771 =item charge HASHREF || AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
6773 Creates a one-time charge for this customer. If there is an error, returns
6774 the error, otherwise returns false.
6776 New-style, with a hashref of options:
6778 my $error = $cust_main->charge(
6782 'start_date' => str2time('7/4/2009'),
6783 'pkg' => 'Description',
6784 'comment' => 'Comment',
6785 'additional' => [], #extra invoice detail
6786 'classnum' => 1, #pkg_class
6788 'setuptax' => '', # or 'Y' for tax exempt
6791 'taxclass' => 'Tax class',
6794 'taxproduct' => 2, #part_pkg_taxproduct
6795 'override' => {}, #XXX describe
6801 my $error = $cust_main->charge( 54.32, 'Description', 'Comment', 'Tax class' );
6807 my ( $amount, $quantity, $start_date, $classnum );
6808 my ( $pkg, $comment, $additional );
6809 my ( $setuptax, $taxclass ); #internal taxes
6810 my ( $taxproduct, $override ); #vendor (CCH) taxes
6811 if ( ref( $_[0] ) ) {
6812 $amount = $_[0]->{amount};
6813 $quantity = exists($_[0]->{quantity}) ? $_[0]->{quantity} : 1;
6814 $start_date = exists($_[0]->{start_date}) ? $_[0]->{start_date} : '';
6815 $pkg = exists($_[0]->{pkg}) ? $_[0]->{pkg} : 'One-time charge';
6816 $comment = exists($_[0]->{comment}) ? $_[0]->{comment}
6817 : '$'. sprintf("%.2f",$amount);
6818 $setuptax = exists($_[0]->{setuptax}) ? $_[0]->{setuptax} : '';
6819 $taxclass = exists($_[0]->{taxclass}) ? $_[0]->{taxclass} : '';
6820 $classnum = exists($_[0]->{classnum}) ? $_[0]->{classnum} : '';
6821 $additional = $_[0]->{additional} || [];
6822 $taxproduct = $_[0]->{taxproductnum};
6823 $override = { '' => $_[0]->{tax_override} };
6828 $pkg = @_ ? shift : 'One-time charge';
6829 $comment = @_ ? shift : '$'. sprintf("%.2f",$amount);
6831 $taxclass = @_ ? shift : '';
6835 local $SIG{HUP} = 'IGNORE';
6836 local $SIG{INT} = 'IGNORE';
6837 local $SIG{QUIT} = 'IGNORE';
6838 local $SIG{TERM} = 'IGNORE';
6839 local $SIG{TSTP} = 'IGNORE';
6840 local $SIG{PIPE} = 'IGNORE';
6842 my $oldAutoCommit = $FS::UID::AutoCommit;
6843 local $FS::UID::AutoCommit = 0;
6846 my $part_pkg = new FS::part_pkg ( {
6848 'comment' => $comment,
6852 'classnum' => $classnum ? $classnum : '',
6853 'setuptax' => $setuptax,
6854 'taxclass' => $taxclass,
6855 'taxproductnum' => $taxproduct,
6858 my %options = ( ( map { ("additional_info$_" => $additional->[$_] ) }
6859 ( 0 .. @$additional - 1 )
6861 'additional_count' => scalar(@$additional),
6862 'setup_fee' => $amount,
6865 my $error = $part_pkg->insert( options => \%options,
6866 tax_overrides => $override,
6869 $dbh->rollback if $oldAutoCommit;
6873 my $pkgpart = $part_pkg->pkgpart;
6874 my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
6875 unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
6876 my $type_pkgs = new FS::type_pkgs \%type_pkgs;
6877 $error = $type_pkgs->insert;
6879 $dbh->rollback if $oldAutoCommit;
6884 my $cust_pkg = new FS::cust_pkg ( {
6885 'custnum' => $self->custnum,
6886 'pkgpart' => $pkgpart,
6887 'quantity' => $quantity,
6888 'start_date' => $start_date,
6891 $error = $cust_pkg->insert;
6893 $dbh->rollback if $oldAutoCommit;
6897 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
6902 #=item charge_postal_fee
6904 #Applies a one time charge this customer. If there is an error,
6905 #returns the error, returns the cust_pkg charge object or false
6906 #if there was no charge.
6910 # This should be a customer event. For that to work requires that bill
6911 # also be a customer event.
6913 sub charge_postal_fee {
6916 my $pkgpart = $conf->config('postal_invoice-fee_pkgpart');
6917 return '' unless ($pkgpart && grep { $_ eq 'POST' } $self->invoicing_list);
6919 my $cust_pkg = new FS::cust_pkg ( {
6920 'custnum' => $self->custnum,
6921 'pkgpart' => $pkgpart,
6925 my $error = $cust_pkg->insert;
6926 $error ? $error : $cust_pkg;
6931 Returns all the invoices (see L<FS::cust_bill>) for this customer.
6937 sort { $a->_date <=> $b->_date }
6938 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
6941 =item open_cust_bill
6943 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
6948 sub open_cust_bill {
6952 'table' => 'cust_bill',
6953 'hashref' => { 'custnum' => $self->custnum, },
6954 'extra_sql' => ' AND '. FS::cust_bill->owed_sql. ' > 0',
6955 'order_by' => 'ORDER BY _date ASC',
6962 Returns all the credits (see L<FS::cust_credit>) for this customer.
6968 sort { $a->_date <=> $b->_date }
6969 qsearch( 'cust_credit', { 'custnum' => $self->custnum } )
6974 Returns all the payments (see L<FS::cust_pay>) for this customer.
6980 sort { $a->_date <=> $b->_date }
6981 qsearch( 'cust_pay', { 'custnum' => $self->custnum } )
6986 Returns all voided payments (see L<FS::cust_pay_void>) for this customer.
6992 sort { $a->_date <=> $b->_date }
6993 qsearch( 'cust_pay_void', { 'custnum' => $self->custnum } )
6996 =item cust_pay_batch
6998 Returns all batched payments (see L<FS::cust_pay_void>) for this customer.
7002 sub cust_pay_batch {
7004 sort { $a->paybatchnum <=> $b->paybatchnum }
7005 qsearch( 'cust_pay_batch', { 'custnum' => $self->custnum } )
7008 =item cust_pay_pending
7010 Returns all pending payments (see L<FS::cust_pay_pending>) for this customer
7011 (without status "done").
7015 sub cust_pay_pending {
7017 return $self->num_cust_pay_pending unless wantarray;
7018 sort { $a->_date <=> $b->_date }
7019 qsearch( 'cust_pay_pending', {
7020 'custnum' => $self->custnum,
7021 'status' => { op=>'!=', value=>'done' },
7026 =item num_cust_pay_pending
7028 Returns the number of pending payments (see L<FS::cust_pay_pending>) for this
7029 customer (without status "done"). Also called automatically when the
7030 cust_pay_pending method is used in a scalar context.
7034 sub num_cust_pay_pending {
7036 my $sql = " SELECT COUNT(*) FROM cust_pay_pending ".
7037 " WHERE custnum = ? AND status != 'done' ";
7038 my $sth = dbh->prepare($sql) or die dbh->errstr;
7039 $sth->execute($self->custnum) or die $sth->errstr;
7040 $sth->fetchrow_arrayref->[0];
7045 Returns all the refunds (see L<FS::cust_refund>) for this customer.
7051 sort { $a->_date <=> $b->_date }
7052 qsearch( 'cust_refund', { 'custnum' => $self->custnum } )
7055 =item display_custnum
7057 Returns the displayed customer number for this customer: agent_custid if
7058 cust_main-default_agent_custid is set and it has a value, custnum otherwise.
7062 sub display_custnum {
7064 if ( $conf->exists('cust_main-default_agent_custid') && $self->agent_custid ){
7065 return $self->agent_custid;
7067 return $self->custnum;
7073 Returns a name string for this customer, either "Company (Last, First)" or
7080 my $name = $self->contact;
7081 $name = $self->company. " ($name)" if $self->company;
7087 Returns a name string for this (service/shipping) contact, either
7088 "Company (Last, First)" or "Last, First".
7094 if ( $self->get('ship_last') ) {
7095 my $name = $self->ship_contact;
7096 $name = $self->ship_company. " ($name)" if $self->ship_company;
7105 Returns a name string for this customer, either "Company" or "First Last".
7111 $self->company !~ /^\s*$/ ? $self->company : $self->contact_firstlast;
7114 =item ship_name_short
7116 Returns a name string for this (service/shipping) contact, either "Company"
7121 sub ship_name_short {
7123 if ( $self->get('ship_last') ) {
7124 $self->ship_company !~ /^\s*$/
7125 ? $self->ship_company
7126 : $self->ship_contact_firstlast;
7128 $self->name_company_or_firstlast;
7134 Returns this customer's full (billing) contact name only, "Last, First"
7140 $self->get('last'). ', '. $self->first;
7145 Returns this customer's full (shipping) contact name only, "Last, First"
7151 $self->get('ship_last')
7152 ? $self->get('ship_last'). ', '. $self->ship_first
7156 =item contact_firstlast
7158 Returns this customers full (billing) contact name only, "First Last".
7162 sub contact_firstlast {
7164 $self->first. ' '. $self->get('last');
7167 =item ship_contact_firstlast
7169 Returns this customer's full (shipping) contact name only, "First Last".
7173 sub ship_contact_firstlast {
7175 $self->get('ship_last')
7176 ? $self->first. ' '. $self->get('ship_last')
7177 : $self->contact_firstlast;
7182 Returns this customer's full country name
7188 code2country($self->country);
7191 =item geocode DATA_VENDOR
7193 Returns a value for the customer location as encoded by DATA_VENDOR.
7194 Currently this only makes sense for "CCH" as DATA_VENDOR.
7199 my ($self, $data_vendor) = (shift, shift); #always cch for now
7201 my $geocode = $self->get('geocode'); #XXX only one data_vendor for geocode
7202 return $geocode if $geocode;
7204 my $prefix = ( $conf->exists('tax-ship_address') && length($self->ship_last) )
7208 my ($zip,$plus4) = split /-/, $self->get("${prefix}zip")
7209 if $self->country eq 'US';
7211 #CCH specific location stuff
7212 my $extra_sql = "AND plus4lo <= '$plus4' AND plus4hi >= '$plus4'";
7214 my @cust_tax_location =
7216 'table' => 'cust_tax_location',
7217 'hashref' => { 'zip' => $zip, 'data_vendor' => $data_vendor },
7218 'extra_sql' => $extra_sql,
7219 'order_by' => 'ORDER BY plus4hi',#overlapping with distinct ends
7222 $geocode = $cust_tax_location[0]->geocode
7223 if scalar(@cust_tax_location);
7232 Returns a status string for this customer, currently:
7236 =item prospect - No packages have ever been ordered
7238 =item active - One or more recurring packages is active
7240 =item inactive - No active recurring packages, but otherwise unsuspended/uncancelled (the inactive status is new - previously inactive customers were mis-identified as cancelled)
7242 =item suspended - All non-cancelled recurring packages are suspended
7244 =item cancelled - All recurring packages are cancelled
7250 sub status { shift->cust_status(@_); }
7254 for my $status (qw( prospect active inactive suspended cancelled )) {
7255 my $method = $status.'_sql';
7256 my $numnum = ( my $sql = $self->$method() ) =~ s/cust_main\.custnum/?/g;
7257 my $sth = dbh->prepare("SELECT $sql") or die dbh->errstr;
7258 $sth->execute( ($self->custnum) x $numnum )
7259 or die "Error executing 'SELECT $sql': ". $sth->errstr;
7260 return $status if $sth->fetchrow_arrayref->[0];
7264 =item ucfirst_cust_status
7266 =item ucfirst_status
7268 Returns the status with the first character capitalized.
7272 sub ucfirst_status { shift->ucfirst_cust_status(@_); }
7274 sub ucfirst_cust_status {
7276 ucfirst($self->cust_status);
7281 Returns a hex triplet color string for this customer's status.
7285 use vars qw(%statuscolor);
7286 tie %statuscolor, 'Tie::IxHash',
7287 'prospect' => '7e0079', #'000000', #black? naw, purple
7288 'active' => '00CC00', #green
7289 'inactive' => '0000CC', #blue
7290 'suspended' => 'FF9900', #yellow
7291 'cancelled' => 'FF0000', #red
7294 sub statuscolor { shift->cust_statuscolor(@_); }
7296 sub cust_statuscolor {
7298 $statuscolor{$self->cust_status};
7303 Returns an array of hashes representing the customer's RT tickets.
7310 my $num = $conf->config('cust_main-max_tickets') || 10;
7313 if ( $conf->config('ticket_system') ) {
7314 unless ( $conf->config('ticket_system-custom_priority_field') ) {
7316 @tickets = @{ FS::TicketSystem->customer_tickets($self->custnum, $num) };
7320 foreach my $priority (
7321 $conf->config('ticket_system-custom_priority_field-values'), ''
7323 last if scalar(@tickets) >= $num;
7325 @{ FS::TicketSystem->customer_tickets( $self->custnum,
7326 $num - scalar(@tickets),
7336 # Return services representing svc_accts in customer support packages
7337 sub support_services {
7339 my %packages = map { $_ => 1 } $conf->config('support_packages');
7341 grep { $_->pkg_svc && $_->pkg_svc->primary_svc eq 'Y' }
7342 grep { $_->part_svc->svcdb eq 'svc_acct' }
7343 map { $_->cust_svc }
7344 grep { exists $packages{ $_->pkgpart } }
7345 $self->ncancelled_pkgs;
7351 =head1 CLASS METHODS
7357 Class method that returns the list of possible status strings for customers
7358 (see L<the status method|/status>). For example:
7360 @statuses = FS::cust_main->statuses();
7365 #my $self = shift; #could be class...
7371 Returns an SQL expression identifying prospective cust_main records (customers
7372 with no packages ever ordered)
7376 use vars qw($select_count_pkgs);
7377 $select_count_pkgs =
7378 "SELECT COUNT(*) FROM cust_pkg
7379 WHERE cust_pkg.custnum = cust_main.custnum";
7381 sub select_count_pkgs_sql {
7385 sub prospect_sql { "
7386 0 = ( $select_count_pkgs )
7391 Returns an SQL expression identifying active cust_main records (customers with
7392 active recurring packages).
7397 0 < ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. "
7403 Returns an SQL expression identifying inactive cust_main records (customers with
7404 no active recurring packages, but otherwise unsuspended/uncancelled).
7408 sub inactive_sql { "
7409 0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " )
7411 0 < ( $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " )
7417 Returns an SQL expression identifying suspended cust_main records.
7422 sub suspended_sql { susp_sql(@_); }
7424 0 < ( $select_count_pkgs AND ". FS::cust_pkg->suspended_sql. " )
7426 0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " )
7432 Returns an SQL expression identifying cancelled cust_main records.
7436 sub cancelled_sql { cancel_sql(@_); }
7439 my $recurring_sql = FS::cust_pkg->recurring_sql;
7440 my $cancelled_sql = FS::cust_pkg->cancelled_sql;
7443 0 < ( $select_count_pkgs )
7444 AND 0 < ( $select_count_pkgs AND $recurring_sql AND $cancelled_sql )
7445 AND 0 = ( $select_count_pkgs AND $recurring_sql
7446 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
7448 AND 0 = ( $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " )
7454 =item uncancelled_sql
7456 Returns an SQL expression identifying un-cancelled cust_main records.
7460 sub uncancelled_sql { uncancel_sql(@_); }
7461 sub uncancel_sql { "
7462 ( 0 < ( $select_count_pkgs
7463 AND ( cust_pkg.cancel IS NULL
7464 OR cust_pkg.cancel = 0
7467 OR 0 = ( $select_count_pkgs )
7473 Returns an SQL fragment to retreive the balance.
7478 ( SELECT COALESCE( SUM(charged), 0 ) FROM cust_bill
7479 WHERE cust_bill.custnum = cust_main.custnum )
7480 - ( SELECT COALESCE( SUM(paid), 0 ) FROM cust_pay
7481 WHERE cust_pay.custnum = cust_main.custnum )
7482 - ( SELECT COALESCE( SUM(amount), 0 ) FROM cust_credit
7483 WHERE cust_credit.custnum = cust_main.custnum )
7484 + ( SELECT COALESCE( SUM(refund), 0 ) FROM cust_refund
7485 WHERE cust_refund.custnum = cust_main.custnum )
7488 =item balance_date_sql START_TIME [ END_TIME [ OPTION => VALUE ... ] ]
7490 Returns an SQL fragment to retreive the balance for this customer, only
7491 considering invoices with date earlier than START_TIME, and optionally not
7492 later than END_TIME (total_owed_date minus total_unapplied_credits minus
7493 total_unapplied_payments).
7495 Times are specified as SQL fragments or numeric
7496 UNIX timestamps; see L<perlfunc/"time">). Also see L<Time::Local> and
7497 L<Date::Parse> for conversion functions. The empty string can be passed
7498 to disable that time constraint completely.
7500 Available options are:
7504 =item unapplied_date
7506 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)
7511 set to true to remove all customer comparison clauses, for totals
7516 WHERE clause hashref (elements "AND"ed together) (typically used with the total option)
7521 JOIN clause (typically used with the total option)
7527 sub balance_date_sql {
7528 my( $class, $start, $end, %opt ) = @_;
7530 my $owed = FS::cust_bill->owed_sql;
7531 my $unapp_refund = FS::cust_refund->unapplied_sql;
7532 my $unapp_credit = FS::cust_credit->unapplied_sql;
7533 my $unapp_pay = FS::cust_pay->unapplied_sql;
7535 my $j = $opt{'join'} || '';
7537 my $owed_wh = $class->_money_table_where( 'cust_bill', $start,$end,%opt );
7538 my $refund_wh = $class->_money_table_where( 'cust_refund', $start,$end,%opt );
7539 my $credit_wh = $class->_money_table_where( 'cust_credit', $start,$end,%opt );
7540 my $pay_wh = $class->_money_table_where( 'cust_pay', $start,$end,%opt );
7542 " ( SELECT COALESCE(SUM($owed), 0) FROM cust_bill $j $owed_wh )
7543 + ( SELECT COALESCE(SUM($unapp_refund), 0) FROM cust_refund $j $refund_wh )
7544 - ( SELECT COALESCE(SUM($unapp_credit), 0) FROM cust_credit $j $credit_wh )
7545 - ( SELECT COALESCE(SUM($unapp_pay), 0) FROM cust_pay $j $pay_wh )
7550 =item unapplied_payments_date_sql START_TIME [ END_TIME ]
7552 Returns an SQL fragment to retreive the total unapplied payments for this
7553 customer, only considering invoices with date earlier than START_TIME, and
7554 optionally not later than END_TIME.
7556 Times are specified as SQL fragments or numeric
7557 UNIX timestamps; see L<perlfunc/"time">). Also see L<Time::Local> and
7558 L<Date::Parse> for conversion functions. The empty string can be passed
7559 to disable that time constraint completely.
7561 Available options are:
7565 sub unapplied_payments_date_sql {
7566 my( $class, $start, $end, ) = @_;
7568 my $unapp_pay = FS::cust_pay->unapplied_sql;
7570 my $pay_where = $class->_money_table_where( 'cust_pay', $start, $end,
7571 'unapplied_date'=>1 );
7573 " ( SELECT COALESCE(SUM($unapp_pay), 0) FROM cust_pay $pay_where ) ";
7576 =item _money_table_where TABLE START_TIME [ END_TIME [ OPTION => VALUE ... ] ]
7578 Helper method for balance_date_sql; name (and usage) subject to change
7579 (suggestions welcome).
7581 Returns a WHERE clause for the specified monetary TABLE (cust_bill,
7582 cust_refund, cust_credit or cust_pay).
7584 If TABLE is "cust_bill" or the unapplied_date option is true, only
7585 considers records with date earlier than START_TIME, and optionally not
7586 later than END_TIME .
7590 sub _money_table_where {
7591 my( $class, $table, $start, $end, %opt ) = @_;
7594 push @where, "cust_main.custnum = $table.custnum" unless $opt{'total'};
7595 if ( $table eq 'cust_bill' || $opt{'unapplied_date'} ) {
7596 push @where, "$table._date <= $start" if defined($start) && length($start);
7597 push @where, "$table._date > $end" if defined($end) && length($end);
7599 push @where, @{$opt{'where'}} if $opt{'where'};
7600 my $where = scalar(@where) ? 'WHERE '. join(' AND ', @where ) : '';
7606 =item search_sql HASHREF
7610 Returns a qsearch hash expression to search for parameters specified in HREF.
7611 Valid parameters are
7619 =item cancelled_pkgs
7625 listref of start date, end date
7631 =item current_balance
7633 listref (list returned by FS::UI::Web::parse_lt_gt($cgi, 'current_balance'))
7637 =item flattened_pkgs
7646 my ($class, $params) = @_;
7657 if ( $params->{'agentnum'} =~ /^(\d+)$/ and $1 ) {
7659 "cust_main.agentnum = $1";
7666 #prospect active inactive suspended cancelled
7667 if ( grep { $params->{'status'} eq $_ } FS::cust_main->statuses() ) {
7668 my $method = $params->{'status'}. '_sql';
7669 #push @where, $class->$method();
7670 push @where, FS::cust_main->$method();
7674 # parse cancelled package checkbox
7679 $pkgwhere .= "AND (cancel = 0 or cancel is null)"
7680 unless $params->{'cancelled_pkgs'};
7683 # parse without census tract checkbox
7686 push @where, "(censustract = '' or censustract is null)"
7687 if $params->{'no_censustract'};
7693 foreach my $field (qw( signupdate )) {
7695 next unless exists($params->{$field});
7697 my($beginning, $ending) = @{$params->{$field}};
7700 "cust_main.$field IS NOT NULL",
7701 "cust_main.$field >= $beginning",
7702 "cust_main.$field <= $ending";
7704 $orderby ||= "ORDER BY cust_main.$field";
7712 my @payby = grep /^([A-Z]{4})$/, @{ $params->{'payby'} };
7714 push @where, '( '. join(' OR ', map "cust_main.payby = '$_'", @payby). ' )';
7721 #my $balance_sql = $class->balance_sql();
7722 my $balance_sql = FS::cust_main->balance_sql();
7724 push @where, map { s/current_balance/$balance_sql/; $_ }
7725 @{ $params->{'current_balance'} };
7731 if ( $params->{'custbatch'} =~ /^([\w\/\-\:\.]+)$/ and $1 ) {
7733 "cust_main.custbatch = '$1'";
7737 # setup queries, subs, etc. for the search
7740 $orderby ||= 'ORDER BY custnum';
7742 # here is the agent virtualization
7743 push @where, $FS::CurrentUser::CurrentUser->agentnums_sql;
7745 my $extra_sql = scalar(@where) ? ' WHERE '. join(' AND ', @where) : '';
7747 my $addl_from = 'LEFT JOIN cust_pkg USING ( custnum ) ';
7749 my $count_query = "SELECT COUNT(*) FROM cust_main $extra_sql";
7751 my $select = join(', ',
7752 'cust_main.custnum',
7753 FS::UI::Web::cust_sql_fields($params->{'cust_fields'}),
7756 my(@extra_headers) = ();
7757 my(@extra_fields) = ();
7759 if ($params->{'flattened_pkgs'}) {
7761 if ($dbh->{Driver}->{Name} eq 'Pg') {
7763 $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";
7765 }elsif ($dbh->{Driver}->{Name} =~ /^mysql/i) {
7766 $select .= ", GROUP_CONCAT(pkg SEPARATOR '|') as magic";
7767 $addl_from .= " LEFT JOIN part_pkg using ( pkgpart )";
7769 warn "warning: unknown database type ". $dbh->{Driver}->{Name}.
7770 "omitting packing information from report.";
7773 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";
7775 my $sth = dbh->prepare($header_query) or die dbh->errstr;
7776 $sth->execute() or die $sth->errstr;
7777 my $headerrow = $sth->fetchrow_arrayref;
7778 my $headercount = $headerrow ? $headerrow->[0] : 0;
7779 while($headercount) {
7780 unshift @extra_headers, "Package ". $headercount;
7781 unshift @extra_fields, eval q!sub {my $c = shift;
7782 my @a = split '\|', $c->magic;
7783 my $p = $a[!.--$headercount. q!];
7791 'table' => 'cust_main',
7792 'select' => $select,
7794 'extra_sql' => $extra_sql,
7795 'order_by' => $orderby,
7796 'count_query' => $count_query,
7797 'extra_headers' => \@extra_headers,
7798 'extra_fields' => \@extra_fields,
7803 =item email_search_sql HASHREF
7807 Emails a notice to the specified customers.
7809 Valid parameters are those of the L<search_sql> method, plus the following:
7831 Optional job queue job for status updates.
7835 Returns an error message, or false for success.
7837 If an error occurs during any email, stops the enture send and returns that
7838 error. Presumably if you're getting SMTP errors aborting is better than
7839 retrying everything.
7843 sub email_search_sql {
7844 my($class, $params) = @_;
7846 my $from = delete $params->{from};
7847 my $subject = delete $params->{subject};
7848 my $html_body = delete $params->{html_body};
7849 my $text_body = delete $params->{text_body};
7851 my $job = delete $params->{'job'};
7853 my $sql_query = $class->search_sql($params);
7855 my $count_query = delete($sql_query->{'count_query'});
7856 my $count_sth = dbh->prepare($count_query)
7857 or die "Error preparing $count_query: ". dbh->errstr;
7859 or die "Error executing $count_query: ". $count_sth->errstr;
7860 my $count_arrayref = $count_sth->fetchrow_arrayref;
7861 my $num_cust = $count_arrayref->[0];
7863 #my @extra_headers = @{ delete($sql_query->{'extra_headers'}) };
7864 #my @extra_fields = @{ delete($sql_query->{'extra_fields'}) };
7867 my( $num, $last, $min_sec ) = (0, time, 5); #progresbar foo
7869 #eventually order+limit magic to reduce memory use?
7870 foreach my $cust_main ( qsearch($sql_query) ) {
7872 my $to = $cust_main->invoicing_list_emailonly_scalar;
7875 my $error = send_email(
7879 'subject' => $subject,
7880 'html_body' => $html_body,
7881 'text_body' => $text_body,
7884 return $error if $error;
7886 if ( $job ) { #progressbar foo
7888 if ( time - $min_sec > $last ) {
7889 my $error = $job->update_statustext(
7890 int( 100 * $num / $num_cust )
7892 die $error if $error;
7902 use Storable qw(thaw);
7905 sub process_email_search_sql {
7907 #warn "$me process_re_X $method for job $job\n" if $DEBUG;
7909 my $param = thaw(decode_base64(shift));
7910 warn Dumper($param) if $DEBUG;
7912 $param->{'job'} = $job;
7914 my $error = FS::cust_main->email_search_sql( $param );
7915 die $error if $error;
7919 =item fuzzy_search FUZZY_HASHREF [ HASHREF, SELECT, EXTRA_SQL, CACHE_OBJ ]
7921 Performs a fuzzy (approximate) search and returns the matching FS::cust_main
7922 records. Currently, I<first>, I<last> and/or I<company> may be specified (the
7923 appropriate ship_ field is also searched).
7925 Additional options are the same as FS::Record::qsearch
7930 my( $self, $fuzzy, $hash, @opt) = @_;
7935 check_and_rebuild_fuzzyfiles();
7936 foreach my $field ( keys %$fuzzy ) {
7938 my $all = $self->all_X($field);
7939 next unless scalar(@$all);
7942 $match{$_}=1 foreach ( amatch( $fuzzy->{$field}, ['i'], @$all ) );
7945 foreach ( keys %match ) {
7946 push @fcust, qsearch('cust_main', { %$hash, $field=>$_}, @opt);
7947 push @fcust, qsearch('cust_main', { %$hash, "ship_$field"=>$_}, @opt);
7950 push @cust_main, grep { ! $fsaw{$_->custnum}++ } @fcust;
7953 # we want the components of $fuzzy ANDed, not ORed, but still don't want dupes
7955 @cust_main = grep { ++$saw{$_->custnum} == scalar(keys %$fuzzy) } @cust_main;
7963 Returns a masked version of the named field
7968 my ($self,$field) = @_;
7972 'x'x(length($self->getfield($field))-4).
7973 substr($self->getfield($field), (length($self->getfield($field))-4));
7983 =item smart_search OPTION => VALUE ...
7985 Accepts the following options: I<search>, the string to search for. The string
7986 will be searched for as a customer number, phone number, name or company name,
7987 as an exact, or, in some cases, a substring or fuzzy match (see the source code
7988 for the exact heuristics used); I<no_fuzzy_on_exact>, causes smart_search to
7989 skip fuzzy matching when an exact match is found.
7991 Any additional options are treated as an additional qualifier on the search
7994 Returns a (possibly empty) array of FS::cust_main objects.
8001 #here is the agent virtualization
8002 my $agentnums_sql = $FS::CurrentUser::CurrentUser->agentnums_sql;
8006 my $skip_fuzzy = delete $options{'no_fuzzy_on_exact'};
8007 my $search = delete $options{'search'};
8008 ( my $alphanum_search = $search ) =~ s/\W//g;
8010 if ( $alphanum_search =~ /^1?(\d{3})(\d{3})(\d{4})(\d*)$/ ) { #phone# search
8012 #false laziness w/Record::ut_phone
8013 my $phonen = "$1-$2-$3";
8014 $phonen .= " x$4" if $4;
8016 push @cust_main, qsearch( {
8017 'table' => 'cust_main',
8018 'hashref' => { %options },
8019 'extra_sql' => ( scalar(keys %options) ? ' AND ' : ' WHERE ' ).
8021 join(' OR ', map "$_ = '$phonen'",
8022 qw( daytime night fax
8023 ship_daytime ship_night ship_fax )
8026 " AND $agentnums_sql", #agent virtualization
8029 unless ( @cust_main || $phonen =~ /x\d+$/ ) { #no exact match
8030 #try looking for matches with extensions unless one was specified
8032 push @cust_main, qsearch( {
8033 'table' => 'cust_main',
8034 'hashref' => { %options },
8035 'extra_sql' => ( scalar(keys %options) ? ' AND ' : ' WHERE ' ).
8037 join(' OR ', map "$_ LIKE '$phonen\%'",
8039 ship_daytime ship_night )
8042 " AND $agentnums_sql", #agent virtualization
8047 # custnum search (also try agent_custid), with some tweaking options if your
8048 # legacy cust "numbers" have letters
8051 if ( $search =~ /^\s*(\d+)\s*$/
8052 || ( $conf->config('cust_main-agent_custid-format') eq 'ww?d+'
8053 && $search =~ /^\s*(\w\w?\d+)\s*$/
8060 if ( $num <= 2147483647 ) { #need a bigint custnum? wow.
8061 push @cust_main, qsearch( {
8062 'table' => 'cust_main',
8063 'hashref' => { 'custnum' => $num, %options },
8064 'extra_sql' => " AND $agentnums_sql", #agent virtualization
8068 push @cust_main, qsearch( {
8069 'table' => 'cust_main',
8070 'hashref' => { 'agent_custid' => $num, %options },
8071 'extra_sql' => " AND $agentnums_sql", #agent virtualization
8074 } elsif ( $search =~ /^\s*(\S.*\S)\s+\((.+), ([^,]+)\)\s*$/ ) {
8076 my($company, $last, $first) = ( $1, $2, $3 );
8078 # "Company (Last, First)"
8079 #this is probably something a browser remembered,
8080 #so just do an exact search
8082 foreach my $prefix ( '', 'ship_' ) {
8083 push @cust_main, qsearch( {
8084 'table' => 'cust_main',
8085 'hashref' => { $prefix.'first' => $first,
8086 $prefix.'last' => $last,
8087 $prefix.'company' => $company,
8090 'extra_sql' => " AND $agentnums_sql",
8094 } elsif ( $search =~ /^\s*(\S.*\S)\s*$/ ) { # value search
8095 # try (ship_){last,company}
8099 # # remove "(Last, First)" in "Company (Last, First)", otherwise the
8100 # # full strings the browser remembers won't work
8101 # $value =~ s/\([\w \,\.\-\']*\)$//; #false laziness w/Record::ut_name
8103 use Lingua::EN::NameParse;
8104 my $NameParse = new Lingua::EN::NameParse(
8106 allow_reversed => 1,
8109 my($last, $first) = ( '', '' );
8110 #maybe disable this too and just rely on NameParse?
8111 if ( $value =~ /^(.+),\s*([^,]+)$/ ) { # Last, First
8113 ($last, $first) = ( $1, $2 );
8115 #} elsif ( $value =~ /^(.+)\s+(.+)$/ ) {
8116 } elsif ( ! $NameParse->parse($value) ) {
8118 my %name = $NameParse->components;
8119 $first = $name{'given_name_1'};
8120 $last = $name{'surname_1'};
8124 if ( $first && $last ) {
8126 my($q_last, $q_first) = ( dbh->quote($last), dbh->quote($first) );
8129 my $sql = scalar(keys %options) ? ' AND ' : ' WHERE ';
8131 ( ( LOWER(last) = $q_last AND LOWER(first) = $q_first )
8132 OR ( LOWER(ship_last) = $q_last AND LOWER(ship_first) = $q_first )
8135 push @cust_main, qsearch( {
8136 'table' => 'cust_main',
8137 'hashref' => \%options,
8138 'extra_sql' => "$sql AND $agentnums_sql", #agent virtualization
8141 # or it just be something that was typed in... (try that in a sec)
8145 my $q_value = dbh->quote($value);
8148 my $sql = scalar(keys %options) ? ' AND ' : ' WHERE ';
8149 $sql .= " ( LOWER(last) = $q_value
8150 OR LOWER(company) = $q_value
8151 OR LOWER(ship_last) = $q_value
8152 OR LOWER(ship_company) = $q_value
8155 push @cust_main, qsearch( {
8156 'table' => 'cust_main',
8157 'hashref' => \%options,
8158 'extra_sql' => "$sql AND $agentnums_sql", #agent virtualization
8161 #no exact match, trying substring/fuzzy
8162 #always do substring & fuzzy (unless they're explicity config'ed off)
8163 #getting complaints searches are not returning enough
8164 unless ( @cust_main && $skip_fuzzy || $conf->exists('disable-fuzzy') ) {
8166 #still some false laziness w/search_sql (was search/cust_main.cgi)
8171 { 'company' => { op=>'ILIKE', value=>"%$value%" }, },
8172 { 'ship_company' => { op=>'ILIKE', value=>"%$value%" }, },
8175 if ( $first && $last ) {
8178 { 'first' => { op=>'ILIKE', value=>"%$first%" },
8179 'last' => { op=>'ILIKE', value=>"%$last%" },
8181 { 'ship_first' => { op=>'ILIKE', value=>"%$first%" },
8182 'ship_last' => { op=>'ILIKE', value=>"%$last%" },
8189 { 'last' => { op=>'ILIKE', value=>"%$value%" }, },
8190 { 'ship_last' => { op=>'ILIKE', value=>"%$value%" }, },
8194 foreach my $hashref ( @hashrefs ) {
8196 push @cust_main, qsearch( {
8197 'table' => 'cust_main',
8198 'hashref' => { %$hashref,
8201 'extra_sql' => " AND $agentnums_sql", #agent virtualizaiton
8210 " AND $agentnums_sql", #extra_sql #agent virtualization
8213 if ( $first && $last ) {
8214 push @cust_main, FS::cust_main->fuzzy_search(
8215 { 'last' => $last, #fuzzy hashref
8216 'first' => $first }, #
8220 foreach my $field ( 'last', 'company' ) {
8222 FS::cust_main->fuzzy_search( { $field => $value }, @fuzopts );
8229 #eliminate duplicates
8231 @cust_main = grep { !$saw{$_->custnum}++ } @cust_main;
8239 Accepts the following options: I<email>, the email address to search for. The
8240 email address will be searched for as an email invoice destination and as an
8243 #Any additional options are treated as an additional qualifier on the search
8244 #(i.e. I<agentnum>).
8246 Returns a (possibly empty) array of FS::cust_main objects (but usually just
8256 my $email = delete $options{'email'};
8258 #we're only being used by RT at the moment... no agent virtualization yet
8259 #my $agentnums_sql = $FS::CurrentUser::CurrentUser->agentnums_sql;
8263 if ( $email =~ /([^@]+)\@([^@]+)/ ) {
8265 my ( $user, $domain ) = ( $1, $2 );
8267 warn "$me smart_search: searching for $user in domain $domain"
8273 'table' => 'cust_main_invoice',
8274 'hashref' => { 'dest' => $email },
8281 map $_->cust_svc->cust_pkg,
8283 'table' => 'svc_acct',
8284 'hashref' => { 'username' => $user, },
8286 'AND ( SELECT domain FROM svc_domain
8287 WHERE svc_acct.domsvc = svc_domain.svcnum
8288 ) = '. dbh->quote($domain),
8294 @cust_main = grep { !$saw{$_->custnum}++ } @cust_main;
8296 warn "$me smart_search: found ". scalar(@cust_main). " unique customers"
8303 =item check_and_rebuild_fuzzyfiles
8307 use vars qw(@fuzzyfields);
8308 @fuzzyfields = ( 'last', 'first', 'company' );
8310 sub check_and_rebuild_fuzzyfiles {
8311 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
8312 rebuild_fuzzyfiles() if grep { ! -e "$dir/cust_main.$_" } @fuzzyfields
8315 =item rebuild_fuzzyfiles
8319 sub rebuild_fuzzyfiles {
8321 use Fcntl qw(:flock);
8323 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
8324 mkdir $dir, 0700 unless -d $dir;
8326 foreach my $fuzzy ( @fuzzyfields ) {
8328 open(LOCK,">>$dir/cust_main.$fuzzy")
8329 or die "can't open $dir/cust_main.$fuzzy: $!";
8331 or die "can't lock $dir/cust_main.$fuzzy: $!";
8333 open (CACHE,">$dir/cust_main.$fuzzy.tmp")
8334 or die "can't open $dir/cust_main.$fuzzy.tmp: $!";
8336 foreach my $field ( $fuzzy, "ship_$fuzzy" ) {
8337 my $sth = dbh->prepare("SELECT $field FROM cust_main".
8338 " WHERE $field != '' AND $field IS NOT NULL");
8339 $sth->execute or die $sth->errstr;
8341 while ( my $row = $sth->fetchrow_arrayref ) {
8342 print CACHE $row->[0]. "\n";
8347 close CACHE or die "can't close $dir/cust_main.$fuzzy.tmp: $!";
8349 rename "$dir/cust_main.$fuzzy.tmp", "$dir/cust_main.$fuzzy";
8360 my( $self, $field ) = @_;
8361 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
8362 open(CACHE,"<$dir/cust_main.$field")
8363 or die "can't open $dir/cust_main.$field: $!";
8364 my @array = map { chomp; $_; } <CACHE>;
8369 =item append_fuzzyfiles LASTNAME COMPANY
8373 sub append_fuzzyfiles {
8374 #my( $first, $last, $company ) = @_;
8376 &check_and_rebuild_fuzzyfiles;
8378 use Fcntl qw(:flock);
8380 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
8382 foreach my $field (qw( first last company )) {
8387 open(CACHE,">>$dir/cust_main.$field")
8388 or die "can't open $dir/cust_main.$field: $!";
8389 flock(CACHE,LOCK_EX)
8390 or die "can't lock $dir/cust_main.$field: $!";
8392 print CACHE "$value\n";
8394 flock(CACHE,LOCK_UN)
8395 or die "can't unlock $dir/cust_main.$field: $!";
8410 #warn join('-',keys %$param);
8411 my $fh = $param->{filehandle};
8412 my @fields = @{$param->{fields}};
8414 eval "use Text::CSV_XS;";
8417 my $csv = new Text::CSV_XS;
8424 local $SIG{HUP} = 'IGNORE';
8425 local $SIG{INT} = 'IGNORE';
8426 local $SIG{QUIT} = 'IGNORE';
8427 local $SIG{TERM} = 'IGNORE';
8428 local $SIG{TSTP} = 'IGNORE';
8429 local $SIG{PIPE} = 'IGNORE';
8431 my $oldAutoCommit = $FS::UID::AutoCommit;
8432 local $FS::UID::AutoCommit = 0;
8435 #while ( $columns = $csv->getline($fh) ) {
8437 while ( defined($line=<$fh>) ) {
8439 $csv->parse($line) or do {
8440 $dbh->rollback if $oldAutoCommit;
8441 return "can't parse: ". $csv->error_input();
8444 my @columns = $csv->fields();
8445 #warn join('-',@columns);
8448 foreach my $field ( @fields ) {
8449 $row{$field} = shift @columns;
8452 my $cust_main = qsearchs('cust_main', { 'custnum' => $row{'custnum'} } );
8453 unless ( $cust_main ) {
8454 $dbh->rollback if $oldAutoCommit;
8455 return "unknown custnum $row{'custnum'}";
8458 if ( $row{'amount'} > 0 ) {
8459 my $error = $cust_main->charge($row{'amount'}, $row{'pkg'});
8461 $dbh->rollback if $oldAutoCommit;
8465 } elsif ( $row{'amount'} < 0 ) {
8466 my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ),
8469 $dbh->rollback if $oldAutoCommit;
8479 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
8481 return "Empty file!" unless $imported;
8487 =item notify CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
8489 Sends a templated email notification to the customer (see L<Text::Template>).
8491 OPTIONS is a hash and may include
8493 I<from> - the email sender (default is invoice_from)
8495 I<to> - comma-separated scalar or arrayref of recipients
8496 (default is invoicing_list)
8498 I<subject> - The subject line of the sent email notification
8499 (default is "Notice from company_name")
8501 I<extra_fields> - a hashref of name/value pairs which will be substituted
8504 The following variables are vavailable in the template.
8506 I<$first> - the customer first name
8507 I<$last> - the customer last name
8508 I<$company> - the customer company
8509 I<$payby> - a description of the method of payment for the customer
8510 # would be nice to use FS::payby::shortname
8511 I<$payinfo> - the account information used to collect for this customer
8512 I<$expdate> - the expiration of the customer payment in seconds from epoch
8517 my ($self, $template, %options) = @_;
8519 return unless $conf->exists($template);
8521 my $from = $conf->config('invoice_from', $self->agentnum)
8522 if $conf->exists('invoice_from', $self->agentnum);
8523 $from = $options{from} if exists($options{from});
8525 my $to = join(',', $self->invoicing_list_emailonly);
8526 $to = $options{to} if exists($options{to});
8528 my $subject = "Notice from " . $conf->config('company_name', $self->agentnum)
8529 if $conf->exists('company_name', $self->agentnum);
8530 $subject = $options{subject} if exists($options{subject});
8532 my $notify_template = new Text::Template (TYPE => 'ARRAY',
8533 SOURCE => [ map "$_\n",
8534 $conf->config($template)]
8536 or die "can't create new Text::Template object: Text::Template::ERROR";
8537 $notify_template->compile()
8538 or die "can't compile template: Text::Template::ERROR";
8540 $FS::notify_template::_template::company_name =
8541 $conf->config('company_name', $self->agentnum);
8542 $FS::notify_template::_template::company_address =
8543 join("\n", $conf->config('company_address', $self->agentnum) ). "\n";
8545 my $paydate = $self->paydate || '2037-12-31';
8546 $FS::notify_template::_template::first = $self->first;
8547 $FS::notify_template::_template::last = $self->last;
8548 $FS::notify_template::_template::company = $self->company;
8549 $FS::notify_template::_template::payinfo = $self->mask_payinfo;
8550 my $payby = $self->payby;
8551 my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
8552 my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
8554 #credit cards expire at the end of the month/year of their exp date
8555 if ($payby eq 'CARD' || $payby eq 'DCRD') {
8556 $FS::notify_template::_template::payby = 'credit card';
8557 ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
8558 $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
8560 }elsif ($payby eq 'COMP') {
8561 $FS::notify_template::_template::payby = 'complimentary account';
8563 $FS::notify_template::_template::payby = 'current method';
8565 $FS::notify_template::_template::expdate = $expire_time;
8567 for (keys %{$options{extra_fields}}){
8569 ${"FS::notify_template::_template::$_"} = $options{extra_fields}->{$_};
8572 send_email(from => $from,
8574 subject => $subject,
8575 body => $notify_template->fill_in( PACKAGE =>
8576 'FS::notify_template::_template' ),
8581 =item generate_letter CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
8583 Generates a templated notification to the customer (see L<Text::Template>).
8585 OPTIONS is a hash and may include
8587 I<extra_fields> - a hashref of name/value pairs which will be substituted
8588 into the template. These values may override values mentioned below
8589 and those from the customer record.
8591 The following variables are available in the template instead of or in addition
8592 to the fields of the customer record.
8594 I<$payby> - a description of the method of payment for the customer
8595 # would be nice to use FS::payby::shortname
8596 I<$payinfo> - the masked account information used to collect for this customer
8597 I<$expdate> - the expiration of the customer payment method in seconds from epoch
8598 I<$returnaddress> - the return address defaults to invoice_latexreturnaddress or company_address
8602 sub generate_letter {
8603 my ($self, $template, %options) = @_;
8605 return unless $conf->exists($template);
8607 my $letter_template = new Text::Template
8609 SOURCE => [ map "$_\n", $conf->config($template)],
8610 DELIMITERS => [ '[@--', '--@]' ],
8612 or die "can't create new Text::Template object: Text::Template::ERROR";
8614 $letter_template->compile()
8615 or die "can't compile template: Text::Template::ERROR";
8617 my %letter_data = map { $_ => $self->$_ } $self->fields;
8618 $letter_data{payinfo} = $self->mask_payinfo;
8620 #my $paydate = $self->paydate || '2037-12-31';
8621 my $paydate = $self->paydate =~ /^\S+$/ ? $self->paydate : '2037-12-31';
8623 my $payby = $self->payby;
8624 my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
8625 my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
8627 #credit cards expire at the end of the month/year of their exp date
8628 if ($payby eq 'CARD' || $payby eq 'DCRD') {
8629 $letter_data{payby} = 'credit card';
8630 ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
8631 $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
8633 }elsif ($payby eq 'COMP') {
8634 $letter_data{payby} = 'complimentary account';
8636 $letter_data{payby} = 'current method';
8638 $letter_data{expdate} = $expire_time;
8640 for (keys %{$options{extra_fields}}){
8641 $letter_data{$_} = $options{extra_fields}->{$_};
8644 unless(exists($letter_data{returnaddress})){
8645 my $retadd = join("\n", $conf->config_orbase( 'invoice_latexreturnaddress',
8646 $self->agent_template)
8648 if ( length($retadd) ) {
8649 $letter_data{returnaddress} = $retadd;
8650 } elsif ( grep /\S/, $conf->config('company_address', $self->agentnum) ) {
8651 $letter_data{returnaddress} =
8652 join( '\\*'."\n", map s/( {2,})/'~' x length($1)/eg,
8653 $conf->config('company_address', $self->agentnum)
8656 $letter_data{returnaddress} = '~';
8660 $letter_data{conf_dir} = "$FS::UID::conf_dir/conf.$FS::UID::datasrc";
8662 $letter_data{company_name} = $conf->config('company_name', $self->agentnum);
8664 my $dir = $FS::UID::conf_dir."/cache.". $FS::UID::datasrc;
8665 my $fh = new File::Temp( TEMPLATE => 'letter.'. $self->custnum. '.XXXXXXXX',
8669 ) or die "can't open temp file: $!\n";
8671 $letter_template->fill_in( OUTPUT => $fh, HASH => \%letter_data );
8673 $fh->filename =~ /^(.*).tex$/ or die "unparsable filename: ". $fh->filename;
8677 =item print_ps TEMPLATE
8679 Returns an postscript letter filled in from TEMPLATE, as a scalar.
8685 my $file = $self->generate_letter(@_);
8686 FS::Misc::generate_ps($file);
8689 =item print TEMPLATE
8691 Prints the filled in template.
8693 TEMPLATE is the name of a L<Text::Template> to fill in and print.
8697 sub queueable_print {
8700 my $self = qsearchs('cust_main', { 'custnum' => $opt{custnum} } )
8701 or die "invalid customer number: " . $opt{custvnum};
8703 my $error = $self->print( $opt{template} );
8704 die $error if $error;
8708 my ($self, $template) = (shift, shift);
8709 do_print [ $self->print_ps($template) ];
8712 #these three subs should just go away once agent stuff is all config overrides
8714 sub agent_template {
8716 $self->_agent_plandata('agent_templatename');
8719 sub agent_invoice_from {
8721 $self->_agent_plandata('agent_invoice_from');
8724 sub _agent_plandata {
8725 my( $self, $option ) = @_;
8727 #yuck. this whole thing needs to be reconciled better with 1.9's idea of
8728 #agent-specific Conf
8730 use FS::part_event::Condition;
8732 my $agentnum = $self->agentnum;
8735 if ( driver_name =~ /^Pg/i ) {
8737 } elsif ( driver_name =~ /^mysql/i ) {
8740 die "don't know how to use regular expressions in ". driver_name. " databases";
8743 my $part_event_option =
8745 'select' => 'part_event_option.*',
8746 'table' => 'part_event_option',
8748 LEFT JOIN part_event USING ( eventpart )
8749 LEFT JOIN part_event_option AS peo_agentnum
8750 ON ( part_event.eventpart = peo_agentnum.eventpart
8751 AND peo_agentnum.optionname = 'agentnum'
8752 AND peo_agentnum.optionvalue }. $regexp. q{ '(^|,)}. $agentnum. q{(,|$)'
8754 LEFT JOIN part_event_condition
8755 ON ( part_event.eventpart = part_event_condition.eventpart
8756 AND part_event_condition.conditionname = 'cust_bill_age'
8758 LEFT JOIN part_event_condition_option
8759 ON ( part_event_condition.eventconditionnum = part_event_condition_option.eventconditionnum
8760 AND part_event_condition_option.optionname = 'age'
8763 #'hashref' => { 'optionname' => $option },
8764 #'hashref' => { 'part_event_option.optionname' => $option },
8766 " WHERE part_event_option.optionname = ". dbh->quote($option).
8767 " AND action = 'cust_bill_send_agent' ".
8768 " AND ( disabled IS NULL OR disabled != 'Y' ) ".
8769 " AND peo_agentnum.optionname = 'agentnum' ".
8770 " AND ( agentnum IS NULL OR agentnum = $agentnum ) ".
8772 CASE WHEN part_event_condition_option.optionname IS NULL
8774 ELSE ". FS::part_event::Condition->age2seconds_sql('part_event_condition_option.optionvalue').
8776 , part_event.weight".
8780 unless ( $part_event_option ) {
8781 return $self->agent->invoice_template || ''
8782 if $option eq 'agent_templatename';
8786 $part_event_option->optionvalue;
8791 ## actual sub, not a method, designed to be called from the queue.
8792 ## sets up the customer, and calls the bill_and_collect
8793 my (%args) = @_; #, ($time, $invoice_time, $check_freq, $resetup) = @_;
8794 my $cust_main = qsearchs( 'cust_main', { custnum => $args{'custnum'} } );
8795 $cust_main->bill_and_collect(
8800 sub _upgrade_data { #class method
8801 my ($class, %opts) = @_;
8803 my $sql = 'UPDATE h_cust_main SET paycvv = NULL WHERE paycvv IS NOT NULL';
8804 my $sth = dbh->prepare($sql) or die dbh->errstr;
8805 $sth->execute or die $sth->errstr;
8815 The delete method should possibly take an FS::cust_main object reference
8816 instead of a scalar customer number.
8818 Bill and collect options should probably be passed as references instead of a
8821 There should probably be a configuration file with a list of allowed credit
8824 No multiple currency support (probably a larger project than just this module).
8826 payinfo_masked false laziness with cust_pay.pm and cust_refund.pm
8828 Birthdates rely on negative epoch values.
8830 The payby for card/check batches is broken. With mixed batching, bad
8833 B<collect> I<invoice_time> should be renamed I<time>, like B<bill>.
8837 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
8838 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
8839 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.