5 use vars qw( @ISA @EXPORT_OK $DEBUG $me $conf @encrypted_fields
6 $import $skip_fuzzyfiles $ignore_expired_card @paytypes);
7 use vars qw( $realtime_bop_decline_quiet ); #ugh
11 use Scalar::Util qw( blessed );
12 use Time::Local qw(timelocal);
15 use Digest::MD5 qw(md5_base64);
18 use File::Temp qw( tempfile );
19 use String::Approx qw(amatch);
20 use Business::CreditCard 0.28;
22 use FS::UID qw( getotaker dbh driver_name );
23 use FS::Record qw( qsearchs qsearch dbdef );
24 use FS::Misc qw( generate_email send_email generate_ps do_print );
25 use FS::Msgcat qw(gettext);
30 use FS::cust_bill_pkg;
31 use FS::cust_bill_pkg_display;
32 use FS::cust_bill_pkg_tax_location;
33 use FS::cust_bill_pkg_tax_rate_location;
35 use FS::cust_pay_pending;
36 use FS::cust_pay_void;
37 use FS::cust_pay_batch;
40 use FS::part_referral;
41 use FS::cust_main_county;
42 use FS::cust_location;
43 use FS::cust_main_exemption;
44 use FS::cust_tax_adjustment;
46 use FS::tax_rate_location;
47 use FS::cust_tax_location;
48 use FS::part_pkg_taxrate;
50 use FS::cust_main_invoice;
51 use FS::cust_credit_bill;
52 use FS::cust_bill_pay;
53 use FS::prepay_credit;
57 use FS::part_event_condition;
60 use FS::payment_gateway;
61 use FS::agent_payment_gateway;
63 use FS::payinfo_Mixin;
66 @ISA = qw( FS::payinfo_Mixin FS::Record );
68 @EXPORT_OK = qw( smart_search );
70 $realtime_bop_decline_quiet = 0;
72 # 1 is mostly method/subroutine entry and options
73 # 2 traces progress of some operations
74 # 3 is even more information including possibly sensitive data
76 $me = '[FS::cust_main]';
80 $ignore_expired_card = 0;
82 @encrypted_fields = ('payinfo', 'paycvv');
83 sub nohistory_fields { ('paycvv'); }
85 @paytypes = ('', 'Personal checking', 'Personal savings', 'Business checking', 'Business savings');
87 #ask FS::UID to run this stuff for us later
88 #$FS::UID::callback{'FS::cust_main'} = sub {
89 install_callback FS::UID sub {
91 #yes, need it for stuff below (prolly should be cached)
96 my ( $hashref, $cache ) = @_;
97 if ( exists $hashref->{'pkgnum'} ) {
98 #@{ $self->{'_pkgnum'} } = ();
99 my $subcache = $cache->subcache( 'pkgnum', 'cust_pkg', $hashref->{custnum});
100 $self->{'_pkgnum'} = $subcache;
101 #push @{ $self->{'_pkgnum'} },
102 FS::cust_pkg->new_or_cached($hashref, $subcache) if $hashref->{pkgnum};
108 FS::cust_main - Object methods for cust_main records
114 $record = new FS::cust_main \%hash;
115 $record = new FS::cust_main { 'column' => 'value' };
117 $error = $record->insert;
119 $error = $new_record->replace($old_record);
121 $error = $record->delete;
123 $error = $record->check;
125 @cust_pkg = $record->all_pkgs;
127 @cust_pkg = $record->ncancelled_pkgs;
129 @cust_pkg = $record->suspended_pkgs;
131 $error = $record->bill;
132 $error = $record->bill %options;
133 $error = $record->bill 'time' => $time;
135 $error = $record->collect;
136 $error = $record->collect %options;
137 $error = $record->collect 'invoice_time' => $time,
142 An FS::cust_main object represents a customer. FS::cust_main inherits from
143 FS::Record. The following fields are currently supported:
149 Primary key (assigned automatically for new customers)
153 Agent (see L<FS::agent>)
157 Advertising source (see L<FS::part_referral>)
169 Cocial security number (optional)
185 (optional, see L<FS::cust_main_county>)
189 (see L<FS::cust_main_county>)
195 (see L<FS::cust_main_county>)
231 (optional, see L<FS::cust_main_county>)
235 (see L<FS::cust_main_county>)
241 (see L<FS::cust_main_county>)
257 Payment Type (See L<FS::payinfo_Mixin> for valid payby values)
261 Payment Information (See L<FS::payinfo_Mixin> for data format)
265 Masked payinfo (See L<FS::payinfo_Mixin> for how this works)
269 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
273 Expiration date, mm/yyyy, m/yyyy, mm/yy or m/yy
277 Start date month (maestro/solo cards only)
281 Start date year (maestro/solo cards only)
285 Issue number (maestro/solo cards only)
289 Name on card or billing name
293 IP address from which payment information was received
297 Tax exempt, empty or `Y'
301 Order taker (assigned automatically, see L<FS::UID>)
307 =item referral_custnum
309 Referring customer number
313 Enable individual CDR spooling, empty or `Y'
317 A suggestion to events (see L<FS::part_bill_event">) to delay until this unix timestamp
321 Discourage individual CDR printing, empty or `Y'
331 Creates a new customer. To add the customer to the database, see L<"insert">.
333 Note that this stores the hash reference, not a distinct copy of the hash it
334 points to. You can ask the object for a copy with the I<hash> method.
338 sub table { 'cust_main'; }
340 =item insert [ CUST_PKG_HASHREF [ , INVOICING_LIST_ARYREF ] [ , OPTION => VALUE ... ] ]
342 Adds this customer to the database. If there is an error, returns the error,
343 otherwise returns false.
345 CUST_PKG_HASHREF: If you pass a Tie::RefHash data structure to the insert
346 method containing FS::cust_pkg and FS::svc_I<tablename> objects, all records
347 are inserted atomicly, or the transaction is rolled back. Passing an empty
348 hash reference is equivalent to not supplying this parameter. There should be
349 a better explanation of this, but until then, here's an example:
352 tie %hash, 'Tie::RefHash'; #this part is important
354 $cust_pkg => [ $svc_acct ],
357 $cust_main->insert( \%hash );
359 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
360 be set as the invoicing list (see L<"invoicing_list">). Errors return as
361 expected and rollback the entire transaction; it is not necessary to call
362 check_invoicing_list first. The invoicing_list is set after the records in the
363 CUST_PKG_HASHREF above are inserted, so it is now possible to set an
364 invoicing_list destination to the newly-created svc_acct. Here's an example:
366 $cust_main->insert( {}, [ $email, 'POST' ] );
368 Currently available options are: I<depend_jobnum>, I<noexport> and I<tax_exemption>.
370 If I<depend_jobnum> is set, all provisioning jobs will have a dependancy
371 on the supplied jobnum (they will not run until the specific job completes).
372 This can be used to defer provisioning until some action completes (such
373 as running the customer's credit card successfully).
375 The I<noexport> option is deprecated. If I<noexport> is set true, no
376 provisioning jobs (exports) are scheduled. (You can schedule them later with
377 the B<reexport> method.)
379 The I<tax_exemption> option can be set to an arrayref of tax names.
380 FS::cust_main_exemption records will be created and inserted.
386 my $cust_pkgs = @_ ? shift : {};
387 my $invoicing_list = @_ ? shift : '';
389 warn "$me insert called with options ".
390 join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
393 local $SIG{HUP} = 'IGNORE';
394 local $SIG{INT} = 'IGNORE';
395 local $SIG{QUIT} = 'IGNORE';
396 local $SIG{TERM} = 'IGNORE';
397 local $SIG{TSTP} = 'IGNORE';
398 local $SIG{PIPE} = 'IGNORE';
400 my $oldAutoCommit = $FS::UID::AutoCommit;
401 local $FS::UID::AutoCommit = 0;
404 my $prepay_identifier = '';
405 my( $amount, $seconds, $upbytes, $downbytes, $totalbytes ) = (0, 0, 0, 0, 0);
407 if ( $self->payby eq 'PREPAY' ) {
409 $self->payby('BILL');
410 $prepay_identifier = $self->payinfo;
413 warn " looking up prepaid card $prepay_identifier\n"
416 my $error = $self->get_prepay( $prepay_identifier,
417 'amount_ref' => \$amount,
418 'seconds_ref' => \$seconds,
419 'upbytes_ref' => \$upbytes,
420 'downbytes_ref' => \$downbytes,
421 'totalbytes_ref' => \$totalbytes,
424 $dbh->rollback if $oldAutoCommit;
425 #return "error applying prepaid card (transaction rolled back): $error";
429 $payby = 'PREP' if $amount;
431 } elsif ( $self->payby =~ /^(CASH|WEST|MCRD)$/ ) {
434 $self->payby('BILL');
435 $amount = $self->paid;
439 warn " inserting $self\n"
442 $self->signupdate(time) unless $self->signupdate;
444 $self->auto_agent_custid()
445 if $conf->config('cust_main-auto_agent_custid') && ! $self->agent_custid;
447 my $error = $self->SUPER::insert;
449 $dbh->rollback if $oldAutoCommit;
450 #return "inserting cust_main record (transaction rolled back): $error";
454 warn " setting invoicing list\n"
457 if ( $invoicing_list ) {
458 $error = $self->check_invoicing_list( $invoicing_list );
460 $dbh->rollback if $oldAutoCommit;
461 #return "checking invoicing_list (transaction rolled back): $error";
464 $self->invoicing_list( $invoicing_list );
467 warn " setting cust_main_exemption\n"
470 my $tax_exemption = delete $options{'tax_exemption'};
471 if ( $tax_exemption ) {
472 foreach my $taxname ( @$tax_exemption ) {
473 my $cust_main_exemption = new FS::cust_main_exemption {
474 'custnum' => $self->custnum,
475 'taxname' => $taxname,
477 my $error = $cust_main_exemption->insert;
479 $dbh->rollback if $oldAutoCommit;
480 return "inserting cust_main_exemption (transaction rolled back): $error";
485 if ( $conf->config('cust_main-skeleton_tables')
486 && $conf->config('cust_main-skeleton_custnum') ) {
488 warn " inserting skeleton records\n"
491 my $error = $self->start_copy_skel;
493 $dbh->rollback if $oldAutoCommit;
499 warn " ordering packages\n"
502 $error = $self->order_pkgs( $cust_pkgs,
504 'seconds_ref' => \$seconds,
505 'upbytes_ref' => \$upbytes,
506 'downbytes_ref' => \$downbytes,
507 'totalbytes_ref' => \$totalbytes,
510 $dbh->rollback if $oldAutoCommit;
515 $dbh->rollback if $oldAutoCommit;
516 return "No svc_acct record to apply pre-paid time";
518 if ( $upbytes || $downbytes || $totalbytes ) {
519 $dbh->rollback if $oldAutoCommit;
520 return "No svc_acct record to apply pre-paid data";
524 warn " inserting initial $payby payment of $amount\n"
526 $error = $self->insert_cust_pay($payby, $amount, $prepay_identifier);
528 $dbh->rollback if $oldAutoCommit;
529 return "inserting payment (transaction rolled back): $error";
533 unless ( $import || $skip_fuzzyfiles ) {
534 warn " queueing fuzzyfiles update\n"
536 $error = $self->queue_fuzzyfiles_update;
538 $dbh->rollback if $oldAutoCommit;
539 return "updating fuzzy search cache: $error";
543 warn " insert complete; committing transaction\n"
546 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
551 use File::CounterFile;
552 sub auto_agent_custid {
555 my $format = $conf->config('cust_main-auto_agent_custid');
557 if ( $format eq '1YMMXXXXXXXX' ) {
559 my $counter = new File::CounterFile 'cust_main.agent_custid';
562 my $ym = 100000000000 + time2str('%y%m00000000', time);
563 if ( $ym > $counter->value ) {
564 $counter->{'value'} = $agent_custid = $ym;
565 $counter->{'updated'} = 1;
567 $agent_custid = $counter->inc;
573 die "Unknown cust_main-auto_agent_custid format: $format";
576 $self->agent_custid($agent_custid);
580 sub start_copy_skel {
583 #'mg_user_preference' => {},
584 #'mg_user_indicator_profile.user_indicator_profile_id' => { 'mg_profile_indicator.profile_indicator_id' => { 'mg_profile_details.profile_detail_id' }, },
585 #'mg_watchlist_header.watchlist_header_id' => { 'mg_watchlist_details.watchlist_details_id' },
586 #'mg_user_grid_header.grid_header_id' => { 'mg_user_grid_details.user_grid_details_id' },
587 #'mg_portfolio_header.portfolio_header_id' => { 'mg_portfolio_trades.portfolio_trades_id' => { 'mg_portfolio_trades_positions.portfolio_trades_positions_id' } },
588 my @tables = eval(join('\n',$conf->config('cust_main-skeleton_tables')));
591 _copy_skel( 'cust_main', #tablename
592 $conf->config('cust_main-skeleton_custnum'), #sourceid
593 $self->custnum, #destid
594 @tables, #child tables
598 #recursive subroutine, not a method
600 my( $table, $sourceid, $destid, %child_tables ) = @_;
603 if ( $table =~ /^(\w+)\.(\w+)$/ ) {
604 ( $table, $primary_key ) = ( $1, $2 );
606 my $dbdef_table = dbdef->table($table);
607 $primary_key = $dbdef_table->primary_key
608 or return "$table has no primary key".
609 " (or do you need to run dbdef-create?)";
612 warn " _copy_skel: $table.$primary_key $sourceid to $destid for ".
613 join (', ', keys %child_tables). "\n"
616 foreach my $child_table_def ( keys %child_tables ) {
620 if ( $child_table_def =~ /^(\w+)\.(\w+)$/ ) {
621 ( $child_table, $child_pkey ) = ( $1, $2 );
623 $child_table = $child_table_def;
625 $child_pkey = dbdef->table($child_table)->primary_key;
626 # or return "$table has no primary key".
627 # " (or do you need to run dbdef-create?)\n";
631 if ( keys %{ $child_tables{$child_table_def} } ) {
633 return "$child_table has no primary key".
634 " (run dbdef-create or try specifying it?)\n"
637 #false laziness w/Record::insert and only works on Pg
638 #refactor the proper last-inserted-id stuff out of Record::insert if this
639 # ever gets use for anything besides a quick kludge for one customer
640 my $default = dbdef->table($child_table)->column($child_pkey)->default;
641 $default =~ /^nextval\(\(?'"?([\w\.]+)"?'/i
642 or return "can't parse $child_table.$child_pkey default value ".
643 " for sequence name: $default";
648 my @sel_columns = grep { $_ ne $primary_key }
649 dbdef->table($child_table)->columns;
650 my $sel_columns = join(', ', @sel_columns );
652 my @ins_columns = grep { $_ ne $child_pkey } @sel_columns;
653 my $ins_columns = ' ( '. join(', ', $primary_key, @ins_columns ). ' ) ';
654 my $placeholders = ' ( ?, '. join(', ', map '?', @ins_columns ). ' ) ';
656 my $sel_st = "SELECT $sel_columns FROM $child_table".
657 " WHERE $primary_key = $sourceid";
660 my $sel_sth = dbh->prepare( $sel_st )
661 or return dbh->errstr;
663 $sel_sth->execute or return $sel_sth->errstr;
665 while ( my $row = $sel_sth->fetchrow_hashref ) {
667 warn " selected row: ".
668 join(', ', map { "$_=".$row->{$_} } keys %$row ). "\n"
672 "INSERT INTO $child_table $ins_columns VALUES $placeholders";
673 my $ins_sth =dbh->prepare($statement)
674 or return dbh->errstr;
675 my @param = ( $destid, map $row->{$_}, @ins_columns );
676 warn " $statement: [ ". join(', ', @param). " ]\n"
678 $ins_sth->execute( @param )
679 or return $ins_sth->errstr;
681 #next unless keys %{ $child_tables{$child_table} };
682 next unless $sequence;
684 #another section of that laziness
685 my $seq_sql = "SELECT currval('$sequence')";
686 my $seq_sth = dbh->prepare($seq_sql) or return dbh->errstr;
687 $seq_sth->execute or return $seq_sth->errstr;
688 my $insertid = $seq_sth->fetchrow_arrayref->[0];
690 # don't drink soap! recurse! recurse! okay!
692 _copy_skel( $child_table_def,
693 $row->{$child_pkey}, #sourceid
695 %{ $child_tables{$child_table_def} },
697 return $error if $error;
707 =item order_pkg HASHREF | OPTION => VALUE ...
709 Orders a single package.
711 Options may be passed as a list of key/value pairs or as a hash reference.
722 Optional FS::cust_location object
726 Optional arryaref of FS::svc_* service objects.
730 If this option is set to a job queue jobnum (see L<FS::queue>), all provisioning
731 jobs will have a dependancy on the supplied job (they will not run until the
732 specific job completes). This can be used to defer provisioning until some
733 action completes (such as running the customer's credit card successfully).
737 Optional subject for a ticket created and attached to this customer
741 Optional queue name for ticket additions
749 my $opt = ref($_[0]) ? shift : { @_ };
751 warn "$me order_pkg called with options ".
752 join(', ', map { "$_: $opt->{$_}" } keys %$opt ). "\n"
755 my $cust_pkg = $opt->{'cust_pkg'};
756 my $svcs = $opt->{'svcs'} || [];
758 my %svc_options = ();
759 $svc_options{'depend_jobnum'} = $opt->{'depend_jobnum'}
760 if exists($opt->{'depend_jobnum'}) && $opt->{'depend_jobnum'};
762 my %insert_params = map { $opt->{$_} ? ( $_ => $opt->{$_} ) : () }
763 qw( ticket_subject ticket_queue );
765 local $SIG{HUP} = 'IGNORE';
766 local $SIG{INT} = 'IGNORE';
767 local $SIG{QUIT} = 'IGNORE';
768 local $SIG{TERM} = 'IGNORE';
769 local $SIG{TSTP} = 'IGNORE';
770 local $SIG{PIPE} = 'IGNORE';
772 my $oldAutoCommit = $FS::UID::AutoCommit;
773 local $FS::UID::AutoCommit = 0;
776 if ( $opt->{'cust_location'} &&
777 ( ! $cust_pkg->locationnum || $cust_pkg->locationnum == -1 ) ) {
778 my $error = $opt->{'cust_location'}->insert;
780 $dbh->rollback if $oldAutoCommit;
781 return "inserting cust_location (transaction rolled back): $error";
783 $cust_pkg->locationnum($opt->{'cust_location'}->locationnum);
786 $cust_pkg->custnum( $self->custnum );
788 my $error = $cust_pkg->insert( %insert_params );
790 $dbh->rollback if $oldAutoCommit;
791 return "inserting cust_pkg (transaction rolled back): $error";
794 foreach my $svc_something ( @{ $opt->{'svcs'} } ) {
795 if ( $svc_something->svcnum ) {
796 my $old_cust_svc = $svc_something->cust_svc;
797 my $new_cust_svc = new FS::cust_svc { $old_cust_svc->hash };
798 $new_cust_svc->pkgnum( $cust_pkg->pkgnum);
799 $error = $new_cust_svc->replace($old_cust_svc);
801 $svc_something->pkgnum( $cust_pkg->pkgnum );
802 if ( $svc_something->isa('FS::svc_acct') ) {
803 foreach ( grep { $opt->{$_.'_ref'} && ${ $opt->{$_.'_ref'} } }
804 qw( seconds upbytes downbytes totalbytes ) ) {
805 $svc_something->$_( $svc_something->$_() + ${ $opt->{$_.'_ref'} } );
806 ${ $opt->{$_.'_ref'} } = 0;
809 $error = $svc_something->insert(%svc_options);
812 $dbh->rollback if $oldAutoCommit;
813 return "inserting svc_ (transaction rolled back): $error";
817 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
822 #deprecated #=item order_pkgs HASHREF [ , SECONDSREF ] [ , OPTION => VALUE ... ]
823 =item order_pkgs HASHREF [ , OPTION => VALUE ... ]
825 Like the insert method on an existing record, this method orders multiple
826 packages and included services atomicaly. Pass a Tie::RefHash data structure
827 to this method containing FS::cust_pkg and FS::svc_I<tablename> objects.
828 There should be a better explanation of this, but until then, here's an
832 tie %hash, 'Tie::RefHash'; #this part is important
834 $cust_pkg => [ $svc_acct ],
837 $cust_main->order_pkgs( \%hash, 'noexport'=>1 );
839 Services can be new, in which case they are inserted, or existing unaudited
840 services, in which case they are linked to the newly-created package.
842 Currently available options are: I<depend_jobnum>, I<noexport>, I<seconds_ref>,
843 I<upbytes_ref>, I<downbytes_ref>, and I<totalbytes_ref>.
845 If I<depend_jobnum> is set, all provisioning jobs will have a dependancy
846 on the supplied jobnum (they will not run until the specific job completes).
847 This can be used to defer provisioning until some action completes (such
848 as running the customer's credit card successfully).
850 The I<noexport> option is deprecated. If I<noexport> is set true, no
851 provisioning jobs (exports) are scheduled. (You can schedule them later with
852 the B<reexport> method for each cust_pkg object. Using the B<reexport> method
853 on the cust_main object is not recommended, as existing services will also be
856 If I<seconds_ref>, I<upbytes_ref>, I<downbytes_ref>, or I<totalbytes_ref> is
857 provided, the scalars (provided by references) will be incremented by the
858 values of the prepaid card.`
864 my $cust_pkgs = shift;
865 my $seconds_ref = ref($_[0]) ? shift : ''; #deprecated
867 $seconds_ref ||= $options{'seconds_ref'};
869 warn "$me order_pkgs called with options ".
870 join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
873 local $SIG{HUP} = 'IGNORE';
874 local $SIG{INT} = 'IGNORE';
875 local $SIG{QUIT} = 'IGNORE';
876 local $SIG{TERM} = 'IGNORE';
877 local $SIG{TSTP} = 'IGNORE';
878 local $SIG{PIPE} = 'IGNORE';
880 my $oldAutoCommit = $FS::UID::AutoCommit;
881 local $FS::UID::AutoCommit = 0;
884 local $FS::svc_Common::noexport_hack = 1 if $options{'noexport'};
886 foreach my $cust_pkg ( keys %$cust_pkgs ) {
888 my $error = $self->order_pkg(
889 'cust_pkg' => $cust_pkg,
890 'svcs' => $cust_pkgs->{$cust_pkg},
891 'seconds_ref' => $seconds_ref,
892 map { $_ => $options{$_} } qw( upbytes_ref downbytes_ref totalbytes_ref
897 $dbh->rollback if $oldAutoCommit;
903 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
907 =item recharge_prepay IDENTIFIER | PREPAY_CREDIT_OBJ [ , AMOUNTREF, SECONDSREF, UPBYTEREF, DOWNBYTEREF ]
909 Recharges this (existing) customer with the specified prepaid card (see
910 L<FS::prepay_credit>), specified either by I<identifier> or as an
911 FS::prepay_credit object. If there is an error, returns the error, otherwise
914 Optionally, five scalar references can be passed as well. They will have their
915 values filled in with the amount, number of seconds, and number of upload,
916 download, and total bytes applied by this prepaid card.
920 #the ref bullshit here should be refactored like get_prepay. MyAccount.pm is
921 #the only place that uses these args
922 sub recharge_prepay {
923 my( $self, $prepay_credit, $amountref, $secondsref,
924 $upbytesref, $downbytesref, $totalbytesref ) = @_;
926 local $SIG{HUP} = 'IGNORE';
927 local $SIG{INT} = 'IGNORE';
928 local $SIG{QUIT} = 'IGNORE';
929 local $SIG{TERM} = 'IGNORE';
930 local $SIG{TSTP} = 'IGNORE';
931 local $SIG{PIPE} = 'IGNORE';
933 my $oldAutoCommit = $FS::UID::AutoCommit;
934 local $FS::UID::AutoCommit = 0;
937 my( $amount, $seconds, $upbytes, $downbytes, $totalbytes) = ( 0, 0, 0, 0, 0 );
939 my $error = $self->get_prepay( $prepay_credit,
940 'amount_ref' => \$amount,
941 'seconds_ref' => \$seconds,
942 'upbytes_ref' => \$upbytes,
943 'downbytes_ref' => \$downbytes,
944 'totalbytes_ref' => \$totalbytes,
946 || $self->increment_seconds($seconds)
947 || $self->increment_upbytes($upbytes)
948 || $self->increment_downbytes($downbytes)
949 || $self->increment_totalbytes($totalbytes)
950 || $self->insert_cust_pay_prepay( $amount,
952 ? $prepay_credit->identifier
957 $dbh->rollback if $oldAutoCommit;
961 if ( defined($amountref) ) { $$amountref = $amount; }
962 if ( defined($secondsref) ) { $$secondsref = $seconds; }
963 if ( defined($upbytesref) ) { $$upbytesref = $upbytes; }
964 if ( defined($downbytesref) ) { $$downbytesref = $downbytes; }
965 if ( defined($totalbytesref) ) { $$totalbytesref = $totalbytes; }
967 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
972 =item get_prepay IDENTIFIER | PREPAY_CREDIT_OBJ [ , OPTION => VALUE ... ]
974 Looks up and deletes a prepaid card (see L<FS::prepay_credit>),
975 specified either by I<identifier> or as an FS::prepay_credit object.
977 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
978 incremented by the values of the prepaid card.
980 If the prepaid card specifies an I<agentnum> (see L<FS::agent>), it is used to
981 check or set this customer's I<agentnum>.
983 If there is an error, returns the error, otherwise returns false.
989 my( $self, $prepay_credit, %opt ) = @_;
991 local $SIG{HUP} = 'IGNORE';
992 local $SIG{INT} = 'IGNORE';
993 local $SIG{QUIT} = 'IGNORE';
994 local $SIG{TERM} = 'IGNORE';
995 local $SIG{TSTP} = 'IGNORE';
996 local $SIG{PIPE} = 'IGNORE';
998 my $oldAutoCommit = $FS::UID::AutoCommit;
999 local $FS::UID::AutoCommit = 0;
1002 unless ( ref($prepay_credit) ) {
1004 my $identifier = $prepay_credit;
1006 $prepay_credit = qsearchs(
1008 { 'identifier' => $prepay_credit },
1013 unless ( $prepay_credit ) {
1014 $dbh->rollback if $oldAutoCommit;
1015 return "Invalid prepaid card: ". $identifier;
1020 if ( $prepay_credit->agentnum ) {
1021 if ( $self->agentnum && $self->agentnum != $prepay_credit->agentnum ) {
1022 $dbh->rollback if $oldAutoCommit;
1023 return "prepaid card not valid for agent ". $self->agentnum;
1025 $self->agentnum($prepay_credit->agentnum);
1028 my $error = $prepay_credit->delete;
1030 $dbh->rollback if $oldAutoCommit;
1031 return "removing prepay_credit (transaction rolled back): $error";
1034 ${ $opt{$_.'_ref'} } += $prepay_credit->$_()
1035 for grep $opt{$_.'_ref'}, qw( amount seconds upbytes downbytes totalbytes );
1037 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1042 =item increment_upbytes SECONDS
1044 Updates this customer's single or primary account (see L<FS::svc_acct>) by
1045 the specified number of upbytes. If there is an error, returns the error,
1046 otherwise returns false.
1050 sub increment_upbytes {
1051 _increment_column( shift, 'upbytes', @_);
1054 =item increment_downbytes SECONDS
1056 Updates this customer's single or primary account (see L<FS::svc_acct>) by
1057 the specified number of downbytes. If there is an error, returns the error,
1058 otherwise returns false.
1062 sub increment_downbytes {
1063 _increment_column( shift, 'downbytes', @_);
1066 =item increment_totalbytes SECONDS
1068 Updates this customer's single or primary account (see L<FS::svc_acct>) by
1069 the specified number of totalbytes. If there is an error, returns the error,
1070 otherwise returns false.
1074 sub increment_totalbytes {
1075 _increment_column( shift, 'totalbytes', @_);
1078 =item increment_seconds SECONDS
1080 Updates this customer's single or primary account (see L<FS::svc_acct>) by
1081 the specified number of seconds. If there is an error, returns the error,
1082 otherwise returns false.
1086 sub increment_seconds {
1087 _increment_column( shift, 'seconds', @_);
1090 =item _increment_column AMOUNT
1092 Updates this customer's single or primary account (see L<FS::svc_acct>) by
1093 the specified number of seconds or bytes. If there is an error, returns
1094 the error, otherwise returns false.
1098 sub _increment_column {
1099 my( $self, $column, $amount ) = @_;
1100 warn "$me increment_column called: $column, $amount\n"
1103 return '' unless $amount;
1105 my @cust_pkg = grep { $_->part_pkg->svcpart('svc_acct') }
1106 $self->ncancelled_pkgs;
1108 if ( ! @cust_pkg ) {
1109 return 'No packages with primary or single services found'.
1110 ' to apply pre-paid time';
1111 } elsif ( scalar(@cust_pkg) > 1 ) {
1112 #maybe have a way to specify the package/account?
1113 return 'Multiple packages found to apply pre-paid time';
1116 my $cust_pkg = $cust_pkg[0];
1117 warn " found package pkgnum ". $cust_pkg->pkgnum. "\n"
1121 $cust_pkg->cust_svc( $cust_pkg->part_pkg->svcpart('svc_acct') );
1123 if ( ! @cust_svc ) {
1124 return 'No account found to apply pre-paid time';
1125 } elsif ( scalar(@cust_svc) > 1 ) {
1126 return 'Multiple accounts found to apply pre-paid time';
1129 my $svc_acct = $cust_svc[0]->svc_x;
1130 warn " found service svcnum ". $svc_acct->pkgnum.
1131 ' ('. $svc_acct->email. ")\n"
1134 $column = "increment_$column";
1135 $svc_acct->$column($amount);
1139 =item insert_cust_pay_prepay AMOUNT [ PAYINFO ]
1141 Inserts a prepayment in the specified amount for this customer. An optional
1142 second argument can specify the prepayment identifier for tracking purposes.
1143 If there is an error, returns the error, otherwise returns false.
1147 sub insert_cust_pay_prepay {
1148 shift->insert_cust_pay('PREP', @_);
1151 =item insert_cust_pay_cash AMOUNT [ PAYINFO ]
1153 Inserts a cash payment in the specified amount for this customer. An optional
1154 second argument can specify the payment identifier for tracking purposes.
1155 If there is an error, returns the error, otherwise returns false.
1159 sub insert_cust_pay_cash {
1160 shift->insert_cust_pay('CASH', @_);
1163 =item insert_cust_pay_west AMOUNT [ PAYINFO ]
1165 Inserts a Western Union payment in the specified amount for this customer. An
1166 optional second argument can specify the prepayment identifier for tracking
1167 purposes. If there is an error, returns the error, otherwise returns false.
1171 sub insert_cust_pay_west {
1172 shift->insert_cust_pay('WEST', @_);
1175 sub insert_cust_pay {
1176 my( $self, $payby, $amount ) = splice(@_, 0, 3);
1177 my $payinfo = scalar(@_) ? shift : '';
1179 my $cust_pay = new FS::cust_pay {
1180 'custnum' => $self->custnum,
1181 'paid' => sprintf('%.2f', $amount),
1182 #'_date' => #date the prepaid card was purchased???
1184 'payinfo' => $payinfo,
1192 This method is deprecated. See the I<depend_jobnum> option to the insert and
1193 order_pkgs methods for a better way to defer provisioning.
1195 Re-schedules all exports by calling the B<reexport> method of all associated
1196 packages (see L<FS::cust_pkg>). If there is an error, returns the error;
1197 otherwise returns false.
1204 carp "WARNING: FS::cust_main::reexport is deprectated; ".
1205 "use the depend_jobnum option to insert or order_pkgs to delay export";
1207 local $SIG{HUP} = 'IGNORE';
1208 local $SIG{INT} = 'IGNORE';
1209 local $SIG{QUIT} = 'IGNORE';
1210 local $SIG{TERM} = 'IGNORE';
1211 local $SIG{TSTP} = 'IGNORE';
1212 local $SIG{PIPE} = 'IGNORE';
1214 my $oldAutoCommit = $FS::UID::AutoCommit;
1215 local $FS::UID::AutoCommit = 0;
1218 foreach my $cust_pkg ( $self->ncancelled_pkgs ) {
1219 my $error = $cust_pkg->reexport;
1221 $dbh->rollback if $oldAutoCommit;
1226 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1231 =item delete NEW_CUSTNUM
1233 This deletes the customer. If there is an error, returns the error, otherwise
1236 This will completely remove all traces of the customer record. This is not
1237 what you want when a customer cancels service; for that, cancel all of the
1238 customer's packages (see L</cancel>).
1240 If the customer has any uncancelled packages, you need to pass a new (valid)
1241 customer number for those packages to be transferred to. Cancelled packages
1242 will be deleted. Did I mention that this is NOT what you want when a customer
1243 cancels service and that you really should be looking see L<FS::cust_pkg/cancel>?
1245 You can't delete a customer with invoices (see L<FS::cust_bill>),
1246 or credits (see L<FS::cust_credit>), payments (see L<FS::cust_pay>) or
1247 refunds (see L<FS::cust_refund>).
1254 local $SIG{HUP} = 'IGNORE';
1255 local $SIG{INT} = 'IGNORE';
1256 local $SIG{QUIT} = 'IGNORE';
1257 local $SIG{TERM} = 'IGNORE';
1258 local $SIG{TSTP} = 'IGNORE';
1259 local $SIG{PIPE} = 'IGNORE';
1261 my $oldAutoCommit = $FS::UID::AutoCommit;
1262 local $FS::UID::AutoCommit = 0;
1265 if ( $self->cust_bill ) {
1266 $dbh->rollback if $oldAutoCommit;
1267 return "Can't delete a customer with invoices";
1269 if ( $self->cust_credit ) {
1270 $dbh->rollback if $oldAutoCommit;
1271 return "Can't delete a customer with credits";
1273 if ( $self->cust_pay ) {
1274 $dbh->rollback if $oldAutoCommit;
1275 return "Can't delete a customer with payments";
1277 if ( $self->cust_refund ) {
1278 $dbh->rollback if $oldAutoCommit;
1279 return "Can't delete a customer with refunds";
1282 my @cust_pkg = $self->ncancelled_pkgs;
1284 my $new_custnum = shift;
1285 unless ( qsearchs( 'cust_main', { 'custnum' => $new_custnum } ) ) {
1286 $dbh->rollback if $oldAutoCommit;
1287 return "Invalid new customer number: $new_custnum";
1289 foreach my $cust_pkg ( @cust_pkg ) {
1290 my %hash = $cust_pkg->hash;
1291 $hash{'custnum'} = $new_custnum;
1292 my $new_cust_pkg = new FS::cust_pkg ( \%hash );
1293 my $error = $new_cust_pkg->replace($cust_pkg,
1294 options => { $cust_pkg->options },
1297 $dbh->rollback if $oldAutoCommit;
1302 my @cancelled_cust_pkg = $self->all_pkgs;
1303 foreach my $cust_pkg ( @cancelled_cust_pkg ) {
1304 my $error = $cust_pkg->delete;
1306 $dbh->rollback if $oldAutoCommit;
1311 foreach my $cust_main_invoice ( #(email invoice destinations, not invoices)
1312 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } )
1314 my $error = $cust_main_invoice->delete;
1316 $dbh->rollback if $oldAutoCommit;
1321 foreach my $cust_main_exemption (
1322 qsearch( 'cust_main_exemption', { 'custnum' => $self->custnum } )
1324 my $error = $cust_main_exemption->delete;
1326 $dbh->rollback if $oldAutoCommit;
1331 my $error = $self->SUPER::delete;
1333 $dbh->rollback if $oldAutoCommit;
1337 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1342 =item replace [ OLD_RECORD ] [ INVOICING_LIST_ARYREF ] [ , OPTION => VALUE ... ] ]
1345 Replaces the OLD_RECORD with this one in the database. If there is an error,
1346 returns the error, otherwise returns false.
1348 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
1349 be set as the invoicing list (see L<"invoicing_list">). Errors return as
1350 expected and rollback the entire transaction; it is not necessary to call
1351 check_invoicing_list first. Here's an example:
1353 $new_cust_main->replace( $old_cust_main, [ $email, 'POST' ] );
1355 Currently available options are: I<tax_exemption>.
1357 The I<tax_exemption> option can be set to an arrayref of tax names.
1358 FS::cust_main_exemption records will be deleted and inserted as appropriate.
1365 my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
1367 : $self->replace_old;
1371 warn "$me replace called\n"
1374 my $curuser = $FS::CurrentUser::CurrentUser;
1375 if ( $self->payby eq 'COMP'
1376 && $self->payby ne $old->payby
1377 && ! $curuser->access_right('Complimentary customer')
1380 return "You are not permitted to create complimentary accounts.";
1383 local($ignore_expired_card) = 1
1384 if $old->payby =~ /^(CARD|DCRD)$/
1385 && $self->payby =~ /^(CARD|DCRD)$/
1386 && ( $old->payinfo eq $self->payinfo || $old->paymask eq $self->paymask );
1388 local $SIG{HUP} = 'IGNORE';
1389 local $SIG{INT} = 'IGNORE';
1390 local $SIG{QUIT} = 'IGNORE';
1391 local $SIG{TERM} = 'IGNORE';
1392 local $SIG{TSTP} = 'IGNORE';
1393 local $SIG{PIPE} = 'IGNORE';
1395 my $oldAutoCommit = $FS::UID::AutoCommit;
1396 local $FS::UID::AutoCommit = 0;
1399 my $error = $self->SUPER::replace($old);
1402 $dbh->rollback if $oldAutoCommit;
1406 if ( @param && ref($param[0]) eq 'ARRAY' ) { # INVOICING_LIST_ARYREF
1407 my $invoicing_list = shift @param;
1408 $error = $self->check_invoicing_list( $invoicing_list );
1410 $dbh->rollback if $oldAutoCommit;
1413 $self->invoicing_list( $invoicing_list );
1416 my %options = @param;
1418 my $tax_exemption = delete $options{'tax_exemption'};
1419 if ( $tax_exemption ) {
1421 my %cust_main_exemption =
1422 map { $_->taxname => $_ }
1423 qsearch('cust_main_exemption', { 'custnum' => $old->custnum } );
1425 foreach my $taxname ( @$tax_exemption ) {
1427 next if delete $cust_main_exemption{$taxname};
1429 my $cust_main_exemption = new FS::cust_main_exemption {
1430 'custnum' => $self->custnum,
1431 'taxname' => $taxname,
1433 my $error = $cust_main_exemption->insert;
1435 $dbh->rollback if $oldAutoCommit;
1436 return "inserting cust_main_exemption (transaction rolled back): $error";
1440 foreach my $cust_main_exemption ( values %cust_main_exemption ) {
1441 my $error = $cust_main_exemption->delete;
1443 $dbh->rollback if $oldAutoCommit;
1444 return "deleting cust_main_exemption (transaction rolled back): $error";
1450 if ( $self->payby =~ /^(CARD|CHEK|LECB)$/ &&
1451 grep { $self->get($_) ne $old->get($_) } qw(payinfo paydate payname) ) {
1452 # card/check/lec info has changed, want to retry realtime_ invoice events
1453 my $error = $self->retry_realtime;
1455 $dbh->rollback if $oldAutoCommit;
1460 unless ( $import || $skip_fuzzyfiles ) {
1461 $error = $self->queue_fuzzyfiles_update;
1463 $dbh->rollback if $oldAutoCommit;
1464 return "updating fuzzy search cache: $error";
1468 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1473 =item queue_fuzzyfiles_update
1475 Used by insert & replace to update the fuzzy search cache
1479 sub queue_fuzzyfiles_update {
1482 local $SIG{HUP} = 'IGNORE';
1483 local $SIG{INT} = 'IGNORE';
1484 local $SIG{QUIT} = 'IGNORE';
1485 local $SIG{TERM} = 'IGNORE';
1486 local $SIG{TSTP} = 'IGNORE';
1487 local $SIG{PIPE} = 'IGNORE';
1489 my $oldAutoCommit = $FS::UID::AutoCommit;
1490 local $FS::UID::AutoCommit = 0;
1493 my $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
1494 my $error = $queue->insert( map $self->getfield($_),
1495 qw(first last company)
1498 $dbh->rollback if $oldAutoCommit;
1499 return "queueing job (transaction rolled back): $error";
1502 if ( $self->ship_last ) {
1503 $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
1504 $error = $queue->insert( map $self->getfield("ship_$_"),
1505 qw(first last company)
1508 $dbh->rollback if $oldAutoCommit;
1509 return "queueing job (transaction rolled back): $error";
1513 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1520 Checks all fields to make sure this is a valid customer record. If there is
1521 an error, returns the error, otherwise returns false. Called by the insert
1522 and replace methods.
1529 warn "$me check BEFORE: \n". $self->_dump
1533 $self->ut_numbern('custnum')
1534 || $self->ut_number('agentnum')
1535 || $self->ut_textn('agent_custid')
1536 || $self->ut_number('refnum')
1537 || $self->ut_textn('custbatch')
1538 || $self->ut_name('last')
1539 || $self->ut_name('first')
1540 || $self->ut_snumbern('birthdate')
1541 || $self->ut_snumbern('signupdate')
1542 || $self->ut_textn('company')
1543 || $self->ut_text('address1')
1544 || $self->ut_textn('address2')
1545 || $self->ut_text('city')
1546 || $self->ut_textn('county')
1547 || $self->ut_textn('state')
1548 || $self->ut_country('country')
1549 || $self->ut_anything('comments')
1550 || $self->ut_numbern('referral_custnum')
1551 || $self->ut_textn('stateid')
1552 || $self->ut_textn('stateid_state')
1553 || $self->ut_textn('invoice_terms')
1554 || $self->ut_alphan('geocode')
1557 #barf. need message catalogs. i18n. etc.
1558 $error .= "Please select an advertising source."
1559 if $error =~ /^Illegal or empty \(numeric\) refnum: /;
1560 return $error if $error;
1562 return "Unknown agent"
1563 unless qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
1565 return "Unknown refnum"
1566 unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } );
1568 return "Unknown referring custnum: ". $self->referral_custnum
1569 unless ! $self->referral_custnum
1570 || qsearchs( 'cust_main', { 'custnum' => $self->referral_custnum } );
1572 if ( $self->ss eq '' ) {
1577 $ss =~ /^(\d{3})(\d{2})(\d{4})$/
1578 or return "Illegal social security number: ". $self->ss;
1579 $self->ss("$1-$2-$3");
1583 # bad idea to disable, causes billing to fail because of no tax rates later
1584 # unless ( $import ) {
1585 unless ( qsearch('cust_main_county', {
1586 'country' => $self->country,
1589 return "Unknown state/county/country: ".
1590 $self->state. "/". $self->county. "/". $self->country
1591 unless qsearch('cust_main_county',{
1592 'state' => $self->state,
1593 'county' => $self->county,
1594 'country' => $self->country,
1600 $self->ut_phonen('daytime', $self->country)
1601 || $self->ut_phonen('night', $self->country)
1602 || $self->ut_phonen('fax', $self->country)
1603 || $self->ut_zip('zip', $self->country)
1605 return $error if $error;
1607 if ( $conf->exists('cust_main-require_phone')
1608 && ! length($self->daytime) && ! length($self->night)
1611 my $daytime_label = FS::Msgcat::_gettext('daytime') =~ /^(daytime)?$/
1613 : FS::Msgcat::_gettext('daytime');
1614 my $night_label = FS::Msgcat::_gettext('night') =~ /^(night)?$/
1616 : FS::Msgcat::_gettext('night');
1618 return "$daytime_label or $night_label is required"
1622 if ( $self->has_ship_address
1623 && scalar ( grep { $self->getfield($_) ne $self->getfield("ship_$_") }
1624 $self->addr_fields )
1628 $self->ut_name('ship_last')
1629 || $self->ut_name('ship_first')
1630 || $self->ut_textn('ship_company')
1631 || $self->ut_text('ship_address1')
1632 || $self->ut_textn('ship_address2')
1633 || $self->ut_text('ship_city')
1634 || $self->ut_textn('ship_county')
1635 || $self->ut_textn('ship_state')
1636 || $self->ut_country('ship_country')
1638 return $error if $error;
1640 #false laziness with above
1641 unless ( qsearchs('cust_main_county', {
1642 'country' => $self->ship_country,
1645 return "Unknown ship_state/ship_county/ship_country: ".
1646 $self->ship_state. "/". $self->ship_county. "/". $self->ship_country
1647 unless qsearch('cust_main_county',{
1648 'state' => $self->ship_state,
1649 'county' => $self->ship_county,
1650 'country' => $self->ship_country,
1656 $self->ut_phonen('ship_daytime', $self->ship_country)
1657 || $self->ut_phonen('ship_night', $self->ship_country)
1658 || $self->ut_phonen('ship_fax', $self->ship_country)
1659 || $self->ut_zip('ship_zip', $self->ship_country)
1661 return $error if $error;
1663 return "Unit # is required."
1664 if $self->ship_address2 =~ /^\s*$/
1665 && $conf->exists('cust_main-require_address2');
1667 } else { # ship_ info eq billing info, so don't store dup info in database
1669 $self->setfield("ship_$_", '')
1670 foreach $self->addr_fields;
1672 return "Unit # is required."
1673 if $self->address2 =~ /^\s*$/
1674 && $conf->exists('cust_main-require_address2');
1678 #$self->payby =~ /^(CARD|DCRD|CHEK|DCHK|LECB|BILL|COMP|PREPAY|CASH|WEST|MCRD)$/
1679 # or return "Illegal payby: ". $self->payby;
1681 FS::payby->can_payby($self->table, $self->payby)
1682 or return "Illegal payby: ". $self->payby;
1684 $error = $self->ut_numbern('paystart_month')
1685 || $self->ut_numbern('paystart_year')
1686 || $self->ut_numbern('payissue')
1687 || $self->ut_textn('paytype')
1689 return $error if $error;
1691 if ( $self->payip eq '' ) {
1694 $error = $self->ut_ip('payip');
1695 return $error if $error;
1698 # If it is encrypted and the private key is not availaible then we can't
1699 # check the credit card.
1701 my $check_payinfo = 1;
1703 if ($self->is_encrypted($self->payinfo)) {
1707 if ( $check_payinfo && $self->payby =~ /^(CARD|DCRD)$/ ) {
1709 my $payinfo = $self->payinfo;
1710 $payinfo =~ s/\D//g;
1711 $payinfo =~ /^(\d{13,16})$/
1712 or return gettext('invalid_card'); # . ": ". $self->payinfo;
1714 $self->payinfo($payinfo);
1716 or return gettext('invalid_card'); # . ": ". $self->payinfo;
1718 return gettext('unknown_card_type')
1719 if cardtype($self->payinfo) eq "Unknown";
1721 my $ban = qsearchs('banned_pay', $self->_banned_pay_hashref);
1723 return 'Banned credit card: banned on '.
1724 time2str('%a %h %o at %r', $ban->_date).
1725 ' by '. $ban->otaker.
1726 ' (ban# '. $ban->bannum. ')';
1729 if (length($self->paycvv) && !$self->is_encrypted($self->paycvv)) {
1730 if ( cardtype($self->payinfo) eq 'American Express card' ) {
1731 $self->paycvv =~ /^(\d{4})$/
1732 or return "CVV2 (CID) for American Express cards is four digits.";
1735 $self->paycvv =~ /^(\d{3})$/
1736 or return "CVV2 (CVC2/CID) is three digits.";
1743 my $cardtype = cardtype($payinfo);
1744 if ( $cardtype =~ /^(Switch|Solo)$/i ) {
1746 return "Start date or issue number is required for $cardtype cards"
1747 unless $self->paystart_month && $self->paystart_year or $self->payissue;
1749 return "Start month must be between 1 and 12"
1750 if $self->paystart_month
1751 and $self->paystart_month < 1 || $self->paystart_month > 12;
1753 return "Start year must be 1990 or later"
1754 if $self->paystart_year
1755 and $self->paystart_year < 1990;
1757 return "Issue number must be beween 1 and 99"
1759 and $self->payissue < 1 || $self->payissue > 99;
1762 $self->paystart_month('');
1763 $self->paystart_year('');
1764 $self->payissue('');
1767 } elsif ( $check_payinfo && $self->payby =~ /^(CHEK|DCHK)$/ ) {
1769 my $payinfo = $self->payinfo;
1770 $payinfo =~ s/[^\d\@]//g;
1771 if ( $conf->exists('echeck-nonus') ) {
1772 $payinfo =~ /^(\d+)\@(\d+)$/ or return 'invalid echeck account@aba';
1773 $payinfo = "$1\@$2";
1775 $payinfo =~ /^(\d+)\@(\d{9})$/ or return 'invalid echeck account@aba';
1776 $payinfo = "$1\@$2";
1778 $self->payinfo($payinfo);
1781 my $ban = qsearchs('banned_pay', $self->_banned_pay_hashref);
1783 return 'Banned ACH account: banned on '.
1784 time2str('%a %h %o at %r', $ban->_date).
1785 ' by '. $ban->otaker.
1786 ' (ban# '. $ban->bannum. ')';
1789 } elsif ( $self->payby eq 'LECB' ) {
1791 my $payinfo = $self->payinfo;
1792 $payinfo =~ s/\D//g;
1793 $payinfo =~ /^1?(\d{10})$/ or return 'invalid btn billing telephone number';
1795 $self->payinfo($payinfo);
1798 } elsif ( $self->payby eq 'BILL' ) {
1800 $error = $self->ut_textn('payinfo');
1801 return "Illegal P.O. number: ". $self->payinfo if $error;
1804 } elsif ( $self->payby eq 'COMP' ) {
1806 my $curuser = $FS::CurrentUser::CurrentUser;
1807 if ( ! $self->custnum
1808 && ! $curuser->access_right('Complimentary customer')
1811 return "You are not permitted to create complimentary accounts."
1814 $error = $self->ut_textn('payinfo');
1815 return "Illegal comp account issuer: ". $self->payinfo if $error;
1818 } elsif ( $self->payby eq 'PREPAY' ) {
1820 my $payinfo = $self->payinfo;
1821 $payinfo =~ s/\W//g; #anything else would just confuse things
1822 $self->payinfo($payinfo);
1823 $error = $self->ut_alpha('payinfo');
1824 return "Illegal prepayment identifier: ". $self->payinfo if $error;
1825 return "Unknown prepayment identifier"
1826 unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } );
1831 if ( $self->paydate eq '' || $self->paydate eq '-' ) {
1832 return "Expiration date required"
1833 unless $self->payby =~ /^(BILL|PREPAY|CHEK|DCHK|LECB|CASH|WEST|MCRD)$/;
1837 if ( $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/ ) {
1838 ( $m, $y ) = ( $1, length($2) == 4 ? $2 : "20$2" );
1839 } elsif ( $self->paydate =~ /^(20)?(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) {
1840 ( $m, $y ) = ( $3, "20$2" );
1842 return "Illegal expiration date: ". $self->paydate;
1844 $self->paydate("$y-$m-01");
1845 my($nowm,$nowy)=(localtime(time))[4,5]; $nowm++; $nowy+=1900;
1846 return gettext('expired_card')
1848 && !$ignore_expired_card
1849 && ( $y<$nowy || ( $y==$nowy && $1<$nowm ) );
1852 if ( $self->payname eq '' && $self->payby !~ /^(CHEK|DCHK)$/ &&
1853 ( ! $conf->exists('require_cardname')
1854 || $self->payby !~ /^(CARD|DCRD)$/ )
1856 $self->payname( $self->first. " ". $self->getfield('last') );
1858 $self->payname =~ /^([\w \,\.\-\'\&]+)$/
1859 or return gettext('illegal_name'). " payname: ". $self->payname;
1863 foreach my $flag (qw( tax spool_cdr squelch_cdr archived )) {
1864 $self->$flag() =~ /^(Y?)$/ or return "Illegal $flag: ". $self->$flag();
1868 $self->otaker(getotaker) unless $self->otaker;
1870 warn "$me check AFTER: \n". $self->_dump
1873 $self->SUPER::check;
1878 Returns a list of fields which have ship_ duplicates.
1883 qw( last first company
1884 address1 address2 city county state zip country
1889 =item has_ship_address
1891 Returns true if this customer record has a separate shipping address.
1895 sub has_ship_address {
1897 scalar( grep { $self->getfield("ship_$_") ne '' } $self->addr_fields );
1900 =item all_pkgs [ EXTRA_QSEARCH_PARAMS_HASHREF ]
1902 Returns all packages (see L<FS::cust_pkg>) for this customer.
1908 my $extra_qsearch = ref($_[0]) ? shift : {};
1910 return $self->num_pkgs unless wantarray || keys(%$extra_qsearch);
1913 if ( $self->{'_pkgnum'} ) {
1914 @cust_pkg = values %{ $self->{'_pkgnum'}->cache };
1916 @cust_pkg = $self->_cust_pkg($extra_qsearch);
1919 sort sort_packages @cust_pkg;
1924 Synonym for B<all_pkgs>.
1929 shift->all_pkgs(@_);
1934 Returns all locations (see L<FS::cust_location>) for this customer.
1940 qsearch('cust_location', { 'custnum' => $self->custnum } );
1943 =item ncancelled_pkgs [ EXTRA_QSEARCH_PARAMS_HASHREF ]
1945 Returns all non-cancelled packages (see L<FS::cust_pkg>) for this customer.
1949 sub ncancelled_pkgs {
1951 my $extra_qsearch = ref($_[0]) ? shift : {};
1953 return $self->num_ncancelled_pkgs unless wantarray;
1956 if ( $self->{'_pkgnum'} ) {
1958 warn "$me ncancelled_pkgs: returning cached objects"
1961 @cust_pkg = grep { ! $_->getfield('cancel') }
1962 values %{ $self->{'_pkgnum'}->cache };
1966 warn "$me ncancelled_pkgs: searching for packages with custnum ".
1967 $self->custnum. "\n"
1970 $extra_qsearch->{'extra_sql'} .= ' AND ( cancel IS NULL OR cancel = 0 ) ';
1972 @cust_pkg = $self->_cust_pkg($extra_qsearch);
1976 sort sort_packages @cust_pkg;
1982 my $extra_qsearch = ref($_[0]) ? shift : {};
1984 $extra_qsearch->{'select'} ||= '*';
1985 $extra_qsearch->{'select'} .=
1986 ',( SELECT COUNT(*) FROM cust_svc WHERE cust_pkg.pkgnum = cust_svc.pkgnum )
1990 $_->{'_num_cust_svc'} = $_->get('_num_cust_svc');
1995 'table' => 'cust_pkg',
1996 'hashref' => { 'custnum' => $self->custnum },
2001 # This should be generalized to use config options to determine order.
2004 if ( $a->get('cancel') xor $b->get('cancel') ) {
2005 return -1 if $b->get('cancel');
2006 return 1 if $a->get('cancel');
2007 #shouldn't get here...
2010 my $a_num_cust_svc = $a->num_cust_svc;
2011 my $b_num_cust_svc = $b->num_cust_svc;
2012 return 0 if !$a_num_cust_svc && !$b_num_cust_svc;
2013 return -1 if $a_num_cust_svc && !$b_num_cust_svc;
2014 return 1 if !$a_num_cust_svc && $b_num_cust_svc;
2015 my @a_cust_svc = $a->cust_svc;
2016 my @b_cust_svc = $b->cust_svc;
2017 $a_cust_svc[0]->svc_x->label cmp $b_cust_svc[0]->svc_x->label;
2022 =item suspended_pkgs
2024 Returns all suspended packages (see L<FS::cust_pkg>) for this customer.
2028 sub suspended_pkgs {
2030 grep { $_->susp } $self->ncancelled_pkgs;
2033 =item unflagged_suspended_pkgs
2035 Returns all unflagged suspended packages (see L<FS::cust_pkg>) for this
2036 customer (thouse packages without the `manual_flag' set).
2040 sub unflagged_suspended_pkgs {
2042 return $self->suspended_pkgs
2043 unless dbdef->table('cust_pkg')->column('manual_flag');
2044 grep { ! $_->manual_flag } $self->suspended_pkgs;
2047 =item unsuspended_pkgs
2049 Returns all unsuspended (and uncancelled) packages (see L<FS::cust_pkg>) for
2054 sub unsuspended_pkgs {
2056 grep { ! $_->susp } $self->ncancelled_pkgs;
2059 =item num_cancelled_pkgs
2061 Returns the number of cancelled packages (see L<FS::cust_pkg>) for this
2066 sub num_cancelled_pkgs {
2067 shift->num_pkgs("cust_pkg.cancel IS NOT NULL AND cust_pkg.cancel != 0");
2070 sub num_ncancelled_pkgs {
2071 shift->num_pkgs("( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )");
2075 my( $self ) = shift;
2076 my $sql = scalar(@_) ? shift : '';
2077 $sql = "AND $sql" if $sql && $sql !~ /^\s*$/ && $sql !~ /^\s*AND/i;
2078 my $sth = dbh->prepare(
2079 "SELECT COUNT(*) FROM cust_pkg WHERE custnum = ? $sql"
2080 ) or die dbh->errstr;
2081 $sth->execute($self->custnum) or die $sth->errstr;
2082 $sth->fetchrow_arrayref->[0];
2087 Unsuspends all unflagged suspended packages (see L</unflagged_suspended_pkgs>
2088 and L<FS::cust_pkg>) for this customer. Always returns a list: an empty list
2089 on success or a list of errors.
2095 grep { $_->unsuspend } $self->suspended_pkgs;
2100 Suspends all unsuspended packages (see L<FS::cust_pkg>) for this customer.
2102 Returns a list: an empty list on success or a list of errors.
2108 grep { $_->suspend(@_) } $self->unsuspended_pkgs;
2111 =item suspend_if_pkgpart HASHREF | PKGPART [ , PKGPART ... ]
2113 Suspends all unsuspended packages (see L<FS::cust_pkg>) matching the listed
2114 PKGPARTs (see L<FS::part_pkg>). Preferred usage is to pass a hashref instead
2115 of a list of pkgparts; the hashref has the following keys:
2119 =item pkgparts - listref of pkgparts
2121 =item (other options are passed to the suspend method)
2126 Returns a list: an empty list on success or a list of errors.
2130 sub suspend_if_pkgpart {
2132 my (@pkgparts, %opt);
2133 if (ref($_[0]) eq 'HASH'){
2134 @pkgparts = @{$_[0]{pkgparts}};
2139 grep { $_->suspend(%opt) }
2140 grep { my $pkgpart = $_->pkgpart; grep { $pkgpart eq $_ } @pkgparts }
2141 $self->unsuspended_pkgs;
2144 =item suspend_unless_pkgpart HASHREF | PKGPART [ , PKGPART ... ]
2146 Suspends all unsuspended packages (see L<FS::cust_pkg>) unless they match the
2147 given PKGPARTs (see L<FS::part_pkg>). Preferred usage is to pass a hashref
2148 instead of a list of pkgparts; the hashref has the following keys:
2152 =item pkgparts - listref of pkgparts
2154 =item (other options are passed to the suspend method)
2158 Returns a list: an empty list on success or a list of errors.
2162 sub suspend_unless_pkgpart {
2164 my (@pkgparts, %opt);
2165 if (ref($_[0]) eq 'HASH'){
2166 @pkgparts = @{$_[0]{pkgparts}};
2171 grep { $_->suspend(%opt) }
2172 grep { my $pkgpart = $_->pkgpart; ! grep { $pkgpart eq $_ } @pkgparts }
2173 $self->unsuspended_pkgs;
2176 =item cancel [ OPTION => VALUE ... ]
2178 Cancels all uncancelled packages (see L<FS::cust_pkg>) for this customer.
2180 Available options are:
2184 =item quiet - can be set true to supress email cancellation notices.
2186 =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.
2188 =item ban - can be set true to ban this customer's credit card or ACH information, if present.
2192 Always returns a list: an empty list on success or a list of errors.
2197 my( $self, %opt ) = @_;
2199 warn "$me cancel called on customer ". $self->custnum. " with options ".
2200 join(', ', map { "$_: $opt{$_}" } keys %opt ). "\n"
2203 return ( 'access denied' )
2204 unless $FS::CurrentUser::CurrentUser->access_right('Cancel customer');
2206 if ( $opt{'ban'} && $self->payby =~ /^(CARD|DCRD|CHEK|DCHK)$/ ) {
2208 #should try decryption (we might have the private key)
2209 # and if not maybe queue a job for the server that does?
2210 return ( "Can't (yet) ban encrypted credit cards" )
2211 if $self->is_encrypted($self->payinfo);
2213 my $ban = new FS::banned_pay $self->_banned_pay_hashref;
2214 my $error = $ban->insert;
2215 return ( $error ) if $error;
2219 my @pkgs = $self->ncancelled_pkgs;
2221 warn "$me cancelling ". scalar($self->ncancelled_pkgs). "/".
2222 scalar(@pkgs). " packages for customer ". $self->custnum. "\n"
2225 grep { $_ } map { $_->cancel(%opt) } $self->ncancelled_pkgs;
2228 sub _banned_pay_hashref {
2239 'payby' => $payby2ban{$self->payby},
2240 'payinfo' => md5_base64($self->payinfo),
2241 #don't ever *search* on reason! #'reason' =>
2247 Returns all notes (see L<FS::cust_main_note>) for this customer.
2254 qsearch( 'cust_main_note',
2255 { 'custnum' => $self->custnum },
2257 'ORDER BY _DATE DESC'
2263 Returns the agent (see L<FS::agent>) for this customer.
2269 qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
2272 =item bill_and_collect
2274 Cancels and suspends any packages due, generates bills, applies payments and
2277 Warns on errors (Does not currently: If there is an error, returns the error, otherwise returns false.)
2279 Options are passed as name-value pairs. Currently available options are:
2285 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:
2289 $cust_main->bill( 'time' => str2time('April 20th, 2001') );
2293 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.
2297 "1d" for the traditional, daily events (the default), or "1m" for the new monthly events (part_event.check_freq)
2301 If set true, re-charges setup fees.
2305 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)
2311 sub bill_and_collect {
2312 my( $self, %options ) = @_;
2314 #$options{actual_time} not $options{time} because freeside-daily -d is for
2315 #pre-printing invoices
2316 $self->cancel_expired_pkgs( $options{actual_time} );
2317 $self->suspend_adjourned_pkgs( $options{actual_time} );
2319 my $error = $self->bill( %options );
2320 warn "Error billing, custnum ". $self->custnum. ": $error" if $error;
2322 $self->apply_payments_and_credits;
2324 unless ( $conf->exists('cancelled_cust-noevents')
2325 && ! $self->num_ncancelled_pkgs
2328 $error = $self->collect( %options );
2329 warn "Error collecting, custnum". $self->custnum. ": $error" if $error;
2335 sub cancel_expired_pkgs {
2336 my ( $self, $time ) = @_;
2338 my @cancel_pkgs = $self->ncancelled_pkgs( {
2339 'extra_sql' => " AND expire IS NOT NULL AND expire > 0 AND expire <= $time "
2342 foreach my $cust_pkg ( @cancel_pkgs ) {
2343 my $cpr = $cust_pkg->last_cust_pkg_reason('expire');
2344 my $error = $cust_pkg->cancel($cpr ? ( 'reason' => $cpr->reasonnum,
2345 'reason_otaker' => $cpr->otaker
2349 warn "Error cancelling expired pkg ". $cust_pkg->pkgnum.
2350 " for custnum ". $self->custnum. ": $error"
2356 sub suspend_adjourned_pkgs {
2357 my ( $self, $time ) = @_;
2359 my @susp_pkgs = $self->ncancelled_pkgs( {
2361 " AND ( susp IS NULL OR susp = 0 )
2362 AND ( ( bill IS NOT NULL AND bill != 0 AND bill < $time )
2363 OR ( adjourn IS NOT NULL AND adjourn != 0 AND adjourn <= $time )
2368 #only because there's no SQL test for is_prepaid :/
2370 grep { ( $_->part_pkg->is_prepaid
2375 && $_->adjourn <= $time
2381 foreach my $cust_pkg ( @susp_pkgs ) {
2382 my $cpr = $cust_pkg->last_cust_pkg_reason('adjourn')
2383 if ($cust_pkg->adjourn && $cust_pkg->adjourn < $^T);
2384 my $error = $cust_pkg->suspend($cpr ? ( 'reason' => $cpr->reasonnum,
2385 'reason_otaker' => $cpr->otaker
2390 warn "Error suspending package ". $cust_pkg->pkgnum.
2391 " for custnum ". $self->custnum. ": $error"
2399 Generates invoices (see L<FS::cust_bill>) for this customer. Usually used in
2400 conjunction with the collect method by calling B<bill_and_collect>.
2402 If there is an error, returns the error, otherwise returns false.
2404 Options are passed as name-value pairs. Currently available options are:
2410 If set true, re-charges setup fees.
2414 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:
2418 $cust_main->bill( 'time' => str2time('April 20th, 2001') );
2422 An array ref of specific packages (objects) to attempt billing, instead trying all of them.
2424 $cust_main->bill( pkg_list => [$pkg1, $pkg2] );
2428 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.
2435 my( $self, %options ) = @_;
2436 return '' if $self->payby eq 'COMP';
2437 warn "$me bill customer ". $self->custnum. "\n"
2440 my $time = $options{'time'} || time;
2441 my $invoice_time = $options{'invoice_time'} || $time;
2444 local $SIG{HUP} = 'IGNORE';
2445 local $SIG{INT} = 'IGNORE';
2446 local $SIG{QUIT} = 'IGNORE';
2447 local $SIG{TERM} = 'IGNORE';
2448 local $SIG{TSTP} = 'IGNORE';
2449 local $SIG{PIPE} = 'IGNORE';
2451 my $oldAutoCommit = $FS::UID::AutoCommit;
2452 local $FS::UID::AutoCommit = 0;
2455 $self->select_for_update; #mutex
2457 my @cust_bill_pkg = ();
2460 # find the packages which are due for billing, find out how much they are
2461 # & generate invoice database.
2464 my( $total_setup, $total_recur, $postal_charge ) = ( 0, 0, 0 );
2466 my @precommit_hooks = ();
2468 foreach my $cust_pkg ( $self->ncancelled_pkgs ) {
2470 warn " bill package ". $cust_pkg->pkgnum. "\n" if $DEBUG > 1;
2472 #? to avoid use of uninitialized value errors... ?
2473 $cust_pkg->setfield('bill', '')
2474 unless defined($cust_pkg->bill);
2476 #my $part_pkg = $cust_pkg->part_pkg;
2478 my $real_pkgpart = $cust_pkg->pkgpart;
2479 my %hash = $cust_pkg->hash;
2481 foreach my $part_pkg ( $cust_pkg->part_pkg->self_and_bill_linked ) {
2483 $cust_pkg->set($_, $hash{$_}) foreach qw ( setup last_bill bill );
2486 $self->_make_lines( 'part_pkg' => $part_pkg,
2487 'cust_pkg' => $cust_pkg,
2488 'precommit_hooks' => \@precommit_hooks,
2489 'line_items' => \@cust_bill_pkg,
2490 'setup' => \$total_setup,
2491 'recur' => \$total_recur,
2492 'tax_matrix' => \%taxlisthash,
2494 'options' => \%options,
2497 $dbh->rollback if $oldAutoCommit;
2501 } #foreach my $part_pkg
2503 } #foreach my $cust_pkg
2505 unless ( @cust_bill_pkg ) { #don't create an invoice w/o line items
2506 #but do commit any package date cycling that happened
2507 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2511 if ( scalar( grep { $_->recur && $_->recur > 0 } @cust_bill_pkg) ||
2512 !$conf->exists('postal_invoice-recurring_only')
2516 my $postal_pkg = $self->charge_postal_fee();
2517 if ( $postal_pkg && !ref( $postal_pkg ) ) {
2519 $dbh->rollback if $oldAutoCommit;
2520 return "can't charge postal invoice fee for customer ".
2521 $self->custnum. ": $postal_pkg";
2523 } elsif ( $postal_pkg ) {
2525 foreach my $part_pkg ( $postal_pkg->part_pkg->self_and_bill_linked ) {
2527 $self->_make_lines( 'part_pkg' => $part_pkg,
2528 'cust_pkg' => $postal_pkg,
2529 'precommit_hooks' => \@precommit_hooks,
2530 'line_items' => \@cust_bill_pkg,
2531 'setup' => \$total_setup,
2532 'recur' => \$total_recur,
2533 'tax_matrix' => \%taxlisthash,
2535 'options' => \%options,
2538 $dbh->rollback if $oldAutoCommit;
2547 warn "having a look at the taxes we found...\n" if $DEBUG > 2;
2549 # keys are tax names (as printed on invoices / itemdesc )
2550 # values are listrefs of taxlisthash keys (internal identifiers)
2553 # keys are taxlisthash keys (internal identifiers)
2554 # values are (cumulative) amounts
2557 # keys are taxlisthash keys (internal identifiers)
2558 # values are listrefs of cust_bill_pkg_tax_location hashrefs
2559 my %tax_location = ();
2561 # keys are taxlisthash keys (internal identifiers)
2562 # values are listrefs of cust_bill_pkg_tax_rate_location hashrefs
2563 my %tax_rate_location = ();
2565 foreach my $tax ( keys %taxlisthash ) {
2566 my $tax_object = shift @{ $taxlisthash{$tax} };
2567 warn "found ". $tax_object->taxname. " as $tax\n" if $DEBUG > 2;
2568 warn " ". join('/', @{ $taxlisthash{$tax} } ). "\n" if $DEBUG > 2;
2569 my $hashref_or_error =
2570 $tax_object->taxline( $taxlisthash{$tax},
2571 'custnum' => $self->custnum,
2572 'invoice_time' => $invoice_time
2574 unless ( ref($hashref_or_error) ) {
2575 $dbh->rollback if $oldAutoCommit;
2576 return $hashref_or_error;
2578 unshift @{ $taxlisthash{$tax} }, $tax_object;
2580 my $name = $hashref_or_error->{'name'};
2581 my $amount = $hashref_or_error->{'amount'};
2583 #warn "adding $amount as $name\n";
2584 $taxname{ $name } ||= [];
2585 push @{ $taxname{ $name } }, $tax;
2587 $tax{ $tax } += $amount;
2589 $tax_location{ $tax } ||= [];
2590 if ( $tax_object->get('pkgnum') || $tax_object->get('locationnum') ) {
2591 push @{ $tax_location{ $tax } },
2593 'taxnum' => $tax_object->taxnum,
2594 'taxtype' => ref($tax_object),
2595 'pkgnum' => $tax_object->get('pkgnum'),
2596 'locationnum' => $tax_object->get('locationnum'),
2597 'amount' => sprintf('%.2f', $amount ),
2601 $tax_rate_location{ $tax } ||= [];
2602 if ( ref($tax_object) eq 'FS::tax_rate' ) {
2603 my $taxratelocationnum =
2604 $tax_object->tax_rate_location->taxratelocationnum;
2605 push @{ $tax_rate_location{ $tax } },
2607 'taxnum' => $tax_object->taxnum,
2608 'taxtype' => ref($tax_object),
2609 'amount' => sprintf('%.2f', $amount ),
2610 'locationtaxid' => $tax_object->location,
2611 'taxratelocationnum' => $taxratelocationnum,
2617 #move the cust_tax_exempt_pkg records to the cust_bill_pkgs we will commit
2618 my %packagemap = map { $_->pkgnum => $_ } @cust_bill_pkg;
2619 foreach my $tax ( keys %taxlisthash ) {
2620 foreach ( @{ $taxlisthash{$tax} }[1 ... scalar(@{ $taxlisthash{$tax} })] ) {
2621 next unless ref($_) eq 'FS::cust_bill_pkg';
2623 push @{ $packagemap{$_->pkgnum}->_cust_tax_exempt_pkg },
2624 splice( @{ $_->_cust_tax_exempt_pkg } );
2628 #consolidate and create tax line items
2629 warn "consolidating and generating...\n" if $DEBUG > 2;
2630 foreach my $taxname ( keys %taxname ) {
2633 my @cust_bill_pkg_tax_location = ();
2634 my @cust_bill_pkg_tax_rate_location = ();
2635 warn "adding $taxname\n" if $DEBUG > 1;
2636 foreach my $taxitem ( @{ $taxname{$taxname} } ) {
2637 next if $seen{$taxitem}++;
2638 warn "adding $tax{$taxitem}\n" if $DEBUG > 1;
2639 $tax += $tax{$taxitem};
2640 push @cust_bill_pkg_tax_location,
2641 map { new FS::cust_bill_pkg_tax_location $_ }
2642 @{ $tax_location{ $taxitem } };
2643 push @cust_bill_pkg_tax_rate_location,
2644 map { new FS::cust_bill_pkg_tax_rate_location $_ }
2645 @{ $tax_rate_location{ $taxitem } };
2649 $tax = sprintf('%.2f', $tax );
2650 $total_setup = sprintf('%.2f', $total_setup+$tax );
2652 push @cust_bill_pkg, new FS::cust_bill_pkg {
2658 'itemdesc' => $taxname,
2659 'cust_bill_pkg_tax_location' => \@cust_bill_pkg_tax_location,
2660 'cust_bill_pkg_tax_rate_location' => \@cust_bill_pkg_tax_rate_location,
2665 #add tax adjustments
2666 warn "adding tax adjustments...\n" if $DEBUG > 2;
2667 foreach my $cust_tax_adjustment (
2668 qsearch('cust_tax_adjustment', { 'custnum' => $self->custnum,
2674 my $tax = sprintf('%.2f', $cust_tax_adjustment->amount );
2675 $total_setup = sprintf('%.2f', $total_setup+$tax );
2677 my $itemdesc = $cust_tax_adjustment->taxname;
2678 $itemdesc = '' if $itemdesc eq 'Tax';
2680 push @cust_bill_pkg, new FS::cust_bill_pkg {
2686 'itemdesc' => $itemdesc,
2687 'itemcomment' => $cust_tax_adjustment->comment,
2688 'cust_tax_adjustment' => $cust_tax_adjustment,
2689 #'cust_bill_pkg_tax_location' => \@cust_bill_pkg_tax_location,
2694 my $charged = sprintf('%.2f', $total_setup + $total_recur );
2696 #create the new invoice
2697 my $cust_bill = new FS::cust_bill ( {
2698 'custnum' => $self->custnum,
2699 '_date' => ( $invoice_time ),
2700 'charged' => $charged,
2702 my $error = $cust_bill->insert;
2704 $dbh->rollback if $oldAutoCommit;
2705 return "can't create invoice for customer #". $self->custnum. ": $error";
2708 foreach my $cust_bill_pkg ( @cust_bill_pkg ) {
2709 $cust_bill_pkg->invnum($cust_bill->invnum);
2710 my $error = $cust_bill_pkg->insert;
2712 $dbh->rollback if $oldAutoCommit;
2713 return "can't create invoice line item: $error";
2718 foreach my $hook ( @precommit_hooks ) {
2720 &{$hook}; #($self) ?
2723 $dbh->rollback if $oldAutoCommit;
2724 return "$@ running precommit hook $hook\n";
2728 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2734 my ($self, %params) = @_;
2736 my $part_pkg = $params{part_pkg} or die "no part_pkg specified";
2737 my $cust_pkg = $params{cust_pkg} or die "no cust_pkg specified";
2738 my $precommit_hooks = $params{precommit_hooks} or die "no package specified";
2739 my $cust_bill_pkgs = $params{line_items} or die "no line buffer specified";
2740 my $total_setup = $params{setup} or die "no setup accumulator specified";
2741 my $total_recur = $params{recur} or die "no recur accumulator specified";
2742 my $taxlisthash = $params{tax_matrix} or die "no tax accumulator specified";
2743 my $time = $params{'time'} or die "no time specified";
2744 my (%options) = %{$params{options}};
2747 my $real_pkgpart = $cust_pkg->pkgpart;
2748 my %hash = $cust_pkg->hash;
2749 my $old_cust_pkg = new FS::cust_pkg \%hash;
2755 $cust_pkg->pkgpart($part_pkg->pkgpart);
2763 if ( ! $cust_pkg->setup &&
2765 ( $conf->exists('disable_setup_suspended_pkgs') &&
2766 ! $cust_pkg->getfield('susp')
2767 ) || ! $conf->exists('disable_setup_suspended_pkgs')
2769 || $options{'resetup'}
2772 warn " bill setup\n" if $DEBUG > 1;
2775 $setup = eval { $cust_pkg->calc_setup( $time, \@details ) };
2776 return "$@ running calc_setup for $cust_pkg\n"
2779 $unitsetup = $cust_pkg->part_pkg->unit_setup || $setup; #XXX uuh
2781 $cust_pkg->setfield('setup', $time)
2782 unless $cust_pkg->setup;
2783 #do need it, but it won't get written to the db
2784 #|| $cust_pkg->pkgpart != $real_pkgpart;
2789 # bill recurring fee
2792 #XXX unit stuff here too
2796 if ( ! $cust_pkg->getfield('susp') and
2797 ( $part_pkg->getfield('freq') ne '0' &&
2798 ( $cust_pkg->getfield('bill') || 0 ) <= $time
2800 || ( $part_pkg->plan eq 'voip_cdr'
2801 && $part_pkg->option('bill_every_call')
2805 # XXX should this be a package event? probably. events are called
2806 # at collection time at the moment, though...
2807 $part_pkg->reset_usage($cust_pkg, 'debug'=>$DEBUG)
2808 if $part_pkg->can('reset_usage');
2809 #don't want to reset usage just cause we want a line item??
2810 #&& $part_pkg->pkgpart == $real_pkgpart;
2812 warn " bill recur\n" if $DEBUG > 1;
2815 # XXX shared with $recur_prog
2816 $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
2818 #over two params! lets at least switch to a hashref for the rest...
2819 my $increment_next_bill = ( $part_pkg->freq ne '0'
2820 && ( $cust_pkg->getfield('bill') || 0 ) <= $time
2822 my %param = ( 'precommit_hooks' => $precommit_hooks,
2823 'increment_next_bill' => $increment_next_bill,
2826 $recur = eval { $cust_pkg->calc_recur( \$sdate, \@details, \%param ) };
2827 return "$@ running calc_recur for $cust_pkg\n"
2830 if ( $increment_next_bill ) {
2832 my $next_bill = $part_pkg->add_freq($sdate);
2833 return "unparsable frequency: ". $part_pkg->freq
2834 if $next_bill == -1;
2836 #pro-rating magic - if $recur_prog fiddled $sdate, want to use that
2837 # only for figuring next bill date, nothing else, so, reset $sdate again
2839 $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
2840 #no need, its in $hash{last_bill}# my $last_bill = $cust_pkg->last_bill;
2841 $cust_pkg->last_bill($sdate);
2843 $cust_pkg->setfield('bill', $next_bill );
2849 warn "\$setup is undefined" unless defined($setup);
2850 warn "\$recur is undefined" unless defined($recur);
2851 warn "\$cust_pkg->bill is undefined" unless defined($cust_pkg->bill);
2854 # If there's line items, create em cust_bill_pkg records
2855 # If $cust_pkg has been modified, update it (if we're a real pkgpart)
2860 if ( $cust_pkg->modified && $cust_pkg->pkgpart == $real_pkgpart ) {
2861 # hmm.. and if just the options are modified in some weird price plan?
2863 warn " package ". $cust_pkg->pkgnum. " modified; updating\n"
2866 my $error = $cust_pkg->replace( $old_cust_pkg,
2867 'options' => { $cust_pkg->options },
2869 return "Error modifying pkgnum ". $cust_pkg->pkgnum. ": $error"
2870 if $error; #just in case
2873 $setup = sprintf( "%.2f", $setup );
2874 $recur = sprintf( "%.2f", $recur );
2875 if ( $setup < 0 && ! $conf->exists('allow_negative_charges') ) {
2876 return "negative setup $setup for pkgnum ". $cust_pkg->pkgnum;
2878 if ( $recur < 0 && ! $conf->exists('allow_negative_charges') ) {
2879 return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum;
2882 if ( $setup != 0 || $recur != 0 ) {
2884 warn " charges (setup=$setup, recur=$recur); adding line items\n"
2887 my @cust_pkg_detail = map { $_->detail } $cust_pkg->cust_pkg_detail('I');
2889 warn " adding customer package invoice detail: $_\n"
2890 foreach @cust_pkg_detail;
2892 push @details, @cust_pkg_detail;
2894 my $cust_bill_pkg = new FS::cust_bill_pkg {
2895 'pkgnum' => $cust_pkg->pkgnum,
2897 'unitsetup' => $unitsetup,
2899 'unitrecur' => $unitrecur,
2900 'quantity' => $cust_pkg->quantity,
2901 'details' => \@details,
2904 if ( $part_pkg->option('recur_temporality', 1) eq 'preceding' ) {
2905 $cust_bill_pkg->sdate( $hash{last_bill} );
2906 $cust_bill_pkg->edate( $sdate - 86399 ); #60s*60m*24h-1
2907 } else { #if ( $part_pkg->option('recur_temporality', 1) eq 'upcoming' ) {
2908 $cust_bill_pkg->sdate( $sdate );
2909 $cust_bill_pkg->edate( $cust_pkg->bill );
2912 $cust_bill_pkg->pkgpart_override($part_pkg->pkgpart)
2913 unless $part_pkg->pkgpart == $real_pkgpart;
2915 $$total_setup += $setup;
2916 $$total_recur += $recur;
2923 $self->_handle_taxes($part_pkg, $taxlisthash, $cust_bill_pkg, $cust_pkg, $options{invoice_time});
2924 return $error if $error;
2926 push @$cust_bill_pkgs, $cust_bill_pkg;
2928 } #if $setup != 0 || $recur != 0
2938 my $part_pkg = shift;
2939 my $taxlisthash = shift;
2940 my $cust_bill_pkg = shift;
2941 my $cust_pkg = shift;
2942 my $invoice_time = shift;
2944 my %cust_bill_pkg = ();
2948 #push @classes, $cust_bill_pkg->usage_classes if $cust_bill_pkg->type eq 'U';
2949 push @classes, $cust_bill_pkg->usage_classes if $cust_bill_pkg->usage;
2950 push @classes, 'setup' if $cust_bill_pkg->setup;
2951 push @classes, 'recur' if $cust_bill_pkg->recur;
2953 if ( $self->tax !~ /Y/i && $self->payby ne 'COMP' ) {
2955 if ( $conf->exists('enable_taxproducts')
2956 && ( scalar($part_pkg->part_pkg_taxoverride)
2957 || $part_pkg->has_taxproduct
2962 if ( $conf->exists('tax-pkg_address') && $cust_pkg->locationnum ) {
2963 return "fatal: Can't (yet) use tax-pkg_address with taxproducts";
2966 foreach my $class (@classes) {
2967 my $err_or_ref = $self->_gather_taxes( $part_pkg, $class );
2968 return $err_or_ref unless ref($err_or_ref);
2969 $taxes{$class} = $err_or_ref;
2972 unless (exists $taxes{''}) {
2973 my $err_or_ref = $self->_gather_taxes( $part_pkg, '' );
2974 return $err_or_ref unless ref($err_or_ref);
2975 $taxes{''} = $err_or_ref;
2980 my @loc_keys = qw( state county country );
2982 if ( $conf->exists('tax-pkg_address') && $cust_pkg->locationnum ) {
2983 my $cust_location = $cust_pkg->cust_location;
2984 %taxhash = map { $_ => $cust_location->$_() } @loc_keys;
2987 ( $conf->exists('tax-ship_address') && length($self->ship_last) )
2990 %taxhash = map { $_ => $self->get("$prefix$_") } @loc_keys;
2993 $taxhash{'taxclass'} = $part_pkg->taxclass;
2995 my @taxes = qsearch( 'cust_main_county', \%taxhash );
2997 my %taxhash_elim = %taxhash;
2999 my @elim = qw( taxclass county state );
3000 while ( !scalar(@taxes) && scalar(@elim) ) {
3001 $taxhash_elim{ shift(@elim) } = '';
3002 @taxes = qsearch( 'cust_main_county', \%taxhash_elim );
3005 @taxes = grep { ! $_->taxname or ! $self->tax_exemption($_->taxname) }
3007 if $self->cust_main_exemption; #just to be safe
3009 if ( $conf->exists('tax-pkg_address') && $cust_pkg->locationnum ) {
3011 $_->set('pkgnum', $cust_pkg->pkgnum );
3012 $_->set('locationnum', $cust_pkg->locationnum );
3016 $taxes{''} = [ @taxes ];
3017 $taxes{'setup'} = [ @taxes ];
3018 $taxes{'recur'} = [ @taxes ];
3019 $taxes{$_} = [ @taxes ] foreach (@classes);
3021 # # maybe eliminate this entirely, along with all the 0% records
3022 # unless ( @taxes ) {
3024 # "fatal: can't find tax rate for state/county/country/taxclass ".
3025 # join('/', map $taxhash{$_}, qw(state county country taxclass) );
3028 } #if $conf->exists('enable_taxproducts') ...
3033 if ( $conf->exists('separate_usage') ) {
3034 my $section = $cust_pkg->part_pkg->option('usage_section', 'Hush!');
3035 my $summary = $cust_pkg->part_pkg->option('summarize_usage', 'Hush!');
3036 push @display, new FS::cust_bill_pkg_display { type => 'S' };
3037 push @display, new FS::cust_bill_pkg_display { type => 'R' };
3038 push @display, new FS::cust_bill_pkg_display { type => 'U',
3041 if ($section && $summary) {
3042 $display[2]->post_total('Y');
3043 push @display, new FS::cust_bill_pkg_display { type => 'U',
3048 $cust_bill_pkg->set('display', \@display);
3050 my %tax_cust_bill_pkg = $cust_bill_pkg->disintegrate;
3051 foreach my $key (keys %tax_cust_bill_pkg) {
3052 my @taxes = @{ $taxes{$key} || [] };
3053 my $tax_cust_bill_pkg = $tax_cust_bill_pkg{$key};
3055 my %localtaxlisthash = ();
3056 foreach my $tax ( @taxes ) {
3058 my $taxname = ref( $tax ). ' '. $tax->taxnum;
3059 # $taxname .= ' pkgnum'. $cust_pkg->pkgnum.
3060 # ' locationnum'. $cust_pkg->locationnum
3061 # if $conf->exists('tax-pkg_address') && $cust_pkg->locationnum;
3063 $taxlisthash->{ $taxname } ||= [ $tax ];
3064 push @{ $taxlisthash->{ $taxname } }, $tax_cust_bill_pkg;
3066 $localtaxlisthash{ $taxname } ||= [ $tax ];
3067 push @{ $localtaxlisthash{ $taxname } }, $tax_cust_bill_pkg;
3071 warn "finding taxed taxes...\n" if $DEBUG > 2;
3072 foreach my $tax ( keys %localtaxlisthash ) {
3073 my $tax_object = shift @{ $localtaxlisthash{$tax} };
3074 warn "found possible taxed tax ". $tax_object->taxname. " we call $tax\n"
3076 next unless $tax_object->can('tax_on_tax');
3078 foreach my $tot ( $tax_object->tax_on_tax( $self ) ) {
3079 my $totname = ref( $tot ). ' '. $tot->taxnum;
3081 warn "checking $totname which we call ". $tot->taxname. " as applicable\n"
3083 next unless exists( $localtaxlisthash{ $totname } ); # only increase
3085 warn "adding $totname to taxed taxes\n" if $DEBUG > 2;
3086 my $hashref_or_error =
3087 $tax_object->taxline( $localtaxlisthash{$tax},
3088 'custnum' => $self->custnum,
3089 'invoice_time' => $invoice_time,
3091 return $hashref_or_error
3092 unless ref($hashref_or_error);
3094 $taxlisthash->{ $totname } ||= [ $tot ];
3095 push @{ $taxlisthash->{ $totname } }, $hashref_or_error->{amount};
3107 my $part_pkg = shift;
3111 my $geocode = $self->geocode('cch');
3113 my @taxclassnums = map { $_->taxclassnum }
3114 $part_pkg->part_pkg_taxoverride($class);
3116 unless (@taxclassnums) {
3117 @taxclassnums = map { $_->taxclassnum }
3118 grep { $_->taxable eq 'Y' }
3119 $part_pkg->part_pkg_taxrate('cch', $geocode, $class);
3121 warn "Found taxclassnum values of ". join(',', @taxclassnums)
3126 join(' OR ', map { "taxclassnum = $_" } @taxclassnums ). ")";
3128 @taxes = qsearch({ 'table' => 'tax_rate',
3129 'hashref' => { 'geocode' => $geocode, },
3130 'extra_sql' => $extra_sql,
3132 if scalar(@taxclassnums);
3134 warn "Found taxes ".
3135 join(',', map{ ref($_). " ". $_->get($_->primary_key) } @taxes). "\n"
3142 =item collect OPTIONS
3144 (Attempt to) collect money for this customer's outstanding invoices (see
3145 L<FS::cust_bill>). Usually used after the bill method.
3147 Actions are now triggered by billing events; see L<FS::part_event> and the
3148 billing events web interface. Old-style invoice events (see
3149 L<FS::part_bill_event>) have been deprecated.
3151 If there is an error, returns the error, otherwise returns false.
3153 Options are passed as name-value pairs.
3155 Currently available options are:
3161 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.
3165 Retry card/echeck/LEC transactions even when not scheduled by invoice events.
3169 set true to surpress email card/ACH decline notices.
3173 "1d" for the traditional, daily events (the default), or "1m" for the new monthly events (part_event.check_freq)
3177 allows for one time override of normal customer billing method
3181 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)
3189 my( $self, %options ) = @_;
3190 my $invoice_time = $options{'invoice_time'} || time;
3193 local $SIG{HUP} = 'IGNORE';
3194 local $SIG{INT} = 'IGNORE';
3195 local $SIG{QUIT} = 'IGNORE';
3196 local $SIG{TERM} = 'IGNORE';
3197 local $SIG{TSTP} = 'IGNORE';
3198 local $SIG{PIPE} = 'IGNORE';
3200 my $oldAutoCommit = $FS::UID::AutoCommit;
3201 local $FS::UID::AutoCommit = 0;
3204 $self->select_for_update; #mutex
3207 my $balance = $self->balance;
3208 warn "$me collect customer ". $self->custnum. ": balance $balance\n"
3211 if ( exists($options{'retry_card'}) ) {
3212 carp 'retry_card option passed to collect is deprecated; use retry';
3213 $options{'retry'} ||= $options{'retry_card'};
3215 if ( exists($options{'retry'}) && $options{'retry'} ) {
3216 my $error = $self->retry_realtime;
3218 $dbh->rollback if $oldAutoCommit;
3223 # false laziness w/pay_batch::import_results
3225 my $due_cust_event = $self->due_cust_event(
3226 'debug' => ( $options{'debug'} || 0 ),
3227 'time' => $invoice_time,
3228 'check_freq' => $options{'check_freq'},
3230 unless( ref($due_cust_event) ) {
3231 $dbh->rollback if $oldAutoCommit;
3232 return $due_cust_event;
3235 foreach my $cust_event ( @$due_cust_event ) {
3239 #re-eval event conditions (a previous event could have changed things)
3240 unless ( $cust_event->test_conditions( 'time' => $invoice_time ) ) {
3241 #don't leave stray "new/locked" records around
3242 my $error = $cust_event->delete;
3244 #gah, even with transactions
3245 $dbh->commit if $oldAutoCommit; #well.
3252 local $realtime_bop_decline_quiet = 1 if $options{'quiet'};
3253 warn " running cust_event ". $cust_event->eventnum. "\n"
3257 #if ( my $error = $cust_event->do_event(%options) ) { #XXX %options?
3258 if ( my $error = $cust_event->do_event() ) {
3259 #XXX wtf is this? figure out a proper dealio with return value
3261 # gah, even with transactions.
3262 $dbh->commit if $oldAutoCommit; #well.
3269 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3274 =item due_cust_event [ HASHREF | OPTION => VALUE ... ]
3276 Inserts database records for and returns an ordered listref of new events due
3277 for this customer, as FS::cust_event objects (see L<FS::cust_event>). If no
3278 events are due, an empty listref is returned. If there is an error, returns a
3279 scalar error message.
3281 To actually run the events, call each event's test_condition method, and if
3282 still true, call the event's do_event method.
3284 Options are passed as a hashref or as a list of name-value pairs. Available
3291 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.
3295 "Current time" for the events.
3299 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)
3303 Only return events for the specified eventtable (by default, events of all eventtables are returned)
3307 Explicitly pass the objects to be tested (typically used with eventtable).
3311 Set to true to return the objects, but not actually insert them into the
3318 sub due_cust_event {
3320 my %opt = ref($_[0]) ? %{ $_[0] } : @_;
3323 #my $DEBUG = $opt{'debug'}
3324 local($DEBUG) = $opt{'debug'}
3325 if defined($opt{'debug'}) && $opt{'debug'} > $DEBUG;
3327 warn "$me due_cust_event called with options ".
3328 join(', ', map { "$_: $opt{$_}" } keys %opt). "\n"
3331 $opt{'time'} ||= time;
3333 local $SIG{HUP} = 'IGNORE';
3334 local $SIG{INT} = 'IGNORE';
3335 local $SIG{QUIT} = 'IGNORE';
3336 local $SIG{TERM} = 'IGNORE';
3337 local $SIG{TSTP} = 'IGNORE';
3338 local $SIG{PIPE} = 'IGNORE';
3340 my $oldAutoCommit = $FS::UID::AutoCommit;
3341 local $FS::UID::AutoCommit = 0;
3344 $self->select_for_update #mutex
3345 unless $opt{testonly};
3348 # 1: find possible events (initial search)
3351 my @cust_event = ();
3353 my @eventtable = $opt{'eventtable'}
3354 ? ( $opt{'eventtable'} )
3355 : FS::part_event->eventtables_runorder;
3357 foreach my $eventtable ( @eventtable ) {
3360 if ( $opt{'objects'} ) {
3362 @objects = @{ $opt{'objects'} };
3366 #my @objects = $self->eventtable(); # sub cust_main { @{ [ $self ] }; }
3367 @objects = ( $eventtable eq 'cust_main' )
3369 : ( $self->$eventtable() );
3373 my @e_cust_event = ();
3375 my $cross = "CROSS JOIN $eventtable";
3376 $cross .= ' LEFT JOIN cust_main USING ( custnum )'
3377 unless $eventtable eq 'cust_main';
3379 foreach my $object ( @objects ) {
3381 #this first search uses the condition_sql magic for optimization.
3382 #the more possible events we can eliminate in this step the better
3384 my $cross_where = '';
3385 my $pkey = $object->primary_key;
3386 $cross_where = "$eventtable.$pkey = ". $object->$pkey();
3388 my $join = FS::part_event_condition->join_conditions_sql( $eventtable );
3390 FS::part_event_condition->where_conditions_sql( $eventtable,
3391 'time'=>$opt{'time'}
3393 my $order = FS::part_event_condition->order_conditions_sql( $eventtable );
3395 $extra_sql = "AND $extra_sql" if $extra_sql;
3397 #here is the agent virtualization
3398 $extra_sql .= " AND ( part_event.agentnum IS NULL
3399 OR part_event.agentnum = ". $self->agentnum. ' )';
3401 $extra_sql .= " $order";
3403 warn "searching for events for $eventtable ". $object->$pkey. "\n"
3404 if $opt{'debug'} > 2;
3405 my @part_event = qsearch( {
3406 'debug' => ( $opt{'debug'} > 3 ? 1 : 0 ),
3407 'select' => 'part_event.*',
3408 'table' => 'part_event',
3409 'addl_from' => "$cross $join",
3410 'hashref' => { 'check_freq' => ( $opt{'check_freq'} || '1d' ),
3411 'eventtable' => $eventtable,
3414 'extra_sql' => "AND $cross_where $extra_sql",
3418 my $pkey = $object->primary_key;
3419 warn " ". scalar(@part_event).
3420 " possible events found for $eventtable ". $object->$pkey(). "\n";
3423 push @e_cust_event, map { $_->new_cust_event($object) } @part_event;
3427 warn " ". scalar(@e_cust_event).
3428 " subtotal possible cust events found for $eventtable\n"
3431 push @cust_event, @e_cust_event;
3435 warn " ". scalar(@cust_event).
3436 " total possible cust events found in initial search\n"
3440 # 2: test conditions
3445 @cust_event = grep $_->test_conditions( 'time' => $opt{'time'},
3446 'stats_hashref' => \%unsat ),
3449 warn " ". scalar(@cust_event). " cust events left satisfying conditions\n"
3452 warn " invalid conditions not eliminated with condition_sql:\n".
3453 join('', map " $_: ".$unsat{$_}."\n", keys %unsat )
3460 unless( $opt{testonly} ) {
3461 foreach my $cust_event ( @cust_event ) {
3463 my $error = $cust_event->insert();
3465 $dbh->rollback if $oldAutoCommit;
3472 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3478 warn " returning events: ". Dumper(@cust_event). "\n"
3485 =item retry_realtime
3487 Schedules realtime / batch credit card / electronic check / LEC billing
3488 events for for retry. Useful if card information has changed or manual
3489 retry is desired. The 'collect' method must be called to actually retry
3492 Implementation details: For either this customer, or for each of this
3493 customer's open invoices, changes the status of the first "done" (with
3494 statustext error) realtime processing event to "failed".
3498 sub retry_realtime {
3501 local $SIG{HUP} = 'IGNORE';
3502 local $SIG{INT} = 'IGNORE';
3503 local $SIG{QUIT} = 'IGNORE';
3504 local $SIG{TERM} = 'IGNORE';
3505 local $SIG{TSTP} = 'IGNORE';
3506 local $SIG{PIPE} = 'IGNORE';
3508 my $oldAutoCommit = $FS::UID::AutoCommit;
3509 local $FS::UID::AutoCommit = 0;
3512 #a little false laziness w/due_cust_event (not too bad, really)
3514 my $join = FS::part_event_condition->join_conditions_sql;
3515 my $order = FS::part_event_condition->order_conditions_sql;
3518 . join ( ' OR ' , map {
3519 "( part_event.eventtable = " . dbh->quote($_)
3520 . " AND tablenum IN( SELECT " . dbdef->table($_)->primary_key . " from $_ where custnum = " . dbh->quote( $self->custnum ) . "))" ;
3521 } FS::part_event->eventtables)
3524 #here is the agent virtualization
3525 my $agent_virt = " ( part_event.agentnum IS NULL
3526 OR part_event.agentnum = ". $self->agentnum. ' )';
3528 #XXX this shouldn't be hardcoded, actions should declare it...
3529 my @realtime_events = qw(
3530 cust_bill_realtime_card
3531 cust_bill_realtime_check
3532 cust_bill_realtime_lec
3536 my $is_realtime_event = ' ( '. join(' OR ', map "part_event.action = '$_'",
3541 my @cust_event = qsearchs({
3542 'table' => 'cust_event',
3543 'select' => 'cust_event.*',
3544 'addl_from' => "LEFT JOIN part_event USING ( eventpart ) $join",
3545 'hashref' => { 'status' => 'done' },
3546 'extra_sql' => " AND statustext IS NOT NULL AND statustext != '' ".
3547 " AND $mine AND $is_realtime_event AND $agent_virt $order" # LIMIT 1"
3550 my %seen_invnum = ();
3551 foreach my $cust_event (@cust_event) {
3553 #max one for the customer, one for each open invoice
3554 my $cust_X = $cust_event->cust_X;
3555 next if $seen_invnum{ $cust_event->part_event->eventtable eq 'cust_bill'
3559 or $cust_event->part_event->eventtable eq 'cust_bill'
3562 my $error = $cust_event->retry;
3564 $dbh->rollback if $oldAutoCommit;
3565 return "error scheduling event for retry: $error";
3570 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3575 # some horrid false laziness here to avoid refactor fallout
3576 # eventually realtime realtime_bop and realtime_refund_bop should go
3577 # away and be replaced by _new_realtime_bop and _new_realtime_refund_bop
3579 =item realtime_bop METHOD AMOUNT [ OPTION => VALUE ... ]
3581 Runs a realtime credit card, ACH (electronic check) or phone bill transaction
3582 via a Business::OnlinePayment realtime gateway. See
3583 L<http://420.am/business-onlinepayment> for supported gateways.
3585 Available methods are: I<CC>, I<ECHECK> and I<LEC>
3587 Available options are: I<description>, I<invnum>, I<quiet>, I<paynum_ref>, I<payunique>
3589 The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
3590 I<zip>, I<payinfo> and I<paydate> are also available. Any of these options,
3591 if set, will override the value from the customer record.
3593 I<description> is a free-text field passed to the gateway. It defaults to
3594 "Internet services".
3596 If an I<invnum> is specified, this payment (if successful) is applied to the
3597 specified invoice. If you don't specify an I<invnum> you might want to
3598 call the B<apply_payments> method.
3600 I<quiet> can be set true to surpress email decline notices.
3602 I<paynum_ref> can be set to a scalar reference. It will be filled in with the
3603 resulting paynum, if any.
3605 I<payunique> is a unique identifier for this payment.
3607 (moved from cust_bill) (probably should get realtime_{card,ach,lec} here too)
3614 return $self->_new_realtime_bop(@_)
3615 if $self->_new_bop_required();
3617 my( $method, $amount, %options ) = @_;
3619 warn "$me realtime_bop: $method $amount\n";
3620 warn " $_ => $options{$_}\n" foreach keys %options;
3623 $options{'description'} ||= 'Internet services';
3625 return $self->fake_bop($method, $amount, %options) if $options{'fake'};
3627 eval "use Business::OnlinePayment";
3630 my $payinfo = exists($options{'payinfo'})
3631 ? $options{'payinfo'}
3634 my %method2payby = (
3641 # check for banned credit card/ACH
3644 my $ban = qsearchs('banned_pay', {
3645 'payby' => $method2payby{$method},
3646 'payinfo' => md5_base64($payinfo),
3648 return "Banned credit card" if $ban;
3651 # set taxclass and trans_is_recur based on invnum if there is one
3655 my $trans_is_recur = 0;
3656 if ( $options{'invnum'} ) {
3658 my $cust_bill = qsearchs('cust_bill', { 'invnum' => $options{'invnum'} } );
3659 die "invnum ". $options{'invnum'}. " not found" unless $cust_bill;
3662 map { $_->part_pkg }
3664 map { $_->cust_pkg }
3665 $cust_bill->cust_bill_pkg;
3667 my @taxclasses = map $_->taxclass, @part_pkg;
3668 $taxclass = $taxclasses[0]
3669 unless grep { $taxclasses[0] ne $_ } @taxclasses; #unless there are
3670 #different taxclasses
3672 if grep { $_->freq ne '0' } @part_pkg;
3680 #look for an agent gateway override first
3682 if ( $method eq 'CC' ) {
3683 $cardtype = cardtype($payinfo);
3684 } elsif ( $method eq 'ECHECK' ) {
3687 $cardtype = $method;
3691 qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
3692 cardtype => $cardtype,
3693 taxclass => $taxclass, } )
3694 || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
3696 taxclass => $taxclass, } )
3697 || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
3698 cardtype => $cardtype,
3700 || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
3702 taxclass => '', } );
3704 my $payment_gateway = '';
3705 my( $processor, $login, $password, $action, @bop_options );
3706 if ( $override ) { #use a payment gateway override
3708 $payment_gateway = $override->payment_gateway;
3710 $processor = $payment_gateway->gateway_module;
3711 $login = $payment_gateway->gateway_username;
3712 $password = $payment_gateway->gateway_password;
3713 $action = $payment_gateway->gateway_action;
3714 @bop_options = $payment_gateway->options;
3716 } else { #use the standard settings from the config
3718 ( $processor, $login, $password, $action, @bop_options ) =
3719 $self->default_payment_gateway($method);
3727 my $address = exists($options{'address1'})
3728 ? $options{'address1'}
3730 my $address2 = exists($options{'address2'})
3731 ? $options{'address2'}
3733 $address .= ", ". $address2 if length($address2);
3735 my $o_payname = exists($options{'payname'})
3736 ? $options{'payname'}
3738 my($payname, $payfirst, $paylast);
3739 if ( $o_payname && $method ne 'ECHECK' ) {
3740 ($payname = $o_payname) =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
3741 or return "Illegal payname $payname";
3742 ($payfirst, $paylast) = ($1, $2);
3744 $payfirst = $self->getfield('first');
3745 $paylast = $self->getfield('last');
3746 $payname = "$payfirst $paylast";
3749 my @invoicing_list = $self->invoicing_list_emailonly;
3750 if ( $conf->exists('emailinvoiceautoalways')
3751 || $conf->exists('emailinvoiceauto') && ! @invoicing_list
3752 || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
3753 push @invoicing_list, $self->all_emails;
3756 my $email = ($conf->exists('business-onlinepayment-email-override'))
3757 ? $conf->config('business-onlinepayment-email-override')
3758 : $invoicing_list[0];
3762 my $payip = exists($options{'payip'})
3765 $content{customer_ip} = $payip
3768 $content{invoice_number} = $options{'invnum'}
3769 if exists($options{'invnum'}) && length($options{'invnum'});
3771 $content{email_customer} =
3772 ( $conf->exists('business-onlinepayment-email_customer')
3773 || $conf->exists('business-onlinepayment-email-override') );
3776 if ( $method eq 'CC' ) {
3778 $content{card_number} = $payinfo;
3779 $paydate = exists($options{'paydate'})
3780 ? $options{'paydate'}
3782 $paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
3783 $content{expiration} = "$2/$1";
3785 my $paycvv = exists($options{'paycvv'})
3786 ? $options{'paycvv'}
3788 $content{cvv2} = $paycvv
3791 my $paystart_month = exists($options{'paystart_month'})
3792 ? $options{'paystart_month'}
3793 : $self->paystart_month;
3795 my $paystart_year = exists($options{'paystart_year'})
3796 ? $options{'paystart_year'}
3797 : $self->paystart_year;
3799 $content{card_start} = "$paystart_month/$paystart_year"
3800 if $paystart_month && $paystart_year;
3802 my $payissue = exists($options{'payissue'})
3803 ? $options{'payissue'}
3805 $content{issue_number} = $payissue if $payissue;
3807 if ( $self->_bop_recurring_billing( 'payinfo' => $payinfo,
3808 'trans_is_recur' => $trans_is_recur,
3812 $content{recurring_billing} = 'YES';
3813 $content{acct_code} = 'rebill'
3814 if $conf->exists('credit_card-recurring_billing_acct_code');
3817 } elsif ( $method eq 'ECHECK' ) {
3818 ( $content{account_number}, $content{routing_code} ) =
3819 split('@', $payinfo);
3820 $content{bank_name} = $o_payname;
3821 $content{bank_state} = exists($options{'paystate'})
3822 ? $options{'paystate'}
3823 : $self->getfield('paystate');
3824 $content{account_type} = exists($options{'paytype'})
3825 ? uc($options{'paytype'}) || 'CHECKING'
3826 : uc($self->getfield('paytype')) || 'CHECKING';
3827 $content{account_name} = $payname;
3828 $content{customer_org} = $self->company ? 'B' : 'I';
3829 $content{state_id} = exists($options{'stateid'})
3830 ? $options{'stateid'}
3831 : $self->getfield('stateid');
3832 $content{state_id_state} = exists($options{'stateid_state'})
3833 ? $options{'stateid_state'}
3834 : $self->getfield('stateid_state');
3835 $content{customer_ssn} = exists($options{'ss'})
3838 } elsif ( $method eq 'LEC' ) {
3839 $content{phone} = $payinfo;
3843 # run transaction(s)
3846 my $balance = exists( $options{'balance'} )
3847 ? $options{'balance'}
3850 $self->select_for_update; #mutex ... just until we get our pending record in
3852 #the checks here are intended to catch concurrent payments
3853 #double-form-submission prevention is taken care of in cust_pay_pending::check
3856 return "The customer's balance has changed; $method transaction aborted."
3857 if $self->balance < $balance;
3858 #&& $self->balance < $amount; #might as well anyway?
3860 #also check and make sure there aren't *other* pending payments for this cust
3862 my @pending = qsearch('cust_pay_pending', {
3863 'custnum' => $self->custnum,
3864 'status' => { op=>'!=', value=>'done' }
3866 return "A payment is already being processed for this customer (".
3867 join(', ', map 'paypendingnum '. $_->paypendingnum, @pending ).
3868 "); $method transaction aborted."
3869 if scalar(@pending);
3871 #okay, good to go, if we're a duplicate, cust_pay_pending will kick us out
3873 my $cust_pay_pending = new FS::cust_pay_pending {
3874 'custnum' => $self->custnum,
3875 #'invnum' => $options{'invnum'},
3878 'payby' => $method2payby{$method},
3879 'payinfo' => $payinfo,
3880 'paydate' => $paydate,
3881 'recurring_billing' => $content{recurring_billing},
3883 'gatewaynum' => ( $payment_gateway ? $payment_gateway->gatewaynum : '' ),
3885 $cust_pay_pending->payunique( $options{payunique} )
3886 if defined($options{payunique}) && length($options{payunique});
3887 my $cpp_new_err = $cust_pay_pending->insert; #mutex lost when this is inserted
3888 return $cpp_new_err if $cpp_new_err;
3890 my( $action1, $action2 ) = split(/\s*\,\s*/, $action );
3892 my $transaction = new Business::OnlinePayment( $processor, @bop_options );
3893 $transaction->content(
3896 'password' => $password,
3897 'action' => $action1,
3898 'description' => $options{'description'},
3899 'amount' => $amount,
3900 #'invoice_number' => $options{'invnum'},
3901 'customer_id' => $self->custnum,
3902 'last_name' => $paylast,
3903 'first_name' => $payfirst,
3905 'address' => $address,
3906 'city' => ( exists($options{'city'})
3909 'state' => ( exists($options{'state'})
3912 'zip' => ( exists($options{'zip'})
3915 'country' => ( exists($options{'country'})
3916 ? $options{'country'}
3918 'referer' => 'http://cleanwhisker.420.am/', #XXX fix referer :/
3920 'phone' => $self->daytime || $self->night,
3924 $cust_pay_pending->status('pending');
3925 my $cpp_pending_err = $cust_pay_pending->replace;
3926 return $cpp_pending_err if $cpp_pending_err;
3929 my $BOP_TESTING = 0;
3930 my $BOP_TESTING_SUCCESS = 1;
3932 unless ( $BOP_TESTING ) {
3933 $transaction->submit();
3935 if ( $BOP_TESTING_SUCCESS ) {
3936 $transaction->is_success(1);
3937 $transaction->authorization('fake auth');
3939 $transaction->is_success(0);
3940 $transaction->error_message('fake failure');
3944 if ( $transaction->is_success() && $action2 ) {
3946 $cust_pay_pending->status('authorized');
3947 my $cpp_authorized_err = $cust_pay_pending->replace;
3948 return $cpp_authorized_err if $cpp_authorized_err;
3950 my $auth = $transaction->authorization;
3951 my $ordernum = $transaction->can('order_number')
3952 ? $transaction->order_number
3956 new Business::OnlinePayment( $processor, @bop_options );
3963 password => $password,
3964 order_number => $ordernum,
3966 authorization => $auth,
3967 description => $options{'description'},
3970 foreach my $field (qw( authorization_source_code returned_ACI
3971 transaction_identifier validation_code
3972 transaction_sequence_num local_transaction_date
3973 local_transaction_time AVS_result_code )) {
3974 $capture{$field} = $transaction->$field() if $transaction->can($field);
3977 $capture->content( %capture );
3981 unless ( $capture->is_success ) {
3982 my $e = "Authorization successful but capture failed, custnum #".
3983 $self->custnum. ': '. $capture->result_code.
3984 ": ". $capture->error_message;
3991 $cust_pay_pending->status($transaction->is_success() ? 'captured' : 'declined');
3992 my $cpp_captured_err = $cust_pay_pending->replace;
3993 return $cpp_captured_err if $cpp_captured_err;
3996 # remove paycvv after initial transaction
3999 #false laziness w/misc/process/payment.cgi - check both to make sure working
4001 if ( defined $self->dbdef_table->column('paycvv')
4002 && length($self->paycvv)
4003 && ! grep { $_ eq cardtype($payinfo) } $conf->config('cvv-save')
4005 my $error = $self->remove_cvv;
4007 warn "WARNING: error removing cvv: $error\n";
4015 if ( $transaction->is_success() ) {
4018 if ( $payment_gateway ) { # agent override
4019 $paybatch = $payment_gateway->gatewaynum. '-';
4022 $paybatch .= "$processor:". $transaction->authorization;
4024 $paybatch .= ':'. $transaction->order_number
4025 if $transaction->can('order_number')
4026 && length($transaction->order_number);
4028 my $cust_pay = new FS::cust_pay ( {
4029 'custnum' => $self->custnum,
4030 'invnum' => $options{'invnum'},
4033 'payby' => $method2payby{$method},
4034 'payinfo' => $payinfo,
4035 'paybatch' => $paybatch,
4036 'paydate' => $paydate,
4038 #doesn't hurt to know, even though the dup check is in cust_pay_pending now
4039 $cust_pay->payunique( $options{payunique} )
4040 if defined($options{payunique}) && length($options{payunique});
4042 my $oldAutoCommit = $FS::UID::AutoCommit;
4043 local $FS::UID::AutoCommit = 0;
4046 #start a transaction, insert the cust_pay and set cust_pay_pending.status to done in a single transction
4048 my $error = $cust_pay->insert($options{'manual'} ? ( 'manual' => 1 ) : () );
4051 $cust_pay->invnum(''); #try again with no specific invnum
4052 my $error2 = $cust_pay->insert( $options{'manual'} ?
4053 ( 'manual' => 1 ) : ()
4056 # gah. but at least we have a record of the state we had to abort in
4057 # from cust_pay_pending now.
4058 my $e = "WARNING: $method captured but payment not recorded - ".
4059 "error inserting payment ($processor): $error2".
4060 " (previously tried insert with invnum #$options{'invnum'}" .
4061 ": $error ) - pending payment saved as paypendingnum ".
4062 $cust_pay_pending->paypendingnum. "\n";
4068 if ( $options{'paynum_ref'} ) {
4069 ${ $options{'paynum_ref'} } = $cust_pay->paynum;
4072 $cust_pay_pending->status('done');
4073 $cust_pay_pending->statustext('captured');
4074 $cust_pay_pending->paynum($cust_pay->paynum);
4075 my $cpp_done_err = $cust_pay_pending->replace;
4077 if ( $cpp_done_err ) {
4079 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
4080 my $e = "WARNING: $method captured but payment not recorded - ".
4081 "error updating status for paypendingnum ".
4082 $cust_pay_pending->paypendingnum. ": $cpp_done_err \n";
4088 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4089 return ''; #no error
4095 my $perror = "$processor error: ". $transaction->error_message;
4097 unless ( $transaction->error_message ) {
4100 if ( $transaction->can('response_page') ) {
4102 'page' => ( $transaction->can('response_page')
4103 ? $transaction->response_page
4106 'code' => ( $transaction->can('response_code')
4107 ? $transaction->response_code
4110 'headers' => ( $transaction->can('response_headers')
4111 ? $transaction->response_headers
4117 "No additional debugging information available for $processor";
4120 $perror .= "No error_message returned from $processor -- ".
4121 ( ref($t_response) ? Dumper($t_response) : $t_response );
4125 if ( !$options{'quiet'} && !$realtime_bop_decline_quiet
4126 && $conf->exists('emaildecline')
4127 && grep { $_ ne 'POST' } $self->invoicing_list
4128 && ! grep { $transaction->error_message =~ /$_/ }
4129 $conf->config('emaildecline-exclude')
4131 my @templ = $conf->config('declinetemplate');
4132 my $template = new Text::Template (
4134 SOURCE => [ map "$_\n", @templ ],
4135 ) or return "($perror) can't create template: $Text::Template::ERROR";
4136 $template->compile()
4137 or return "($perror) can't compile template: $Text::Template::ERROR";
4139 my $templ_hash = { error => $transaction->error_message };
4141 my $error = send_email(
4142 'from' => $conf->config('invoice_from', $self->agentnum ),
4143 'to' => [ grep { $_ ne 'POST' } $self->invoicing_list ],
4144 'subject' => 'Your payment could not be processed',
4145 'body' => [ $template->fill_in(HASH => $templ_hash) ],
4148 $perror .= " (also received error sending decline notification: $error)"
4153 $cust_pay_pending->status('done');
4154 $cust_pay_pending->statustext("declined: $perror");
4155 my $cpp_done_err = $cust_pay_pending->replace;
4156 if ( $cpp_done_err ) {
4157 my $e = "WARNING: $method declined but pending payment not resolved - ".
4158 "error updating status for paypendingnum ".
4159 $cust_pay_pending->paypendingnum. ": $cpp_done_err \n";
4161 $perror = "$e ($perror)";
4169 sub _bop_recurring_billing {
4170 my( $self, %opt ) = @_;
4172 my $method = $conf->config('credit_card-recurring_billing_flag');
4174 if ( $method eq 'transaction_is_recur' ) {
4176 return 1 if $opt{'trans_is_recur'};
4180 my %hash = ( 'custnum' => $self->custnum,
4185 if qsearch('cust_pay', { %hash, 'payinfo' => $opt{'payinfo'} } )
4186 || qsearch('cust_pay', { %hash, 'paymask' => $self->mask_payinfo('CARD',
4197 =item realtime_refund_bop METHOD [ OPTION => VALUE ... ]
4199 Refunds a realtime credit card, ACH (electronic check) or phone bill transaction
4200 via a Business::OnlinePayment realtime gateway. See
4201 L<http://420.am/business-onlinepayment> for supported gateways.
4203 Available methods are: I<CC>, I<ECHECK> and I<LEC>
4205 Available options are: I<amount>, I<reason>, I<paynum>, I<paydate>
4207 Most gateways require a reference to an original payment transaction to refund,
4208 so you probably need to specify a I<paynum>.
4210 I<amount> defaults to the original amount of the payment if not specified.
4212 I<reason> specifies a reason for the refund.
4214 I<paydate> specifies the expiration date for a credit card overriding the
4215 value from the customer record or the payment record. Specified as yyyy-mm-dd
4217 Implementation note: If I<amount> is unspecified or equal to the amount of the
4218 orignal payment, first an attempt is made to "void" the transaction via
4219 the gateway (to cancel a not-yet settled transaction) and then if that fails,
4220 the normal attempt is made to "refund" ("credit") the transaction via the
4221 gateway is attempted.
4223 #The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
4224 #I<zip>, I<payinfo> and I<paydate> are also available. Any of these options,
4225 #if set, will override the value from the customer record.
4227 #If an I<invnum> is specified, this payment (if successful) is applied to the
4228 #specified invoice. If you don't specify an I<invnum> you might want to
4229 #call the B<apply_payments> method.
4233 #some false laziness w/realtime_bop, not enough to make it worth merging
4234 #but some useful small subs should be pulled out
4235 sub realtime_refund_bop {
4238 return $self->_new_realtime_refund_bop(@_)
4239 if $self->_new_bop_required();
4241 my( $method, %options ) = @_;
4243 warn "$me realtime_refund_bop: $method refund\n";
4244 warn " $_ => $options{$_}\n" foreach keys %options;
4247 eval "use Business::OnlinePayment";
4251 # look up the original payment and optionally a gateway for that payment
4255 my $amount = $options{'amount'};
4257 my( $processor, $login, $password, @bop_options ) ;
4258 my( $auth, $order_number ) = ( '', '', '' );
4260 if ( $options{'paynum'} ) {
4262 warn " paynum: $options{paynum}\n" if $DEBUG > 1;
4263 $cust_pay = qsearchs('cust_pay', { paynum=>$options{'paynum'} } )
4264 or return "Unknown paynum $options{'paynum'}";
4265 $amount ||= $cust_pay->paid;
4267 $cust_pay->paybatch =~ /^((\d+)\-)?(\w+):\s*([\w\-\/ ]*)(:([\w\-]+))?$/
4268 or return "Can't parse paybatch for paynum $options{'paynum'}: ".
4269 $cust_pay->paybatch;
4270 my $gatewaynum = '';
4271 ( $gatewaynum, $processor, $auth, $order_number ) = ( $2, $3, $4, $6 );
4273 if ( $gatewaynum ) { #gateway for the payment to be refunded
4275 my $payment_gateway =
4276 qsearchs('payment_gateway', { 'gatewaynum' => $gatewaynum } );
4277 die "payment gateway $gatewaynum not found"
4278 unless $payment_gateway;
4280 $processor = $payment_gateway->gateway_module;
4281 $login = $payment_gateway->gateway_username;
4282 $password = $payment_gateway->gateway_password;
4283 @bop_options = $payment_gateway->options;
4285 } else { #try the default gateway
4287 my( $conf_processor, $unused_action );
4288 ( $conf_processor, $login, $password, $unused_action, @bop_options ) =
4289 $self->default_payment_gateway($method);
4291 return "processor of payment $options{'paynum'} $processor does not".
4292 " match default processor $conf_processor"
4293 unless $processor eq $conf_processor;
4298 } else { # didn't specify a paynum, so look for agent gateway overrides
4299 # like a normal transaction
4302 if ( $method eq 'CC' ) {
4303 $cardtype = cardtype($self->payinfo);
4304 } elsif ( $method eq 'ECHECK' ) {
4307 $cardtype = $method;
4310 qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
4311 cardtype => $cardtype,
4313 || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
4315 taxclass => '', } );
4317 if ( $override ) { #use a payment gateway override
4319 my $payment_gateway = $override->payment_gateway;
4321 $processor = $payment_gateway->gateway_module;
4322 $login = $payment_gateway->gateway_username;
4323 $password = $payment_gateway->gateway_password;
4324 #$action = $payment_gateway->gateway_action;
4325 @bop_options = $payment_gateway->options;
4327 } else { #use the standard settings from the config
4330 ( $processor, $login, $password, $unused_action, @bop_options ) =
4331 $self->default_payment_gateway($method);
4336 return "neither amount nor paynum specified" unless $amount;
4341 'password' => $password,
4342 'order_number' => $order_number,
4343 'amount' => $amount,
4344 'referer' => 'http://cleanwhisker.420.am/', #XXX fix referer :/
4346 $content{authorization} = $auth
4347 if length($auth); #echeck/ACH transactions have an order # but no auth
4348 #(at least with authorize.net)
4350 my $disable_void_after;
4351 if ($conf->exists('disable_void_after')
4352 && $conf->config('disable_void_after') =~ /^(\d+)$/) {
4353 $disable_void_after = $1;
4356 #first try void if applicable
4357 if ( $cust_pay && $cust_pay->paid == $amount
4359 ( not defined($disable_void_after) )
4360 || ( time < ($cust_pay->_date + $disable_void_after ) )
4363 warn " attempting void\n" if $DEBUG > 1;
4364 my $void = new Business::OnlinePayment( $processor, @bop_options );
4365 $void->content( 'action' => 'void', %content );
4367 if ( $void->is_success ) {
4368 my $error = $cust_pay->void($options{'reason'});
4370 # gah, even with transactions.
4371 my $e = 'WARNING: Card/ACH voided but database not updated - '.
4372 "error voiding payment: $error";
4376 warn " void successful\n" if $DEBUG > 1;
4381 warn " void unsuccessful, trying refund\n"
4385 my $address = $self->address1;
4386 $address .= ", ". $self->address2 if $self->address2;
4388 my($payname, $payfirst, $paylast);
4389 if ( $self->payname && $method ne 'ECHECK' ) {
4390 $payname = $self->payname;
4391 $payname =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
4392 or return "Illegal payname $payname";
4393 ($payfirst, $paylast) = ($1, $2);
4395 $payfirst = $self->getfield('first');
4396 $paylast = $self->getfield('last');
4397 $payname = "$payfirst $paylast";
4400 my @invoicing_list = $self->invoicing_list_emailonly;
4401 if ( $conf->exists('emailinvoiceautoalways')
4402 || $conf->exists('emailinvoiceauto') && ! @invoicing_list
4403 || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
4404 push @invoicing_list, $self->all_emails;
4407 my $email = ($conf->exists('business-onlinepayment-email-override'))
4408 ? $conf->config('business-onlinepayment-email-override')
4409 : $invoicing_list[0];
4411 my $payip = exists($options{'payip'})
4414 $content{customer_ip} = $payip
4418 if ( $method eq 'CC' ) {
4421 $content{card_number} = $payinfo = $cust_pay->payinfo;
4422 (exists($options{'paydate'}) ? $options{'paydate'} : $cust_pay->paydate)
4423 =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/ &&
4424 ($content{expiration} = "$2/$1"); # where available
4426 $content{card_number} = $payinfo = $self->payinfo;
4427 (exists($options{'paydate'}) ? $options{'paydate'} : $self->paydate)
4428 =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
4429 $content{expiration} = "$2/$1";
4432 } elsif ( $method eq 'ECHECK' ) {
4435 $payinfo = $cust_pay->payinfo;
4437 $payinfo = $self->payinfo;
4439 ( $content{account_number}, $content{routing_code} )= split('@', $payinfo );
4440 $content{bank_name} = $self->payname;
4441 $content{account_type} = 'CHECKING';
4442 $content{account_name} = $payname;
4443 $content{customer_org} = $self->company ? 'B' : 'I';
4444 $content{customer_ssn} = $self->ss;
4445 } elsif ( $method eq 'LEC' ) {
4446 $content{phone} = $payinfo = $self->payinfo;
4450 my $refund = new Business::OnlinePayment( $processor, @bop_options );
4451 my %sub_content = $refund->content(
4452 'action' => 'credit',
4453 'customer_id' => $self->custnum,
4454 'last_name' => $paylast,
4455 'first_name' => $payfirst,
4457 'address' => $address,
4458 'city' => $self->city,
4459 'state' => $self->state,
4460 'zip' => $self->zip,
4461 'country' => $self->country,
4463 'phone' => $self->daytime || $self->night,
4466 warn join('', map { " $_ => $sub_content{$_}\n" } keys %sub_content )
4470 return "$processor error: ". $refund->error_message
4471 unless $refund->is_success();
4473 my %method2payby = (
4479 my $paybatch = "$processor:". $refund->authorization;
4480 $paybatch .= ':'. $refund->order_number
4481 if $refund->can('order_number') && $refund->order_number;
4483 while ( $cust_pay && $cust_pay->unapplied < $amount ) {
4484 my @cust_bill_pay = $cust_pay->cust_bill_pay;
4485 last unless @cust_bill_pay;
4486 my $cust_bill_pay = pop @cust_bill_pay;
4487 my $error = $cust_bill_pay->delete;
4491 my $cust_refund = new FS::cust_refund ( {
4492 'custnum' => $self->custnum,
4493 'paynum' => $options{'paynum'},
4494 'refund' => $amount,
4496 'payby' => $method2payby{$method},
4497 'payinfo' => $payinfo,
4498 'paybatch' => $paybatch,
4499 'reason' => $options{'reason'} || 'card or ACH refund',
4501 my $error = $cust_refund->insert;
4503 $cust_refund->paynum(''); #try again with no specific paynum
4504 my $error2 = $cust_refund->insert;
4506 # gah, even with transactions.
4507 my $e = 'WARNING: Card/ACH refunded but database not updated - '.
4508 "error inserting refund ($processor): $error2".
4509 " (previously tried insert with paynum #$options{'paynum'}" .
4520 # does the configuration indicate the new bop routines are required?
4522 sub _new_bop_required {
4525 my $botpp = 'Business::OnlineThirdPartyPayment';
4528 if ( $conf->config('business-onlinepayment-namespace') eq $botpp ||
4529 scalar( grep { $_->gateway_namespace eq $botpp }
4530 qsearch( 'payment_gateway', { 'disabled' => '' } )
4539 =item realtime_collect [ OPTION => VALUE ... ]
4541 Runs a realtime credit card, ACH (electronic check) or phone bill transaction
4542 via a Business::OnlinePayment or Business::OnlineThirdPartyPayment realtime
4543 gateway. See L<http://420.am/business-onlinepayment> and
4544 L<http://420.am/business-onlinethirdpartypayment> for supported gateways.
4546 On failure returns an error message.
4548 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.
4550 Available options are: I<method>, I<amount>, I<description>, I<invnum>, I<quiet>, I<paynum_ref>, I<payunique>, I<session_id>
4552 I<method> is one of: I<CC>, I<ECHECK> and I<LEC>. If none is specified
4553 then it is deduced from the customer record.
4555 If no I<amount> is specified, then the customer balance is used.
4557 The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
4558 I<zip>, I<payinfo> and I<paydate> are also available. Any of these options,
4559 if set, will override the value from the customer record.
4561 I<description> is a free-text field passed to the gateway. It defaults to
4562 "Internet services".
4564 If an I<invnum> is specified, this payment (if successful) is applied to the
4565 specified invoice. If you don't specify an I<invnum> you might want to
4566 call the B<apply_payments> method.
4568 I<quiet> can be set true to surpress email decline notices.
4570 I<paynum_ref> can be set to a scalar reference. It will be filled in with the
4571 resulting paynum, if any.
4573 I<payunique> is a unique identifier for this payment.
4575 I<session_id> is a session identifier associated with this payment.
4577 I<depend_jobnum> allows payment capture to unlock export jobs
4581 sub realtime_collect {
4582 my( $self, %options ) = @_;
4585 warn "$me realtime_collect:\n";
4586 warn " $_ => $options{$_}\n" foreach keys %options;
4589 $options{amount} = $self->balance unless exists( $options{amount} );
4590 $options{method} = FS::payby->payby2bop($self->payby)
4591 unless exists( $options{method} );
4593 return $self->realtime_bop({%options});
4597 =item _realtime_bop { [ ARG => VALUE ... ] }
4599 Runs a realtime credit card, ACH (electronic check) or phone bill transaction
4600 via a Business::OnlinePayment realtime gateway. See
4601 L<http://420.am/business-onlinepayment> for supported gateways.
4603 Required arguments in the hashref are I<method>, and I<amount>
4605 Available methods are: I<CC>, I<ECHECK> and I<LEC>
4607 Available optional arguments are: I<description>, I<invnum>, I<quiet>, I<paynum_ref>, I<payunique>, I<session_id>
4609 The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
4610 I<zip>, I<payinfo> and I<paydate> are also available. Any of these options,
4611 if set, will override the value from the customer record.
4613 I<description> is a free-text field passed to the gateway. It defaults to
4614 "Internet services".
4616 If an I<invnum> is specified, this payment (if successful) is applied to the
4617 specified invoice. If you don't specify an I<invnum> you might want to
4618 call the B<apply_payments> method.
4620 I<quiet> can be set true to surpress email decline notices.
4622 I<paynum_ref> can be set to a scalar reference. It will be filled in with the
4623 resulting paynum, if any.
4625 I<payunique> is a unique identifier for this payment.
4627 I<session_id> is a session identifier associated with this payment.
4629 I<depend_jobnum> allows payment capture to unlock export jobs
4631 (moved from cust_bill) (probably should get realtime_{card,ach,lec} here too)
4635 # some helper routines
4636 sub _payment_gateway {
4637 my ($self, $options) = @_;
4639 $options->{payment_gateway} = $self->agent->payment_gateway( %$options )
4640 unless exists($options->{payment_gateway});
4642 $options->{payment_gateway};
4646 my ($self, $options) = @_;
4649 'login' => $options->{payment_gateway}->gateway_username,
4650 'password' => $options->{payment_gateway}->gateway_password,
4655 my ($self, $options) = @_;
4657 $options->{payment_gateway}->gatewaynum
4658 ? $options->{payment_gateway}->options
4659 : @{ $options->{payment_gateway}->get('options') };
4663 my ($self, $options) = @_;
4665 $options->{description} ||= 'Internet services';
4666 $options->{payinfo} = $self->payinfo unless exists( $options->{payinfo} );
4667 $options->{invnum} ||= '';
4668 $options->{payname} = $self->payname unless exists( $options->{payname} );
4672 my ($self, $options) = @_;
4675 $content{address} = exists($options->{'address1'})
4676 ? $options->{'address1'}
4678 my $address2 = exists($options->{'address2'})
4679 ? $options->{'address2'}
4681 $content{address} .= ", ". $address2 if length($address2);
4683 my $payip = exists($options->{'payip'}) ? $options->{'payip'} : $self->payip;
4684 $content{customer_ip} = $payip if length($payip);
4686 $content{invoice_number} = $options->{'invnum'}
4687 if exists($options->{'invnum'}) && length($options->{'invnum'});
4689 $content{email_customer} =
4690 ( $conf->exists('business-onlinepayment-email_customer')
4691 || $conf->exists('business-onlinepayment-email-override') );
4693 $content{payfirst} = $self->getfield('first');
4694 $content{paylast} = $self->getfield('last');
4696 $content{account_name} = "$content{payfirst} $content{paylast}"
4697 if $options->{method} eq 'ECHECK';
4699 $content{name} = $options->{payname};
4700 $content{name} = $content{account_name} if exists($content{account_name});
4702 $content{city} = exists($options->{city})
4705 $content{state} = exists($options->{state})
4708 $content{zip} = exists($options->{zip})
4711 $content{country} = exists($options->{country})
4712 ? $options->{country}
4714 $content{referer} = 'http://cleanwhisker.420.am/'; #XXX fix referer :/
4715 $content{phone} = $self->daytime || $self->night;
4720 my %bop_method2payby = (
4726 sub _new_realtime_bop {
4730 if (ref($_[0]) eq 'HASH') {
4731 %options = %{$_[0]};
4733 my ( $method, $amount ) = ( shift, shift );
4735 $options{method} = $method;
4736 $options{amount} = $amount;
4740 warn "$me realtime_bop (new): $options{method} $options{amount}\n";
4741 warn " $_ => $options{$_}\n" foreach keys %options;
4744 return $self->fake_bop(%options) if $options{'fake'};
4746 $self->_bop_defaults(\%options);
4749 # set trans_is_recur based on invnum if there is one
4752 my $trans_is_recur = 0;
4753 if ( $options{'invnum'} ) {
4755 my $cust_bill = qsearchs('cust_bill', { 'invnum' => $options{'invnum'} } );
4756 die "invnum ". $options{'invnum'}. " not found" unless $cust_bill;
4759 map { $_->part_pkg }
4761 map { $_->cust_pkg }
4762 $cust_bill->cust_bill_pkg;
4765 if grep { $_->freq ne '0' } @part_pkg;
4773 my $payment_gateway = $self->_payment_gateway( \%options );
4774 my $namespace = $payment_gateway->gateway_namespace;
4776 eval "use $namespace";
4780 # check for banned credit card/ACH
4783 my $ban = qsearchs('banned_pay', {
4784 'payby' => $bop_method2payby{$options{method}},
4785 'payinfo' => md5_base64($options{payinfo}),
4787 return "Banned credit card" if $ban;
4793 my (%bop_content) = $self->_bop_content(\%options);
4795 if ( $options{method} ne 'ECHECK' ) {
4796 $options{payname} =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
4797 or return "Illegal payname $options{payname}";
4798 ($bop_content{payfirst}, $bop_content{paylast}) = ($1, $2);
4801 my @invoicing_list = $self->invoicing_list_emailonly;
4802 if ( $conf->exists('emailinvoiceautoalways')
4803 || $conf->exists('emailinvoiceauto') && ! @invoicing_list
4804 || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
4805 push @invoicing_list, $self->all_emails;
4808 my $email = ($conf->exists('business-onlinepayment-email-override'))
4809 ? $conf->config('business-onlinepayment-email-override')
4810 : $invoicing_list[0];
4814 if ( $namespace eq 'Business::OnlinePayment' && $options{method} eq 'CC' ) {
4816 $content{card_number} = $options{payinfo};
4817 $paydate = exists($options{'paydate'})
4818 ? $options{'paydate'}
4820 $paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
4821 $content{expiration} = "$2/$1";
4823 my $paycvv = exists($options{'paycvv'})
4824 ? $options{'paycvv'}
4826 $content{cvv2} = $paycvv
4829 my $paystart_month = exists($options{'paystart_month'})
4830 ? $options{'paystart_month'}
4831 : $self->paystart_month;
4833 my $paystart_year = exists($options{'paystart_year'})
4834 ? $options{'paystart_year'}
4835 : $self->paystart_year;
4837 $content{card_start} = "$paystart_month/$paystart_year"
4838 if $paystart_month && $paystart_year;
4840 my $payissue = exists($options{'payissue'})
4841 ? $options{'payissue'}
4843 $content{issue_number} = $payissue if $payissue;
4845 if ( $self->_bop_recurring_billing( 'payinfo' => $options{'payinfo'},
4846 'trans_is_recur' => $trans_is_recur,
4850 $content{recurring_billing} = 'YES';
4851 $content{acct_code} = 'rebill'
4852 if $conf->exists('credit_card-recurring_billing_acct_code');
4855 } elsif ( $namespace eq 'Business::OnlinePayment' && $options{method} eq 'ECHECK' ){
4856 ( $content{account_number}, $content{routing_code} ) =
4857 split('@', $options{payinfo});
4858 $content{bank_name} = $options{payname};
4859 $content{bank_state} = exists($options{'paystate'})
4860 ? $options{'paystate'}
4861 : $self->getfield('paystate');
4862 $content{account_type} = exists($options{'paytype'})
4863 ? uc($options{'paytype'}) || 'CHECKING'
4864 : uc($self->getfield('paytype')) || 'CHECKING';
4865 $content{customer_org} = $self->company ? 'B' : 'I';
4866 $content{state_id} = exists($options{'stateid'})
4867 ? $options{'stateid'}
4868 : $self->getfield('stateid');
4869 $content{state_id_state} = exists($options{'stateid_state'})
4870 ? $options{'stateid_state'}
4871 : $self->getfield('stateid_state');
4872 $content{customer_ssn} = exists($options{'ss'})
4875 } elsif ( $namespace eq 'Business::OnlinePayment' && $options{method} eq 'LEC' ) {
4876 $content{phone} = $options{payinfo};
4877 } elsif ( $namespace eq 'Business::OnlineThirdPartyPayment' ) {
4884 # run transaction(s)
4887 my $balance = exists( $options{'balance'} )
4888 ? $options{'balance'}
4891 $self->select_for_update; #mutex ... just until we get our pending record in
4893 #the checks here are intended to catch concurrent payments
4894 #double-form-submission prevention is taken care of in cust_pay_pending::check
4897 return "The customer's balance has changed; $options{method} transaction aborted."
4898 if $self->balance < $balance;
4899 #&& $self->balance < $options{amount}; #might as well anyway?
4901 #also check and make sure there aren't *other* pending payments for this cust
4903 my @pending = qsearch('cust_pay_pending', {
4904 'custnum' => $self->custnum,
4905 'status' => { op=>'!=', value=>'done' }
4907 return "A payment is already being processed for this customer (".
4908 join(', ', map 'paypendingnum '. $_->paypendingnum, @pending ).
4909 "); $options{method} transaction aborted."
4910 if scalar(@pending);
4912 #okay, good to go, if we're a duplicate, cust_pay_pending will kick us out
4914 my $cust_pay_pending = new FS::cust_pay_pending {
4915 'custnum' => $self->custnum,
4916 #'invnum' => $options{'invnum'},
4917 'paid' => $options{amount},
4919 'payby' => $bop_method2payby{$options{method}},
4920 'payinfo' => $options{payinfo},
4921 'paydate' => $paydate,
4922 'recurring_billing' => $content{recurring_billing},
4924 'gatewaynum' => $payment_gateway->gatewaynum || '',
4925 'session_id' => $options{session_id} || '',
4926 'jobnum' => $options{depend_jobnum} || '',
4928 $cust_pay_pending->payunique( $options{payunique} )
4929 if defined($options{payunique}) && length($options{payunique});
4930 my $cpp_new_err = $cust_pay_pending->insert; #mutex lost when this is inserted
4931 return $cpp_new_err if $cpp_new_err;
4933 my( $action1, $action2 ) =
4934 split( /\s*\,\s*/, $payment_gateway->gateway_action );
4936 my $transaction = new $namespace( $payment_gateway->gateway_module,
4937 $self->_bop_options(\%options),
4940 $transaction->content(
4941 'type' => $options{method},
4942 $self->_bop_auth(\%options),
4943 'action' => $action1,
4944 'description' => $options{'description'},
4945 'amount' => $options{amount},
4946 #'invoice_number' => $options{'invnum'},
4947 'customer_id' => $self->custnum,
4949 'reference' => $cust_pay_pending->paypendingnum, #for now
4954 $cust_pay_pending->status('pending');
4955 my $cpp_pending_err = $cust_pay_pending->replace;
4956 return $cpp_pending_err if $cpp_pending_err;
4959 my $BOP_TESTING = 0;
4960 my $BOP_TESTING_SUCCESS = 1;
4962 unless ( $BOP_TESTING ) {
4963 $transaction->submit();
4965 if ( $BOP_TESTING_SUCCESS ) {
4966 $transaction->is_success(1);
4967 $transaction->authorization('fake auth');
4969 $transaction->is_success(0);
4970 $transaction->error_message('fake failure');
4974 if ( $transaction->is_success() && $namespace eq 'Business::OnlineThirdPartyPayment' ) {
4976 return { reference => $cust_pay_pending->paypendingnum,
4977 map { $_ => $transaction->$_ } qw ( popup_url collectitems ) };
4979 } elsif ( $transaction->is_success() && $action2 ) {
4981 $cust_pay_pending->status('authorized');
4982 my $cpp_authorized_err = $cust_pay_pending->replace;
4983 return $cpp_authorized_err if $cpp_authorized_err;
4985 my $auth = $transaction->authorization;
4986 my $ordernum = $transaction->can('order_number')
4987 ? $transaction->order_number
4991 new Business::OnlinePayment( $payment_gateway->gateway_module,
4992 $self->_bop_options(\%options),
4997 type => $options{method},
4999 $self->_bop_auth(\%options),
5000 order_number => $ordernum,
5001 amount => $options{amount},
5002 authorization => $auth,
5003 description => $options{'description'},
5006 foreach my $field (qw( authorization_source_code returned_ACI
5007 transaction_identifier validation_code
5008 transaction_sequence_num local_transaction_date
5009 local_transaction_time AVS_result_code )) {
5010 $capture{$field} = $transaction->$field() if $transaction->can($field);
5013 $capture->content( %capture );
5017 unless ( $capture->is_success ) {
5018 my $e = "Authorization successful but capture failed, custnum #".
5019 $self->custnum. ': '. $capture->result_code.
5020 ": ". $capture->error_message;
5028 # remove paycvv after initial transaction
5031 #false laziness w/misc/process/payment.cgi - check both to make sure working
5033 if ( defined $self->dbdef_table->column('paycvv')
5034 && length($self->paycvv)
5035 && ! grep { $_ eq cardtype($options{payinfo}) } $conf->config('cvv-save')
5037 my $error = $self->remove_cvv;
5039 warn "WARNING: error removing cvv: $error\n";
5047 $self->_realtime_bop_result( $cust_pay_pending, $transaction, %options );
5059 if (ref($_[0]) eq 'HASH') {
5060 %options = %{$_[0]};
5062 my ( $method, $amount ) = ( shift, shift );
5064 $options{method} = $method;
5065 $options{amount} = $amount;
5068 if ( $options{'fake_failure'} ) {
5069 return "Error: No error; test failure requested with fake_failure";
5073 #if ( $payment_gateway->gatewaynum ) { # agent override
5074 # $paybatch = $payment_gateway->gatewaynum. '-';
5077 #$paybatch .= "$processor:". $transaction->authorization;
5079 #$paybatch .= ':'. $transaction->order_number
5080 # if $transaction->can('order_number')
5081 # && length($transaction->order_number);
5083 my $paybatch = 'FakeProcessor:54:32';
5085 my $cust_pay = new FS::cust_pay ( {
5086 'custnum' => $self->custnum,
5087 'invnum' => $options{'invnum'},
5088 'paid' => $options{amount},
5090 'payby' => $bop_method2payby{$options{method}},
5091 #'payinfo' => $payinfo,
5092 'payinfo' => '4111111111111111',
5093 'paybatch' => $paybatch,
5094 #'paydate' => $paydate,
5095 'paydate' => '2012-05-01',
5097 $cust_pay->payunique( $options{payunique} ) if length($options{payunique});
5099 my $error = $cust_pay->insert($options{'manual'} ? ( 'manual' => 1 ) : () );
5102 $cust_pay->invnum(''); #try again with no specific invnum
5103 my $error2 = $cust_pay->insert( $options{'manual'} ?
5104 ( 'manual' => 1 ) : ()
5107 # gah, even with transactions.
5108 my $e = 'WARNING: Card/ACH debited but database not updated - '.
5109 "error inserting (fake!) payment: $error2".
5110 " (previously tried insert with invnum #$options{'invnum'}" .
5117 if ( $options{'paynum_ref'} ) {
5118 ${ $options{'paynum_ref'} } = $cust_pay->paynum;
5121 return ''; #no error
5126 # item _realtime_bop_result CUST_PAY_PENDING, BOP_OBJECT [ OPTION => VALUE ... ]
5128 # Wraps up processing of a realtime credit card, ACH (electronic check) or
5129 # phone bill transaction.
5131 sub _realtime_bop_result {
5132 my( $self, $cust_pay_pending, $transaction, %options ) = @_;
5134 warn "$me _realtime_bop_result: pending transaction ".
5135 $cust_pay_pending->paypendingnum. "\n";
5136 warn " $_ => $options{$_}\n" foreach keys %options;
5139 my $payment_gateway = $options{payment_gateway}
5140 or return "no payment gateway in arguments to _realtime_bop_result";
5142 $cust_pay_pending->status($transaction->is_success() ? 'captured' : 'declined');
5143 my $cpp_captured_err = $cust_pay_pending->replace;
5144 return $cpp_captured_err if $cpp_captured_err;
5146 if ( $transaction->is_success() ) {
5149 if ( $payment_gateway->gatewaynum ) { # agent override
5150 $paybatch = $payment_gateway->gatewaynum. '-';
5153 $paybatch .= $payment_gateway->gateway_module. ":".
5154 $transaction->authorization;
5156 $paybatch .= ':'. $transaction->order_number
5157 if $transaction->can('order_number')
5158 && length($transaction->order_number);
5160 my $cust_pay = new FS::cust_pay ( {
5161 'custnum' => $self->custnum,
5162 'invnum' => $options{'invnum'},
5163 'paid' => $cust_pay_pending->paid,
5165 'payby' => $cust_pay_pending->payby,
5166 #'payinfo' => $payinfo,
5167 'paybatch' => $paybatch,
5168 'paydate' => $cust_pay_pending->paydate,
5170 #doesn't hurt to know, even though the dup check is in cust_pay_pending now
5171 $cust_pay->payunique( $options{payunique} )
5172 if defined($options{payunique}) && length($options{payunique});
5174 my $oldAutoCommit = $FS::UID::AutoCommit;
5175 local $FS::UID::AutoCommit = 0;
5178 #start a transaction, insert the cust_pay and set cust_pay_pending.status to done in a single transction
5180 my $error = $cust_pay->insert($options{'manual'} ? ( 'manual' => 1 ) : () );
5183 $cust_pay->invnum(''); #try again with no specific invnum
5184 my $error2 = $cust_pay->insert( $options{'manual'} ?
5185 ( 'manual' => 1 ) : ()
5188 # gah. but at least we have a record of the state we had to abort in
5189 # from cust_pay_pending now.
5190 my $e = "WARNING: $options{method} captured but payment not recorded -".
5191 " error inserting payment (". $payment_gateway->gateway_module.
5193 " (previously tried insert with invnum #$options{'invnum'}" .
5194 ": $error ) - pending payment saved as paypendingnum ".
5195 $cust_pay_pending->paypendingnum. "\n";
5201 my $jobnum = $cust_pay_pending->jobnum;
5203 my $placeholder = qsearchs( 'queue', { 'jobnum' => $jobnum } );
5205 unless ( $placeholder ) {
5206 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
5207 my $e = "WARNING: $options{method} captured but job $jobnum not ".
5208 "found for paypendingnum ". $cust_pay_pending->paypendingnum. "\n";
5213 $error = $placeholder->delete;
5216 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
5217 my $e = "WARNING: $options{method} captured but could not delete ".
5218 "job $jobnum for paypendingnum ".
5219 $cust_pay_pending->paypendingnum. ": $error\n";
5226 if ( $options{'paynum_ref'} ) {
5227 ${ $options{'paynum_ref'} } = $cust_pay->paynum;
5230 $cust_pay_pending->status('done');
5231 $cust_pay_pending->statustext('captured');
5232 $cust_pay_pending->paynum($cust_pay->paynum);
5233 my $cpp_done_err = $cust_pay_pending->replace;
5235 if ( $cpp_done_err ) {
5237 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
5238 my $e = "WARNING: $options{method} captured but payment not recorded - ".
5239 "error updating status for paypendingnum ".
5240 $cust_pay_pending->paypendingnum. ": $cpp_done_err \n";
5246 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
5247 return ''; #no error
5253 my $perror = $payment_gateway->gateway_module. " error: ".
5254 $transaction->error_message;
5256 my $jobnum = $cust_pay_pending->jobnum;
5258 my $placeholder = qsearchs( 'queue', { 'jobnum' => $jobnum } );
5260 if ( $placeholder ) {
5261 my $error = $placeholder->depended_delete;
5262 $error ||= $placeholder->delete;
5263 warn "error removing provisioning jobs after declined paypendingnum ".
5264 $cust_pay_pending->paypendingnum. "\n";
5266 my $e = "error finding job $jobnum for declined paypendingnum ".
5267 $cust_pay_pending->paypendingnum. "\n";
5273 unless ( $transaction->error_message ) {
5276 if ( $transaction->can('response_page') ) {
5278 'page' => ( $transaction->can('response_page')
5279 ? $transaction->response_page
5282 'code' => ( $transaction->can('response_code')
5283 ? $transaction->response_code
5286 'headers' => ( $transaction->can('response_headers')
5287 ? $transaction->response_headers
5293 "No additional debugging information available for ".
5294 $payment_gateway->gateway_module;
5297 $perror .= "No error_message returned from ".
5298 $payment_gateway->gateway_module. " -- ".
5299 ( ref($t_response) ? Dumper($t_response) : $t_response );
5303 if ( !$options{'quiet'} && !$realtime_bop_decline_quiet
5304 && $conf->exists('emaildecline')
5305 && grep { $_ ne 'POST' } $self->invoicing_list
5306 && ! grep { $transaction->error_message =~ /$_/ }
5307 $conf->config('emaildecline-exclude')
5309 my @templ = $conf->config('declinetemplate');
5310 my $template = new Text::Template (
5312 SOURCE => [ map "$_\n", @templ ],
5313 ) or return "($perror) can't create template: $Text::Template::ERROR";
5314 $template->compile()
5315 or return "($perror) can't compile template: $Text::Template::ERROR";
5317 my $templ_hash = { error => $transaction->error_message };
5319 my $error = send_email(
5320 'from' => $conf->config('invoice_from', $self->agentnum ),
5321 'to' => [ grep { $_ ne 'POST' } $self->invoicing_list ],
5322 'subject' => 'Your payment could not be processed',
5323 'body' => [ $template->fill_in(HASH => $templ_hash) ],
5326 $perror .= " (also received error sending decline notification: $error)"
5331 $cust_pay_pending->status('done');
5332 $cust_pay_pending->statustext("declined: $perror");
5333 my $cpp_done_err = $cust_pay_pending->replace;
5334 if ( $cpp_done_err ) {
5335 my $e = "WARNING: $options{method} declined but pending payment not ".
5336 "resolved - error updating status for paypendingnum ".
5337 $cust_pay_pending->paypendingnum. ": $cpp_done_err \n";
5339 $perror = "$e ($perror)";
5347 =item realtime_botpp_capture CUST_PAY_PENDING [ OPTION => VALUE ... ]
5349 Verifies successful third party processing of a realtime credit card,
5350 ACH (electronic check) or phone bill transaction via a
5351 Business::OnlineThirdPartyPayment realtime gateway. See
5352 L<http://420.am/business-onlinethirdpartypayment> for supported gateways.
5354 Available options are: I<description>, I<invnum>, I<quiet>, I<paynum_ref>, I<payunique>
5356 The additional options I<payname>, I<city>, I<state>,
5357 I<zip>, I<payinfo> and I<paydate> are also available. Any of these options,
5358 if set, will override the value from the customer record.
5360 I<description> is a free-text field passed to the gateway. It defaults to
5361 "Internet services".
5363 If an I<invnum> is specified, this payment (if successful) is applied to the
5364 specified invoice. If you don't specify an I<invnum> you might want to
5365 call the B<apply_payments> method.
5367 I<quiet> can be set true to surpress email decline notices.
5369 I<paynum_ref> can be set to a scalar reference. It will be filled in with the
5370 resulting paynum, if any.
5372 I<payunique> is a unique identifier for this payment.
5374 Returns a hashref containing elements bill_error (which will be undefined
5375 upon success) and session_id of any associated session.
5379 sub realtime_botpp_capture {
5380 my( $self, $cust_pay_pending, %options ) = @_;
5382 warn "$me realtime_botpp_capture: pending transaction $cust_pay_pending\n";
5383 warn " $_ => $options{$_}\n" foreach keys %options;
5386 eval "use Business::OnlineThirdPartyPayment";
5390 # select the gateway
5393 my $method = FS::payby->payby2bop($cust_pay_pending->payby);
5395 my $payment_gateway = $cust_pay_pending->gatewaynum
5396 ? qsearchs( 'payment_gateway',
5397 { gatewaynum => $cust_pay_pending->gatewaynum }
5399 : $self->agent->payment_gateway( 'method' => $method,
5400 # 'invnum' => $cust_pay_pending->invnum,
5401 # 'payinfo' => $cust_pay_pending->payinfo,
5404 $options{payment_gateway} = $payment_gateway; # for the helper subs
5410 my @invoicing_list = $self->invoicing_list_emailonly;
5411 if ( $conf->exists('emailinvoiceautoalways')
5412 || $conf->exists('emailinvoiceauto') && ! @invoicing_list
5413 || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
5414 push @invoicing_list, $self->all_emails;
5417 my $email = ($conf->exists('business-onlinepayment-email-override'))
5418 ? $conf->config('business-onlinepayment-email-override')
5419 : $invoicing_list[0];
5423 $content{email_customer} =
5424 ( $conf->exists('business-onlinepayment-email_customer')
5425 || $conf->exists('business-onlinepayment-email-override') );
5428 # run transaction(s)
5432 new Business::OnlineThirdPartyPayment( $payment_gateway->gateway_module,
5433 $self->_bop_options(\%options),
5436 $transaction->reference({ %options });
5438 $transaction->content(
5440 $self->_bop_auth(\%options),
5441 'action' => 'Post Authorization',
5442 'description' => $options{'description'},
5443 'amount' => $cust_pay_pending->paid,
5444 #'invoice_number' => $options{'invnum'},
5445 'customer_id' => $self->custnum,
5446 'referer' => 'http://cleanwhisker.420.am/',
5447 'reference' => $cust_pay_pending->paypendingnum,
5449 'phone' => $self->daytime || $self->night,
5451 # plus whatever is required for bogus capture avoidance
5454 $transaction->submit();
5457 $self->_realtime_bop_result( $cust_pay_pending, $transaction, %options );
5460 bill_error => $error,
5461 session_id => $cust_pay_pending->session_id,
5466 =item default_payment_gateway DEPRECATED -- use agent->payment_gateway
5470 sub default_payment_gateway {
5471 my( $self, $method ) = @_;
5473 die "Real-time processing not enabled\n"
5474 unless $conf->exists('business-onlinepayment');
5476 #warn "default_payment_gateway deprecated -- use agent->payment_gateway\n";
5479 my $bop_config = 'business-onlinepayment';
5480 $bop_config .= '-ach'
5481 if $method =~ /^(ECHECK|CHEK)$/ && $conf->exists($bop_config. '-ach');
5482 my ( $processor, $login, $password, $action, @bop_options ) =
5483 $conf->config($bop_config);
5484 $action ||= 'normal authorization';
5485 pop @bop_options if scalar(@bop_options) % 2 && $bop_options[-1] =~ /^\s*$/;
5486 die "No real-time processor is enabled - ".
5487 "did you set the business-onlinepayment configuration value?\n"
5490 ( $processor, $login, $password, $action, @bop_options )
5495 Removes the I<paycvv> field from the database directly.
5497 If there is an error, returns the error, otherwise returns false.
5503 my $sth = dbh->prepare("UPDATE cust_main SET paycvv = '' WHERE custnum = ?")
5504 or return dbh->errstr;
5505 $sth->execute($self->custnum)
5506 or return $sth->errstr;
5511 =item _new_realtime_refund_bop METHOD [ OPTION => VALUE ... ]
5513 Refunds a realtime credit card, ACH (electronic check) or phone bill transaction
5514 via a Business::OnlinePayment realtime gateway. See
5515 L<http://420.am/business-onlinepayment> for supported gateways.
5517 Available methods are: I<CC>, I<ECHECK> and I<LEC>
5519 Available options are: I<amount>, I<reason>, I<paynum>, I<paydate>
5521 Most gateways require a reference to an original payment transaction to refund,
5522 so you probably need to specify a I<paynum>.
5524 I<amount> defaults to the original amount of the payment if not specified.
5526 I<reason> specifies a reason for the refund.
5528 I<paydate> specifies the expiration date for a credit card overriding the
5529 value from the customer record or the payment record. Specified as yyyy-mm-dd
5531 Implementation note: If I<amount> is unspecified or equal to the amount of the
5532 orignal payment, first an attempt is made to "void" the transaction via
5533 the gateway (to cancel a not-yet settled transaction) and then if that fails,
5534 the normal attempt is made to "refund" ("credit") the transaction via the
5535 gateway is attempted.
5537 #The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
5538 #I<zip>, I<payinfo> and I<paydate> are also available. Any of these options,
5539 #if set, will override the value from the customer record.
5541 #If an I<invnum> is specified, this payment (if successful) is applied to the
5542 #specified invoice. If you don't specify an I<invnum> you might want to
5543 #call the B<apply_payments> method.
5547 #some false laziness w/realtime_bop, not enough to make it worth merging
5548 #but some useful small subs should be pulled out
5549 sub _new_realtime_refund_bop {
5553 if (ref($_[0]) ne 'HASH') {
5554 %options = %{$_[0]};
5558 $options{method} = $method;
5562 warn "$me realtime_refund_bop (new): $options{method} refund\n";
5563 warn " $_ => $options{$_}\n" foreach keys %options;
5567 # look up the original payment and optionally a gateway for that payment
5571 my $amount = $options{'amount'};
5573 my( $processor, $login, $password, @bop_options, $namespace ) ;
5574 my( $auth, $order_number ) = ( '', '', '' );
5576 if ( $options{'paynum'} ) {
5578 warn " paynum: $options{paynum}\n" if $DEBUG > 1;
5579 $cust_pay = qsearchs('cust_pay', { paynum=>$options{'paynum'} } )
5580 or return "Unknown paynum $options{'paynum'}";
5581 $amount ||= $cust_pay->paid;
5583 $cust_pay->paybatch =~ /^((\d+)\-)?(\w+):\s*([\w\-\/ ]*)(:([\w\-]+))?$/
5584 or return "Can't parse paybatch for paynum $options{'paynum'}: ".
5585 $cust_pay->paybatch;
5586 my $gatewaynum = '';
5587 ( $gatewaynum, $processor, $auth, $order_number ) = ( $2, $3, $4, $6 );
5589 if ( $gatewaynum ) { #gateway for the payment to be refunded
5591 my $payment_gateway =
5592 qsearchs('payment_gateway', { 'gatewaynum' => $gatewaynum } );
5593 die "payment gateway $gatewaynum not found"
5594 unless $payment_gateway;
5596 $processor = $payment_gateway->gateway_module;
5597 $login = $payment_gateway->gateway_username;
5598 $password = $payment_gateway->gateway_password;
5599 $namespace = $payment_gateway->gateway_namespace;
5600 @bop_options = $payment_gateway->options;
5602 } else { #try the default gateway
5605 my $payment_gateway =
5606 $self->agent->payment_gateway('method' => $options{method});
5608 ( $conf_processor, $login, $password, $namespace ) =
5609 map { my $method = "gateway_$_"; $payment_gateway->$method }
5610 qw( module username password namespace );
5612 @bop_options = $payment_gateway->gatewaynum
5613 ? $payment_gateway->options
5614 : @{ $payment_gateway->get('options') };
5616 return "processor of payment $options{'paynum'} $processor does not".
5617 " match default processor $conf_processor"
5618 unless $processor eq $conf_processor;
5623 } else { # didn't specify a paynum, so look for agent gateway overrides
5624 # like a normal transaction
5626 my $payment_gateway =
5627 $self->agent->payment_gateway( 'method' => $options{method},
5628 #'payinfo' => $payinfo,
5630 my( $processor, $login, $password, $namespace ) =
5631 map { my $method = "gateway_$_"; $payment_gateway->$method }
5632 qw( module username password namespace );
5634 my @bop_options = $payment_gateway->gatewaynum
5635 ? $payment_gateway->options
5636 : @{ $payment_gateway->get('options') };
5639 return "neither amount nor paynum specified" unless $amount;
5641 eval "use $namespace";
5645 'type' => $options{method},
5647 'password' => $password,
5648 'order_number' => $order_number,
5649 'amount' => $amount,
5650 'referer' => 'http://cleanwhisker.420.am/', #XXX fix referer :/
5652 $content{authorization} = $auth
5653 if length($auth); #echeck/ACH transactions have an order # but no auth
5654 #(at least with authorize.net)
5656 my $disable_void_after;
5657 if ($conf->exists('disable_void_after')
5658 && $conf->config('disable_void_after') =~ /^(\d+)$/) {
5659 $disable_void_after = $1;
5662 #first try void if applicable
5663 if ( $cust_pay && $cust_pay->paid == $amount
5665 ( not defined($disable_void_after) )
5666 || ( time < ($cust_pay->_date + $disable_void_after ) )
5669 warn " attempting void\n" if $DEBUG > 1;
5670 my $void = new Business::OnlinePayment( $processor, @bop_options );
5671 $void->content( 'action' => 'void', %content );
5673 if ( $void->is_success ) {
5674 my $error = $cust_pay->void($options{'reason'});
5676 # gah, even with transactions.
5677 my $e = 'WARNING: Card/ACH voided but database not updated - '.
5678 "error voiding payment: $error";
5682 warn " void successful\n" if $DEBUG > 1;
5687 warn " void unsuccessful, trying refund\n"
5691 my $address = $self->address1;
5692 $address .= ", ". $self->address2 if $self->address2;
5694 my($payname, $payfirst, $paylast);
5695 if ( $self->payname && $options{method} ne 'ECHECK' ) {
5696 $payname = $self->payname;
5697 $payname =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
5698 or return "Illegal payname $payname";
5699 ($payfirst, $paylast) = ($1, $2);
5701 $payfirst = $self->getfield('first');
5702 $paylast = $self->getfield('last');
5703 $payname = "$payfirst $paylast";
5706 my @invoicing_list = $self->invoicing_list_emailonly;
5707 if ( $conf->exists('emailinvoiceautoalways')
5708 || $conf->exists('emailinvoiceauto') && ! @invoicing_list
5709 || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
5710 push @invoicing_list, $self->all_emails;
5713 my $email = ($conf->exists('business-onlinepayment-email-override'))
5714 ? $conf->config('business-onlinepayment-email-override')
5715 : $invoicing_list[0];
5717 my $payip = exists($options{'payip'})
5720 $content{customer_ip} = $payip
5724 if ( $options{method} eq 'CC' ) {
5727 $content{card_number} = $payinfo = $cust_pay->payinfo;
5728 (exists($options{'paydate'}) ? $options{'paydate'} : $cust_pay->paydate)
5729 =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/ &&
5730 ($content{expiration} = "$2/$1"); # where available
5732 $content{card_number} = $payinfo = $self->payinfo;
5733 (exists($options{'paydate'}) ? $options{'paydate'} : $self->paydate)
5734 =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
5735 $content{expiration} = "$2/$1";
5738 } elsif ( $options{method} eq 'ECHECK' ) {
5741 $payinfo = $cust_pay->payinfo;
5743 $payinfo = $self->payinfo;
5745 ( $content{account_number}, $content{routing_code} )= split('@', $payinfo );
5746 $content{bank_name} = $self->payname;
5747 $content{account_type} = 'CHECKING';
5748 $content{account_name} = $payname;
5749 $content{customer_org} = $self->company ? 'B' : 'I';
5750 $content{customer_ssn} = $self->ss;
5751 } elsif ( $options{method} eq 'LEC' ) {
5752 $content{phone} = $payinfo = $self->payinfo;
5756 my $refund = new Business::OnlinePayment( $processor, @bop_options );
5757 my %sub_content = $refund->content(
5758 'action' => 'credit',
5759 'customer_id' => $self->custnum,
5760 'last_name' => $paylast,
5761 'first_name' => $payfirst,
5763 'address' => $address,
5764 'city' => $self->city,
5765 'state' => $self->state,
5766 'zip' => $self->zip,
5767 'country' => $self->country,
5769 'phone' => $self->daytime || $self->night,
5772 warn join('', map { " $_ => $sub_content{$_}\n" } keys %sub_content )
5776 return "$processor error: ". $refund->error_message
5777 unless $refund->is_success();
5779 my $paybatch = "$processor:". $refund->authorization;
5780 $paybatch .= ':'. $refund->order_number
5781 if $refund->can('order_number') && $refund->order_number;
5783 while ( $cust_pay && $cust_pay->unapplied < $amount ) {
5784 my @cust_bill_pay = $cust_pay->cust_bill_pay;
5785 last unless @cust_bill_pay;
5786 my $cust_bill_pay = pop @cust_bill_pay;
5787 my $error = $cust_bill_pay->delete;
5791 my $cust_refund = new FS::cust_refund ( {
5792 'custnum' => $self->custnum,
5793 'paynum' => $options{'paynum'},
5794 'refund' => $amount,
5796 'payby' => $bop_method2payby{$options{method}},
5797 'payinfo' => $payinfo,
5798 'paybatch' => $paybatch,
5799 'reason' => $options{'reason'} || 'card or ACH refund',
5801 my $error = $cust_refund->insert;
5803 $cust_refund->paynum(''); #try again with no specific paynum
5804 my $error2 = $cust_refund->insert;
5806 # gah, even with transactions.
5807 my $e = 'WARNING: Card/ACH refunded but database not updated - '.
5808 "error inserting refund ($processor): $error2".
5809 " (previously tried insert with paynum #$options{'paynum'}" .
5820 =item batch_card OPTION => VALUE...
5822 Adds a payment for this invoice to the pending credit card batch (see
5823 L<FS::cust_pay_batch>), or, if the B<realtime> option is set to a true value,
5824 runs the payment using a realtime gateway.
5829 my ($self, %options) = @_;
5832 if (exists($options{amount})) {
5833 $amount = $options{amount};
5835 $amount = sprintf("%.2f", $self->balance - $self->in_transit_payments);
5837 return '' unless $amount > 0;
5839 my $invnum = delete $options{invnum};
5840 my $payby = $options{invnum} || $self->payby; #dubious
5842 if ($options{'realtime'}) {
5843 return $self->realtime_bop( FS::payby->payby2bop($self->payby),
5849 my $oldAutoCommit = $FS::UID::AutoCommit;
5850 local $FS::UID::AutoCommit = 0;
5853 #this needs to handle mysql as well as Pg, like svc_acct.pm
5854 #(make it into a common function if folks need to do batching with mysql)
5855 $dbh->do("LOCK TABLE pay_batch IN SHARE ROW EXCLUSIVE MODE")
5856 or return "Cannot lock pay_batch: " . $dbh->errstr;
5860 'payby' => FS::payby->payby2payment($payby),
5863 my $pay_batch = qsearchs( 'pay_batch', \%pay_batch );
5865 unless ( $pay_batch ) {
5866 $pay_batch = new FS::pay_batch \%pay_batch;
5867 my $error = $pay_batch->insert;
5869 $dbh->rollback if $oldAutoCommit;
5870 die "error creating new batch: $error\n";
5874 my $old_cust_pay_batch = qsearchs('cust_pay_batch', {
5875 'batchnum' => $pay_batch->batchnum,
5876 'custnum' => $self->custnum,
5879 foreach (qw( address1 address2 city state zip country payby payinfo paydate
5881 $options{$_} = '' unless exists($options{$_});
5884 my $cust_pay_batch = new FS::cust_pay_batch ( {
5885 'batchnum' => $pay_batch->batchnum,
5886 'invnum' => $invnum || 0, # is there a better value?
5887 # this field should be
5889 # cust_bill_pay_batch now
5890 'custnum' => $self->custnum,
5891 'last' => $self->getfield('last'),
5892 'first' => $self->getfield('first'),
5893 'address1' => $options{address1} || $self->address1,
5894 'address2' => $options{address2} || $self->address2,
5895 'city' => $options{city} || $self->city,
5896 'state' => $options{state} || $self->state,
5897 'zip' => $options{zip} || $self->zip,
5898 'country' => $options{country} || $self->country,
5899 'payby' => $options{payby} || $self->payby,
5900 'payinfo' => $options{payinfo} || $self->payinfo,
5901 'exp' => $options{paydate} || $self->paydate,
5902 'payname' => $options{payname} || $self->payname,
5903 'amount' => $amount, # consolidating
5906 $cust_pay_batch->paybatchnum($old_cust_pay_batch->paybatchnum)
5907 if $old_cust_pay_batch;
5910 if ($old_cust_pay_batch) {
5911 $error = $cust_pay_batch->replace($old_cust_pay_batch)
5913 $error = $cust_pay_batch->insert;
5917 $dbh->rollback if $oldAutoCommit;
5921 my $unapplied = $self->total_unapplied_credits
5922 + $self->total_unapplied_payments
5923 + $self->in_transit_payments;
5924 foreach my $cust_bill ($self->open_cust_bill) {
5925 #$dbh->commit or die $dbh->errstr if $oldAutoCommit;
5926 my $cust_bill_pay_batch = new FS::cust_bill_pay_batch {
5927 'invnum' => $cust_bill->invnum,
5928 'paybatchnum' => $cust_pay_batch->paybatchnum,
5929 'amount' => $cust_bill->owed,
5932 if ($unapplied >= $cust_bill_pay_batch->amount){
5933 $unapplied -= $cust_bill_pay_batch->amount;
5936 $cust_bill_pay_batch->amount(sprintf ( "%.2f",
5937 $cust_bill_pay_batch->amount - $unapplied )); $unapplied = 0;
5939 $error = $cust_bill_pay_batch->insert;
5941 $dbh->rollback if $oldAutoCommit;
5946 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
5950 =item apply_payments_and_credits
5952 Applies unapplied payments and credits.
5954 In most cases, this new method should be used in place of sequential
5955 apply_payments and apply_credits methods.
5957 If there is an error, returns the error, otherwise returns false.
5961 sub apply_payments_and_credits {
5964 local $SIG{HUP} = 'IGNORE';
5965 local $SIG{INT} = 'IGNORE';
5966 local $SIG{QUIT} = 'IGNORE';
5967 local $SIG{TERM} = 'IGNORE';
5968 local $SIG{TSTP} = 'IGNORE';
5969 local $SIG{PIPE} = 'IGNORE';
5971 my $oldAutoCommit = $FS::UID::AutoCommit;
5972 local $FS::UID::AutoCommit = 0;
5975 $self->select_for_update; #mutex
5977 foreach my $cust_bill ( $self->open_cust_bill ) {
5978 my $error = $cust_bill->apply_payments_and_credits;
5980 $dbh->rollback if $oldAutoCommit;
5981 return "Error applying: $error";
5985 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
5990 =item apply_credits OPTION => VALUE ...
5992 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
5993 to outstanding invoice balances in chronological order (or reverse
5994 chronological order if the I<order> option is set to B<newest>) and returns the
5995 value of any remaining unapplied credits available for refund (see
5996 L<FS::cust_refund>).
5998 Dies if there is an error.
6006 local $SIG{HUP} = 'IGNORE';
6007 local $SIG{INT} = 'IGNORE';
6008 local $SIG{QUIT} = 'IGNORE';
6009 local $SIG{TERM} = 'IGNORE';
6010 local $SIG{TSTP} = 'IGNORE';
6011 local $SIG{PIPE} = 'IGNORE';
6013 my $oldAutoCommit = $FS::UID::AutoCommit;
6014 local $FS::UID::AutoCommit = 0;
6017 $self->select_for_update; #mutex
6019 unless ( $self->total_unapplied_credits ) {
6020 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
6024 my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
6025 qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
6027 my @invoices = $self->open_cust_bill;
6028 @invoices = sort { $b->_date <=> $a->_date } @invoices
6029 if defined($opt{'order'}) && $opt{'order'} eq 'newest';
6032 foreach my $cust_bill ( @invoices ) {
6035 if ( !defined($credit) || $credit->credited == 0) {
6036 $credit = pop @credits or last;
6039 if ($cust_bill->owed >= $credit->credited) {
6040 $amount=$credit->credited;
6042 $amount=$cust_bill->owed;
6045 my $cust_credit_bill = new FS::cust_credit_bill ( {
6046 'crednum' => $credit->crednum,
6047 'invnum' => $cust_bill->invnum,
6048 'amount' => $amount,
6050 my $error = $cust_credit_bill->insert;
6052 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
6056 redo if ($cust_bill->owed > 0);
6060 my $total_unapplied_credits = $self->total_unapplied_credits;
6062 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
6064 return $total_unapplied_credits;
6067 =item apply_payments
6069 Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
6070 to outstanding invoice balances in chronological order.
6072 #and returns the value of any remaining unapplied payments.
6074 Dies if there is an error.
6078 sub apply_payments {
6081 local $SIG{HUP} = 'IGNORE';
6082 local $SIG{INT} = 'IGNORE';
6083 local $SIG{QUIT} = 'IGNORE';
6084 local $SIG{TERM} = 'IGNORE';
6085 local $SIG{TSTP} = 'IGNORE';
6086 local $SIG{PIPE} = 'IGNORE';
6088 my $oldAutoCommit = $FS::UID::AutoCommit;
6089 local $FS::UID::AutoCommit = 0;
6092 $self->select_for_update; #mutex
6096 my @payments = sort { $b->_date <=> $a->_date }
6097 grep { $_->unapplied > 0 }
6100 my @invoices = sort { $a->_date <=> $b->_date}
6101 grep { $_->owed > 0 }
6106 foreach my $cust_bill ( @invoices ) {
6109 if ( !defined($payment) || $payment->unapplied == 0 ) {
6110 $payment = pop @payments or last;
6113 if ( $cust_bill->owed >= $payment->unapplied ) {
6114 $amount = $payment->unapplied;
6116 $amount = $cust_bill->owed;
6119 my $cust_bill_pay = new FS::cust_bill_pay ( {
6120 'paynum' => $payment->paynum,
6121 'invnum' => $cust_bill->invnum,
6122 'amount' => $amount,
6124 my $error = $cust_bill_pay->insert;
6126 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
6130 redo if ( $cust_bill->owed > 0);
6134 my $total_unapplied_payments = $self->total_unapplied_payments;
6136 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
6138 return $total_unapplied_payments;
6143 Returns the total owed for this customer on all invoices
6144 (see L<FS::cust_bill/owed>).
6150 $self->total_owed_date(2145859200); #12/31/2037
6153 =item total_owed_date TIME
6155 Returns the total owed for this customer on all invoices with date earlier than
6156 TIME. TIME is specified as a UNIX timestamp; see L<perlfunc/"time">). Also
6157 see L<Time::Local> and L<Date::Parse> for conversion functions.
6161 sub total_owed_date {
6165 # my $custnum = $self->custnum;
6167 # my $owed_sql = FS::cust_bill->owed_sql;
6170 # SELECT SUM($owed_sql) FROM cust_bill
6171 # WHERE custnum = $custnum
6172 # AND _date <= $time
6175 # my $sth = dbh->prepare($sql) or die dbh->errstr;
6176 # $sth->execute() or die $sth->errstr;
6178 # return sprintf( '%.2f', $sth->fetchrow_arrayref->[0] );
6181 foreach my $cust_bill (
6182 grep { $_->_date <= $time }
6183 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
6185 $total_bill += $cust_bill->owed;
6187 sprintf( "%.2f", $total_bill );
6193 Returns the total amount of all payments.
6200 $total += $_->paid foreach $self->cust_pay;
6201 sprintf( "%.2f", $total );
6204 =item total_unapplied_credits
6206 Returns the total outstanding credit (see L<FS::cust_credit>) for this
6207 customer. See L<FS::cust_credit/credited>.
6209 =item total_credited
6211 Old name for total_unapplied_credits. Don't use.
6215 sub total_credited {
6216 #carp "total_credited deprecated, use total_unapplied_credits";
6217 shift->total_unapplied_credits(@_);
6220 sub total_unapplied_credits {
6222 my $total_credit = 0;
6223 $total_credit += $_->credited foreach $self->cust_credit;
6224 sprintf( "%.2f", $total_credit );
6227 =item total_unapplied_payments
6229 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
6230 See L<FS::cust_pay/unapplied>.
6234 sub total_unapplied_payments {
6236 my $total_unapplied = 0;
6237 $total_unapplied += $_->unapplied foreach $self->cust_pay;
6238 sprintf( "%.2f", $total_unapplied );
6241 =item total_unapplied_refunds
6243 Returns the total unrefunded refunds (see L<FS::cust_refund>) for this
6244 customer. See L<FS::cust_refund/unapplied>.
6248 sub total_unapplied_refunds {
6250 my $total_unapplied = 0;
6251 $total_unapplied += $_->unapplied foreach $self->cust_refund;
6252 sprintf( "%.2f", $total_unapplied );
6257 Returns the balance for this customer (total_owed plus total_unrefunded, minus
6258 total_unapplied_credits minus total_unapplied_payments).
6266 + $self->total_unapplied_refunds
6267 - $self->total_unapplied_credits
6268 - $self->total_unapplied_payments
6272 =item balance_date TIME
6274 Returns the balance for this customer, only considering invoices with date
6275 earlier than TIME (total_owed_date minus total_credited minus
6276 total_unapplied_payments). TIME is specified as a UNIX timestamp; see
6277 L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion
6286 $self->total_owed_date($time)
6287 + $self->total_unapplied_refunds
6288 - $self->total_unapplied_credits
6289 - $self->total_unapplied_payments
6293 =item in_transit_payments
6295 Returns the total of requests for payments for this customer pending in
6296 batches in transit to the bank. See L<FS::pay_batch> and L<FS::cust_pay_batch>
6300 sub in_transit_payments {
6302 my $in_transit_payments = 0;
6303 foreach my $pay_batch ( qsearch('pay_batch', {
6306 foreach my $cust_pay_batch ( qsearch('cust_pay_batch', {
6307 'batchnum' => $pay_batch->batchnum,
6308 'custnum' => $self->custnum,
6310 $in_transit_payments += $cust_pay_batch->amount;
6313 sprintf( "%.2f", $in_transit_payments );
6318 Returns a hash of useful information for making a payment.
6328 'CARD' (credit card - automatic), 'DCRD' (credit card - on-demand),
6329 'CHEK' (electronic check - automatic), 'DCHK' (electronic check - on-demand),
6330 'LECB' (Phone bill billing), 'BILL' (billing), or 'COMP' (free).
6334 For credit card transactions:
6346 For electronic check transactions:
6361 $return{balance} = $self->balance;
6363 $return{payname} = $self->payname
6364 || ( $self->first. ' '. $self->get('last') );
6366 $return{$_} = $self->get($_) for qw(address1 address2 city state zip);
6368 $return{payby} = $self->payby;
6369 $return{stateid_state} = $self->stateid_state;
6371 if ( $self->payby =~ /^(CARD|DCRD)$/ ) {
6372 $return{card_type} = cardtype($self->payinfo);
6373 $return{payinfo} = $self->paymask;
6375 @return{'month', 'year'} = $self->paydate_monthyear;
6379 if ( $self->payby =~ /^(CHEK|DCHK)$/ ) {
6380 my ($payinfo1, $payinfo2) = split '@', $self->paymask;
6381 $return{payinfo1} = $payinfo1;
6382 $return{payinfo2} = $payinfo2;
6383 $return{paytype} = $self->paytype;
6384 $return{paystate} = $self->paystate;
6388 #doubleclick protection
6390 $return{paybatch} = "webui-MyAccount-$_date-$$-". rand() * 2**32;
6396 =item paydate_monthyear
6398 Returns a two-element list consisting of the month and year of this customer's
6399 paydate (credit card expiration date for CARD customers)
6403 sub paydate_monthyear {
6405 if ( $self->paydate =~ /^(\d{4})-(\d{1,2})-\d{1,2}$/ ) { #Pg date format
6407 } elsif ( $self->paydate =~ /^(\d{1,2})-(\d{1,2}-)?(\d{4}$)/ ) {
6414 =item tax_exemption TAXNAME
6419 my( $self, $taxname ) = @_;
6421 qsearchs( 'cust_main_exemption', { 'custnum' => $self->custnum,
6422 'taxname' => $taxname,
6427 =item cust_main_exemption
6431 sub cust_main_exemption {
6433 qsearch( 'cust_main_exemption', { 'custnum' => $self->custnum } );
6436 =item invoicing_list [ ARRAYREF ]
6438 If an arguement is given, sets these email addresses as invoice recipients
6439 (see L<FS::cust_main_invoice>). Errors are not fatal and are not reported
6440 (except as warnings), so use check_invoicing_list first.
6442 Returns a list of email addresses (with svcnum entries expanded).
6444 Note: You can clear the invoicing list by passing an empty ARRAYREF. You can
6445 check it without disturbing anything by passing nothing.
6447 This interface may change in the future.
6451 sub invoicing_list {
6452 my( $self, $arrayref ) = @_;
6455 my @cust_main_invoice;
6456 if ( $self->custnum ) {
6457 @cust_main_invoice =
6458 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
6460 @cust_main_invoice = ();
6462 foreach my $cust_main_invoice ( @cust_main_invoice ) {
6463 #warn $cust_main_invoice->destnum;
6464 unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
6465 #warn $cust_main_invoice->destnum;
6466 my $error = $cust_main_invoice->delete;
6467 warn $error if $error;
6470 if ( $self->custnum ) {
6471 @cust_main_invoice =
6472 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
6474 @cust_main_invoice = ();
6476 my %seen = map { $_->address => 1 } @cust_main_invoice;
6477 foreach my $address ( @{$arrayref} ) {
6478 next if exists $seen{$address} && $seen{$address};
6479 $seen{$address} = 1;
6480 my $cust_main_invoice = new FS::cust_main_invoice ( {
6481 'custnum' => $self->custnum,
6484 my $error = $cust_main_invoice->insert;
6485 warn $error if $error;
6489 if ( $self->custnum ) {
6491 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
6498 =item check_invoicing_list ARRAYREF
6500 Checks these arguements as valid input for the invoicing_list method. If there
6501 is an error, returns the error, otherwise returns false.
6505 sub check_invoicing_list {
6506 my( $self, $arrayref ) = @_;
6508 foreach my $address ( @$arrayref ) {
6510 if ($address eq 'FAX' and $self->getfield('fax') eq '') {
6511 return 'Can\'t add FAX invoice destination with a blank FAX number.';
6514 my $cust_main_invoice = new FS::cust_main_invoice ( {
6515 'custnum' => $self->custnum,
6518 my $error = $self->custnum
6519 ? $cust_main_invoice->check
6520 : $cust_main_invoice->checkdest
6522 return $error if $error;
6526 return "Email address required"
6527 if $conf->exists('cust_main-require_invoicing_list_email')
6528 && ! grep { $_ !~ /^([A-Z]+)$/ } @$arrayref;
6533 =item set_default_invoicing_list
6535 Sets the invoicing list to all accounts associated with this customer,
6536 overwriting any previous invoicing list.
6540 sub set_default_invoicing_list {
6542 $self->invoicing_list($self->all_emails);
6547 Returns the email addresses of all accounts provisioned for this customer.
6554 foreach my $cust_pkg ( $self->all_pkgs ) {
6555 my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
6557 map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
6558 grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
6560 $list{$_}=1 foreach map { $_->email } @svc_acct;
6565 =item invoicing_list_addpost
6567 Adds postal invoicing to this customer. If this customer is already configured
6568 to receive postal invoices, does nothing.
6572 sub invoicing_list_addpost {
6574 return if grep { $_ eq 'POST' } $self->invoicing_list;
6575 my @invoicing_list = $self->invoicing_list;
6576 push @invoicing_list, 'POST';
6577 $self->invoicing_list(\@invoicing_list);
6580 =item invoicing_list_emailonly
6582 Returns the list of email invoice recipients (invoicing_list without non-email
6583 destinations such as POST and FAX).
6587 sub invoicing_list_emailonly {
6589 warn "$me invoicing_list_emailonly called"
6591 grep { $_ !~ /^([A-Z]+)$/ } $self->invoicing_list;
6594 =item invoicing_list_emailonly_scalar
6596 Returns the list of email invoice recipients (invoicing_list without non-email
6597 destinations such as POST and FAX) as a comma-separated scalar.
6601 sub invoicing_list_emailonly_scalar {
6603 warn "$me invoicing_list_emailonly_scalar called"
6605 join(', ', $self->invoicing_list_emailonly);
6608 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
6610 Returns an array of customers referred by this customer (referral_custnum set
6611 to this custnum). If DEPTH is given, recurses up to the given depth, returning
6612 customers referred by customers referred by this customer and so on, inclusive.
6613 The default behavior is DEPTH 1 (no recursion).
6617 sub referral_cust_main {
6619 my $depth = @_ ? shift : 1;
6620 my $exclude = @_ ? shift : {};
6623 map { $exclude->{$_->custnum}++; $_; }
6624 grep { ! $exclude->{ $_->custnum } }
6625 qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
6629 map { $_->referral_cust_main($depth-1, $exclude) }
6636 =item referral_cust_main_ncancelled
6638 Same as referral_cust_main, except only returns customers with uncancelled
6643 sub referral_cust_main_ncancelled {
6645 grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
6648 =item referral_cust_pkg [ DEPTH ]
6650 Like referral_cust_main, except returns a flat list of all unsuspended (and
6651 uncancelled) packages for each customer. The number of items in this list may
6652 be useful for comission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
6656 sub referral_cust_pkg {
6658 my $depth = @_ ? shift : 1;
6660 map { $_->unsuspended_pkgs }
6661 grep { $_->unsuspended_pkgs }
6662 $self->referral_cust_main($depth);
6665 =item referring_cust_main
6667 Returns the single cust_main record for the customer who referred this customer
6668 (referral_custnum), or false.
6672 sub referring_cust_main {
6674 return '' unless $self->referral_custnum;
6675 qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
6678 =item credit AMOUNT, REASON [ , OPTION => VALUE ... ]
6680 Applies a credit to this customer. If there is an error, returns the error,
6681 otherwise returns false.
6683 REASON can be a text string, an FS::reason object, or a scalar reference to
6684 a reasonnum. If a text string, it will be automatically inserted as a new
6685 reason, and a 'reason_type' option must be passed to indicate the
6686 FS::reason_type for the new reason.
6688 An I<addlinfo> option may be passed to set the credit's I<addlinfo> field.
6690 Any other options are passed to FS::cust_credit::insert.
6695 my( $self, $amount, $reason, %options ) = @_;
6697 my $cust_credit = new FS::cust_credit {
6698 'custnum' => $self->custnum,
6699 'amount' => $amount,
6702 if ( ref($reason) ) {
6704 if ( ref($reason) eq 'SCALAR' ) {
6705 $cust_credit->reasonnum( $$reason );
6707 $cust_credit->reasonnum( $reason->reasonnum );
6711 $cust_credit->set('reason', $reason)
6714 $cust_credit->addlinfo( delete $options{'addlinfo'} )
6715 if exists($options{'addlinfo'});
6717 $cust_credit->insert(%options);
6721 =item charge AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
6723 Creates a one-time charge for this customer. If there is an error, returns
6724 the error, otherwise returns false.
6730 my ( $amount, $quantity, $pkg, $comment, $classnum, $additional );
6731 my ( $setuptax, $taxclass ); #internal taxes
6732 my ( $taxproduct, $override ); #vendor (CCH) taxes
6733 if ( ref( $_[0] ) ) {
6734 $amount = $_[0]->{amount};
6735 $quantity = exists($_[0]->{quantity}) ? $_[0]->{quantity} : 1;
6736 $pkg = exists($_[0]->{pkg}) ? $_[0]->{pkg} : 'One-time charge';
6737 $comment = exists($_[0]->{comment}) ? $_[0]->{comment}
6738 : '$'. sprintf("%.2f",$amount);
6739 $setuptax = exists($_[0]->{setuptax}) ? $_[0]->{setuptax} : '';
6740 $taxclass = exists($_[0]->{taxclass}) ? $_[0]->{taxclass} : '';
6741 $classnum = exists($_[0]->{classnum}) ? $_[0]->{classnum} : '';
6742 $additional = $_[0]->{additional};
6743 $taxproduct = $_[0]->{taxproductnum};
6744 $override = { '' => $_[0]->{tax_override} };
6748 $pkg = @_ ? shift : 'One-time charge';
6749 $comment = @_ ? shift : '$'. sprintf("%.2f",$amount);
6751 $taxclass = @_ ? shift : '';
6755 local $SIG{HUP} = 'IGNORE';
6756 local $SIG{INT} = 'IGNORE';
6757 local $SIG{QUIT} = 'IGNORE';
6758 local $SIG{TERM} = 'IGNORE';
6759 local $SIG{TSTP} = 'IGNORE';
6760 local $SIG{PIPE} = 'IGNORE';
6762 my $oldAutoCommit = $FS::UID::AutoCommit;
6763 local $FS::UID::AutoCommit = 0;
6766 my $part_pkg = new FS::part_pkg ( {
6768 'comment' => $comment,
6772 'classnum' => $classnum ? $classnum : '',
6773 'setuptax' => $setuptax,
6774 'taxclass' => $taxclass,
6775 'taxproductnum' => $taxproduct,
6778 my %options = ( ( map { ("additional_info$_" => $additional->[$_] ) }
6779 ( 0 .. @$additional - 1 )
6781 'additional_count' => scalar(@$additional),
6782 'setup_fee' => $amount,
6785 my $error = $part_pkg->insert( options => \%options,
6786 tax_overrides => $override,
6789 $dbh->rollback if $oldAutoCommit;
6793 my $pkgpart = $part_pkg->pkgpart;
6794 my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
6795 unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
6796 my $type_pkgs = new FS::type_pkgs \%type_pkgs;
6797 $error = $type_pkgs->insert;
6799 $dbh->rollback if $oldAutoCommit;
6804 my $cust_pkg = new FS::cust_pkg ( {
6805 'custnum' => $self->custnum,
6806 'pkgpart' => $pkgpart,
6807 'quantity' => $quantity,
6810 $error = $cust_pkg->insert;
6812 $dbh->rollback if $oldAutoCommit;
6816 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
6821 #=item charge_postal_fee
6823 #Applies a one time charge this customer. If there is an error,
6824 #returns the error, returns the cust_pkg charge object or false
6825 #if there was no charge.
6829 # This should be a customer event. For that to work requires that bill
6830 # also be a customer event.
6832 sub charge_postal_fee {
6835 my $pkgpart = $conf->config('postal_invoice-fee_pkgpart');
6836 return '' unless ($pkgpart && grep { $_ eq 'POST' } $self->invoicing_list);
6838 my $cust_pkg = new FS::cust_pkg ( {
6839 'custnum' => $self->custnum,
6840 'pkgpart' => $pkgpart,
6844 my $error = $cust_pkg->insert;
6845 $error ? $error : $cust_pkg;
6850 Returns all the invoices (see L<FS::cust_bill>) for this customer.
6856 sort { $a->_date <=> $b->_date }
6857 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
6860 =item open_cust_bill
6862 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
6867 sub open_cust_bill {
6871 'table' => 'cust_bill',
6872 'hashref' => { 'custnum' => $self->custnum, },
6873 'extra_sql' => ' AND '. FS::cust_bill->owed_sql. ' > 0',
6874 'order_by' => 'ORDER BY _date ASC',
6881 Returns all the credits (see L<FS::cust_credit>) for this customer.
6887 sort { $a->_date <=> $b->_date }
6888 qsearch( 'cust_credit', { 'custnum' => $self->custnum } )
6893 Returns all the payments (see L<FS::cust_pay>) for this customer.
6899 sort { $a->_date <=> $b->_date }
6900 qsearch( 'cust_pay', { 'custnum' => $self->custnum } )
6905 Returns all voided payments (see L<FS::cust_pay_void>) for this customer.
6911 sort { $a->_date <=> $b->_date }
6912 qsearch( 'cust_pay_void', { 'custnum' => $self->custnum } )
6915 =item cust_pay_batch
6917 Returns all batched payments (see L<FS::cust_pay_void>) for this customer.
6921 sub cust_pay_batch {
6923 sort { $a->paybatchnum <=> $b->paybatchnum }
6924 qsearch( 'cust_pay_batch', { 'custnum' => $self->custnum } )
6927 =item cust_pay_pending
6929 Returns all pending payments (see L<FS::cust_pay_pending>) for this customer
6930 (without status "done").
6934 sub cust_pay_pending {
6936 return $self->num_cust_pay_pending unless wantarray;
6937 sort { $a->_date <=> $b->_date }
6938 qsearch( 'cust_pay_pending', {
6939 'custnum' => $self->custnum,
6940 'status' => { op=>'!=', value=>'done' },
6945 =item num_cust_pay_pending
6947 Returns the number of pending payments (see L<FS::cust_pay_pending>) for this
6948 customer (without status "done"). Also called automatically when the
6949 cust_pay_pending method is used in a scalar context.
6953 sub num_cust_pay_pending {
6955 my $sql = " SELECT COUNT(*) FROM cust_pay_pending ".
6956 " WHERE custnum = ? AND status != 'done' ";
6957 my $sth = dbh->prepare($sql) or die dbh->errstr;
6958 $sth->execute($self->custnum) or die $sth->errstr;
6959 $sth->fetchrow_arrayref->[0];
6964 Returns all the refunds (see L<FS::cust_refund>) for this customer.
6970 sort { $a->_date <=> $b->_date }
6971 qsearch( 'cust_refund', { 'custnum' => $self->custnum } )
6974 =item display_custnum
6976 Returns the displayed customer number for this customer: agent_custid if
6977 cust_main-default_agent_custid is set and it has a value, custnum otherwise.
6981 sub display_custnum {
6983 if ( $conf->exists('cust_main-default_agent_custid') && $self->agent_custid ){
6984 return $self->agent_custid;
6986 return $self->custnum;
6992 Returns a name string for this customer, either "Company (Last, First)" or
6999 my $name = $self->contact;
7000 $name = $self->company. " ($name)" if $self->company;
7006 Returns a name string for this (service/shipping) contact, either
7007 "Company (Last, First)" or "Last, First".
7013 if ( $self->get('ship_last') ) {
7014 my $name = $self->ship_contact;
7015 $name = $self->ship_company. " ($name)" if $self->ship_company;
7024 Returns a name string for this customer, either "Company" or "First Last".
7030 $self->company !~ /^\s*$/ ? $self->company : $self->contact_firstlast;
7033 =item ship_name_short
7035 Returns a name string for this (service/shipping) contact, either "Company"
7040 sub ship_name_short {
7042 if ( $self->get('ship_last') ) {
7043 $self->ship_company !~ /^\s*$/
7044 ? $self->ship_company
7045 : $self->ship_contact_firstlast;
7047 $self->name_company_or_firstlast;
7053 Returns this customer's full (billing) contact name only, "Last, First"
7059 $self->get('last'). ', '. $self->first;
7064 Returns this customer's full (shipping) contact name only, "Last, First"
7070 $self->get('ship_last')
7071 ? $self->get('ship_last'). ', '. $self->ship_first
7075 =item contact_firstlast
7077 Returns this customers full (billing) contact name only, "First Last".
7081 sub contact_firstlast {
7083 $self->first. ' '. $self->get('last');
7086 =item ship_contact_firstlast
7088 Returns this customer's full (shipping) contact name only, "First Last".
7092 sub ship_contact_firstlast {
7094 $self->get('ship_last')
7095 ? $self->first. ' '. $self->get('ship_last')
7096 : $self->contact_firstlast;
7101 Returns this customer's full country name
7107 code2country($self->country);
7110 =item geocode DATA_VENDOR
7112 Returns a value for the customer location as encoded by DATA_VENDOR.
7113 Currently this only makes sense for "CCH" as DATA_VENDOR.
7118 my ($self, $data_vendor) = (shift, shift); #always cch for now
7120 my $geocode = $self->get('geocode'); #XXX only one data_vendor for geocode
7121 return $geocode if $geocode;
7123 my $prefix = ( $conf->exists('tax-ship_address') && length($self->ship_last) )
7127 my ($zip,$plus4) = split /-/, $self->get("${prefix}zip")
7128 if $self->country eq 'US';
7130 #CCH specific location stuff
7131 my $extra_sql = "AND plus4lo <= '$plus4' AND plus4hi >= '$plus4'";
7133 my @cust_tax_location =
7135 'table' => 'cust_tax_location',
7136 'hashref' => { 'zip' => $zip, 'data_vendor' => $data_vendor },
7137 'extra_sql' => $extra_sql,
7138 'order_by' => 'ORDER BY plus4hi',#overlapping with distinct ends
7141 $geocode = $cust_tax_location[0]->geocode
7142 if scalar(@cust_tax_location);
7151 Returns a status string for this customer, currently:
7155 =item prospect - No packages have ever been ordered
7157 =item active - One or more recurring packages is active
7159 =item inactive - No active recurring packages, but otherwise unsuspended/uncancelled (the inactive status is new - previously inactive customers were mis-identified as cancelled)
7161 =item suspended - All non-cancelled recurring packages are suspended
7163 =item cancelled - All recurring packages are cancelled
7169 sub status { shift->cust_status(@_); }
7173 for my $status (qw( prospect active inactive suspended cancelled )) {
7174 my $method = $status.'_sql';
7175 my $numnum = ( my $sql = $self->$method() ) =~ s/cust_main\.custnum/?/g;
7176 my $sth = dbh->prepare("SELECT $sql") or die dbh->errstr;
7177 $sth->execute( ($self->custnum) x $numnum )
7178 or die "Error executing 'SELECT $sql': ". $sth->errstr;
7179 return $status if $sth->fetchrow_arrayref->[0];
7183 =item ucfirst_cust_status
7185 =item ucfirst_status
7187 Returns the status with the first character capitalized.
7191 sub ucfirst_status { shift->ucfirst_cust_status(@_); }
7193 sub ucfirst_cust_status {
7195 ucfirst($self->cust_status);
7200 Returns a hex triplet color string for this customer's status.
7204 use vars qw(%statuscolor);
7205 tie %statuscolor, 'Tie::IxHash',
7206 'prospect' => '7e0079', #'000000', #black? naw, purple
7207 'active' => '00CC00', #green
7208 'inactive' => '0000CC', #blue
7209 'suspended' => 'FF9900', #yellow
7210 'cancelled' => 'FF0000', #red
7213 sub statuscolor { shift->cust_statuscolor(@_); }
7215 sub cust_statuscolor {
7217 $statuscolor{$self->cust_status};
7222 Returns an array of hashes representing the customer's RT tickets.
7229 my $num = $conf->config('cust_main-max_tickets') || 10;
7232 if ( $conf->config('ticket_system') ) {
7233 unless ( $conf->config('ticket_system-custom_priority_field') ) {
7235 @tickets = @{ FS::TicketSystem->customer_tickets($self->custnum, $num) };
7239 foreach my $priority (
7240 $conf->config('ticket_system-custom_priority_field-values'), ''
7242 last if scalar(@tickets) >= $num;
7244 @{ FS::TicketSystem->customer_tickets( $self->custnum,
7245 $num - scalar(@tickets),
7255 # Return services representing svc_accts in customer support packages
7256 sub support_services {
7258 my %packages = map { $_ => 1 } $conf->config('support_packages');
7260 grep { $_->pkg_svc && $_->pkg_svc->primary_svc eq 'Y' }
7261 grep { $_->part_svc->svcdb eq 'svc_acct' }
7262 map { $_->cust_svc }
7263 grep { exists $packages{ $_->pkgpart } }
7264 $self->ncancelled_pkgs;
7270 =head1 CLASS METHODS
7276 Class method that returns the list of possible status strings for customers
7277 (see L<the status method|/status>). For example:
7279 @statuses = FS::cust_main->statuses();
7284 #my $self = shift; #could be class...
7290 Returns an SQL expression identifying prospective cust_main records (customers
7291 with no packages ever ordered)
7295 use vars qw($select_count_pkgs);
7296 $select_count_pkgs =
7297 "SELECT COUNT(*) FROM cust_pkg
7298 WHERE cust_pkg.custnum = cust_main.custnum";
7300 sub select_count_pkgs_sql {
7304 sub prospect_sql { "
7305 0 = ( $select_count_pkgs )
7310 Returns an SQL expression identifying active cust_main records (customers with
7311 active recurring packages).
7316 0 < ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. "
7322 Returns an SQL expression identifying inactive cust_main records (customers with
7323 no active recurring packages, but otherwise unsuspended/uncancelled).
7327 sub inactive_sql { "
7328 0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " )
7330 0 < ( $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " )
7336 Returns an SQL expression identifying suspended cust_main records.
7341 sub suspended_sql { susp_sql(@_); }
7343 0 < ( $select_count_pkgs AND ". FS::cust_pkg->suspended_sql. " )
7345 0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " )
7351 Returns an SQL expression identifying cancelled cust_main records.
7355 sub cancelled_sql { cancel_sql(@_); }
7358 my $recurring_sql = FS::cust_pkg->recurring_sql;
7359 my $cancelled_sql = FS::cust_pkg->cancelled_sql;
7362 0 < ( $select_count_pkgs )
7363 AND 0 < ( $select_count_pkgs AND $recurring_sql AND $cancelled_sql )
7364 AND 0 = ( $select_count_pkgs AND $recurring_sql
7365 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
7367 AND 0 = ( $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " )
7373 =item uncancelled_sql
7375 Returns an SQL expression identifying un-cancelled cust_main records.
7379 sub uncancelled_sql { uncancel_sql(@_); }
7380 sub uncancel_sql { "
7381 ( 0 < ( $select_count_pkgs
7382 AND ( cust_pkg.cancel IS NULL
7383 OR cust_pkg.cancel = 0
7386 OR 0 = ( $select_count_pkgs )
7392 Returns an SQL fragment to retreive the balance.
7397 ( SELECT COALESCE( SUM(charged), 0 ) FROM cust_bill
7398 WHERE cust_bill.custnum = cust_main.custnum )
7399 - ( SELECT COALESCE( SUM(paid), 0 ) FROM cust_pay
7400 WHERE cust_pay.custnum = cust_main.custnum )
7401 - ( SELECT COALESCE( SUM(amount), 0 ) FROM cust_credit
7402 WHERE cust_credit.custnum = cust_main.custnum )
7403 + ( SELECT COALESCE( SUM(refund), 0 ) FROM cust_refund
7404 WHERE cust_refund.custnum = cust_main.custnum )
7407 =item balance_date_sql START_TIME [ END_TIME [ OPTION => VALUE ... ] ]
7409 Returns an SQL fragment to retreive the balance for this customer, only
7410 considering invoices with date earlier than START_TIME, and optionally not
7411 later than END_TIME (total_owed_date minus total_unapplied_credits minus
7412 total_unapplied_payments).
7414 Times are specified as SQL fragments or numeric
7415 UNIX timestamps; see L<perlfunc/"time">). Also see L<Time::Local> and
7416 L<Date::Parse> for conversion functions. The empty string can be passed
7417 to disable that time constraint completely.
7419 Available options are:
7423 =item unapplied_date
7425 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)
7430 set to true to remove all customer comparison clauses, for totals
7435 WHERE clause hashref (elements "AND"ed together) (typically used with the total option)
7440 JOIN clause (typically used with the total option)
7446 sub balance_date_sql {
7447 my( $class, $start, $end, %opt ) = @_;
7449 my $owed = FS::cust_bill->owed_sql;
7450 my $unapp_refund = FS::cust_refund->unapplied_sql;
7451 my $unapp_credit = FS::cust_credit->unapplied_sql;
7452 my $unapp_pay = FS::cust_pay->unapplied_sql;
7454 my $j = $opt{'join'} || '';
7456 my $owed_wh = $class->_money_table_where( 'cust_bill', $start,$end,%opt );
7457 my $refund_wh = $class->_money_table_where( 'cust_refund', $start,$end,%opt );
7458 my $credit_wh = $class->_money_table_where( 'cust_credit', $start,$end,%opt );
7459 my $pay_wh = $class->_money_table_where( 'cust_pay', $start,$end,%opt );
7461 " ( SELECT COALESCE(SUM($owed), 0) FROM cust_bill $j $owed_wh )
7462 + ( SELECT COALESCE(SUM($unapp_refund), 0) FROM cust_refund $j $refund_wh )
7463 - ( SELECT COALESCE(SUM($unapp_credit), 0) FROM cust_credit $j $credit_wh )
7464 - ( SELECT COALESCE(SUM($unapp_pay), 0) FROM cust_pay $j $pay_wh )
7469 =item _money_table_where TABLE START_TIME [ END_TIME [ OPTION => VALUE ... ] ]
7471 Helper method for balance_date_sql; name (and usage) subject to change
7472 (suggestions welcome).
7474 Returns a WHERE clause for the specified monetary TABLE (cust_bill,
7475 cust_refund, cust_credit or cust_pay).
7477 If TABLE is "cust_bill" or the unapplied_date option is true, only
7478 considers records with date earlier than START_TIME, and optionally not
7479 later than END_TIME .
7483 sub _money_table_where {
7484 my( $class, $table, $start, $end, %opt ) = @_;
7487 push @where, "cust_main.custnum = $table.custnum" unless $opt{'total'};
7488 if ( $table eq 'cust_bill' || $opt{'unapplied_date'} ) {
7489 push @where, "$table._date <= $start" if defined($start) && length($start);
7490 push @where, "$table._date > $end" if defined($end) && length($end);
7492 push @where, @{$opt{'where'}} if $opt{'where'};
7493 my $where = scalar(@where) ? 'WHERE '. join(' AND ', @where ) : '';
7499 =item search_sql HASHREF
7503 Returns a qsearch hash expression to search for parameters specified in HREF.
7504 Valid parameters are
7512 =item cancelled_pkgs
7518 listref of start date, end date
7524 =item current_balance
7526 listref (list returned by FS::UI::Web::parse_lt_gt($cgi, 'current_balance'))
7530 =item flattened_pkgs
7539 my ($class, $params) = @_;
7550 if ( $params->{'agentnum'} =~ /^(\d+)$/ and $1 ) {
7552 "cust_main.agentnum = $1";
7559 #prospect active inactive suspended cancelled
7560 if ( grep { $params->{'status'} eq $_ } FS::cust_main->statuses() ) {
7561 my $method = $params->{'status'}. '_sql';
7562 #push @where, $class->$method();
7563 push @where, FS::cust_main->$method();
7567 # parse cancelled package checkbox
7572 $pkgwhere .= "AND (cancel = 0 or cancel is null)"
7573 unless $params->{'cancelled_pkgs'};
7579 foreach my $field (qw( signupdate )) {
7581 next unless exists($params->{$field});
7583 my($beginning, $ending) = @{$params->{$field}};
7586 "cust_main.$field IS NOT NULL",
7587 "cust_main.$field >= $beginning",
7588 "cust_main.$field <= $ending";
7590 $orderby ||= "ORDER BY cust_main.$field";
7598 my @payby = grep /^([A-Z]{4})$/, @{ $params->{'payby'} };
7600 push @where, '( '. join(' OR ', map "cust_main.payby = '$_'", @payby). ' )';
7607 #my $balance_sql = $class->balance_sql();
7608 my $balance_sql = FS::cust_main->balance_sql();
7610 push @where, map { s/current_balance/$balance_sql/; $_ }
7611 @{ $params->{'current_balance'} };
7617 if ( $params->{'custbatch'} =~ /^([\w\/\-\:\.]+)$/ and $1 ) {
7619 "cust_main.custbatch = '$1'";
7623 # setup queries, subs, etc. for the search
7626 $orderby ||= 'ORDER BY custnum';
7628 # here is the agent virtualization
7629 push @where, $FS::CurrentUser::CurrentUser->agentnums_sql;
7631 my $extra_sql = scalar(@where) ? ' WHERE '. join(' AND ', @where) : '';
7633 my $addl_from = 'LEFT JOIN cust_pkg USING ( custnum ) ';
7635 my $count_query = "SELECT COUNT(*) FROM cust_main $extra_sql";
7637 my $select = join(', ',
7638 'cust_main.custnum',
7639 FS::UI::Web::cust_sql_fields($params->{'cust_fields'}),
7642 my(@extra_headers) = ();
7643 my(@extra_fields) = ();
7645 if ($params->{'flattened_pkgs'}) {
7647 if ($dbh->{Driver}->{Name} eq 'Pg') {
7649 $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";
7651 }elsif ($dbh->{Driver}->{Name} =~ /^mysql/i) {
7652 $select .= ", GROUP_CONCAT(pkg SEPARATOR '|') as magic";
7653 $addl_from .= " LEFT JOIN part_pkg using ( pkgpart )";
7655 warn "warning: unknown database type ". $dbh->{Driver}->{Name}.
7656 "omitting packing information from report.";
7659 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";
7661 my $sth = dbh->prepare($header_query) or die dbh->errstr;
7662 $sth->execute() or die $sth->errstr;
7663 my $headerrow = $sth->fetchrow_arrayref;
7664 my $headercount = $headerrow ? $headerrow->[0] : 0;
7665 while($headercount) {
7666 unshift @extra_headers, "Package ". $headercount;
7667 unshift @extra_fields, eval q!sub {my $c = shift;
7668 my @a = split '\|', $c->magic;
7669 my $p = $a[!.--$headercount. q!];
7677 'table' => 'cust_main',
7678 'select' => $select,
7680 'extra_sql' => $extra_sql,
7681 'order_by' => $orderby,
7682 'count_query' => $count_query,
7683 'extra_headers' => \@extra_headers,
7684 'extra_fields' => \@extra_fields,
7689 =item email_search_sql HASHREF
7693 Emails a notice to the specified customers.
7695 Valid parameters are those of the L<search_sql> method, plus the following:
7717 Optional job queue job for status updates.
7721 Returns an error message, or false for success.
7723 If an error occurs during any email, stops the enture send and returns that
7724 error. Presumably if you're getting SMTP errors aborting is better than
7725 retrying everything.
7729 sub email_search_sql {
7730 my($class, $params) = @_;
7732 my $from = delete $params->{from};
7733 my $subject = delete $params->{subject};
7734 my $html_body = delete $params->{html_body};
7735 my $text_body = delete $params->{text_body};
7737 my $job = delete $params->{'job'};
7739 my $sql_query = $class->search_sql($params);
7741 my $count_query = delete($sql_query->{'count_query'});
7742 my $count_sth = dbh->prepare($count_query)
7743 or die "Error preparing $count_query: ". dbh->errstr;
7745 or die "Error executing $count_query: ". $count_sth->errstr;
7746 my $count_arrayref = $count_sth->fetchrow_arrayref;
7747 my $num_cust = $count_arrayref->[0];
7749 #my @extra_headers = @{ delete($sql_query->{'extra_headers'}) };
7750 #my @extra_fields = @{ delete($sql_query->{'extra_fields'}) };
7753 my( $num, $last, $min_sec ) = (0, time, 5); #progresbar foo
7755 #eventually order+limit magic to reduce memory use?
7756 foreach my $cust_main ( qsearch($sql_query) ) {
7758 my $to = $cust_main->invoicing_list_emailonly_scalar;
7761 my $error = send_email(
7765 'subject' => $subject,
7766 'html_body' => $html_body,
7767 'text_body' => $text_body,
7770 return $error if $error;
7772 if ( $job ) { #progressbar foo
7774 if ( time - $min_sec > $last ) {
7775 my $error = $job->update_statustext(
7776 int( 100 * $num / $num_cust )
7778 die $error if $error;
7788 use Storable qw(thaw);
7791 sub process_email_search_sql {
7793 #warn "$me process_re_X $method for job $job\n" if $DEBUG;
7795 my $param = thaw(decode_base64(shift));
7796 warn Dumper($param) if $DEBUG;
7798 $param->{'job'} = $job;
7800 my $error = FS::cust_main->email_search_sql( $param );
7801 die $error if $error;
7805 =item fuzzy_search FUZZY_HASHREF [ HASHREF, SELECT, EXTRA_SQL, CACHE_OBJ ]
7807 Performs a fuzzy (approximate) search and returns the matching FS::cust_main
7808 records. Currently, I<first>, I<last> and/or I<company> may be specified (the
7809 appropriate ship_ field is also searched).
7811 Additional options are the same as FS::Record::qsearch
7816 my( $self, $fuzzy, $hash, @opt) = @_;
7821 check_and_rebuild_fuzzyfiles();
7822 foreach my $field ( keys %$fuzzy ) {
7824 my $all = $self->all_X($field);
7825 next unless scalar(@$all);
7828 $match{$_}=1 foreach ( amatch( $fuzzy->{$field}, ['i'], @$all ) );
7831 foreach ( keys %match ) {
7832 push @fcust, qsearch('cust_main', { %$hash, $field=>$_}, @opt);
7833 push @fcust, qsearch('cust_main', { %$hash, "ship_$field"=>$_}, @opt);
7836 push @cust_main, grep { ! $fsaw{$_->custnum}++ } @fcust;
7839 # we want the components of $fuzzy ANDed, not ORed, but still don't want dupes
7841 @cust_main = grep { ++$saw{$_->custnum} == scalar(keys %$fuzzy) } @cust_main;
7849 Returns a masked version of the named field
7854 my ($self,$field) = @_;
7858 'x'x(length($self->getfield($field))-4).
7859 substr($self->getfield($field), (length($self->getfield($field))-4));
7869 =item smart_search OPTION => VALUE ...
7871 Accepts the following options: I<search>, the string to search for. The string
7872 will be searched for as a customer number, phone number, name or company name,
7873 as an exact, or, in some cases, a substring or fuzzy match (see the source code
7874 for the exact heuristics used); I<no_fuzzy_on_exact>, causes smart_search to
7875 skip fuzzy matching when an exact match is found.
7877 Any additional options are treated as an additional qualifier on the search
7880 Returns a (possibly empty) array of FS::cust_main objects.
7887 #here is the agent virtualization
7888 my $agentnums_sql = $FS::CurrentUser::CurrentUser->agentnums_sql;
7892 my $skip_fuzzy = delete $options{'no_fuzzy_on_exact'};
7893 my $search = delete $options{'search'};
7894 ( my $alphanum_search = $search ) =~ s/\W//g;
7896 if ( $alphanum_search =~ /^1?(\d{3})(\d{3})(\d{4})(\d*)$/ ) { #phone# search
7898 #false laziness w/Record::ut_phone
7899 my $phonen = "$1-$2-$3";
7900 $phonen .= " x$4" if $4;
7902 push @cust_main, qsearch( {
7903 'table' => 'cust_main',
7904 'hashref' => { %options },
7905 'extra_sql' => ( scalar(keys %options) ? ' AND ' : ' WHERE ' ).
7907 join(' OR ', map "$_ = '$phonen'",
7908 qw( daytime night fax
7909 ship_daytime ship_night ship_fax )
7912 " AND $agentnums_sql", #agent virtualization
7915 unless ( @cust_main || $phonen =~ /x\d+$/ ) { #no exact match
7916 #try looking for matches with extensions unless one was specified
7918 push @cust_main, qsearch( {
7919 'table' => 'cust_main',
7920 'hashref' => { %options },
7921 'extra_sql' => ( scalar(keys %options) ? ' AND ' : ' WHERE ' ).
7923 join(' OR ', map "$_ LIKE '$phonen\%'",
7925 ship_daytime ship_night )
7928 " AND $agentnums_sql", #agent virtualization
7933 # custnum search (also try agent_custid), with some tweaking options if your
7934 # legacy cust "numbers" have letters
7937 if ( $search =~ /^\s*(\d+)\s*$/
7938 || ( $conf->config('cust_main-agent_custid-format') eq 'ww?d+'
7939 && $search =~ /^\s*(\w\w?\d+)\s*$/
7946 if ( $num <= 2147483647 ) { #need a bigint custnum? wow.
7947 push @cust_main, qsearch( {
7948 'table' => 'cust_main',
7949 'hashref' => { 'custnum' => $num, %options },
7950 'extra_sql' => " AND $agentnums_sql", #agent virtualization
7954 push @cust_main, qsearch( {
7955 'table' => 'cust_main',
7956 'hashref' => { 'agent_custid' => $num, %options },
7957 'extra_sql' => " AND $agentnums_sql", #agent virtualization
7960 } elsif ( $search =~ /^\s*(\S.*\S)\s+\((.+), ([^,]+)\)\s*$/ ) {
7962 my($company, $last, $first) = ( $1, $2, $3 );
7964 # "Company (Last, First)"
7965 #this is probably something a browser remembered,
7966 #so just do an exact search
7968 foreach my $prefix ( '', 'ship_' ) {
7969 push @cust_main, qsearch( {
7970 'table' => 'cust_main',
7971 'hashref' => { $prefix.'first' => $first,
7972 $prefix.'last' => $last,
7973 $prefix.'company' => $company,
7976 'extra_sql' => " AND $agentnums_sql",
7980 } elsif ( $search =~ /^\s*(\S.*\S)\s*$/ ) { # value search
7981 # try (ship_){last,company}
7985 # # remove "(Last, First)" in "Company (Last, First)", otherwise the
7986 # # full strings the browser remembers won't work
7987 # $value =~ s/\([\w \,\.\-\']*\)$//; #false laziness w/Record::ut_name
7989 use Lingua::EN::NameParse;
7990 my $NameParse = new Lingua::EN::NameParse(
7992 allow_reversed => 1,
7995 my($last, $first) = ( '', '' );
7996 #maybe disable this too and just rely on NameParse?
7997 if ( $value =~ /^(.+),\s*([^,]+)$/ ) { # Last, First
7999 ($last, $first) = ( $1, $2 );
8001 #} elsif ( $value =~ /^(.+)\s+(.+)$/ ) {
8002 } elsif ( ! $NameParse->parse($value) ) {
8004 my %name = $NameParse->components;
8005 $first = $name{'given_name_1'};
8006 $last = $name{'surname_1'};
8010 if ( $first && $last ) {
8012 my($q_last, $q_first) = ( dbh->quote($last), dbh->quote($first) );
8015 my $sql = scalar(keys %options) ? ' AND ' : ' WHERE ';
8017 ( ( LOWER(last) = $q_last AND LOWER(first) = $q_first )
8018 OR ( LOWER(ship_last) = $q_last AND LOWER(ship_first) = $q_first )
8021 push @cust_main, qsearch( {
8022 'table' => 'cust_main',
8023 'hashref' => \%options,
8024 'extra_sql' => "$sql AND $agentnums_sql", #agent virtualization
8027 # or it just be something that was typed in... (try that in a sec)
8031 my $q_value = dbh->quote($value);
8034 my $sql = scalar(keys %options) ? ' AND ' : ' WHERE ';
8035 $sql .= " ( LOWER(last) = $q_value
8036 OR LOWER(company) = $q_value
8037 OR LOWER(ship_last) = $q_value
8038 OR LOWER(ship_company) = $q_value
8041 push @cust_main, qsearch( {
8042 'table' => 'cust_main',
8043 'hashref' => \%options,
8044 'extra_sql' => "$sql AND $agentnums_sql", #agent virtualization
8047 #no exact match, trying substring/fuzzy
8048 #always do substring & fuzzy (unless they're explicity config'ed off)
8049 #getting complaints searches are not returning enough
8050 unless ( @cust_main && $skip_fuzzy || $conf->exists('disable-fuzzy') ) {
8052 #still some false laziness w/search_sql (was search/cust_main.cgi)
8057 { 'company' => { op=>'ILIKE', value=>"%$value%" }, },
8058 { 'ship_company' => { op=>'ILIKE', value=>"%$value%" }, },
8061 if ( $first && $last ) {
8064 { 'first' => { op=>'ILIKE', value=>"%$first%" },
8065 'last' => { op=>'ILIKE', value=>"%$last%" },
8067 { 'ship_first' => { op=>'ILIKE', value=>"%$first%" },
8068 'ship_last' => { op=>'ILIKE', value=>"%$last%" },
8075 { 'last' => { op=>'ILIKE', value=>"%$value%" }, },
8076 { 'ship_last' => { op=>'ILIKE', value=>"%$value%" }, },
8080 foreach my $hashref ( @hashrefs ) {
8082 push @cust_main, qsearch( {
8083 'table' => 'cust_main',
8084 'hashref' => { %$hashref,
8087 'extra_sql' => " AND $agentnums_sql", #agent virtualizaiton
8096 " AND $agentnums_sql", #extra_sql #agent virtualization
8099 if ( $first && $last ) {
8100 push @cust_main, FS::cust_main->fuzzy_search(
8101 { 'last' => $last, #fuzzy hashref
8102 'first' => $first }, #
8106 foreach my $field ( 'last', 'company' ) {
8108 FS::cust_main->fuzzy_search( { $field => $value }, @fuzopts );
8115 #eliminate duplicates
8117 @cust_main = grep { !$saw{$_->custnum}++ } @cust_main;
8125 Accepts the following options: I<email>, the email address to search for. The
8126 email address will be searched for as an email invoice destination and as an
8129 #Any additional options are treated as an additional qualifier on the search
8130 #(i.e. I<agentnum>).
8132 Returns a (possibly empty) array of FS::cust_main objects (but usually just
8142 my $email = delete $options{'email'};
8144 #we're only being used by RT at the moment... no agent virtualization yet
8145 #my $agentnums_sql = $FS::CurrentUser::CurrentUser->agentnums_sql;
8149 if ( $email =~ /([^@]+)\@([^@]+)/ ) {
8151 my ( $user, $domain ) = ( $1, $2 );
8153 warn "$me smart_search: searching for $user in domain $domain"
8159 'table' => 'cust_main_invoice',
8160 'hashref' => { 'dest' => $email },
8167 map $_->cust_svc->cust_pkg,
8169 'table' => 'svc_acct',
8170 'hashref' => { 'username' => $user, },
8172 'AND ( SELECT domain FROM svc_domain
8173 WHERE svc_acct.domsvc = svc_domain.svcnum
8174 ) = '. dbh->quote($domain),
8180 @cust_main = grep { !$saw{$_->custnum}++ } @cust_main;
8182 warn "$me smart_search: found ". scalar(@cust_main). " unique customers"
8189 =item check_and_rebuild_fuzzyfiles
8193 use vars qw(@fuzzyfields);
8194 @fuzzyfields = ( 'last', 'first', 'company' );
8196 sub check_and_rebuild_fuzzyfiles {
8197 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
8198 rebuild_fuzzyfiles() if grep { ! -e "$dir/cust_main.$_" } @fuzzyfields
8201 =item rebuild_fuzzyfiles
8205 sub rebuild_fuzzyfiles {
8207 use Fcntl qw(:flock);
8209 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
8210 mkdir $dir, 0700 unless -d $dir;
8212 foreach my $fuzzy ( @fuzzyfields ) {
8214 open(LOCK,">>$dir/cust_main.$fuzzy")
8215 or die "can't open $dir/cust_main.$fuzzy: $!";
8217 or die "can't lock $dir/cust_main.$fuzzy: $!";
8219 open (CACHE,">$dir/cust_main.$fuzzy.tmp")
8220 or die "can't open $dir/cust_main.$fuzzy.tmp: $!";
8222 foreach my $field ( $fuzzy, "ship_$fuzzy" ) {
8223 my $sth = dbh->prepare("SELECT $field FROM cust_main".
8224 " WHERE $field != '' AND $field IS NOT NULL");
8225 $sth->execute or die $sth->errstr;
8227 while ( my $row = $sth->fetchrow_arrayref ) {
8228 print CACHE $row->[0]. "\n";
8233 close CACHE or die "can't close $dir/cust_main.$fuzzy.tmp: $!";
8235 rename "$dir/cust_main.$fuzzy.tmp", "$dir/cust_main.$fuzzy";
8246 my( $self, $field ) = @_;
8247 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
8248 open(CACHE,"<$dir/cust_main.$field")
8249 or die "can't open $dir/cust_main.$field: $!";
8250 my @array = map { chomp; $_; } <CACHE>;
8255 =item append_fuzzyfiles LASTNAME COMPANY
8259 sub append_fuzzyfiles {
8260 #my( $first, $last, $company ) = @_;
8262 &check_and_rebuild_fuzzyfiles;
8264 use Fcntl qw(:flock);
8266 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
8268 foreach my $field (qw( first last company )) {
8273 open(CACHE,">>$dir/cust_main.$field")
8274 or die "can't open $dir/cust_main.$field: $!";
8275 flock(CACHE,LOCK_EX)
8276 or die "can't lock $dir/cust_main.$field: $!";
8278 print CACHE "$value\n";
8280 flock(CACHE,LOCK_UN)
8281 or die "can't unlock $dir/cust_main.$field: $!";
8296 #warn join('-',keys %$param);
8297 my $fh = $param->{filehandle};
8298 my @fields = @{$param->{fields}};
8300 eval "use Text::CSV_XS;";
8303 my $csv = new Text::CSV_XS;
8310 local $SIG{HUP} = 'IGNORE';
8311 local $SIG{INT} = 'IGNORE';
8312 local $SIG{QUIT} = 'IGNORE';
8313 local $SIG{TERM} = 'IGNORE';
8314 local $SIG{TSTP} = 'IGNORE';
8315 local $SIG{PIPE} = 'IGNORE';
8317 my $oldAutoCommit = $FS::UID::AutoCommit;
8318 local $FS::UID::AutoCommit = 0;
8321 #while ( $columns = $csv->getline($fh) ) {
8323 while ( defined($line=<$fh>) ) {
8325 $csv->parse($line) or do {
8326 $dbh->rollback if $oldAutoCommit;
8327 return "can't parse: ". $csv->error_input();
8330 my @columns = $csv->fields();
8331 #warn join('-',@columns);
8334 foreach my $field ( @fields ) {
8335 $row{$field} = shift @columns;
8338 my $cust_main = qsearchs('cust_main', { 'custnum' => $row{'custnum'} } );
8339 unless ( $cust_main ) {
8340 $dbh->rollback if $oldAutoCommit;
8341 return "unknown custnum $row{'custnum'}";
8344 if ( $row{'amount'} > 0 ) {
8345 my $error = $cust_main->charge($row{'amount'}, $row{'pkg'});
8347 $dbh->rollback if $oldAutoCommit;
8351 } elsif ( $row{'amount'} < 0 ) {
8352 my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ),
8355 $dbh->rollback if $oldAutoCommit;
8365 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
8367 return "Empty file!" unless $imported;
8373 =item notify CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
8375 Sends a templated email notification to the customer (see L<Text::Template>).
8377 OPTIONS is a hash and may include
8379 I<from> - the email sender (default is invoice_from)
8381 I<to> - comma-separated scalar or arrayref of recipients
8382 (default is invoicing_list)
8384 I<subject> - The subject line of the sent email notification
8385 (default is "Notice from company_name")
8387 I<extra_fields> - a hashref of name/value pairs which will be substituted
8390 The following variables are vavailable in the template.
8392 I<$first> - the customer first name
8393 I<$last> - the customer last name
8394 I<$company> - the customer company
8395 I<$payby> - a description of the method of payment for the customer
8396 # would be nice to use FS::payby::shortname
8397 I<$payinfo> - the account information used to collect for this customer
8398 I<$expdate> - the expiration of the customer payment in seconds from epoch
8403 my ($self, $template, %options) = @_;
8405 return unless $conf->exists($template);
8407 my $from = $conf->config('invoice_from', $self->agentnum)
8408 if $conf->exists('invoice_from', $self->agentnum);
8409 $from = $options{from} if exists($options{from});
8411 my $to = join(',', $self->invoicing_list_emailonly);
8412 $to = $options{to} if exists($options{to});
8414 my $subject = "Notice from " . $conf->config('company_name', $self->agentnum)
8415 if $conf->exists('company_name', $self->agentnum);
8416 $subject = $options{subject} if exists($options{subject});
8418 my $notify_template = new Text::Template (TYPE => 'ARRAY',
8419 SOURCE => [ map "$_\n",
8420 $conf->config($template)]
8422 or die "can't create new Text::Template object: Text::Template::ERROR";
8423 $notify_template->compile()
8424 or die "can't compile template: Text::Template::ERROR";
8426 $FS::notify_template::_template::company_name =
8427 $conf->config('company_name', $self->agentnum);
8428 $FS::notify_template::_template::company_address =
8429 join("\n", $conf->config('company_address', $self->agentnum) ). "\n";
8431 my $paydate = $self->paydate || '2037-12-31';
8432 $FS::notify_template::_template::first = $self->first;
8433 $FS::notify_template::_template::last = $self->last;
8434 $FS::notify_template::_template::company = $self->company;
8435 $FS::notify_template::_template::payinfo = $self->mask_payinfo;
8436 my $payby = $self->payby;
8437 my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
8438 my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
8440 #credit cards expire at the end of the month/year of their exp date
8441 if ($payby eq 'CARD' || $payby eq 'DCRD') {
8442 $FS::notify_template::_template::payby = 'credit card';
8443 ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
8444 $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
8446 }elsif ($payby eq 'COMP') {
8447 $FS::notify_template::_template::payby = 'complimentary account';
8449 $FS::notify_template::_template::payby = 'current method';
8451 $FS::notify_template::_template::expdate = $expire_time;
8453 for (keys %{$options{extra_fields}}){
8455 ${"FS::notify_template::_template::$_"} = $options{extra_fields}->{$_};
8458 send_email(from => $from,
8460 subject => $subject,
8461 body => $notify_template->fill_in( PACKAGE =>
8462 'FS::notify_template::_template' ),
8467 =item generate_letter CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
8469 Generates a templated notification to the customer (see L<Text::Template>).
8471 OPTIONS is a hash and may include
8473 I<extra_fields> - a hashref of name/value pairs which will be substituted
8474 into the template. These values may override values mentioned below
8475 and those from the customer record.
8477 The following variables are available in the template instead of or in addition
8478 to the fields of the customer record.
8480 I<$payby> - a description of the method of payment for the customer
8481 # would be nice to use FS::payby::shortname
8482 I<$payinfo> - the masked account information used to collect for this customer
8483 I<$expdate> - the expiration of the customer payment method in seconds from epoch
8484 I<$returnaddress> - the return address defaults to invoice_latexreturnaddress or company_address
8488 sub generate_letter {
8489 my ($self, $template, %options) = @_;
8491 return unless $conf->exists($template);
8493 my $letter_template = new Text::Template
8495 SOURCE => [ map "$_\n", $conf->config($template)],
8496 DELIMITERS => [ '[@--', '--@]' ],
8498 or die "can't create new Text::Template object: Text::Template::ERROR";
8500 $letter_template->compile()
8501 or die "can't compile template: Text::Template::ERROR";
8503 my %letter_data = map { $_ => $self->$_ } $self->fields;
8504 $letter_data{payinfo} = $self->mask_payinfo;
8506 #my $paydate = $self->paydate || '2037-12-31';
8507 my $paydate = $self->paydate =~ /^\S+$/ ? $self->paydate : '2037-12-31';
8509 my $payby = $self->payby;
8510 my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
8511 my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
8513 #credit cards expire at the end of the month/year of their exp date
8514 if ($payby eq 'CARD' || $payby eq 'DCRD') {
8515 $letter_data{payby} = 'credit card';
8516 ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
8517 $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
8519 }elsif ($payby eq 'COMP') {
8520 $letter_data{payby} = 'complimentary account';
8522 $letter_data{payby} = 'current method';
8524 $letter_data{expdate} = $expire_time;
8526 for (keys %{$options{extra_fields}}){
8527 $letter_data{$_} = $options{extra_fields}->{$_};
8530 unless(exists($letter_data{returnaddress})){
8531 my $retadd = join("\n", $conf->config_orbase( 'invoice_latexreturnaddress',
8532 $self->agent_template)
8534 if ( length($retadd) ) {
8535 $letter_data{returnaddress} = $retadd;
8536 } elsif ( grep /\S/, $conf->config('company_address', $self->agentnum) ) {
8537 $letter_data{returnaddress} =
8538 join( '\\*'."\n", map s/( {2,})/'~' x length($1)/eg,
8539 $conf->config('company_address', $self->agentnum)
8542 $letter_data{returnaddress} = '~';
8546 $letter_data{conf_dir} = "$FS::UID::conf_dir/conf.$FS::UID::datasrc";
8548 $letter_data{company_name} = $conf->config('company_name', $self->agentnum);
8550 my $dir = $FS::UID::conf_dir."/cache.". $FS::UID::datasrc;
8551 my $fh = new File::Temp( TEMPLATE => 'letter.'. $self->custnum. '.XXXXXXXX',
8555 ) or die "can't open temp file: $!\n";
8557 $letter_template->fill_in( OUTPUT => $fh, HASH => \%letter_data );
8559 $fh->filename =~ /^(.*).tex$/ or die "unparsable filename: ". $fh->filename;
8563 =item print_ps TEMPLATE
8565 Returns an postscript letter filled in from TEMPLATE, as a scalar.
8571 my $file = $self->generate_letter(@_);
8572 FS::Misc::generate_ps($file);
8575 =item print TEMPLATE
8577 Prints the filled in template.
8579 TEMPLATE is the name of a L<Text::Template> to fill in and print.
8583 sub queueable_print {
8586 my $self = qsearchs('cust_main', { 'custnum' => $opt{custnum} } )
8587 or die "invalid customer number: " . $opt{custvnum};
8589 my $error = $self->print( $opt{template} );
8590 die $error if $error;
8594 my ($self, $template) = (shift, shift);
8595 do_print [ $self->print_ps($template) ];
8598 #these three subs should just go away once agent stuff is all config overrides
8600 sub agent_template {
8602 $self->_agent_plandata('agent_templatename');
8605 sub agent_invoice_from {
8607 $self->_agent_plandata('agent_invoice_from');
8610 sub _agent_plandata {
8611 my( $self, $option ) = @_;
8613 #yuck. this whole thing needs to be reconciled better with 1.9's idea of
8614 #agent-specific Conf
8616 use FS::part_event::Condition;
8618 my $agentnum = $self->agentnum;
8621 if ( driver_name =~ /^Pg/i ) {
8623 } elsif ( driver_name =~ /^mysql/i ) {
8626 die "don't know how to use regular expressions in ". driver_name. " databases";
8629 my $part_event_option =
8631 'select' => 'part_event_option.*',
8632 'table' => 'part_event_option',
8634 LEFT JOIN part_event USING ( eventpart )
8635 LEFT JOIN part_event_option AS peo_agentnum
8636 ON ( part_event.eventpart = peo_agentnum.eventpart
8637 AND peo_agentnum.optionname = 'agentnum'
8638 AND peo_agentnum.optionvalue }. $regexp. q{ '(^|,)}. $agentnum. q{(,|$)'
8640 LEFT JOIN part_event_condition
8641 ON ( part_event.eventpart = part_event_condition.eventpart
8642 AND part_event_condition.conditionname = 'cust_bill_age'
8644 LEFT JOIN part_event_condition_option
8645 ON ( part_event_condition.eventconditionnum = part_event_condition_option.eventconditionnum
8646 AND part_event_condition_option.optionname = 'age'
8649 #'hashref' => { 'optionname' => $option },
8650 #'hashref' => { 'part_event_option.optionname' => $option },
8652 " WHERE part_event_option.optionname = ". dbh->quote($option).
8653 " AND action = 'cust_bill_send_agent' ".
8654 " AND ( disabled IS NULL OR disabled != 'Y' ) ".
8655 " AND peo_agentnum.optionname = 'agentnum' ".
8656 " AND ( agentnum IS NULL OR agentnum = $agentnum ) ".
8658 CASE WHEN part_event_condition_option.optionname IS NULL
8660 ELSE ". FS::part_event::Condition->age2seconds_sql('part_event_condition_option.optionvalue').
8662 , part_event.weight".
8666 unless ( $part_event_option ) {
8667 return $self->agent->invoice_template || ''
8668 if $option eq 'agent_templatename';
8672 $part_event_option->optionvalue;
8677 ## actual sub, not a method, designed to be called from the queue.
8678 ## sets up the customer, and calls the bill_and_collect
8679 my (%args) = @_; #, ($time, $invoice_time, $check_freq, $resetup) = @_;
8680 my $cust_main = qsearchs( 'cust_main', { custnum => $args{'custnum'} } );
8681 $cust_main->bill_and_collect(
8686 sub _upgrade_data { #class method
8687 my ($class, %opts) = @_;
8689 my $sql = 'UPDATE h_cust_main SET paycvv = NULL WHERE paycvv IS NOT NULL';
8690 my $sth = dbh->prepare($sql) or die dbh->errstr;
8691 $sth->execute or die $sth->errstr;
8701 The delete method should possibly take an FS::cust_main object reference
8702 instead of a scalar customer number.
8704 Bill and collect options should probably be passed as references instead of a
8707 There should probably be a configuration file with a list of allowed credit
8710 No multiple currency support (probably a larger project than just this module).
8712 payinfo_masked false laziness with cust_pay.pm and cust_refund.pm
8714 Birthdates rely on negative epoch values.
8716 The payby for card/check batches is broken. With mixed batching, bad
8719 B<collect> I<invoice_time> should be renamed I<time>, like B<bill>.
8723 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
8724 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
8725 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.