5 use vars qw( @ISA @EXPORT_OK $DEBUG $me $conf
7 $import $ignore_expired_card
8 $skip_fuzzyfiles @fuzzyfields
11 use vars qw( $realtime_bop_decline_quiet ); #ugh
15 use Scalar::Util qw( blessed );
16 use List::Util qw( min );
17 use Time::Local qw(timelocal);
20 use Digest::MD5 qw(md5_base64);
23 use File::Temp qw( tempfile );
24 use String::Approx qw(amatch);
25 use Business::CreditCard 0.28;
27 use FS::UID qw( getotaker dbh driver_name );
28 use FS::Record qw( qsearchs qsearch dbdef );
29 use FS::Misc qw( generate_email send_email generate_ps do_print );
30 use FS::Msgcat qw(gettext);
35 use FS::cust_bill_pkg;
36 use FS::cust_bill_pkg_display;
37 use FS::cust_bill_pkg_tax_location;
38 use FS::cust_bill_pkg_tax_rate_location;
40 use FS::cust_pay_pending;
41 use FS::cust_pay_void;
42 use FS::cust_pay_batch;
45 use FS::part_referral;
46 use FS::cust_main_county;
47 use FS::cust_location;
48 use FS::cust_main_exemption;
49 use FS::cust_tax_adjustment;
51 use FS::tax_rate_location;
52 use FS::cust_tax_location;
53 use FS::part_pkg_taxrate;
55 use FS::cust_main_invoice;
56 use FS::cust_credit_bill;
57 use FS::cust_bill_pay;
58 use FS::prepay_credit;
62 use FS::part_event_condition;
65 use FS::payment_gateway;
66 use FS::agent_payment_gateway;
68 use FS::payinfo_Mixin;
71 @ISA = qw( FS::payinfo_Mixin FS::Record );
73 @EXPORT_OK = qw( smart_search );
75 $realtime_bop_decline_quiet = 0;
77 # 1 is mostly method/subroutine entry and options
78 # 2 traces progress of some operations
79 # 3 is even more information including possibly sensitive data
81 $me = '[FS::cust_main]';
84 $ignore_expired_card = 0;
87 @fuzzyfields = ( 'first', 'last', 'company', 'address1' );
89 @encrypted_fields = ('payinfo', 'paycvv');
90 sub nohistory_fields { ('paycvv'); }
92 @paytypes = ('', 'Personal checking', 'Personal savings', 'Business checking', 'Business savings');
94 #ask FS::UID to run this stuff for us later
95 #$FS::UID::callback{'FS::cust_main'} = sub {
96 install_callback FS::UID sub {
98 #yes, need it for stuff below (prolly should be cached)
103 my ( $hashref, $cache ) = @_;
104 if ( exists $hashref->{'pkgnum'} ) {
105 #@{ $self->{'_pkgnum'} } = ();
106 my $subcache = $cache->subcache( 'pkgnum', 'cust_pkg', $hashref->{custnum});
107 $self->{'_pkgnum'} = $subcache;
108 #push @{ $self->{'_pkgnum'} },
109 FS::cust_pkg->new_or_cached($hashref, $subcache) if $hashref->{pkgnum};
115 FS::cust_main - Object methods for cust_main records
121 $record = new FS::cust_main \%hash;
122 $record = new FS::cust_main { 'column' => 'value' };
124 $error = $record->insert;
126 $error = $new_record->replace($old_record);
128 $error = $record->delete;
130 $error = $record->check;
132 @cust_pkg = $record->all_pkgs;
134 @cust_pkg = $record->ncancelled_pkgs;
136 @cust_pkg = $record->suspended_pkgs;
138 $error = $record->bill;
139 $error = $record->bill %options;
140 $error = $record->bill 'time' => $time;
142 $error = $record->collect;
143 $error = $record->collect %options;
144 $error = $record->collect 'invoice_time' => $time,
149 An FS::cust_main object represents a customer. FS::cust_main inherits from
150 FS::Record. The following fields are currently supported:
156 Primary key (assigned automatically for new customers)
160 Agent (see L<FS::agent>)
164 Advertising source (see L<FS::part_referral>)
176 Cocial security number (optional)
192 (optional, see L<FS::cust_main_county>)
196 (see L<FS::cust_main_county>)
202 (see L<FS::cust_main_county>)
238 (optional, see L<FS::cust_main_county>)
242 (see L<FS::cust_main_county>)
248 (see L<FS::cust_main_county>)
264 Payment Type (See L<FS::payinfo_Mixin> for valid payby values)
268 Payment Information (See L<FS::payinfo_Mixin> for data format)
272 Masked payinfo (See L<FS::payinfo_Mixin> for how this works)
276 Card Verification Value, "CVV2" (also known as CVC2 or CID), the 3 or 4 digit number on the back (or front, for American Express) of the credit card
280 Expiration date, mm/yyyy, m/yyyy, mm/yy or m/yy
284 Start date month (maestro/solo cards only)
288 Start date year (maestro/solo cards only)
292 Issue number (maestro/solo cards only)
296 Name on card or billing name
300 IP address from which payment information was received
304 Tax exempt, empty or `Y'
308 Order taker (assigned automatically, see L<FS::UID>)
314 =item referral_custnum
316 Referring customer number
320 Enable individual CDR spooling, empty or `Y'
324 A suggestion to events (see L<FS::part_bill_event">) to delay until this unix timestamp
328 Discourage individual CDR printing, empty or `Y'
338 Creates a new customer. To add the customer to the database, see L<"insert">.
340 Note that this stores the hash reference, not a distinct copy of the hash it
341 points to. You can ask the object for a copy with the I<hash> method.
345 sub table { 'cust_main'; }
347 =item insert [ CUST_PKG_HASHREF [ , INVOICING_LIST_ARYREF ] [ , OPTION => VALUE ... ] ]
349 Adds this customer to the database. If there is an error, returns the error,
350 otherwise returns false.
352 CUST_PKG_HASHREF: If you pass a Tie::RefHash data structure to the insert
353 method containing FS::cust_pkg and FS::svc_I<tablename> objects, all records
354 are inserted atomicly, or the transaction is rolled back. Passing an empty
355 hash reference is equivalent to not supplying this parameter. There should be
356 a better explanation of this, but until then, here's an example:
359 tie %hash, 'Tie::RefHash'; #this part is important
361 $cust_pkg => [ $svc_acct ],
364 $cust_main->insert( \%hash );
366 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
367 be set as the invoicing list (see L<"invoicing_list">). Errors return as
368 expected and rollback the entire transaction; it is not necessary to call
369 check_invoicing_list first. The invoicing_list is set after the records in the
370 CUST_PKG_HASHREF above are inserted, so it is now possible to set an
371 invoicing_list destination to the newly-created svc_acct. Here's an example:
373 $cust_main->insert( {}, [ $email, 'POST' ] );
375 Currently available options are: I<depend_jobnum>, I<noexport> and I<tax_exemption>.
377 If I<depend_jobnum> is set, all provisioning jobs will have a dependancy
378 on the supplied jobnum (they will not run until the specific job completes).
379 This can be used to defer provisioning until some action completes (such
380 as running the customer's credit card successfully).
382 The I<noexport> option is deprecated. If I<noexport> is set true, no
383 provisioning jobs (exports) are scheduled. (You can schedule them later with
384 the B<reexport> method.)
386 The I<tax_exemption> option can be set to an arrayref of tax names.
387 FS::cust_main_exemption records will be created and inserted.
393 my $cust_pkgs = @_ ? shift : {};
394 my $invoicing_list = @_ ? shift : '';
396 warn "$me insert called with options ".
397 join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
400 local $SIG{HUP} = 'IGNORE';
401 local $SIG{INT} = 'IGNORE';
402 local $SIG{QUIT} = 'IGNORE';
403 local $SIG{TERM} = 'IGNORE';
404 local $SIG{TSTP} = 'IGNORE';
405 local $SIG{PIPE} = 'IGNORE';
407 my $oldAutoCommit = $FS::UID::AutoCommit;
408 local $FS::UID::AutoCommit = 0;
411 my $prepay_identifier = '';
412 my( $amount, $seconds, $upbytes, $downbytes, $totalbytes ) = (0, 0, 0, 0, 0);
414 if ( $self->payby eq 'PREPAY' ) {
416 $self->payby('BILL');
417 $prepay_identifier = $self->payinfo;
420 warn " looking up prepaid card $prepay_identifier\n"
423 my $error = $self->get_prepay( $prepay_identifier,
424 'amount_ref' => \$amount,
425 'seconds_ref' => \$seconds,
426 'upbytes_ref' => \$upbytes,
427 'downbytes_ref' => \$downbytes,
428 'totalbytes_ref' => \$totalbytes,
431 $dbh->rollback if $oldAutoCommit;
432 #return "error applying prepaid card (transaction rolled back): $error";
436 $payby = 'PREP' if $amount;
438 } elsif ( $self->payby =~ /^(CASH|WEST|MCRD)$/ ) {
441 $self->payby('BILL');
442 $amount = $self->paid;
446 warn " inserting $self\n"
449 $self->signupdate(time) unless $self->signupdate;
451 $self->auto_agent_custid()
452 if $conf->config('cust_main-auto_agent_custid') && ! $self->agent_custid;
454 my $error = $self->SUPER::insert;
456 $dbh->rollback if $oldAutoCommit;
457 #return "inserting cust_main record (transaction rolled back): $error";
461 warn " setting invoicing list\n"
464 if ( $invoicing_list ) {
465 $error = $self->check_invoicing_list( $invoicing_list );
467 $dbh->rollback if $oldAutoCommit;
468 #return "checking invoicing_list (transaction rolled back): $error";
471 $self->invoicing_list( $invoicing_list );
474 warn " setting cust_main_exemption\n"
477 my $tax_exemption = delete $options{'tax_exemption'};
478 if ( $tax_exemption ) {
479 foreach my $taxname ( @$tax_exemption ) {
480 my $cust_main_exemption = new FS::cust_main_exemption {
481 'custnum' => $self->custnum,
482 'taxname' => $taxname,
484 my $error = $cust_main_exemption->insert;
486 $dbh->rollback if $oldAutoCommit;
487 return "inserting cust_main_exemption (transaction rolled back): $error";
492 if ( $conf->config('cust_main-skeleton_tables')
493 && $conf->config('cust_main-skeleton_custnum') ) {
495 warn " inserting skeleton records\n"
498 my $error = $self->start_copy_skel;
500 $dbh->rollback if $oldAutoCommit;
506 warn " ordering packages\n"
509 $error = $self->order_pkgs( $cust_pkgs,
511 'seconds_ref' => \$seconds,
512 'upbytes_ref' => \$upbytes,
513 'downbytes_ref' => \$downbytes,
514 'totalbytes_ref' => \$totalbytes,
517 $dbh->rollback if $oldAutoCommit;
522 $dbh->rollback if $oldAutoCommit;
523 return "No svc_acct record to apply pre-paid time";
525 if ( $upbytes || $downbytes || $totalbytes ) {
526 $dbh->rollback if $oldAutoCommit;
527 return "No svc_acct record to apply pre-paid data";
531 warn " inserting initial $payby payment of $amount\n"
533 $error = $self->insert_cust_pay($payby, $amount, $prepay_identifier);
535 $dbh->rollback if $oldAutoCommit;
536 return "inserting payment (transaction rolled back): $error";
540 unless ( $import || $skip_fuzzyfiles ) {
541 warn " queueing fuzzyfiles update\n"
543 $error = $self->queue_fuzzyfiles_update;
545 $dbh->rollback if $oldAutoCommit;
546 return "updating fuzzy search cache: $error";
550 warn " insert complete; committing transaction\n"
553 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
558 use File::CounterFile;
559 sub auto_agent_custid {
562 my $format = $conf->config('cust_main-auto_agent_custid');
564 if ( $format eq '1YMMXXXXXXXX' ) {
566 my $counter = new File::CounterFile 'cust_main.agent_custid';
569 my $ym = 100000000000 + time2str('%y%m00000000', time);
570 if ( $ym > $counter->value ) {
571 $counter->{'value'} = $agent_custid = $ym;
572 $counter->{'updated'} = 1;
574 $agent_custid = $counter->inc;
580 die "Unknown cust_main-auto_agent_custid format: $format";
583 $self->agent_custid($agent_custid);
587 sub start_copy_skel {
590 #'mg_user_preference' => {},
591 #'mg_user_indicator_profile.user_indicator_profile_id' => { 'mg_profile_indicator.profile_indicator_id' => { 'mg_profile_details.profile_detail_id' }, },
592 #'mg_watchlist_header.watchlist_header_id' => { 'mg_watchlist_details.watchlist_details_id' },
593 #'mg_user_grid_header.grid_header_id' => { 'mg_user_grid_details.user_grid_details_id' },
594 #'mg_portfolio_header.portfolio_header_id' => { 'mg_portfolio_trades.portfolio_trades_id' => { 'mg_portfolio_trades_positions.portfolio_trades_positions_id' } },
595 my @tables = eval(join('\n',$conf->config('cust_main-skeleton_tables')));
598 _copy_skel( 'cust_main', #tablename
599 $conf->config('cust_main-skeleton_custnum'), #sourceid
600 $self->custnum, #destid
601 @tables, #child tables
605 #recursive subroutine, not a method
607 my( $table, $sourceid, $destid, %child_tables ) = @_;
610 if ( $table =~ /^(\w+)\.(\w+)$/ ) {
611 ( $table, $primary_key ) = ( $1, $2 );
613 my $dbdef_table = dbdef->table($table);
614 $primary_key = $dbdef_table->primary_key
615 or return "$table has no primary key".
616 " (or do you need to run dbdef-create?)";
619 warn " _copy_skel: $table.$primary_key $sourceid to $destid for ".
620 join (', ', keys %child_tables). "\n"
623 foreach my $child_table_def ( keys %child_tables ) {
627 if ( $child_table_def =~ /^(\w+)\.(\w+)$/ ) {
628 ( $child_table, $child_pkey ) = ( $1, $2 );
630 $child_table = $child_table_def;
632 $child_pkey = dbdef->table($child_table)->primary_key;
633 # or return "$table has no primary key".
634 # " (or do you need to run dbdef-create?)\n";
638 if ( keys %{ $child_tables{$child_table_def} } ) {
640 return "$child_table has no primary key".
641 " (run dbdef-create or try specifying it?)\n"
644 #false laziness w/Record::insert and only works on Pg
645 #refactor the proper last-inserted-id stuff out of Record::insert if this
646 # ever gets use for anything besides a quick kludge for one customer
647 my $default = dbdef->table($child_table)->column($child_pkey)->default;
648 $default =~ /^nextval\(\(?'"?([\w\.]+)"?'/i
649 or return "can't parse $child_table.$child_pkey default value ".
650 " for sequence name: $default";
655 my @sel_columns = grep { $_ ne $primary_key }
656 dbdef->table($child_table)->columns;
657 my $sel_columns = join(', ', @sel_columns );
659 my @ins_columns = grep { $_ ne $child_pkey } @sel_columns;
660 my $ins_columns = ' ( '. join(', ', $primary_key, @ins_columns ). ' ) ';
661 my $placeholders = ' ( ?, '. join(', ', map '?', @ins_columns ). ' ) ';
663 my $sel_st = "SELECT $sel_columns FROM $child_table".
664 " WHERE $primary_key = $sourceid";
667 my $sel_sth = dbh->prepare( $sel_st )
668 or return dbh->errstr;
670 $sel_sth->execute or return $sel_sth->errstr;
672 while ( my $row = $sel_sth->fetchrow_hashref ) {
674 warn " selected row: ".
675 join(', ', map { "$_=".$row->{$_} } keys %$row ). "\n"
679 "INSERT INTO $child_table $ins_columns VALUES $placeholders";
680 my $ins_sth =dbh->prepare($statement)
681 or return dbh->errstr;
682 my @param = ( $destid, map $row->{$_}, @ins_columns );
683 warn " $statement: [ ". join(', ', @param). " ]\n"
685 $ins_sth->execute( @param )
686 or return $ins_sth->errstr;
688 #next unless keys %{ $child_tables{$child_table} };
689 next unless $sequence;
691 #another section of that laziness
692 my $seq_sql = "SELECT currval('$sequence')";
693 my $seq_sth = dbh->prepare($seq_sql) or return dbh->errstr;
694 $seq_sth->execute or return $seq_sth->errstr;
695 my $insertid = $seq_sth->fetchrow_arrayref->[0];
697 # don't drink soap! recurse! recurse! okay!
699 _copy_skel( $child_table_def,
700 $row->{$child_pkey}, #sourceid
702 %{ $child_tables{$child_table_def} },
704 return $error if $error;
714 =item order_pkg HASHREF | OPTION => VALUE ...
716 Orders a single package.
718 Options may be passed as a list of key/value pairs or as a hash reference.
729 Optional FS::cust_location object
733 Optional arryaref of FS::svc_* service objects.
737 If this option is set to a job queue jobnum (see L<FS::queue>), all provisioning
738 jobs will have a dependancy on the supplied job (they will not run until the
739 specific job completes). This can be used to defer provisioning until some
740 action completes (such as running the customer's credit card successfully).
744 Optional subject for a ticket created and attached to this customer
748 Optional queue name for ticket additions
756 my $opt = ref($_[0]) ? shift : { @_ };
758 warn "$me order_pkg called with options ".
759 join(', ', map { "$_: $opt->{$_}" } keys %$opt ). "\n"
762 my $cust_pkg = $opt->{'cust_pkg'};
763 my $svcs = $opt->{'svcs'} || [];
765 my %svc_options = ();
766 $svc_options{'depend_jobnum'} = $opt->{'depend_jobnum'}
767 if exists($opt->{'depend_jobnum'}) && $opt->{'depend_jobnum'};
769 my %insert_params = map { $opt->{$_} ? ( $_ => $opt->{$_} ) : () }
770 qw( ticket_subject ticket_queue );
772 local $SIG{HUP} = 'IGNORE';
773 local $SIG{INT} = 'IGNORE';
774 local $SIG{QUIT} = 'IGNORE';
775 local $SIG{TERM} = 'IGNORE';
776 local $SIG{TSTP} = 'IGNORE';
777 local $SIG{PIPE} = 'IGNORE';
779 my $oldAutoCommit = $FS::UID::AutoCommit;
780 local $FS::UID::AutoCommit = 0;
783 if ( $opt->{'cust_location'} &&
784 ( ! $cust_pkg->locationnum || $cust_pkg->locationnum == -1 ) ) {
785 my $error = $opt->{'cust_location'}->insert;
787 $dbh->rollback if $oldAutoCommit;
788 return "inserting cust_location (transaction rolled back): $error";
790 $cust_pkg->locationnum($opt->{'cust_location'}->locationnum);
793 $cust_pkg->custnum( $self->custnum );
795 my $error = $cust_pkg->insert( %insert_params );
797 $dbh->rollback if $oldAutoCommit;
798 return "inserting cust_pkg (transaction rolled back): $error";
801 foreach my $svc_something ( @{ $opt->{'svcs'} } ) {
802 if ( $svc_something->svcnum ) {
803 my $old_cust_svc = $svc_something->cust_svc;
804 my $new_cust_svc = new FS::cust_svc { $old_cust_svc->hash };
805 $new_cust_svc->pkgnum( $cust_pkg->pkgnum);
806 $error = $new_cust_svc->replace($old_cust_svc);
808 $svc_something->pkgnum( $cust_pkg->pkgnum );
809 if ( $svc_something->isa('FS::svc_acct') ) {
810 foreach ( grep { $opt->{$_.'_ref'} && ${ $opt->{$_.'_ref'} } }
811 qw( seconds upbytes downbytes totalbytes ) ) {
812 $svc_something->$_( $svc_something->$_() + ${ $opt->{$_.'_ref'} } );
813 ${ $opt->{$_.'_ref'} } = 0;
816 $error = $svc_something->insert(%svc_options);
819 $dbh->rollback if $oldAutoCommit;
820 return "inserting svc_ (transaction rolled back): $error";
824 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
829 #deprecated #=item order_pkgs HASHREF [ , SECONDSREF ] [ , OPTION => VALUE ... ]
830 =item order_pkgs HASHREF [ , OPTION => VALUE ... ]
832 Like the insert method on an existing record, this method orders multiple
833 packages and included services atomicaly. Pass a Tie::RefHash data structure
834 to this method containing FS::cust_pkg and FS::svc_I<tablename> objects.
835 There should be a better explanation of this, but until then, here's an
839 tie %hash, 'Tie::RefHash'; #this part is important
841 $cust_pkg => [ $svc_acct ],
844 $cust_main->order_pkgs( \%hash, 'noexport'=>1 );
846 Services can be new, in which case they are inserted, or existing unaudited
847 services, in which case they are linked to the newly-created package.
849 Currently available options are: I<depend_jobnum>, I<noexport>, I<seconds_ref>,
850 I<upbytes_ref>, I<downbytes_ref>, and I<totalbytes_ref>.
852 If I<depend_jobnum> is set, all provisioning jobs will have a dependancy
853 on the supplied jobnum (they will not run until the specific job completes).
854 This can be used to defer provisioning until some action completes (such
855 as running the customer's credit card successfully).
857 The I<noexport> option is deprecated. If I<noexport> is set true, no
858 provisioning jobs (exports) are scheduled. (You can schedule them later with
859 the B<reexport> method for each cust_pkg object. Using the B<reexport> method
860 on the cust_main object is not recommended, as existing services will also be
863 If I<seconds_ref>, I<upbytes_ref>, I<downbytes_ref>, or I<totalbytes_ref> is
864 provided, the scalars (provided by references) will be incremented by the
865 values of the prepaid card.`
871 my $cust_pkgs = shift;
872 my $seconds_ref = ref($_[0]) ? shift : ''; #deprecated
874 $seconds_ref ||= $options{'seconds_ref'};
876 warn "$me order_pkgs called with options ".
877 join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
880 local $SIG{HUP} = 'IGNORE';
881 local $SIG{INT} = 'IGNORE';
882 local $SIG{QUIT} = 'IGNORE';
883 local $SIG{TERM} = 'IGNORE';
884 local $SIG{TSTP} = 'IGNORE';
885 local $SIG{PIPE} = 'IGNORE';
887 my $oldAutoCommit = $FS::UID::AutoCommit;
888 local $FS::UID::AutoCommit = 0;
891 local $FS::svc_Common::noexport_hack = 1 if $options{'noexport'};
893 foreach my $cust_pkg ( keys %$cust_pkgs ) {
895 my $error = $self->order_pkg(
896 'cust_pkg' => $cust_pkg,
897 'svcs' => $cust_pkgs->{$cust_pkg},
898 'seconds_ref' => $seconds_ref,
899 map { $_ => $options{$_} } qw( upbytes_ref downbytes_ref totalbytes_ref
904 $dbh->rollback if $oldAutoCommit;
910 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
914 =item recharge_prepay IDENTIFIER | PREPAY_CREDIT_OBJ [ , AMOUNTREF, SECONDSREF, UPBYTEREF, DOWNBYTEREF ]
916 Recharges this (existing) customer with the specified prepaid card (see
917 L<FS::prepay_credit>), specified either by I<identifier> or as an
918 FS::prepay_credit object. If there is an error, returns the error, otherwise
921 Optionally, five scalar references can be passed as well. They will have their
922 values filled in with the amount, number of seconds, and number of upload,
923 download, and total bytes applied by this prepaid card.
927 #the ref bullshit here should be refactored like get_prepay. MyAccount.pm is
928 #the only place that uses these args
929 sub recharge_prepay {
930 my( $self, $prepay_credit, $amountref, $secondsref,
931 $upbytesref, $downbytesref, $totalbytesref ) = @_;
933 local $SIG{HUP} = 'IGNORE';
934 local $SIG{INT} = 'IGNORE';
935 local $SIG{QUIT} = 'IGNORE';
936 local $SIG{TERM} = 'IGNORE';
937 local $SIG{TSTP} = 'IGNORE';
938 local $SIG{PIPE} = 'IGNORE';
940 my $oldAutoCommit = $FS::UID::AutoCommit;
941 local $FS::UID::AutoCommit = 0;
944 my( $amount, $seconds, $upbytes, $downbytes, $totalbytes) = ( 0, 0, 0, 0, 0 );
946 my $error = $self->get_prepay( $prepay_credit,
947 'amount_ref' => \$amount,
948 'seconds_ref' => \$seconds,
949 'upbytes_ref' => \$upbytes,
950 'downbytes_ref' => \$downbytes,
951 'totalbytes_ref' => \$totalbytes,
953 || $self->increment_seconds($seconds)
954 || $self->increment_upbytes($upbytes)
955 || $self->increment_downbytes($downbytes)
956 || $self->increment_totalbytes($totalbytes)
957 || $self->insert_cust_pay_prepay( $amount,
959 ? $prepay_credit->identifier
964 $dbh->rollback if $oldAutoCommit;
968 if ( defined($amountref) ) { $$amountref = $amount; }
969 if ( defined($secondsref) ) { $$secondsref = $seconds; }
970 if ( defined($upbytesref) ) { $$upbytesref = $upbytes; }
971 if ( defined($downbytesref) ) { $$downbytesref = $downbytes; }
972 if ( defined($totalbytesref) ) { $$totalbytesref = $totalbytes; }
974 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
979 =item get_prepay IDENTIFIER | PREPAY_CREDIT_OBJ [ , OPTION => VALUE ... ]
981 Looks up and deletes a prepaid card (see L<FS::prepay_credit>),
982 specified either by I<identifier> or as an FS::prepay_credit object.
984 Available options are: I<amount_ref>, I<seconds_ref>, I<upbytes_ref>, I<downbytes_ref>, and I<totalbytes_ref>. The scalars (provided by references) will be
985 incremented by the values of the prepaid card.
987 If the prepaid card specifies an I<agentnum> (see L<FS::agent>), it is used to
988 check or set this customer's I<agentnum>.
990 If there is an error, returns the error, otherwise returns false.
996 my( $self, $prepay_credit, %opt ) = @_;
998 local $SIG{HUP} = 'IGNORE';
999 local $SIG{INT} = 'IGNORE';
1000 local $SIG{QUIT} = 'IGNORE';
1001 local $SIG{TERM} = 'IGNORE';
1002 local $SIG{TSTP} = 'IGNORE';
1003 local $SIG{PIPE} = 'IGNORE';
1005 my $oldAutoCommit = $FS::UID::AutoCommit;
1006 local $FS::UID::AutoCommit = 0;
1009 unless ( ref($prepay_credit) ) {
1011 my $identifier = $prepay_credit;
1013 $prepay_credit = qsearchs(
1015 { 'identifier' => $prepay_credit },
1020 unless ( $prepay_credit ) {
1021 $dbh->rollback if $oldAutoCommit;
1022 return "Invalid prepaid card: ". $identifier;
1027 if ( $prepay_credit->agentnum ) {
1028 if ( $self->agentnum && $self->agentnum != $prepay_credit->agentnum ) {
1029 $dbh->rollback if $oldAutoCommit;
1030 return "prepaid card not valid for agent ". $self->agentnum;
1032 $self->agentnum($prepay_credit->agentnum);
1035 my $error = $prepay_credit->delete;
1037 $dbh->rollback if $oldAutoCommit;
1038 return "removing prepay_credit (transaction rolled back): $error";
1041 ${ $opt{$_.'_ref'} } += $prepay_credit->$_()
1042 for grep $opt{$_.'_ref'}, qw( amount seconds upbytes downbytes totalbytes );
1044 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1049 =item increment_upbytes SECONDS
1051 Updates this customer's single or primary account (see L<FS::svc_acct>) by
1052 the specified number of upbytes. If there is an error, returns the error,
1053 otherwise returns false.
1057 sub increment_upbytes {
1058 _increment_column( shift, 'upbytes', @_);
1061 =item increment_downbytes SECONDS
1063 Updates this customer's single or primary account (see L<FS::svc_acct>) by
1064 the specified number of downbytes. If there is an error, returns the error,
1065 otherwise returns false.
1069 sub increment_downbytes {
1070 _increment_column( shift, 'downbytes', @_);
1073 =item increment_totalbytes SECONDS
1075 Updates this customer's single or primary account (see L<FS::svc_acct>) by
1076 the specified number of totalbytes. If there is an error, returns the error,
1077 otherwise returns false.
1081 sub increment_totalbytes {
1082 _increment_column( shift, 'totalbytes', @_);
1085 =item increment_seconds SECONDS
1087 Updates this customer's single or primary account (see L<FS::svc_acct>) by
1088 the specified number of seconds. If there is an error, returns the error,
1089 otherwise returns false.
1093 sub increment_seconds {
1094 _increment_column( shift, 'seconds', @_);
1097 =item _increment_column AMOUNT
1099 Updates this customer's single or primary account (see L<FS::svc_acct>) by
1100 the specified number of seconds or bytes. If there is an error, returns
1101 the error, otherwise returns false.
1105 sub _increment_column {
1106 my( $self, $column, $amount ) = @_;
1107 warn "$me increment_column called: $column, $amount\n"
1110 return '' unless $amount;
1112 my @cust_pkg = grep { $_->part_pkg->svcpart('svc_acct') }
1113 $self->ncancelled_pkgs;
1115 if ( ! @cust_pkg ) {
1116 return 'No packages with primary or single services found'.
1117 ' to apply pre-paid time';
1118 } elsif ( scalar(@cust_pkg) > 1 ) {
1119 #maybe have a way to specify the package/account?
1120 return 'Multiple packages found to apply pre-paid time';
1123 my $cust_pkg = $cust_pkg[0];
1124 warn " found package pkgnum ". $cust_pkg->pkgnum. "\n"
1128 $cust_pkg->cust_svc( $cust_pkg->part_pkg->svcpart('svc_acct') );
1130 if ( ! @cust_svc ) {
1131 return 'No account found to apply pre-paid time';
1132 } elsif ( scalar(@cust_svc) > 1 ) {
1133 return 'Multiple accounts found to apply pre-paid time';
1136 my $svc_acct = $cust_svc[0]->svc_x;
1137 warn " found service svcnum ". $svc_acct->pkgnum.
1138 ' ('. $svc_acct->email. ")\n"
1141 $column = "increment_$column";
1142 $svc_acct->$column($amount);
1146 =item insert_cust_pay_prepay AMOUNT [ PAYINFO ]
1148 Inserts a prepayment in the specified amount for this customer. An optional
1149 second argument can specify the prepayment identifier for tracking purposes.
1150 If there is an error, returns the error, otherwise returns false.
1154 sub insert_cust_pay_prepay {
1155 shift->insert_cust_pay('PREP', @_);
1158 =item insert_cust_pay_cash AMOUNT [ PAYINFO ]
1160 Inserts a cash payment in the specified amount for this customer. An optional
1161 second argument can specify the payment identifier for tracking purposes.
1162 If there is an error, returns the error, otherwise returns false.
1166 sub insert_cust_pay_cash {
1167 shift->insert_cust_pay('CASH', @_);
1170 =item insert_cust_pay_west AMOUNT [ PAYINFO ]
1172 Inserts a Western Union payment in the specified amount for this customer. An
1173 optional second argument can specify the prepayment identifier for tracking
1174 purposes. If there is an error, returns the error, otherwise returns false.
1178 sub insert_cust_pay_west {
1179 shift->insert_cust_pay('WEST', @_);
1182 sub insert_cust_pay {
1183 my( $self, $payby, $amount ) = splice(@_, 0, 3);
1184 my $payinfo = scalar(@_) ? shift : '';
1186 my $cust_pay = new FS::cust_pay {
1187 'custnum' => $self->custnum,
1188 'paid' => sprintf('%.2f', $amount),
1189 #'_date' => #date the prepaid card was purchased???
1191 'payinfo' => $payinfo,
1199 This method is deprecated. See the I<depend_jobnum> option to the insert and
1200 order_pkgs methods for a better way to defer provisioning.
1202 Re-schedules all exports by calling the B<reexport> method of all associated
1203 packages (see L<FS::cust_pkg>). If there is an error, returns the error;
1204 otherwise returns false.
1211 carp "WARNING: FS::cust_main::reexport is deprectated; ".
1212 "use the depend_jobnum option to insert or order_pkgs to delay export";
1214 local $SIG{HUP} = 'IGNORE';
1215 local $SIG{INT} = 'IGNORE';
1216 local $SIG{QUIT} = 'IGNORE';
1217 local $SIG{TERM} = 'IGNORE';
1218 local $SIG{TSTP} = 'IGNORE';
1219 local $SIG{PIPE} = 'IGNORE';
1221 my $oldAutoCommit = $FS::UID::AutoCommit;
1222 local $FS::UID::AutoCommit = 0;
1225 foreach my $cust_pkg ( $self->ncancelled_pkgs ) {
1226 my $error = $cust_pkg->reexport;
1228 $dbh->rollback if $oldAutoCommit;
1233 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1238 =item delete NEW_CUSTNUM
1240 This deletes the customer. If there is an error, returns the error, otherwise
1243 This will completely remove all traces of the customer record. This is not
1244 what you want when a customer cancels service; for that, cancel all of the
1245 customer's packages (see L</cancel>).
1247 If the customer has any uncancelled packages, you need to pass a new (valid)
1248 customer number for those packages to be transferred to. Cancelled packages
1249 will be deleted. Did I mention that this is NOT what you want when a customer
1250 cancels service and that you really should be looking see L<FS::cust_pkg/cancel>?
1252 You can't delete a customer with invoices (see L<FS::cust_bill>),
1253 or credits (see L<FS::cust_credit>), payments (see L<FS::cust_pay>) or
1254 refunds (see L<FS::cust_refund>).
1261 local $SIG{HUP} = 'IGNORE';
1262 local $SIG{INT} = 'IGNORE';
1263 local $SIG{QUIT} = 'IGNORE';
1264 local $SIG{TERM} = 'IGNORE';
1265 local $SIG{TSTP} = 'IGNORE';
1266 local $SIG{PIPE} = 'IGNORE';
1268 my $oldAutoCommit = $FS::UID::AutoCommit;
1269 local $FS::UID::AutoCommit = 0;
1272 if ( $self->cust_bill ) {
1273 $dbh->rollback if $oldAutoCommit;
1274 return "Can't delete a customer with invoices";
1276 if ( $self->cust_credit ) {
1277 $dbh->rollback if $oldAutoCommit;
1278 return "Can't delete a customer with credits";
1280 if ( $self->cust_pay ) {
1281 $dbh->rollback if $oldAutoCommit;
1282 return "Can't delete a customer with payments";
1284 if ( $self->cust_refund ) {
1285 $dbh->rollback if $oldAutoCommit;
1286 return "Can't delete a customer with refunds";
1289 my @cust_pkg = $self->ncancelled_pkgs;
1291 my $new_custnum = shift;
1292 unless ( qsearchs( 'cust_main', { 'custnum' => $new_custnum } ) ) {
1293 $dbh->rollback if $oldAutoCommit;
1294 return "Invalid new customer number: $new_custnum";
1296 foreach my $cust_pkg ( @cust_pkg ) {
1297 my %hash = $cust_pkg->hash;
1298 $hash{'custnum'} = $new_custnum;
1299 my $new_cust_pkg = new FS::cust_pkg ( \%hash );
1300 my $error = $new_cust_pkg->replace($cust_pkg,
1301 options => { $cust_pkg->options },
1304 $dbh->rollback if $oldAutoCommit;
1309 my @cancelled_cust_pkg = $self->all_pkgs;
1310 foreach my $cust_pkg ( @cancelled_cust_pkg ) {
1311 my $error = $cust_pkg->delete;
1313 $dbh->rollback if $oldAutoCommit;
1318 foreach my $cust_main_invoice ( #(email invoice destinations, not invoices)
1319 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } )
1321 my $error = $cust_main_invoice->delete;
1323 $dbh->rollback if $oldAutoCommit;
1328 foreach my $cust_main_exemption (
1329 qsearch( 'cust_main_exemption', { 'custnum' => $self->custnum } )
1331 my $error = $cust_main_exemption->delete;
1333 $dbh->rollback if $oldAutoCommit;
1338 my $error = $self->SUPER::delete;
1340 $dbh->rollback if $oldAutoCommit;
1344 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1349 =item replace [ OLD_RECORD ] [ INVOICING_LIST_ARYREF ] [ , OPTION => VALUE ... ] ]
1352 Replaces the OLD_RECORD with this one in the database. If there is an error,
1353 returns the error, otherwise returns false.
1355 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
1356 be set as the invoicing list (see L<"invoicing_list">). Errors return as
1357 expected and rollback the entire transaction; it is not necessary to call
1358 check_invoicing_list first. Here's an example:
1360 $new_cust_main->replace( $old_cust_main, [ $email, 'POST' ] );
1362 Currently available options are: I<tax_exemption>.
1364 The I<tax_exemption> option can be set to an arrayref of tax names.
1365 FS::cust_main_exemption records will be deleted and inserted as appropriate.
1372 my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
1374 : $self->replace_old;
1378 warn "$me replace called\n"
1381 my $curuser = $FS::CurrentUser::CurrentUser;
1382 if ( $self->payby eq 'COMP'
1383 && $self->payby ne $old->payby
1384 && ! $curuser->access_right('Complimentary customer')
1387 return "You are not permitted to create complimentary accounts.";
1390 local($ignore_expired_card) = 1
1391 if $old->payby =~ /^(CARD|DCRD)$/
1392 && $self->payby =~ /^(CARD|DCRD)$/
1393 && ( $old->payinfo eq $self->payinfo || $old->paymask eq $self->paymask );
1395 local $SIG{HUP} = 'IGNORE';
1396 local $SIG{INT} = 'IGNORE';
1397 local $SIG{QUIT} = 'IGNORE';
1398 local $SIG{TERM} = 'IGNORE';
1399 local $SIG{TSTP} = 'IGNORE';
1400 local $SIG{PIPE} = 'IGNORE';
1402 my $oldAutoCommit = $FS::UID::AutoCommit;
1403 local $FS::UID::AutoCommit = 0;
1406 my $error = $self->SUPER::replace($old);
1409 $dbh->rollback if $oldAutoCommit;
1413 if ( @param && ref($param[0]) eq 'ARRAY' ) { # INVOICING_LIST_ARYREF
1414 my $invoicing_list = shift @param;
1415 $error = $self->check_invoicing_list( $invoicing_list );
1417 $dbh->rollback if $oldAutoCommit;
1420 $self->invoicing_list( $invoicing_list );
1423 my %options = @param;
1425 my $tax_exemption = delete $options{'tax_exemption'};
1426 if ( $tax_exemption ) {
1428 my %cust_main_exemption =
1429 map { $_->taxname => $_ }
1430 qsearch('cust_main_exemption', { 'custnum' => $old->custnum } );
1432 foreach my $taxname ( @$tax_exemption ) {
1434 next if delete $cust_main_exemption{$taxname};
1436 my $cust_main_exemption = new FS::cust_main_exemption {
1437 'custnum' => $self->custnum,
1438 'taxname' => $taxname,
1440 my $error = $cust_main_exemption->insert;
1442 $dbh->rollback if $oldAutoCommit;
1443 return "inserting cust_main_exemption (transaction rolled back): $error";
1447 foreach my $cust_main_exemption ( values %cust_main_exemption ) {
1448 my $error = $cust_main_exemption->delete;
1450 $dbh->rollback if $oldAutoCommit;
1451 return "deleting cust_main_exemption (transaction rolled back): $error";
1457 if ( $self->payby =~ /^(CARD|CHEK|LECB)$/ &&
1458 grep { $self->get($_) ne $old->get($_) } qw(payinfo paydate payname) ) {
1459 # card/check/lec info has changed, want to retry realtime_ invoice events
1460 my $error = $self->retry_realtime;
1462 $dbh->rollback if $oldAutoCommit;
1467 unless ( $import || $skip_fuzzyfiles ) {
1468 $error = $self->queue_fuzzyfiles_update;
1470 $dbh->rollback if $oldAutoCommit;
1471 return "updating fuzzy search cache: $error";
1475 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1480 =item queue_fuzzyfiles_update
1482 Used by insert & replace to update the fuzzy search cache
1486 sub queue_fuzzyfiles_update {
1489 local $SIG{HUP} = 'IGNORE';
1490 local $SIG{INT} = 'IGNORE';
1491 local $SIG{QUIT} = 'IGNORE';
1492 local $SIG{TERM} = 'IGNORE';
1493 local $SIG{TSTP} = 'IGNORE';
1494 local $SIG{PIPE} = 'IGNORE';
1496 my $oldAutoCommit = $FS::UID::AutoCommit;
1497 local $FS::UID::AutoCommit = 0;
1500 my $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
1501 my $error = $queue->insert( map $self->getfield($_), @fuzzyfields );
1503 $dbh->rollback if $oldAutoCommit;
1504 return "queueing job (transaction rolled back): $error";
1507 if ( $self->ship_last ) {
1508 $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
1509 $error = $queue->insert( map $self->getfield("ship_$_"), @fuzzyfields );
1511 $dbh->rollback if $oldAutoCommit;
1512 return "queueing job (transaction rolled back): $error";
1516 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1523 Checks all fields to make sure this is a valid customer record. If there is
1524 an error, returns the error, otherwise returns false. Called by the insert
1525 and replace methods.
1532 warn "$me check BEFORE: \n". $self->_dump
1536 $self->ut_numbern('custnum')
1537 || $self->ut_number('agentnum')
1538 || $self->ut_textn('agent_custid')
1539 || $self->ut_number('refnum')
1540 || $self->ut_textn('custbatch')
1541 || $self->ut_name('last')
1542 || $self->ut_name('first')
1543 || $self->ut_snumbern('birthdate')
1544 || $self->ut_snumbern('signupdate')
1545 || $self->ut_textn('company')
1546 || $self->ut_text('address1')
1547 || $self->ut_textn('address2')
1548 || $self->ut_text('city')
1549 || $self->ut_textn('county')
1550 || $self->ut_textn('state')
1551 || $self->ut_country('country')
1552 || $self->ut_anything('comments')
1553 || $self->ut_numbern('referral_custnum')
1554 || $self->ut_textn('stateid')
1555 || $self->ut_textn('stateid_state')
1556 || $self->ut_textn('invoice_terms')
1557 || $self->ut_alphan('geocode')
1558 || $self->ut_floatn('cdr_termination_percentage')
1561 #barf. need message catalogs. i18n. etc.
1562 $error .= "Please select an advertising source."
1563 if $error =~ /^Illegal or empty \(numeric\) refnum: /;
1564 return $error if $error;
1566 return "Unknown agent"
1567 unless qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
1569 return "Unknown refnum"
1570 unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } );
1572 return "Unknown referring custnum: ". $self->referral_custnum
1573 unless ! $self->referral_custnum
1574 || qsearchs( 'cust_main', { 'custnum' => $self->referral_custnum } );
1576 if ( $self->censustract ne '' ) {
1577 $self->censustract =~ /^\s*(\d{9})\.?(\d{2})\s*$/
1578 or return "Illegal census tract: ". $self->censustract;
1580 $self->censustract("$1.$2");
1583 if ( $self->ss eq '' ) {
1588 $ss =~ /^(\d{3})(\d{2})(\d{4})$/
1589 or return "Illegal social security number: ". $self->ss;
1590 $self->ss("$1-$2-$3");
1594 # bad idea to disable, causes billing to fail because of no tax rates later
1595 # unless ( $import ) {
1596 unless ( qsearch('cust_main_county', {
1597 'country' => $self->country,
1600 return "Unknown state/county/country: ".
1601 $self->state. "/". $self->county. "/". $self->country
1602 unless qsearch('cust_main_county',{
1603 'state' => $self->state,
1604 'county' => $self->county,
1605 'country' => $self->country,
1611 $self->ut_phonen('daytime', $self->country)
1612 || $self->ut_phonen('night', $self->country)
1613 || $self->ut_phonen('fax', $self->country)
1614 || $self->ut_zip('zip', $self->country)
1616 return $error if $error;
1618 if ( $conf->exists('cust_main-require_phone')
1619 && ! length($self->daytime) && ! length($self->night)
1622 my $daytime_label = FS::Msgcat::_gettext('daytime') =~ /^(daytime)?$/
1624 : FS::Msgcat::_gettext('daytime');
1625 my $night_label = FS::Msgcat::_gettext('night') =~ /^(night)?$/
1627 : FS::Msgcat::_gettext('night');
1629 return "$daytime_label or $night_label is required"
1633 if ( $self->has_ship_address
1634 && scalar ( grep { $self->getfield($_) ne $self->getfield("ship_$_") }
1635 $self->addr_fields )
1639 $self->ut_name('ship_last')
1640 || $self->ut_name('ship_first')
1641 || $self->ut_textn('ship_company')
1642 || $self->ut_text('ship_address1')
1643 || $self->ut_textn('ship_address2')
1644 || $self->ut_text('ship_city')
1645 || $self->ut_textn('ship_county')
1646 || $self->ut_textn('ship_state')
1647 || $self->ut_country('ship_country')
1649 return $error if $error;
1651 #false laziness with above
1652 unless ( qsearchs('cust_main_county', {
1653 'country' => $self->ship_country,
1656 return "Unknown ship_state/ship_county/ship_country: ".
1657 $self->ship_state. "/". $self->ship_county. "/". $self->ship_country
1658 unless qsearch('cust_main_county',{
1659 'state' => $self->ship_state,
1660 'county' => $self->ship_county,
1661 'country' => $self->ship_country,
1667 $self->ut_phonen('ship_daytime', $self->ship_country)
1668 || $self->ut_phonen('ship_night', $self->ship_country)
1669 || $self->ut_phonen('ship_fax', $self->ship_country)
1670 || $self->ut_zip('ship_zip', $self->ship_country)
1672 return $error if $error;
1674 return "Unit # is required."
1675 if $self->ship_address2 =~ /^\s*$/
1676 && $conf->exists('cust_main-require_address2');
1678 } else { # ship_ info eq billing info, so don't store dup info in database
1680 $self->setfield("ship_$_", '')
1681 foreach $self->addr_fields;
1683 return "Unit # is required."
1684 if $self->address2 =~ /^\s*$/
1685 && $conf->exists('cust_main-require_address2');
1689 #$self->payby =~ /^(CARD|DCRD|CHEK|DCHK|LECB|BILL|COMP|PREPAY|CASH|WEST|MCRD)$/
1690 # or return "Illegal payby: ". $self->payby;
1692 FS::payby->can_payby($self->table, $self->payby)
1693 or return "Illegal payby: ". $self->payby;
1695 $error = $self->ut_numbern('paystart_month')
1696 || $self->ut_numbern('paystart_year')
1697 || $self->ut_numbern('payissue')
1698 || $self->ut_textn('paytype')
1700 return $error if $error;
1702 if ( $self->payip eq '' ) {
1705 $error = $self->ut_ip('payip');
1706 return $error if $error;
1709 # If it is encrypted and the private key is not availaible then we can't
1710 # check the credit card.
1712 my $check_payinfo = 1;
1714 if ($self->is_encrypted($self->payinfo)) {
1718 if ( $check_payinfo && $self->payby =~ /^(CARD|DCRD)$/ ) {
1720 my $payinfo = $self->payinfo;
1721 $payinfo =~ s/\D//g;
1722 $payinfo =~ /^(\d{13,16})$/
1723 or return gettext('invalid_card'); # . ": ". $self->payinfo;
1725 $self->payinfo($payinfo);
1727 or return gettext('invalid_card'); # . ": ". $self->payinfo;
1729 return gettext('unknown_card_type')
1730 if cardtype($self->payinfo) eq "Unknown";
1732 my $ban = qsearchs('banned_pay', $self->_banned_pay_hashref);
1734 return 'Banned credit card: banned on '.
1735 time2str('%a %h %o at %r', $ban->_date).
1736 ' by '. $ban->otaker.
1737 ' (ban# '. $ban->bannum. ')';
1740 if (length($self->paycvv) && !$self->is_encrypted($self->paycvv)) {
1741 if ( cardtype($self->payinfo) eq 'American Express card' ) {
1742 $self->paycvv =~ /^(\d{4})$/
1743 or return "CVV2 (CID) for American Express cards is four digits.";
1746 $self->paycvv =~ /^(\d{3})$/
1747 or return "CVV2 (CVC2/CID) is three digits.";
1754 my $cardtype = cardtype($payinfo);
1755 if ( $cardtype =~ /^(Switch|Solo)$/i ) {
1757 return "Start date or issue number is required for $cardtype cards"
1758 unless $self->paystart_month && $self->paystart_year or $self->payissue;
1760 return "Start month must be between 1 and 12"
1761 if $self->paystart_month
1762 and $self->paystart_month < 1 || $self->paystart_month > 12;
1764 return "Start year must be 1990 or later"
1765 if $self->paystart_year
1766 and $self->paystart_year < 1990;
1768 return "Issue number must be beween 1 and 99"
1770 and $self->payissue < 1 || $self->payissue > 99;
1773 $self->paystart_month('');
1774 $self->paystart_year('');
1775 $self->payissue('');
1778 } elsif ( $check_payinfo && $self->payby =~ /^(CHEK|DCHK)$/ ) {
1780 my $payinfo = $self->payinfo;
1781 $payinfo =~ s/[^\d\@]//g;
1782 if ( $conf->exists('echeck-nonus') ) {
1783 $payinfo =~ /^(\d+)\@(\d+)$/ or return 'invalid echeck account@aba';
1784 $payinfo = "$1\@$2";
1786 $payinfo =~ /^(\d+)\@(\d{9})$/ or return 'invalid echeck account@aba';
1787 $payinfo = "$1\@$2";
1789 $self->payinfo($payinfo);
1792 my $ban = qsearchs('banned_pay', $self->_banned_pay_hashref);
1794 return 'Banned ACH account: banned on '.
1795 time2str('%a %h %o at %r', $ban->_date).
1796 ' by '. $ban->otaker.
1797 ' (ban# '. $ban->bannum. ')';
1800 } elsif ( $self->payby eq 'LECB' ) {
1802 my $payinfo = $self->payinfo;
1803 $payinfo =~ s/\D//g;
1804 $payinfo =~ /^1?(\d{10})$/ or return 'invalid btn billing telephone number';
1806 $self->payinfo($payinfo);
1809 } elsif ( $self->payby eq 'BILL' ) {
1811 $error = $self->ut_textn('payinfo');
1812 return "Illegal P.O. number: ". $self->payinfo if $error;
1815 } elsif ( $self->payby eq 'COMP' ) {
1817 my $curuser = $FS::CurrentUser::CurrentUser;
1818 if ( ! $self->custnum
1819 && ! $curuser->access_right('Complimentary customer')
1822 return "You are not permitted to create complimentary accounts."
1825 $error = $self->ut_textn('payinfo');
1826 return "Illegal comp account issuer: ". $self->payinfo if $error;
1829 } elsif ( $self->payby eq 'PREPAY' ) {
1831 my $payinfo = $self->payinfo;
1832 $payinfo =~ s/\W//g; #anything else would just confuse things
1833 $self->payinfo($payinfo);
1834 $error = $self->ut_alpha('payinfo');
1835 return "Illegal prepayment identifier: ". $self->payinfo if $error;
1836 return "Unknown prepayment identifier"
1837 unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } );
1842 if ( $self->paydate eq '' || $self->paydate eq '-' ) {
1843 return "Expiration date required"
1844 unless $self->payby =~ /^(BILL|PREPAY|CHEK|DCHK|LECB|CASH|WEST|MCRD)$/;
1848 if ( $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/ ) {
1849 ( $m, $y ) = ( $1, length($2) == 4 ? $2 : "20$2" );
1850 } elsif ( $self->paydate =~ /^19(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) {
1851 ( $m, $y ) = ( $2, "19$1" );
1852 } elsif ( $self->paydate =~ /^(20)?(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) {
1853 ( $m, $y ) = ( $3, "20$2" );
1855 return "Illegal expiration date: ". $self->paydate;
1857 $self->paydate("$y-$m-01");
1858 my($nowm,$nowy)=(localtime(time))[4,5]; $nowm++; $nowy+=1900;
1859 return gettext('expired_card')
1861 && !$ignore_expired_card
1862 && ( $y<$nowy || ( $y==$nowy && $1<$nowm ) );
1865 if ( $self->payname eq '' && $self->payby !~ /^(CHEK|DCHK)$/ &&
1866 ( ! $conf->exists('require_cardname')
1867 || $self->payby !~ /^(CARD|DCRD)$/ )
1869 $self->payname( $self->first. " ". $self->getfield('last') );
1871 $self->payname =~ /^([\w \,\.\-\'\&]+)$/
1872 or return gettext('illegal_name'). " payname: ". $self->payname;
1876 foreach my $flag (qw( tax spool_cdr squelch_cdr archived email_csv_cdr )) {
1877 $self->$flag() =~ /^(Y?)$/ or return "Illegal $flag: ". $self->$flag();
1881 $self->otaker(getotaker) unless $self->otaker;
1883 warn "$me check AFTER: \n". $self->_dump
1886 $self->SUPER::check;
1891 Returns a list of fields which have ship_ duplicates.
1896 qw( last first company
1897 address1 address2 city county state zip country
1902 =item has_ship_address
1904 Returns true if this customer record has a separate shipping address.
1908 sub has_ship_address {
1910 scalar( grep { $self->getfield("ship_$_") ne '' } $self->addr_fields );
1913 =item all_pkgs [ EXTRA_QSEARCH_PARAMS_HASHREF ]
1915 Returns all packages (see L<FS::cust_pkg>) for this customer.
1921 my $extra_qsearch = ref($_[0]) ? shift : {};
1923 return $self->num_pkgs unless wantarray || keys(%$extra_qsearch);
1926 if ( $self->{'_pkgnum'} ) {
1927 @cust_pkg = values %{ $self->{'_pkgnum'}->cache };
1929 @cust_pkg = $self->_cust_pkg($extra_qsearch);
1932 sort sort_packages @cust_pkg;
1937 Synonym for B<all_pkgs>.
1942 shift->all_pkgs(@_);
1947 Returns all locations (see L<FS::cust_location>) for this customer.
1953 qsearch('cust_location', { 'custnum' => $self->custnum } );
1956 =item location_label_short
1958 Returns the short label of the service location (see analog in L<FS::cust_location>) for this customer.
1962 # false laziness with FS::cust_location::line_short
1964 sub location_label_short {
1966 my $cydefault = FS::conf->new->config('countrydefault') || 'US';
1968 my $line = $self->address1;
1969 #$line .= ', '. $self->address2 if $self->address2;
1970 $line .= ', '. $self->city;
1971 $line .= ', '. $self->state if $self->state;
1972 $line .= ' '. $self->zip if $self->zip;
1973 $line .= ' '. code2country($self->country) if $self->country ne $cydefault;
1978 =item ncancelled_pkgs [ EXTRA_QSEARCH_PARAMS_HASHREF ]
1980 Returns all non-cancelled packages (see L<FS::cust_pkg>) for this customer.
1984 sub ncancelled_pkgs {
1986 my $extra_qsearch = ref($_[0]) ? shift : {};
1988 return $self->num_ncancelled_pkgs unless wantarray;
1991 if ( $self->{'_pkgnum'} ) {
1993 warn "$me ncancelled_pkgs: returning cached objects"
1996 @cust_pkg = grep { ! $_->getfield('cancel') }
1997 values %{ $self->{'_pkgnum'}->cache };
2001 warn "$me ncancelled_pkgs: searching for packages with custnum ".
2002 $self->custnum. "\n"
2005 $extra_qsearch->{'extra_sql'} .= ' AND ( cancel IS NULL OR cancel = 0 ) ';
2007 @cust_pkg = $self->_cust_pkg($extra_qsearch);
2011 sort sort_packages @cust_pkg;
2017 my $extra_qsearch = ref($_[0]) ? shift : {};
2019 $extra_qsearch->{'select'} ||= '*';
2020 $extra_qsearch->{'select'} .=
2021 ',( SELECT COUNT(*) FROM cust_svc WHERE cust_pkg.pkgnum = cust_svc.pkgnum )
2025 $_->{'_num_cust_svc'} = $_->get('_num_cust_svc');
2030 'table' => 'cust_pkg',
2031 'hashref' => { 'custnum' => $self->custnum },
2036 # This should be generalized to use config options to determine order.
2039 my $locationsort = $a->locationnum <=> $b->locationnum;
2040 return $locationsort if $locationsort;
2042 if ( $a->get('cancel') xor $b->get('cancel') ) {
2043 return -1 if $b->get('cancel');
2044 return 1 if $a->get('cancel');
2045 #shouldn't get here...
2048 my $a_num_cust_svc = $a->num_cust_svc;
2049 my $b_num_cust_svc = $b->num_cust_svc;
2050 return 0 if !$a_num_cust_svc && !$b_num_cust_svc;
2051 return -1 if $a_num_cust_svc && !$b_num_cust_svc;
2052 return 1 if !$a_num_cust_svc && $b_num_cust_svc;
2053 my @a_cust_svc = $a->cust_svc;
2054 my @b_cust_svc = $b->cust_svc;
2055 $a_cust_svc[0]->svc_x->label cmp $b_cust_svc[0]->svc_x->label;
2060 =item suspended_pkgs
2062 Returns all suspended packages (see L<FS::cust_pkg>) for this customer.
2066 sub suspended_pkgs {
2068 grep { $_->susp } $self->ncancelled_pkgs;
2071 =item unflagged_suspended_pkgs
2073 Returns all unflagged suspended packages (see L<FS::cust_pkg>) for this
2074 customer (thouse packages without the `manual_flag' set).
2078 sub unflagged_suspended_pkgs {
2080 return $self->suspended_pkgs
2081 unless dbdef->table('cust_pkg')->column('manual_flag');
2082 grep { ! $_->manual_flag } $self->suspended_pkgs;
2085 =item unsuspended_pkgs
2087 Returns all unsuspended (and uncancelled) packages (see L<FS::cust_pkg>) for
2092 sub unsuspended_pkgs {
2094 grep { ! $_->susp } $self->ncancelled_pkgs;
2097 =item next_bill_date
2099 Returns the next date this customer will be billed, as a UNIX timestamp, or
2100 undef if no active package has a next bill date.
2104 sub next_bill_date {
2106 min( map $_->get('bill'), grep $_->get('bill'), $self->unsuspended_pkgs );
2109 =item num_cancelled_pkgs
2111 Returns the number of cancelled packages (see L<FS::cust_pkg>) for this
2116 sub num_cancelled_pkgs {
2117 shift->num_pkgs("cust_pkg.cancel IS NOT NULL AND cust_pkg.cancel != 0");
2120 sub num_ncancelled_pkgs {
2121 shift->num_pkgs("( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )");
2125 my( $self ) = shift;
2126 my $sql = scalar(@_) ? shift : '';
2127 $sql = "AND $sql" if $sql && $sql !~ /^\s*$/ && $sql !~ /^\s*AND/i;
2128 my $sth = dbh->prepare(
2129 "SELECT COUNT(*) FROM cust_pkg WHERE custnum = ? $sql"
2130 ) or die dbh->errstr;
2131 $sth->execute($self->custnum) or die $sth->errstr;
2132 $sth->fetchrow_arrayref->[0];
2137 Unsuspends all unflagged suspended packages (see L</unflagged_suspended_pkgs>
2138 and L<FS::cust_pkg>) for this customer. Always returns a list: an empty list
2139 on success or a list of errors.
2145 grep { $_->unsuspend } $self->suspended_pkgs;
2150 Suspends all unsuspended packages (see L<FS::cust_pkg>) for this customer.
2152 Returns a list: an empty list on success or a list of errors.
2158 grep { $_->suspend(@_) } $self->unsuspended_pkgs;
2161 =item suspend_if_pkgpart HASHREF | PKGPART [ , PKGPART ... ]
2163 Suspends all unsuspended packages (see L<FS::cust_pkg>) matching the listed
2164 PKGPARTs (see L<FS::part_pkg>). Preferred usage is to pass a hashref instead
2165 of a list of pkgparts; the hashref has the following keys:
2169 =item pkgparts - listref of pkgparts
2171 =item (other options are passed to the suspend method)
2176 Returns a list: an empty list on success or a list of errors.
2180 sub suspend_if_pkgpart {
2182 my (@pkgparts, %opt);
2183 if (ref($_[0]) eq 'HASH'){
2184 @pkgparts = @{$_[0]{pkgparts}};
2189 grep { $_->suspend(%opt) }
2190 grep { my $pkgpart = $_->pkgpart; grep { $pkgpart eq $_ } @pkgparts }
2191 $self->unsuspended_pkgs;
2194 =item suspend_unless_pkgpart HASHREF | PKGPART [ , PKGPART ... ]
2196 Suspends all unsuspended packages (see L<FS::cust_pkg>) unless they match the
2197 given PKGPARTs (see L<FS::part_pkg>). Preferred usage is to pass a hashref
2198 instead of a list of pkgparts; the hashref has the following keys:
2202 =item pkgparts - listref of pkgparts
2204 =item (other options are passed to the suspend method)
2208 Returns a list: an empty list on success or a list of errors.
2212 sub suspend_unless_pkgpart {
2214 my (@pkgparts, %opt);
2215 if (ref($_[0]) eq 'HASH'){
2216 @pkgparts = @{$_[0]{pkgparts}};
2221 grep { $_->suspend(%opt) }
2222 grep { my $pkgpart = $_->pkgpart; ! grep { $pkgpart eq $_ } @pkgparts }
2223 $self->unsuspended_pkgs;
2226 =item cancel [ OPTION => VALUE ... ]
2228 Cancels all uncancelled packages (see L<FS::cust_pkg>) for this customer.
2230 Available options are:
2234 =item quiet - can be set true to supress email cancellation notices.
2236 =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.
2238 =item ban - can be set true to ban this customer's credit card or ACH information, if present.
2240 =item nobill - can be set true to skip billing if it might otherwise be done.
2244 Always returns a list: an empty list on success or a list of errors.
2248 # nb that dates are not specified as valid options to this method
2251 my( $self, %opt ) = @_;
2253 warn "$me cancel called on customer ". $self->custnum. " with options ".
2254 join(', ', map { "$_: $opt{$_}" } keys %opt ). "\n"
2257 return ( 'access denied' )
2258 unless $FS::CurrentUser::CurrentUser->access_right('Cancel customer');
2260 if ( $opt{'ban'} && $self->payby =~ /^(CARD|DCRD|CHEK|DCHK)$/ ) {
2262 #should try decryption (we might have the private key)
2263 # and if not maybe queue a job for the server that does?
2264 return ( "Can't (yet) ban encrypted credit cards" )
2265 if $self->is_encrypted($self->payinfo);
2267 my $ban = new FS::banned_pay $self->_banned_pay_hashref;
2268 my $error = $ban->insert;
2269 return ( $error ) if $error;
2273 my @pkgs = $self->ncancelled_pkgs;
2275 if ( !$opt{nobill} && $conf->exists('bill_usage_on_cancel') ) {
2277 my $error = $self->bill( pkg_list => [ @pkgs ], cancel => 1 );
2278 warn "Error billing during cancel, custnum ". $self->custnum. ": $error"
2282 warn "$me cancelling ". scalar($self->ncancelled_pkgs). "/".
2283 scalar(@pkgs). " packages for customer ". $self->custnum. "\n"
2286 grep { $_ } map { $_->cancel(%opt) } $self->ncancelled_pkgs;
2289 sub _banned_pay_hashref {
2300 'payby' => $payby2ban{$self->payby},
2301 'payinfo' => md5_base64($self->payinfo),
2302 #don't ever *search* on reason! #'reason' =>
2308 Returns all notes (see L<FS::cust_main_note>) for this customer.
2315 qsearch( 'cust_main_note',
2316 { 'custnum' => $self->custnum },
2318 'ORDER BY _DATE DESC'
2324 Returns the agent (see L<FS::agent>) for this customer.
2330 qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
2333 =item bill_and_collect
2335 Cancels and suspends any packages due, generates bills, applies payments and
2338 Warns on errors (Does not currently: If there is an error, returns the error, otherwise returns false.)
2340 Options are passed as name-value pairs. Currently available options are:
2346 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:
2350 $cust_main->bill( 'time' => str2time('April 20th, 2001') );
2354 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.
2358 "1d" for the traditional, daily events (the default), or "1m" for the new monthly events (part_event.check_freq)
2362 If set true, re-charges setup fees.
2366 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)
2370 Options are passed to the B<bill> and B<collect> methods verbatim, so all
2371 options of those methods are also available.
2375 sub bill_and_collect {
2376 my( $self, %options ) = @_;
2378 #$options{actual_time} not $options{time} because freeside-daily -d is for
2379 #pre-printing invoices
2380 $self->cancel_expired_pkgs( $options{actual_time} );
2381 $self->suspend_adjourned_pkgs( $options{actual_time} );
2383 my $error = $self->bill( %options );
2384 warn "Error billing, custnum ". $self->custnum. ": $error" if $error;
2386 $self->apply_payments_and_credits;
2388 unless ( $conf->exists('cancelled_cust-noevents')
2389 && ! $self->num_ncancelled_pkgs
2392 $error = $self->collect( %options );
2393 warn "Error collecting, custnum". $self->custnum. ": $error" if $error;
2399 sub cancel_expired_pkgs {
2400 my ( $self, $time ) = @_;
2402 my @cancel_pkgs = $self->ncancelled_pkgs( {
2403 'extra_sql' => " AND expire IS NOT NULL AND expire > 0 AND expire <= $time "
2406 foreach my $cust_pkg ( @cancel_pkgs ) {
2407 my $cpr = $cust_pkg->last_cust_pkg_reason('expire');
2408 my $error = $cust_pkg->cancel($cpr ? ( 'reason' => $cpr->reasonnum,
2409 'reason_otaker' => $cpr->otaker
2413 warn "Error cancelling expired pkg ". $cust_pkg->pkgnum.
2414 " for custnum ". $self->custnum. ": $error"
2420 sub suspend_adjourned_pkgs {
2421 my ( $self, $time ) = @_;
2423 my @susp_pkgs = $self->ncancelled_pkgs( {
2425 " AND ( susp IS NULL OR susp = 0 )
2426 AND ( ( bill IS NOT NULL AND bill != 0 AND bill < $time )
2427 OR ( adjourn IS NOT NULL AND adjourn != 0 AND adjourn <= $time )
2432 #only because there's no SQL test for is_prepaid :/
2434 grep { ( $_->part_pkg->is_prepaid
2439 && $_->adjourn <= $time
2445 foreach my $cust_pkg ( @susp_pkgs ) {
2446 my $cpr = $cust_pkg->last_cust_pkg_reason('adjourn')
2447 if ($cust_pkg->adjourn && $cust_pkg->adjourn < $^T);
2448 my $error = $cust_pkg->suspend($cpr ? ( 'reason' => $cpr->reasonnum,
2449 'reason_otaker' => $cpr->otaker
2454 warn "Error suspending package ". $cust_pkg->pkgnum.
2455 " for custnum ". $self->custnum. ": $error"
2463 Generates invoices (see L<FS::cust_bill>) for this customer. Usually used in
2464 conjunction with the collect method by calling B<bill_and_collect>.
2466 If there is an error, returns the error, otherwise returns false.
2468 Options are passed as name-value pairs. Currently available options are:
2474 If set true, re-charges setup fees.
2478 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:
2482 $cust_main->bill( 'time' => str2time('April 20th, 2001') );
2486 An array ref of specific packages (objects) to attempt billing, instead trying all of them.
2488 $cust_main->bill( pkg_list => [$pkg1, $pkg2] );
2492 A hashref of pkgparts to exclude from this billing run (can also be specified as a comma-separated scalar).
2496 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.
2500 This boolean value informs the us that the package is being cancelled. This
2501 typically might mean not charging the normal recurring fee but only usage
2502 fees since the last billing. Setup charges may be charged. Not all package
2503 plans support this feature (they tend to charge 0).
2507 Optional terms to be printed on this invoice. Otherwise, customer-specific
2508 terms or the default terms are used.
2515 my( $self, %options ) = @_;
2516 return '' if $self->payby eq 'COMP';
2517 warn "$me bill customer ". $self->custnum. "\n"
2520 my $time = $options{'time'} || time;
2521 my $invoice_time = $options{'invoice_time'} || $time;
2523 $options{'not_pkgpart'} ||= {};
2524 $options{'not_pkgpart'} = { map { $_ => 1 }
2525 split(/\s*,\s*/, $options{'not_pkgpart'})
2527 unless ref($options{'not_pkgpart'});
2529 local $SIG{HUP} = 'IGNORE';
2530 local $SIG{INT} = 'IGNORE';
2531 local $SIG{QUIT} = 'IGNORE';
2532 local $SIG{TERM} = 'IGNORE';
2533 local $SIG{TSTP} = 'IGNORE';
2534 local $SIG{PIPE} = 'IGNORE';
2536 my $oldAutoCommit = $FS::UID::AutoCommit;
2537 local $FS::UID::AutoCommit = 0;
2540 $self->select_for_update; #mutex
2542 my $error = $self->do_cust_event(
2543 'debug' => ( $options{'debug'} || 0 ),
2544 'time' => $invoice_time,
2545 'check_freq' => $options{'check_freq'},
2546 'stage' => 'pre-bill',
2549 $dbh->rollback if $oldAutoCommit;
2553 my @cust_bill_pkg = ();
2556 # find the packages which are due for billing, find out how much they are
2557 # & generate invoice database.
2560 my( $total_setup, $total_recur, $postal_charge ) = ( 0, 0, 0 );
2562 my @precommit_hooks = ();
2564 $options{'pkg_list'} ||= [ $self->ncancelled_pkgs ]; #param checks?
2565 foreach my $cust_pkg ( @{ $options{'pkg_list'} } ) {
2567 next if $options{'not_pkgpart'}->{$cust_pkg->pkgpart};
2569 warn " bill package ". $cust_pkg->pkgnum. "\n" if $DEBUG > 1;
2571 #? to avoid use of uninitialized value errors... ?
2572 $cust_pkg->setfield('bill', '')
2573 unless defined($cust_pkg->bill);
2575 #my $part_pkg = $cust_pkg->part_pkg;
2577 my $real_pkgpart = $cust_pkg->pkgpart;
2578 my %hash = $cust_pkg->hash;
2580 foreach my $part_pkg ( $cust_pkg->part_pkg->self_and_bill_linked ) {
2582 $cust_pkg->set($_, $hash{$_}) foreach qw ( setup last_bill bill );
2585 $self->_make_lines( 'part_pkg' => $part_pkg,
2586 'cust_pkg' => $cust_pkg,
2587 'precommit_hooks' => \@precommit_hooks,
2588 'line_items' => \@cust_bill_pkg,
2589 'setup' => \$total_setup,
2590 'recur' => \$total_recur,
2591 'tax_matrix' => \%taxlisthash,
2593 'real_pkgpart' => $real_pkgpart,
2594 'options' => \%options,
2597 $dbh->rollback if $oldAutoCommit;
2601 } #foreach my $part_pkg
2603 } #foreach my $cust_pkg
2605 unless ( @cust_bill_pkg ) { #don't create an invoice w/o line items
2606 #but do commit any package date cycling that happened
2607 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2611 if ( scalar( grep { $_->recur && $_->recur > 0 } @cust_bill_pkg) ||
2612 !$conf->exists('postal_invoice-recurring_only')
2616 my $postal_pkg = $self->charge_postal_fee();
2617 if ( $postal_pkg && !ref( $postal_pkg ) ) {
2619 $dbh->rollback if $oldAutoCommit;
2620 return "can't charge postal invoice fee for customer ".
2621 $self->custnum. ": $postal_pkg";
2623 } elsif ( $postal_pkg ) {
2625 my $real_pkgpart = $postal_pkg->pkgpart;
2626 foreach my $part_pkg ( $postal_pkg->part_pkg->self_and_bill_linked ) {
2627 my %postal_options = %options;
2628 delete $postal_options{cancel};
2630 $self->_make_lines( 'part_pkg' => $part_pkg,
2631 'cust_pkg' => $postal_pkg,
2632 'precommit_hooks' => \@precommit_hooks,
2633 'line_items' => \@cust_bill_pkg,
2634 'setup' => \$total_setup,
2635 'recur' => \$total_recur,
2636 'tax_matrix' => \%taxlisthash,
2638 'real_pkgpart' => $real_pkgpart,
2639 'options' => \%postal_options,
2642 $dbh->rollback if $oldAutoCommit;
2651 warn "having a look at the taxes we found...\n" if $DEBUG > 2;
2653 # keys are tax names (as printed on invoices / itemdesc )
2654 # values are listrefs of taxlisthash keys (internal identifiers)
2657 # keys are taxlisthash keys (internal identifiers)
2658 # values are (cumulative) amounts
2661 # keys are taxlisthash keys (internal identifiers)
2662 # values are listrefs of cust_bill_pkg_tax_location hashrefs
2663 my %tax_location = ();
2665 # keys are taxlisthash keys (internal identifiers)
2666 # values are listrefs of cust_bill_pkg_tax_rate_location hashrefs
2667 my %tax_rate_location = ();
2669 foreach my $tax ( keys %taxlisthash ) {
2670 my $tax_object = shift @{ $taxlisthash{$tax} };
2671 warn "found ". $tax_object->taxname. " as $tax\n" if $DEBUG > 2;
2672 warn " ". join('/', @{ $taxlisthash{$tax} } ). "\n" if $DEBUG > 2;
2673 my $hashref_or_error =
2674 $tax_object->taxline( $taxlisthash{$tax},
2675 'custnum' => $self->custnum,
2676 'invoice_time' => $invoice_time
2678 unless ( ref($hashref_or_error) ) {
2679 $dbh->rollback if $oldAutoCommit;
2680 return $hashref_or_error;
2682 unshift @{ $taxlisthash{$tax} }, $tax_object;
2684 my $name = $hashref_or_error->{'name'};
2685 my $amount = $hashref_or_error->{'amount'};
2687 #warn "adding $amount as $name\n";
2688 $taxname{ $name } ||= [];
2689 push @{ $taxname{ $name } }, $tax;
2691 $tax{ $tax } += $amount;
2693 $tax_location{ $tax } ||= [];
2694 if ( $tax_object->get('pkgnum') || $tax_object->get('locationnum') ) {
2695 push @{ $tax_location{ $tax } },
2697 'taxnum' => $tax_object->taxnum,
2698 'taxtype' => ref($tax_object),
2699 'pkgnum' => $tax_object->get('pkgnum'),
2700 'locationnum' => $tax_object->get('locationnum'),
2701 'amount' => sprintf('%.2f', $amount ),
2705 $tax_rate_location{ $tax } ||= [];
2706 if ( ref($tax_object) eq 'FS::tax_rate' ) {
2707 my $taxratelocationnum =
2708 $tax_object->tax_rate_location->taxratelocationnum;
2709 push @{ $tax_rate_location{ $tax } },
2711 'taxnum' => $tax_object->taxnum,
2712 'taxtype' => ref($tax_object),
2713 'amount' => sprintf('%.2f', $amount ),
2714 'locationtaxid' => $tax_object->location,
2715 'taxratelocationnum' => $taxratelocationnum,
2721 #move the cust_tax_exempt_pkg records to the cust_bill_pkgs we will commit
2722 my %packagemap = map { $_->pkgnum => $_ } @cust_bill_pkg;
2723 foreach my $tax ( keys %taxlisthash ) {
2724 foreach ( @{ $taxlisthash{$tax} }[1 ... scalar(@{ $taxlisthash{$tax} })] ) {
2725 next unless ref($_) eq 'FS::cust_bill_pkg';
2727 push @{ $packagemap{$_->pkgnum}->_cust_tax_exempt_pkg },
2728 splice( @{ $_->_cust_tax_exempt_pkg } );
2732 #consolidate and create tax line items
2733 warn "consolidating and generating...\n" if $DEBUG > 2;
2734 foreach my $taxname ( keys %taxname ) {
2737 my @cust_bill_pkg_tax_location = ();
2738 my @cust_bill_pkg_tax_rate_location = ();
2739 warn "adding $taxname\n" if $DEBUG > 1;
2740 foreach my $taxitem ( @{ $taxname{$taxname} } ) {
2741 next if $seen{$taxitem}++;
2742 warn "adding $tax{$taxitem}\n" if $DEBUG > 1;
2743 $tax += $tax{$taxitem};
2744 push @cust_bill_pkg_tax_location,
2745 map { new FS::cust_bill_pkg_tax_location $_ }
2746 @{ $tax_location{ $taxitem } };
2747 push @cust_bill_pkg_tax_rate_location,
2748 map { new FS::cust_bill_pkg_tax_rate_location $_ }
2749 @{ $tax_rate_location{ $taxitem } };
2753 $tax = sprintf('%.2f', $tax );
2754 $total_setup = sprintf('%.2f', $total_setup+$tax );
2756 my $pkg_category = qsearchs( 'pkg_category', { 'categoryname' => $taxname,
2762 if ( $pkg_category and
2763 $conf->config('invoice_latexsummary') ||
2764 $conf->config('invoice_htmlsummary')
2768 my %hash = ( 'section' => $pkg_category->categoryname );
2769 push @display, new FS::cust_bill_pkg_display { type => 'S', %hash };
2773 push @cust_bill_pkg, new FS::cust_bill_pkg {
2779 'itemdesc' => $taxname,
2780 'display' => \@display,
2781 'cust_bill_pkg_tax_location' => \@cust_bill_pkg_tax_location,
2782 'cust_bill_pkg_tax_rate_location' => \@cust_bill_pkg_tax_rate_location,
2787 #add tax adjustments
2788 warn "adding tax adjustments...\n" if $DEBUG > 2;
2789 foreach my $cust_tax_adjustment (
2790 qsearch('cust_tax_adjustment', { 'custnum' => $self->custnum,
2796 my $tax = sprintf('%.2f', $cust_tax_adjustment->amount );
2797 $total_setup = sprintf('%.2f', $total_setup+$tax );
2799 my $itemdesc = $cust_tax_adjustment->taxname;
2800 $itemdesc = '' if $itemdesc eq 'Tax';
2802 push @cust_bill_pkg, new FS::cust_bill_pkg {
2808 'itemdesc' => $itemdesc,
2809 'itemcomment' => $cust_tax_adjustment->comment,
2810 'cust_tax_adjustment' => $cust_tax_adjustment,
2811 #'cust_bill_pkg_tax_location' => \@cust_bill_pkg_tax_location,
2816 my $charged = sprintf('%.2f', $total_setup + $total_recur );
2818 my @cust_bill = $self->cust_bill;
2819 my $balance = $self->balance;
2820 my $previous_balance = scalar(@cust_bill)
2821 ? ( $cust_bill[$#cust_bill]->billing_balance || 0 )
2824 $previous_balance += $cust_bill[$#cust_bill]->charged
2825 if scalar(@cust_bill);
2826 #my $balance_adjustments =
2827 # sprintf('%.2f', $balance - $prior_prior_balance - $prior_charged);
2829 #create the new invoice
2830 my $cust_bill = new FS::cust_bill ( {
2831 'custnum' => $self->custnum,
2832 '_date' => ( $invoice_time ),
2833 'charged' => $charged,
2834 'billing_balance' => $balance,
2835 'previous_balance' => $previous_balance,
2836 'invoice_terms' => $options{'invoice_terms'},
2838 $error = $cust_bill->insert;
2840 $dbh->rollback if $oldAutoCommit;
2841 return "can't create invoice for customer #". $self->custnum. ": $error";
2844 foreach my $cust_bill_pkg ( @cust_bill_pkg ) {
2845 $cust_bill_pkg->invnum($cust_bill->invnum);
2846 my $error = $cust_bill_pkg->insert;
2848 $dbh->rollback if $oldAutoCommit;
2849 return "can't create invoice line item: $error";
2854 foreach my $hook ( @precommit_hooks ) {
2856 &{$hook}; #($self) ?
2859 $dbh->rollback if $oldAutoCommit;
2860 return "$@ running precommit hook $hook\n";
2864 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2870 my ($self, %params) = @_;
2872 my $part_pkg = $params{part_pkg} or die "no part_pkg specified";
2873 my $cust_pkg = $params{cust_pkg} or die "no cust_pkg specified";
2874 my $precommit_hooks = $params{precommit_hooks} or die "no package specified";
2875 my $cust_bill_pkgs = $params{line_items} or die "no line buffer specified";
2876 my $total_setup = $params{setup} or die "no setup accumulator specified";
2877 my $total_recur = $params{recur} or die "no recur accumulator specified";
2878 my $taxlisthash = $params{tax_matrix} or die "no tax accumulator specified";
2879 my $time = $params{'time'} or die "no time specified";
2880 my (%options) = %{$params{options}};
2883 my $real_pkgpart = $params{real_pkgpart};
2884 my %hash = $cust_pkg->hash;
2885 my $old_cust_pkg = new FS::cust_pkg \%hash;
2891 $cust_pkg->pkgpart($part_pkg->pkgpart);
2899 if ( $options{'resetup'}
2900 || ( ! $cust_pkg->setup
2901 && ( ! $cust_pkg->start_date
2902 || $cust_pkg->start_date <= $time
2904 && ( ! $conf->exists('disable_setup_suspended_pkgs')
2905 || ( $conf->exists('disable_setup_suspended_pkgs') &&
2906 ! $cust_pkg->getfield('susp')
2913 warn " bill setup\n" if $DEBUG > 1;
2916 $setup = eval { $cust_pkg->calc_setup( $time, \@details ) };
2917 return "$@ running calc_setup for $cust_pkg\n"
2920 $unitsetup = $cust_pkg->part_pkg->unit_setup || $setup; #XXX uuh
2922 $cust_pkg->setfield('setup', $time)
2923 unless $cust_pkg->setup;
2924 #do need it, but it won't get written to the db
2925 #|| $cust_pkg->pkgpart != $real_pkgpart;
2927 $cust_pkg->setfield('start_date', '')
2928 if $cust_pkg->start_date;
2933 # bill recurring fee
2936 #XXX unit stuff here too
2940 if ( ! $cust_pkg->get('susp')
2941 and ! $cust_pkg->get('start_date')
2942 and ( $part_pkg->getfield('freq') ne '0'
2943 && ( $cust_pkg->getfield('bill') || 0 ) <= $time
2945 || ( $part_pkg->plan eq 'voip_cdr'
2946 && $part_pkg->option('bill_every_call')
2948 || ( $options{cancel} )
2951 # XXX should this be a package event? probably. events are called
2952 # at collection time at the moment, though...
2953 $part_pkg->reset_usage($cust_pkg, 'debug'=>$DEBUG)
2954 if $part_pkg->can('reset_usage');
2955 #don't want to reset usage just cause we want a line item??
2956 #&& $part_pkg->pkgpart == $real_pkgpart;
2958 warn " bill recur\n" if $DEBUG > 1;
2961 # XXX shared with $recur_prog
2962 $sdate = ( $options{cancel} ? $cust_pkg->last_bill : $cust_pkg->bill )
2966 #over two params! lets at least switch to a hashref for the rest...
2967 my $increment_next_bill = ( $part_pkg->freq ne '0'
2968 && ( $cust_pkg->getfield('bill') || 0 ) <= $time
2969 && !$options{cancel}
2971 my %param = ( 'precommit_hooks' => $precommit_hooks,
2972 'increment_next_bill' => $increment_next_bill,
2975 my $method = $options{cancel} ? 'calc_cancel' : 'calc_recur';
2976 $recur = eval { $cust_pkg->$method( \$sdate, \@details, \%param ) };
2977 return "$@ running $method for $cust_pkg\n"
2980 if ( $increment_next_bill ) {
2982 my $next_bill = $part_pkg->add_freq($sdate);
2983 return "unparsable frequency: ". $part_pkg->freq
2984 if $next_bill == -1;
2986 #pro-rating magic - if $recur_prog fiddled $sdate, want to use that
2987 # only for figuring next bill date, nothing else, so, reset $sdate again
2989 $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
2990 #no need, its in $hash{last_bill}# my $last_bill = $cust_pkg->last_bill;
2991 $cust_pkg->last_bill($sdate);
2993 $cust_pkg->setfield('bill', $next_bill );
2999 warn "\$setup is undefined" unless defined($setup);
3000 warn "\$recur is undefined" unless defined($recur);
3001 warn "\$cust_pkg->bill is undefined" unless defined($cust_pkg->bill);
3004 # If there's line items, create em cust_bill_pkg records
3005 # If $cust_pkg has been modified, update it (if we're a real pkgpart)
3010 if ( $cust_pkg->modified && $cust_pkg->pkgpart == $real_pkgpart ) {
3011 # hmm.. and if just the options are modified in some weird price plan?
3013 warn " package ". $cust_pkg->pkgnum. " modified; updating\n"
3016 my $error = $cust_pkg->replace( $old_cust_pkg,
3017 'options' => { $cust_pkg->options },
3019 return "Error modifying pkgnum ". $cust_pkg->pkgnum. ": $error"
3020 if $error; #just in case
3023 $setup = sprintf( "%.2f", $setup );
3024 $recur = sprintf( "%.2f", $recur );
3025 if ( $setup < 0 && ! $conf->exists('allow_negative_charges') ) {
3026 return "negative setup $setup for pkgnum ". $cust_pkg->pkgnum;
3028 if ( $recur < 0 && ! $conf->exists('allow_negative_charges') ) {
3029 return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum;
3032 if ( $setup != 0 || $recur != 0 ) {
3034 warn " charges (setup=$setup, recur=$recur); adding line items\n"
3037 my @cust_pkg_detail = map { $_->detail } $cust_pkg->cust_pkg_detail('I');
3039 warn " adding customer package invoice detail: $_\n"
3040 foreach @cust_pkg_detail;
3042 push @details, @cust_pkg_detail;
3044 my $cust_bill_pkg = new FS::cust_bill_pkg {
3045 'pkgnum' => $cust_pkg->pkgnum,
3047 'unitsetup' => $unitsetup,
3049 'unitrecur' => $unitrecur,
3050 'quantity' => $cust_pkg->quantity,
3051 'details' => \@details,
3052 'hidden' => $part_pkg->hidden,
3055 if ( $part_pkg->option('recur_temporality', 1) eq 'preceding' ) {
3056 $cust_bill_pkg->sdate( $hash{last_bill} );
3057 $cust_bill_pkg->edate( $sdate - 86399 ); #60s*60m*24h-1
3058 $cust_bill_pkg->edate( $time ) if $options{cancel};
3059 } else { #if ( $part_pkg->option('recur_temporality', 1) eq 'upcoming' ) {
3060 $cust_bill_pkg->sdate( $sdate );
3061 $cust_bill_pkg->edate( $cust_pkg->bill );
3062 #$cust_bill_pkg->edate( $time ) if $options{cancel};
3065 $cust_bill_pkg->pkgpart_override($part_pkg->pkgpart)
3066 unless $part_pkg->pkgpart == $real_pkgpart;
3068 $$total_setup += $setup;
3069 $$total_recur += $recur;
3076 $self->_handle_taxes($part_pkg, $taxlisthash, $cust_bill_pkg, $cust_pkg, $options{invoice_time}, $real_pkgpart, \%options);
3077 return $error if $error;
3079 push @$cust_bill_pkgs, $cust_bill_pkg;
3081 } #if $setup != 0 || $recur != 0
3091 my $part_pkg = shift;
3092 my $taxlisthash = shift;
3093 my $cust_bill_pkg = shift;
3094 my $cust_pkg = shift;
3095 my $invoice_time = shift;
3096 my $real_pkgpart = shift;
3097 my $options = shift;
3099 my %cust_bill_pkg = ();
3103 #push @classes, $cust_bill_pkg->usage_classes if $cust_bill_pkg->type eq 'U';
3104 push @classes, $cust_bill_pkg->usage_classes if $cust_bill_pkg->usage;
3105 push @classes, 'setup' if ($cust_bill_pkg->setup && !$options->{cancel});
3106 push @classes, 'recur' if ($cust_bill_pkg->recur && !$options->{cancel});
3108 if ( $self->tax !~ /Y/i && $self->payby ne 'COMP' ) {
3110 if ( $conf->exists('enable_taxproducts')
3111 && ( scalar($part_pkg->part_pkg_taxoverride)
3112 || $part_pkg->has_taxproduct
3117 if ( $conf->exists('tax-pkg_address') && $cust_pkg->locationnum ) {
3118 return "fatal: Can't (yet) use tax-pkg_address with taxproducts";
3121 foreach my $class (@classes) {
3122 my $err_or_ref = $self->_gather_taxes( $part_pkg, $class );
3123 return $err_or_ref unless ref($err_or_ref);
3124 $taxes{$class} = $err_or_ref;
3127 unless (exists $taxes{''}) {
3128 my $err_or_ref = $self->_gather_taxes( $part_pkg, '' );
3129 return $err_or_ref unless ref($err_or_ref);
3130 $taxes{''} = $err_or_ref;
3135 my @loc_keys = qw( state county country );
3137 if ( $conf->exists('tax-pkg_address') && $cust_pkg->locationnum ) {
3138 my $cust_location = $cust_pkg->cust_location;
3139 %taxhash = map { $_ => $cust_location->$_() } @loc_keys;
3142 ( $conf->exists('tax-ship_address') && length($self->ship_last) )
3145 %taxhash = map { $_ => $self->get("$prefix$_") } @loc_keys;
3148 $taxhash{'taxclass'} = $part_pkg->taxclass;
3150 my @taxes = qsearch( 'cust_main_county', \%taxhash );
3152 my %taxhash_elim = %taxhash;
3154 my @elim = qw( taxclass county state );
3155 while ( !scalar(@taxes) && scalar(@elim) ) {
3156 $taxhash_elim{ shift(@elim) } = '';
3157 @taxes = qsearch( 'cust_main_county', \%taxhash_elim );
3160 @taxes = grep { ! $_->taxname or ! $self->tax_exemption($_->taxname) }
3162 if $self->cust_main_exemption; #just to be safe
3164 if ( $conf->exists('tax-pkg_address') && $cust_pkg->locationnum ) {
3166 $_->set('pkgnum', $cust_pkg->pkgnum );
3167 $_->set('locationnum', $cust_pkg->locationnum );
3171 $taxes{''} = [ @taxes ];
3172 $taxes{'setup'} = [ @taxes ];
3173 $taxes{'recur'} = [ @taxes ];
3174 $taxes{$_} = [ @taxes ] foreach (@classes);
3176 # # maybe eliminate this entirely, along with all the 0% records
3177 # unless ( @taxes ) {
3179 # "fatal: can't find tax rate for state/county/country/taxclass ".
3180 # join('/', map $taxhash{$_}, qw(state county country taxclass) );
3183 } #if $conf->exists('enable_taxproducts') ...
3188 my $separate = $conf->exists('separate_usage');
3189 my $usage_mandate = $cust_pkg->part_pkg->option('usage_mandate', 'Hush!');
3190 if ( $separate || $cust_bill_pkg->hidden || $usage_mandate ) {
3192 my $temp_pkg = new FS::cust_pkg { pkgpart => $real_pkgpart };
3193 my %hash = $cust_bill_pkg->hidden # maybe for all bill linked?
3194 ? ( 'section' => $temp_pkg->part_pkg->categoryname )
3197 my $section = $cust_pkg->part_pkg->option('usage_section', 'Hush!');
3198 my $summary = $cust_pkg->part_pkg->option('summarize_usage', 'Hush!');
3200 push @display, new FS::cust_bill_pkg_display { type => 'S', %hash };
3201 push @display, new FS::cust_bill_pkg_display { type => 'R', %hash };
3203 push @display, new FS::cust_bill_pkg_display
3206 ( ( $usage_mandate ) ? ( 'summary' => 'Y' ) : () ),
3210 if ($separate && $section && $summary) {
3211 push @display, new FS::cust_bill_pkg_display { type => 'U',
3216 if ($usage_mandate || $section && $summary) {
3217 $hash{post_total} = 'Y';
3220 $hash{section} = $section if ($separate || $usage_mandate);
3221 push @display, new FS::cust_bill_pkg_display { type => 'U', %hash };
3224 $cust_bill_pkg->set('display', \@display);
3226 my %tax_cust_bill_pkg = $cust_bill_pkg->disintegrate;
3227 foreach my $key (keys %tax_cust_bill_pkg) {
3228 my @taxes = @{ $taxes{$key} || [] };
3229 my $tax_cust_bill_pkg = $tax_cust_bill_pkg{$key};
3231 my %localtaxlisthash = ();
3232 foreach my $tax ( @taxes ) {
3234 my $taxname = ref( $tax ). ' '. $tax->taxnum;
3235 # $taxname .= ' pkgnum'. $cust_pkg->pkgnum.
3236 # ' locationnum'. $cust_pkg->locationnum
3237 # if $conf->exists('tax-pkg_address') && $cust_pkg->locationnum;
3239 $taxlisthash->{ $taxname } ||= [ $tax ];
3240 push @{ $taxlisthash->{ $taxname } }, $tax_cust_bill_pkg;
3242 $localtaxlisthash{ $taxname } ||= [ $tax ];
3243 push @{ $localtaxlisthash{ $taxname } }, $tax_cust_bill_pkg;
3247 warn "finding taxed taxes...\n" if $DEBUG > 2;
3248 foreach my $tax ( keys %localtaxlisthash ) {
3249 my $tax_object = shift @{ $localtaxlisthash{$tax} };
3250 warn "found possible taxed tax ". $tax_object->taxname. " we call $tax\n"
3252 next unless $tax_object->can('tax_on_tax');
3254 foreach my $tot ( $tax_object->tax_on_tax( $self ) ) {
3255 my $totname = ref( $tot ). ' '. $tot->taxnum;
3257 warn "checking $totname which we call ". $tot->taxname. " as applicable\n"
3259 next unless exists( $localtaxlisthash{ $totname } ); # only increase
3261 warn "adding $totname to taxed taxes\n" if $DEBUG > 2;
3262 my $hashref_or_error =
3263 $tax_object->taxline( $localtaxlisthash{$tax},
3264 'custnum' => $self->custnum,
3265 'invoice_time' => $invoice_time,
3267 return $hashref_or_error
3268 unless ref($hashref_or_error);
3270 $taxlisthash->{ $totname } ||= [ $tot ];
3271 push @{ $taxlisthash->{ $totname } }, $hashref_or_error->{amount};
3283 my $part_pkg = shift;
3287 my $geocode = $self->geocode('cch');
3289 my @taxclassnums = map { $_->taxclassnum }
3290 $part_pkg->part_pkg_taxoverride($class);
3292 unless (@taxclassnums) {
3293 @taxclassnums = map { $_->taxclassnum }
3294 grep { $_->taxable eq 'Y' }
3295 $part_pkg->part_pkg_taxrate('cch', $geocode, $class);
3297 warn "Found taxclassnum values of ". join(',', @taxclassnums)
3302 join(' OR ', map { "taxclassnum = $_" } @taxclassnums ). ")";
3304 @taxes = qsearch({ 'table' => 'tax_rate',
3305 'hashref' => { 'geocode' => $geocode, },
3306 'extra_sql' => $extra_sql,
3308 if scalar(@taxclassnums);
3310 warn "Found taxes ".
3311 join(',', map{ ref($_). " ". $_->get($_->primary_key) } @taxes). "\n"
3318 =item collect [ HASHREF | OPTION => VALUE ... ]
3320 (Attempt to) collect money for this customer's outstanding invoices (see
3321 L<FS::cust_bill>). Usually used after the bill method.
3323 Actions are now triggered by billing events; see L<FS::part_event> and the
3324 billing events web interface. Old-style invoice events (see
3325 L<FS::part_bill_event>) have been deprecated.
3327 If there is an error, returns the error, otherwise returns false.
3329 Options are passed as name-value pairs.
3331 Currently available options are:
3337 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.
3341 Retry card/echeck/LEC transactions even when not scheduled by invoice events.
3345 "1d" for the traditional, daily events (the default), or "1m" for the new monthly events (part_event.check_freq)
3349 set true to surpress email card/ACH decline notices.
3353 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)
3359 # allows for one time override of normal customer billing method
3364 my( $self, %options ) = @_;
3365 my $invoice_time = $options{'invoice_time'} || time;
3368 local $SIG{HUP} = 'IGNORE';
3369 local $SIG{INT} = 'IGNORE';
3370 local $SIG{QUIT} = 'IGNORE';
3371 local $SIG{TERM} = 'IGNORE';
3372 local $SIG{TSTP} = 'IGNORE';
3373 local $SIG{PIPE} = 'IGNORE';
3375 my $oldAutoCommit = $FS::UID::AutoCommit;
3376 local $FS::UID::AutoCommit = 0;
3379 $self->select_for_update; #mutex
3382 my $balance = $self->balance;
3383 warn "$me collect customer ". $self->custnum. ": balance $balance\n"
3386 if ( exists($options{'retry_card'}) ) {
3387 carp 'retry_card option passed to collect is deprecated; use retry';
3388 $options{'retry'} ||= $options{'retry_card'};
3390 if ( exists($options{'retry'}) && $options{'retry'} ) {
3391 my $error = $self->retry_realtime;
3393 $dbh->rollback if $oldAutoCommit;
3398 my $error = $self->do_cust_event(
3399 'debug' => ( $options{'debug'} || 0 ),
3400 'time' => $invoice_time,
3401 'check_freq' => $options{'check_freq'},
3402 'stage' => 'collect',
3405 $dbh->rollback if $oldAutoCommit;
3409 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3414 =item do_cust_event [ HASHREF | OPTION => VALUE ... ]
3416 Runs billing events; see L<FS::part_event> and the billing events web
3419 If there is an error, returns the error, otherwise returns false.
3421 Options are passed as name-value pairs.
3423 Currently available options are:
3429 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.
3433 "1d" for the traditional, daily events (the default), or "1m" for the new monthly events (part_event.check_freq)
3437 "collect" (the default) or "pre-bill"
3441 set true to surpress email card/ACH decline notices.
3445 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)
3451 # allows for one time override of normal customer billing method
3455 # Retry card/echeck/LEC transactions even when not scheduled by invoice events.
3458 my( $self, %options ) = @_;
3459 my $time = $options{'time'} || time;
3462 local $SIG{HUP} = 'IGNORE';
3463 local $SIG{INT} = 'IGNORE';
3464 local $SIG{QUIT} = 'IGNORE';
3465 local $SIG{TERM} = 'IGNORE';
3466 local $SIG{TSTP} = 'IGNORE';
3467 local $SIG{PIPE} = 'IGNORE';
3469 my $oldAutoCommit = $FS::UID::AutoCommit;
3470 local $FS::UID::AutoCommit = 0;
3473 $self->select_for_update; #mutex
3476 my $balance = $self->balance;
3477 warn "$me do_cust_event customer ". $self->custnum. ": balance $balance\n"
3480 # if ( exists($options{'retry_card'}) ) {
3481 # carp 'retry_card option passed to collect is deprecated; use retry';
3482 # $options{'retry'} ||= $options{'retry_card'};
3484 # if ( exists($options{'retry'}) && $options{'retry'} ) {
3485 # my $error = $self->retry_realtime;
3487 # $dbh->rollback if $oldAutoCommit;
3492 # false laziness w/pay_batch::import_results
3494 my $due_cust_event = $self->due_cust_event(
3495 'debug' => ( $options{'debug'} || 0 ),
3497 'check_freq' => $options{'check_freq'},
3498 'stage' => ( $options{'stage'} || 'collect' ),
3500 unless( ref($due_cust_event) ) {
3501 $dbh->rollback if $oldAutoCommit;
3502 return $due_cust_event;
3505 foreach my $cust_event ( @$due_cust_event ) {
3509 #re-eval event conditions (a previous event could have changed things)
3510 unless ( $cust_event->test_conditions( 'time' => $time ) ) {
3511 #don't leave stray "new/locked" records around
3512 my $error = $cust_event->delete;
3514 #gah, even with transactions
3515 $dbh->commit if $oldAutoCommit; #well.
3522 local $realtime_bop_decline_quiet = 1 if $options{'quiet'};
3523 warn " running cust_event ". $cust_event->eventnum. "\n"
3527 #if ( my $error = $cust_event->do_event(%options) ) { #XXX %options?
3528 if ( my $error = $cust_event->do_event() ) {
3529 #XXX wtf is this? figure out a proper dealio with return value
3531 # gah, even with transactions.
3532 $dbh->commit if $oldAutoCommit; #well.
3539 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3544 =item due_cust_event [ HASHREF | OPTION => VALUE ... ]
3546 Inserts database records for and returns an ordered listref of new events due
3547 for this customer, as FS::cust_event objects (see L<FS::cust_event>). If no
3548 events are due, an empty listref is returned. If there is an error, returns a
3549 scalar error message.
3551 To actually run the events, call each event's test_condition method, and if
3552 still true, call the event's do_event method.
3554 Options are passed as a hashref or as a list of name-value pairs. Available
3561 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.
3565 "collect" (the default) or "pre-bill"
3569 "Current time" for the events.
3573 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)
3577 Only return events for the specified eventtable (by default, events of all eventtables are returned)
3581 Explicitly pass the objects to be tested (typically used with eventtable).
3585 Set to true to return the objects, but not actually insert them into the
3592 sub due_cust_event {
3594 my %opt = ref($_[0]) ? %{ $_[0] } : @_;
3597 #my $DEBUG = $opt{'debug'}
3598 local($DEBUG) = $opt{'debug'}
3599 if defined($opt{'debug'}) && $opt{'debug'} > $DEBUG;
3601 warn "$me due_cust_event called with options ".
3602 join(', ', map { "$_: $opt{$_}" } keys %opt). "\n"
3605 $opt{'time'} ||= time;
3607 local $SIG{HUP} = 'IGNORE';
3608 local $SIG{INT} = 'IGNORE';
3609 local $SIG{QUIT} = 'IGNORE';
3610 local $SIG{TERM} = 'IGNORE';
3611 local $SIG{TSTP} = 'IGNORE';
3612 local $SIG{PIPE} = 'IGNORE';
3614 my $oldAutoCommit = $FS::UID::AutoCommit;
3615 local $FS::UID::AutoCommit = 0;
3618 $self->select_for_update #mutex
3619 unless $opt{testonly};
3622 # find possible events (initial search)
3625 my @cust_event = ();
3627 my @eventtable = $opt{'eventtable'}
3628 ? ( $opt{'eventtable'} )
3629 : FS::part_event->eventtables_runorder;
3631 foreach my $eventtable ( @eventtable ) {
3634 if ( $opt{'objects'} ) {
3636 @objects = @{ $opt{'objects'} };
3640 #my @objects = $self->eventtable(); # sub cust_main { @{ [ $self ] }; }
3641 @objects = ( $eventtable eq 'cust_main' )
3643 : ( $self->$eventtable() );
3647 my @e_cust_event = ();
3649 my $cross = "CROSS JOIN $eventtable";
3650 $cross .= ' LEFT JOIN cust_main USING ( custnum )'
3651 unless $eventtable eq 'cust_main';
3653 foreach my $object ( @objects ) {
3655 #this first search uses the condition_sql magic for optimization.
3656 #the more possible events we can eliminate in this step the better
3658 my $cross_where = '';
3659 my $pkey = $object->primary_key;
3660 $cross_where = "$eventtable.$pkey = ". $object->$pkey();
3662 my $join = FS::part_event_condition->join_conditions_sql( $eventtable );
3664 FS::part_event_condition->where_conditions_sql( $eventtable,
3665 'time'=>$opt{'time'}
3667 my $order = FS::part_event_condition->order_conditions_sql( $eventtable );
3669 $extra_sql = "AND $extra_sql" if $extra_sql;
3671 #here is the agent virtualization
3672 $extra_sql .= " AND ( part_event.agentnum IS NULL
3673 OR part_event.agentnum = ". $self->agentnum. ' )';
3675 $extra_sql .= " $order";
3677 warn "searching for events for $eventtable ". $object->$pkey. "\n"
3678 if $opt{'debug'} > 2;
3679 my @part_event = qsearch( {
3680 'debug' => ( $opt{'debug'} > 3 ? 1 : 0 ),
3681 'select' => 'part_event.*',
3682 'table' => 'part_event',
3683 'addl_from' => "$cross $join",
3684 'hashref' => { 'check_freq' => ( $opt{'check_freq'} || '1d' ),
3685 'eventtable' => $eventtable,
3688 'extra_sql' => "AND $cross_where $extra_sql",
3692 my $pkey = $object->primary_key;
3693 warn " ". scalar(@part_event).
3694 " possible events found for $eventtable ". $object->$pkey(). "\n";
3697 push @e_cust_event, map { $_->new_cust_event($object) } @part_event;
3701 warn " ". scalar(@e_cust_event).
3702 " subtotal possible cust events found for $eventtable\n"
3705 push @cust_event, @e_cust_event;
3709 warn " ". scalar(@cust_event).
3710 " total possible cust events found in initial search\n"
3718 $opt{stage} ||= 'collect';
3720 grep { my $stage = $_->part_event->event_stage;
3721 $opt{stage} eq $stage or ( ! $stage && $opt{stage} eq 'collect' )
3731 @cust_event = grep $_->test_conditions( 'time' => $opt{'time'},
3732 'stats_hashref' => \%unsat ),
3735 warn " ". scalar(@cust_event). " cust events left satisfying conditions\n"
3738 warn " invalid conditions not eliminated with condition_sql:\n".
3739 join('', map " $_: ".$unsat{$_}."\n", keys %unsat )
3746 unless( $opt{testonly} ) {
3747 foreach my $cust_event ( @cust_event ) {
3749 my $error = $cust_event->insert();
3751 $dbh->rollback if $oldAutoCommit;
3758 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3764 warn " returning events: ". Dumper(@cust_event). "\n"
3771 =item retry_realtime
3773 Schedules realtime / batch credit card / electronic check / LEC billing
3774 events for for retry. Useful if card information has changed or manual
3775 retry is desired. The 'collect' method must be called to actually retry
3778 Implementation details: For either this customer, or for each of this
3779 customer's open invoices, changes the status of the first "done" (with
3780 statustext error) realtime processing event to "failed".
3784 sub retry_realtime {
3787 local $SIG{HUP} = 'IGNORE';
3788 local $SIG{INT} = 'IGNORE';
3789 local $SIG{QUIT} = 'IGNORE';
3790 local $SIG{TERM} = 'IGNORE';
3791 local $SIG{TSTP} = 'IGNORE';
3792 local $SIG{PIPE} = 'IGNORE';
3794 my $oldAutoCommit = $FS::UID::AutoCommit;
3795 local $FS::UID::AutoCommit = 0;
3798 #a little false laziness w/due_cust_event (not too bad, really)
3800 my $join = FS::part_event_condition->join_conditions_sql;
3801 my $order = FS::part_event_condition->order_conditions_sql;
3804 . join ( ' OR ' , map {
3805 "( part_event.eventtable = " . dbh->quote($_)
3806 . " AND tablenum IN( SELECT " . dbdef->table($_)->primary_key . " from $_ where custnum = " . dbh->quote( $self->custnum ) . "))" ;
3807 } FS::part_event->eventtables)
3810 #here is the agent virtualization
3811 my $agent_virt = " ( part_event.agentnum IS NULL
3812 OR part_event.agentnum = ". $self->agentnum. ' )';
3814 #XXX this shouldn't be hardcoded, actions should declare it...
3815 my @realtime_events = qw(
3816 cust_bill_realtime_card
3817 cust_bill_realtime_check
3818 cust_bill_realtime_lec
3822 my $is_realtime_event = ' ( '. join(' OR ', map "part_event.action = '$_'",
3827 my @cust_event = qsearchs({
3828 'table' => 'cust_event',
3829 'select' => 'cust_event.*',
3830 'addl_from' => "LEFT JOIN part_event USING ( eventpart ) $join",
3831 'hashref' => { 'status' => 'done' },
3832 'extra_sql' => " AND statustext IS NOT NULL AND statustext != '' ".
3833 " AND $mine AND $is_realtime_event AND $agent_virt $order" # LIMIT 1"
3836 my %seen_invnum = ();
3837 foreach my $cust_event (@cust_event) {
3839 #max one for the customer, one for each open invoice
3840 my $cust_X = $cust_event->cust_X;
3841 next if $seen_invnum{ $cust_event->part_event->eventtable eq 'cust_bill'
3845 or $cust_event->part_event->eventtable eq 'cust_bill'
3848 my $error = $cust_event->retry;
3850 $dbh->rollback if $oldAutoCommit;
3851 return "error scheduling event for retry: $error";
3856 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3861 # some horrid false laziness here to avoid refactor fallout
3862 # eventually realtime realtime_bop and realtime_refund_bop should go
3863 # away and be replaced by _new_realtime_bop and _new_realtime_refund_bop
3865 =item realtime_bop METHOD AMOUNT [ OPTION => VALUE ... ]
3867 Runs a realtime credit card, ACH (electronic check) or phone bill transaction
3868 via a Business::OnlinePayment realtime gateway. See
3869 L<http://420.am/business-onlinepayment> for supported gateways.
3871 Available methods are: I<CC>, I<ECHECK> and I<LEC>
3873 Available options are: I<description>, I<invnum>, I<quiet>, I<paynum_ref>, I<payunique>
3875 The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
3876 I<zip>, I<payinfo> and I<paydate> are also available. Any of these options,
3877 if set, will override the value from the customer record.
3879 I<description> is a free-text field passed to the gateway. It defaults to
3880 the value defined by the business-onlinepayment-description configuration
3881 option, or "Internet services" if that is unset.
3883 If an I<invnum> is specified, this payment (if successful) is applied to the
3884 specified invoice. If you don't specify an I<invnum> you might want to
3885 call the B<apply_payments> method or set the I<apply> option.
3887 I<apply> can be set to true to apply a resulting payment.
3889 I<quiet> can be set true to surpress email decline notices.
3891 I<paynum_ref> can be set to a scalar reference. It will be filled in with the
3892 resulting paynum, if any.
3894 I<payunique> is a unique identifier for this payment.
3896 (moved from cust_bill) (probably should get realtime_{card,ach,lec} here too)
3903 return $self->_new_realtime_bop(@_)
3904 if $self->_new_bop_required();
3906 my($method, $amount);
3908 if (ref($_[0]) eq 'HASH') {
3909 %options = %{$_[0]};
3910 $method = $options{method};
3911 $amount = $options{amount};
3913 ( $method, $amount ) = ( shift, shift );
3917 warn "$me realtime_bop: $method $amount\n";
3918 warn " $_ => $options{$_}\n" foreach keys %options;
3921 unless ( $options{'description'} ) {
3922 if ( $conf->exists('business-onlinepayment-description') ) {
3923 my $dtempl = $conf->config('business-onlinepayment-description');
3925 my $agent = $self->agent->agent;
3927 $options{'description'} = eval qq("$dtempl");
3929 $options{'description'} = 'Internet services';
3933 return $self->fake_bop($method, $amount, %options) if $options{'fake'};
3935 eval "use Business::OnlinePayment";
3938 my $payinfo = exists($options{'payinfo'})
3939 ? $options{'payinfo'}
3942 my %method2payby = (
3949 # check for banned credit card/ACH
3952 my $ban = qsearchs('banned_pay', {
3953 'payby' => $method2payby{$method},
3954 'payinfo' => md5_base64($payinfo),
3956 return "Banned credit card" if $ban;
3959 # set taxclass and trans_is_recur based on invnum if there is one
3963 my $trans_is_recur = 0;
3964 if ( $options{'invnum'} ) {
3966 my $cust_bill = qsearchs('cust_bill', { 'invnum' => $options{'invnum'} } );
3967 die "invnum ". $options{'invnum'}. " not found" unless $cust_bill;
3970 map { $_->part_pkg }
3972 map { $_->cust_pkg }
3973 $cust_bill->cust_bill_pkg;
3975 my @taxclasses = map $_->taxclass, @part_pkg;
3976 $taxclass = $taxclasses[0]
3977 unless grep { $taxclasses[0] ne $_ } @taxclasses; #unless there are
3978 #different taxclasses
3980 if grep { $_->freq ne '0' } @part_pkg;
3988 #look for an agent gateway override first
3990 if ( $method eq 'CC' ) {
3991 $cardtype = cardtype($payinfo);
3992 } elsif ( $method eq 'ECHECK' ) {
3995 $cardtype = $method;
3999 qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
4000 cardtype => $cardtype,
4001 taxclass => $taxclass, } )
4002 || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
4004 taxclass => $taxclass, } )
4005 || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
4006 cardtype => $cardtype,
4008 || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
4010 taxclass => '', } );
4012 my $payment_gateway = '';
4013 my( $processor, $login, $password, $action, @bop_options );
4014 if ( $override ) { #use a payment gateway override
4016 $payment_gateway = $override->payment_gateway;
4018 $processor = $payment_gateway->gateway_module;
4019 $login = $payment_gateway->gateway_username;
4020 $password = $payment_gateway->gateway_password;
4021 $action = $payment_gateway->gateway_action;
4022 @bop_options = $payment_gateway->options;
4024 } else { #use the standard settings from the config
4026 ( $processor, $login, $password, $action, @bop_options ) =
4027 $self->default_payment_gateway($method);
4035 my $address = exists($options{'address1'})
4036 ? $options{'address1'}
4038 my $address2 = exists($options{'address2'})
4039 ? $options{'address2'}
4041 $address .= ", ". $address2 if length($address2);
4043 my $o_payname = exists($options{'payname'})
4044 ? $options{'payname'}
4046 my($payname, $payfirst, $paylast);
4047 if ( $o_payname && $method ne 'ECHECK' ) {
4048 ($payname = $o_payname) =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
4049 or return "Illegal payname $payname";
4050 ($payfirst, $paylast) = ($1, $2);
4052 $payfirst = $self->getfield('first');
4053 $paylast = $self->getfield('last');
4054 $payname = "$payfirst $paylast";
4057 my @invoicing_list = $self->invoicing_list_emailonly;
4058 if ( $conf->exists('emailinvoiceautoalways')
4059 || $conf->exists('emailinvoiceauto') && ! @invoicing_list
4060 || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
4061 push @invoicing_list, $self->all_emails;
4064 my $email = ($conf->exists('business-onlinepayment-email-override'))
4065 ? $conf->config('business-onlinepayment-email-override')
4066 : $invoicing_list[0];
4070 my $payip = exists($options{'payip'})
4073 $content{customer_ip} = $payip
4076 $content{invoice_number} = $options{'invnum'}
4077 if exists($options{'invnum'}) && length($options{'invnum'});
4079 $content{email_customer} =
4080 ( $conf->exists('business-onlinepayment-email_customer')
4081 || $conf->exists('business-onlinepayment-email-override') );
4084 if ( $method eq 'CC' ) {
4086 $content{card_number} = $payinfo;
4087 $paydate = exists($options{'paydate'})
4088 ? $options{'paydate'}
4090 $paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
4091 $content{expiration} = "$2/$1";
4093 my $paycvv = exists($options{'paycvv'})
4094 ? $options{'paycvv'}
4096 $content{cvv2} = $paycvv
4099 my $paystart_month = exists($options{'paystart_month'})
4100 ? $options{'paystart_month'}
4101 : $self->paystart_month;
4103 my $paystart_year = exists($options{'paystart_year'})
4104 ? $options{'paystart_year'}
4105 : $self->paystart_year;
4107 $content{card_start} = "$paystart_month/$paystart_year"
4108 if $paystart_month && $paystart_year;
4110 my $payissue = exists($options{'payissue'})
4111 ? $options{'payissue'}
4113 $content{issue_number} = $payissue if $payissue;
4115 if ( $self->_bop_recurring_billing( 'payinfo' => $payinfo,
4116 'trans_is_recur' => $trans_is_recur,
4120 $content{recurring_billing} = 'YES';
4121 $content{acct_code} = 'rebill'
4122 if $conf->exists('credit_card-recurring_billing_acct_code');
4125 } elsif ( $method eq 'ECHECK' ) {
4126 ( $content{account_number}, $content{routing_code} ) =
4127 split('@', $payinfo);
4128 $content{bank_name} = $o_payname;
4129 $content{bank_state} = exists($options{'paystate'})
4130 ? $options{'paystate'}
4131 : $self->getfield('paystate');
4132 $content{account_type} = exists($options{'paytype'})
4133 ? uc($options{'paytype'}) || 'CHECKING'
4134 : uc($self->getfield('paytype')) || 'CHECKING';
4135 $content{account_name} = $payname;
4136 $content{customer_org} = $self->company ? 'B' : 'I';
4137 $content{state_id} = exists($options{'stateid'})
4138 ? $options{'stateid'}
4139 : $self->getfield('stateid');
4140 $content{state_id_state} = exists($options{'stateid_state'})
4141 ? $options{'stateid_state'}
4142 : $self->getfield('stateid_state');
4143 $content{customer_ssn} = exists($options{'ss'})
4146 } elsif ( $method eq 'LEC' ) {
4147 $content{phone} = $payinfo;
4151 # run transaction(s)
4154 my $balance = exists( $options{'balance'} )
4155 ? $options{'balance'}
4158 $self->select_for_update; #mutex ... just until we get our pending record in
4160 #the checks here are intended to catch concurrent payments
4161 #double-form-submission prevention is taken care of in cust_pay_pending::check
4164 return "The customer's balance has changed; $method transaction aborted."
4165 if $self->balance < $balance;
4166 #&& $self->balance < $amount; #might as well anyway?
4168 #also check and make sure there aren't *other* pending payments for this cust
4170 my @pending = qsearch('cust_pay_pending', {
4171 'custnum' => $self->custnum,
4172 'status' => { op=>'!=', value=>'done' }
4174 return "A payment is already being processed for this customer (".
4175 join(', ', map 'paypendingnum '. $_->paypendingnum, @pending ).
4176 "); $method transaction aborted."
4177 if scalar(@pending);
4179 #okay, good to go, if we're a duplicate, cust_pay_pending will kick us out
4181 my $cust_pay_pending = new FS::cust_pay_pending {
4182 'custnum' => $self->custnum,
4183 #'invnum' => $options{'invnum'},
4186 'payby' => $method2payby{$method},
4187 'payinfo' => $payinfo,
4188 'paydate' => $paydate,
4189 'recurring_billing' => $content{recurring_billing},
4190 'pkgnum' => $options{'pkgnum'},
4192 'gatewaynum' => ( $payment_gateway ? $payment_gateway->gatewaynum : '' ),
4194 $cust_pay_pending->payunique( $options{payunique} )
4195 if defined($options{payunique}) && length($options{payunique});
4196 my $cpp_new_err = $cust_pay_pending->insert; #mutex lost when this is inserted
4197 return $cpp_new_err if $cpp_new_err;
4199 my( $action1, $action2 ) = split(/\s*\,\s*/, $action );
4201 my $transaction = new Business::OnlinePayment( $processor, @bop_options );
4202 $transaction->content(
4205 'password' => $password,
4206 'action' => $action1,
4207 'description' => $options{'description'},
4208 'amount' => $amount,
4209 #'invoice_number' => $options{'invnum'},
4210 'customer_id' => $self->custnum,
4211 'last_name' => $paylast,
4212 'first_name' => $payfirst,
4214 'address' => $address,
4215 'city' => ( exists($options{'city'})
4218 'state' => ( exists($options{'state'})
4221 'zip' => ( exists($options{'zip'})
4224 'country' => ( exists($options{'country'})
4225 ? $options{'country'}
4227 'referer' => 'http://cleanwhisker.420.am/', #XXX fix referer :/
4229 'phone' => $self->daytime || $self->night,
4233 $cust_pay_pending->status('pending');
4234 my $cpp_pending_err = $cust_pay_pending->replace;
4235 return $cpp_pending_err if $cpp_pending_err;
4238 my $BOP_TESTING = 0;
4239 my $BOP_TESTING_SUCCESS = 1;
4241 unless ( $BOP_TESTING ) {
4242 $transaction->submit();
4244 if ( $BOP_TESTING_SUCCESS ) {
4245 $transaction->is_success(1);
4246 $transaction->authorization('fake auth');
4248 $transaction->is_success(0);
4249 $transaction->error_message('fake failure');
4253 if ( $transaction->is_success() && $action2 ) {
4255 $cust_pay_pending->status('authorized');
4256 my $cpp_authorized_err = $cust_pay_pending->replace;
4257 return $cpp_authorized_err if $cpp_authorized_err;
4259 my $auth = $transaction->authorization;
4260 my $ordernum = $transaction->can('order_number')
4261 ? $transaction->order_number
4265 new Business::OnlinePayment( $processor, @bop_options );
4272 password => $password,
4273 order_number => $ordernum,
4275 authorization => $auth,
4276 description => $options{'description'},
4279 foreach my $field (qw( authorization_source_code returned_ACI
4280 transaction_identifier validation_code
4281 transaction_sequence_num local_transaction_date
4282 local_transaction_time AVS_result_code )) {
4283 $capture{$field} = $transaction->$field() if $transaction->can($field);
4286 $capture->content( %capture );
4290 unless ( $capture->is_success ) {
4291 my $e = "Authorization successful but capture failed, custnum #".
4292 $self->custnum. ': '. $capture->result_code.
4293 ": ". $capture->error_message;
4300 $cust_pay_pending->status($transaction->is_success() ? 'captured' : 'declined');
4301 my $cpp_captured_err = $cust_pay_pending->replace;
4302 return $cpp_captured_err if $cpp_captured_err;
4305 # remove paycvv after initial transaction
4308 #false laziness w/misc/process/payment.cgi - check both to make sure working
4310 if ( defined $self->dbdef_table->column('paycvv')
4311 && length($self->paycvv)
4312 && ! grep { $_ eq cardtype($payinfo) } $conf->config('cvv-save')
4314 my $error = $self->remove_cvv;
4316 warn "WARNING: error removing cvv: $error\n";
4324 if ( $transaction->is_success() ) {
4327 if ( $payment_gateway ) { # agent override
4328 $paybatch = $payment_gateway->gatewaynum. '-';
4331 $paybatch .= "$processor:". $transaction->authorization;
4333 $paybatch .= ':'. $transaction->order_number
4334 if $transaction->can('order_number')
4335 && length($transaction->order_number);
4337 my $cust_pay = new FS::cust_pay ( {
4338 'custnum' => $self->custnum,
4339 'invnum' => $options{'invnum'},
4342 'payby' => $method2payby{$method},
4343 'payinfo' => $payinfo,
4344 'paybatch' => $paybatch,
4345 'paydate' => $paydate,
4346 'pkgnum' => $options{'pkgnum'},
4348 #doesn't hurt to know, even though the dup check is in cust_pay_pending now
4349 $cust_pay->payunique( $options{payunique} )
4350 if defined($options{payunique}) && length($options{payunique});
4352 my $oldAutoCommit = $FS::UID::AutoCommit;
4353 local $FS::UID::AutoCommit = 0;
4356 #start a transaction, insert the cust_pay and set cust_pay_pending.status to done in a single transction
4358 my $error = $cust_pay->insert($options{'manual'} ? ( 'manual' => 1 ) : () );
4361 $cust_pay->invnum(''); #try again with no specific invnum
4362 my $error2 = $cust_pay->insert( $options{'manual'} ?
4363 ( 'manual' => 1 ) : ()
4366 # gah. but at least we have a record of the state we had to abort in
4367 # from cust_pay_pending now.
4368 my $e = "WARNING: $method captured but payment not recorded - ".
4369 "error inserting payment ($processor): $error2".
4370 " (previously tried insert with invnum #$options{'invnum'}" .
4371 ": $error ) - pending payment saved as paypendingnum ".
4372 $cust_pay_pending->paypendingnum. "\n";
4378 if ( $options{'paynum_ref'} ) {
4379 ${ $options{'paynum_ref'} } = $cust_pay->paynum;
4382 $cust_pay_pending->status('done');
4383 $cust_pay_pending->statustext('captured');
4384 $cust_pay_pending->paynum($cust_pay->paynum);
4385 my $cpp_done_err = $cust_pay_pending->replace;
4387 if ( $cpp_done_err ) {
4389 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
4390 my $e = "WARNING: $method captured but payment not recorded - ".
4391 "error updating status for paypendingnum ".
4392 $cust_pay_pending->paypendingnum. ": $cpp_done_err \n";
4398 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4400 if ( $options{'apply'} ) {
4401 my $apply_error = $self->apply_payments_and_credits;
4402 if ( $apply_error ) {
4403 warn "WARNING: error applying payment: $apply_error\n";
4404 #but we still should return no error cause the payment otherwise went
4409 return ''; #no error
4415 my $perror = "$processor error: ". $transaction->error_message;
4417 unless ( $transaction->error_message ) {
4420 if ( $transaction->can('response_page') ) {
4422 'page' => ( $transaction->can('response_page')
4423 ? $transaction->response_page
4426 'code' => ( $transaction->can('response_code')
4427 ? $transaction->response_code
4430 'headers' => ( $transaction->can('response_headers')
4431 ? $transaction->response_headers
4437 "No additional debugging information available for $processor";
4440 $perror .= "No error_message returned from $processor -- ".
4441 ( ref($t_response) ? Dumper($t_response) : $t_response );
4445 if ( !$options{'quiet'} && !$realtime_bop_decline_quiet
4446 && $conf->exists('emaildecline')
4447 && grep { $_ ne 'POST' } $self->invoicing_list
4448 && ! grep { $transaction->error_message =~ /$_/ }
4449 $conf->config('emaildecline-exclude')
4451 my @templ = $conf->config('declinetemplate');
4452 my $template = new Text::Template (
4454 SOURCE => [ map "$_\n", @templ ],
4455 ) or return "($perror) can't create template: $Text::Template::ERROR";
4456 $template->compile()
4457 or return "($perror) can't compile template: $Text::Template::ERROR";
4461 scalar( $conf->config('company_name', $self->agentnum ) ),
4462 'company_address' =>
4463 join("\n", $conf->config('company_address', $self->agentnum ) ),
4464 'error' => $transaction->error_message,
4467 my $error = send_email(
4468 'from' => $conf->config('invoice_from', $self->agentnum ),
4469 'to' => [ grep { $_ ne 'POST' } $self->invoicing_list ],
4470 'subject' => 'Your payment could not be processed',
4471 'body' => [ $template->fill_in(HASH => $templ_hash) ],
4474 $perror .= " (also received error sending decline notification: $error)"
4479 $cust_pay_pending->status('done');
4480 $cust_pay_pending->statustext("declined: $perror");
4481 my $cpp_done_err = $cust_pay_pending->replace;
4482 if ( $cpp_done_err ) {
4483 my $e = "WARNING: $method declined but pending payment not resolved - ".
4484 "error updating status for paypendingnum ".
4485 $cust_pay_pending->paypendingnum. ": $cpp_done_err \n";
4487 $perror = "$e ($perror)";
4495 sub _bop_recurring_billing {
4496 my( $self, %opt ) = @_;
4498 my $method = scalar($conf->config('credit_card-recurring_billing_flag'));
4500 if ( defined($method) && $method eq 'transaction_is_recur' ) {
4502 return 1 if $opt{'trans_is_recur'};
4506 my %hash = ( 'custnum' => $self->custnum,
4511 if qsearch('cust_pay', { %hash, 'payinfo' => $opt{'payinfo'} } )
4512 || qsearch('cust_pay', { %hash, 'paymask' => $self->mask_payinfo('CARD',
4523 =item realtime_refund_bop METHOD [ OPTION => VALUE ... ]
4525 Refunds a realtime credit card, ACH (electronic check) or phone bill transaction
4526 via a Business::OnlinePayment realtime gateway. See
4527 L<http://420.am/business-onlinepayment> for supported gateways.
4529 Available methods are: I<CC>, I<ECHECK> and I<LEC>
4531 Available options are: I<amount>, I<reason>, I<paynum>, I<paydate>
4533 Most gateways require a reference to an original payment transaction to refund,
4534 so you probably need to specify a I<paynum>.
4536 I<amount> defaults to the original amount of the payment if not specified.
4538 I<reason> specifies a reason for the refund.
4540 I<paydate> specifies the expiration date for a credit card overriding the
4541 value from the customer record or the payment record. Specified as yyyy-mm-dd
4543 Implementation note: If I<amount> is unspecified or equal to the amount of the
4544 orignal payment, first an attempt is made to "void" the transaction via
4545 the gateway (to cancel a not-yet settled transaction) and then if that fails,
4546 the normal attempt is made to "refund" ("credit") the transaction via the
4547 gateway is attempted.
4549 #The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
4550 #I<zip>, I<payinfo> and I<paydate> are also available. Any of these options,
4551 #if set, will override the value from the customer record.
4553 #If an I<invnum> is specified, this payment (if successful) is applied to the
4554 #specified invoice. If you don't specify an I<invnum> you might want to
4555 #call the B<apply_payments> method.
4559 #some false laziness w/realtime_bop, not enough to make it worth merging
4560 #but some useful small subs should be pulled out
4561 sub realtime_refund_bop {
4564 return $self->_new_realtime_refund_bop(@_)
4565 if $self->_new_bop_required();
4567 my( $method, %options ) = @_;
4569 warn "$me realtime_refund_bop: $method refund\n";
4570 warn " $_ => $options{$_}\n" foreach keys %options;
4573 eval "use Business::OnlinePayment";
4577 # look up the original payment and optionally a gateway for that payment
4581 my $amount = $options{'amount'};
4583 my( $processor, $login, $password, @bop_options ) ;
4584 my( $auth, $order_number ) = ( '', '', '' );
4586 if ( $options{'paynum'} ) {
4588 warn " paynum: $options{paynum}\n" if $DEBUG > 1;
4589 $cust_pay = qsearchs('cust_pay', { paynum=>$options{'paynum'} } )
4590 or return "Unknown paynum $options{'paynum'}";
4591 $amount ||= $cust_pay->paid;
4593 $cust_pay->paybatch =~ /^((\d+)\-)?(\w+):\s*([\w\-\/ ]*)(:([\w\-]+))?$/
4594 or return "Can't parse paybatch for paynum $options{'paynum'}: ".
4595 $cust_pay->paybatch;
4596 my $gatewaynum = '';
4597 ( $gatewaynum, $processor, $auth, $order_number ) = ( $2, $3, $4, $6 );
4599 if ( $gatewaynum ) { #gateway for the payment to be refunded
4601 my $payment_gateway =
4602 qsearchs('payment_gateway', { 'gatewaynum' => $gatewaynum } );
4603 die "payment gateway $gatewaynum not found"
4604 unless $payment_gateway;
4606 $processor = $payment_gateway->gateway_module;
4607 $login = $payment_gateway->gateway_username;
4608 $password = $payment_gateway->gateway_password;
4609 @bop_options = $payment_gateway->options;
4611 } else { #try the default gateway
4613 my( $conf_processor, $unused_action );
4614 ( $conf_processor, $login, $password, $unused_action, @bop_options ) =
4615 $self->default_payment_gateway($method);
4617 return "processor of payment $options{'paynum'} $processor does not".
4618 " match default processor $conf_processor"
4619 unless $processor eq $conf_processor;
4624 } else { # didn't specify a paynum, so look for agent gateway overrides
4625 # like a normal transaction
4628 if ( $method eq 'CC' ) {
4629 $cardtype = cardtype($self->payinfo);
4630 } elsif ( $method eq 'ECHECK' ) {
4633 $cardtype = $method;
4636 qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
4637 cardtype => $cardtype,
4639 || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
4641 taxclass => '', } );
4643 if ( $override ) { #use a payment gateway override
4645 my $payment_gateway = $override->payment_gateway;
4647 $processor = $payment_gateway->gateway_module;
4648 $login = $payment_gateway->gateway_username;
4649 $password = $payment_gateway->gateway_password;
4650 #$action = $payment_gateway->gateway_action;
4651 @bop_options = $payment_gateway->options;
4653 } else { #use the standard settings from the config
4656 ( $processor, $login, $password, $unused_action, @bop_options ) =
4657 $self->default_payment_gateway($method);
4662 return "neither amount nor paynum specified" unless $amount;
4667 'password' => $password,
4668 'order_number' => $order_number,
4669 'amount' => $amount,
4670 'referer' => 'http://cleanwhisker.420.am/', #XXX fix referer :/
4672 $content{authorization} = $auth
4673 if length($auth); #echeck/ACH transactions have an order # but no auth
4674 #(at least with authorize.net)
4676 my $disable_void_after;
4677 if ($conf->exists('disable_void_after')
4678 && $conf->config('disable_void_after') =~ /^(\d+)$/) {
4679 $disable_void_after = $1;
4682 #first try void if applicable
4683 if ( $cust_pay && $cust_pay->paid == $amount
4685 ( not defined($disable_void_after) )
4686 || ( time < ($cust_pay->_date + $disable_void_after ) )
4689 warn " attempting void\n" if $DEBUG > 1;
4690 my $void = new Business::OnlinePayment( $processor, @bop_options );
4691 $content{'card_number'} = $cust_pay->payinfo
4692 if $cust_pay->payby eq 'CARD'
4693 && $void->can('info') && $void->info('CC_void_requires_card');
4694 $void->content( 'action' => 'void', %content );
4696 if ( $void->is_success ) {
4697 my $error = $cust_pay->void($options{'reason'});
4699 # gah, even with transactions.
4700 my $e = 'WARNING: Card/ACH voided but database not updated - '.
4701 "error voiding payment: $error";
4705 warn " void successful\n" if $DEBUG > 1;
4710 warn " void unsuccessful, trying refund\n"
4714 my $address = $self->address1;
4715 $address .= ", ". $self->address2 if $self->address2;
4717 my($payname, $payfirst, $paylast);
4718 if ( $self->payname && $method ne 'ECHECK' ) {
4719 $payname = $self->payname;
4720 $payname =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
4721 or return "Illegal payname $payname";
4722 ($payfirst, $paylast) = ($1, $2);
4724 $payfirst = $self->getfield('first');
4725 $paylast = $self->getfield('last');
4726 $payname = "$payfirst $paylast";
4729 my @invoicing_list = $self->invoicing_list_emailonly;
4730 if ( $conf->exists('emailinvoiceautoalways')
4731 || $conf->exists('emailinvoiceauto') && ! @invoicing_list
4732 || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
4733 push @invoicing_list, $self->all_emails;
4736 my $email = ($conf->exists('business-onlinepayment-email-override'))
4737 ? $conf->config('business-onlinepayment-email-override')
4738 : $invoicing_list[0];
4740 my $payip = exists($options{'payip'})
4743 $content{customer_ip} = $payip
4747 if ( $method eq 'CC' ) {
4750 $content{card_number} = $payinfo = $cust_pay->payinfo;
4751 (exists($options{'paydate'}) ? $options{'paydate'} : $cust_pay->paydate)
4752 =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/ &&
4753 ($content{expiration} = "$2/$1"); # where available
4755 $content{card_number} = $payinfo = $self->payinfo;
4756 (exists($options{'paydate'}) ? $options{'paydate'} : $self->paydate)
4757 =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
4758 $content{expiration} = "$2/$1";
4761 } elsif ( $method eq 'ECHECK' ) {
4764 $payinfo = $cust_pay->payinfo;
4766 $payinfo = $self->payinfo;
4768 ( $content{account_number}, $content{routing_code} )= split('@', $payinfo );
4769 $content{bank_name} = $self->payname;
4770 $content{account_type} = 'CHECKING';
4771 $content{account_name} = $payname;
4772 $content{customer_org} = $self->company ? 'B' : 'I';
4773 $content{customer_ssn} = $self->ss;
4774 } elsif ( $method eq 'LEC' ) {
4775 $content{phone} = $payinfo = $self->payinfo;
4779 my $refund = new Business::OnlinePayment( $processor, @bop_options );
4780 my %sub_content = $refund->content(
4781 'action' => 'credit',
4782 'customer_id' => $self->custnum,
4783 'last_name' => $paylast,
4784 'first_name' => $payfirst,
4786 'address' => $address,
4787 'city' => $self->city,
4788 'state' => $self->state,
4789 'zip' => $self->zip,
4790 'country' => $self->country,
4792 'phone' => $self->daytime || $self->night,
4795 warn join('', map { " $_ => $sub_content{$_}\n" } keys %sub_content )
4799 return "$processor error: ". $refund->error_message
4800 unless $refund->is_success();
4802 my %method2payby = (
4808 my $paybatch = "$processor:". $refund->authorization;
4809 $paybatch .= ':'. $refund->order_number
4810 if $refund->can('order_number') && $refund->order_number;
4812 while ( $cust_pay && $cust_pay->unapplied < $amount ) {
4813 my @cust_bill_pay = $cust_pay->cust_bill_pay;
4814 last unless @cust_bill_pay;
4815 my $cust_bill_pay = pop @cust_bill_pay;
4816 my $error = $cust_bill_pay->delete;
4820 my $cust_refund = new FS::cust_refund ( {
4821 'custnum' => $self->custnum,
4822 'paynum' => $options{'paynum'},
4823 'refund' => $amount,
4825 'payby' => $method2payby{$method},
4826 'payinfo' => $payinfo,
4827 'paybatch' => $paybatch,
4828 'reason' => $options{'reason'} || 'card or ACH refund',
4830 my $error = $cust_refund->insert;
4832 $cust_refund->paynum(''); #try again with no specific paynum
4833 my $error2 = $cust_refund->insert;
4835 # gah, even with transactions.
4836 my $e = 'WARNING: Card/ACH refunded but database not updated - '.
4837 "error inserting refund ($processor): $error2".
4838 " (previously tried insert with paynum #$options{'paynum'}" .
4849 # does the configuration indicate the new bop routines are required?
4851 sub _new_bop_required {
4854 my $botpp = 'Business::OnlineThirdPartyPayment';
4857 if ( $conf->config('business-onlinepayment-namespace') eq $botpp ||
4858 scalar( grep { $_->gateway_namespace eq $botpp }
4859 qsearch( 'payment_gateway', { 'disabled' => '' } )
4867 =item realtime_collect [ OPTION => VALUE ... ]
4869 Runs a realtime credit card, ACH (electronic check) or phone bill transaction
4870 via a Business::OnlinePayment or Business::OnlineThirdPartyPayment realtime
4871 gateway. See L<http://420.am/business-onlinepayment> and
4872 L<http://420.am/business-onlinethirdpartypayment> for supported gateways.
4874 On failure returns an error message.
4876 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.
4878 Available options are: I<method>, I<amount>, I<description>, I<invnum>, I<quiet>, I<paynum_ref>, I<payunique>, I<session_id>, I<pkgnum>
4880 I<method> is one of: I<CC>, I<ECHECK> and I<LEC>. If none is specified
4881 then it is deduced from the customer record.
4883 If no I<amount> is specified, then the customer balance is used.
4885 The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
4886 I<zip>, I<payinfo> and I<paydate> are also available. Any of these options,
4887 if set, will override the value from the customer record.
4889 I<description> is a free-text field passed to the gateway. It defaults to
4890 the value defined by the business-onlinepayment-description configuration
4891 option, or "Internet services" if that is unset.
4893 If an I<invnum> is specified, this payment (if successful) is applied to the
4894 specified invoice. If you don't specify an I<invnum> you might want to
4895 call the B<apply_payments> method or set the I<apply> option.
4897 I<apply> can be set to true to apply a resulting payment.
4899 I<quiet> can be set true to surpress email decline notices.
4901 I<paynum_ref> can be set to a scalar reference. It will be filled in with the
4902 resulting paynum, if any.
4904 I<payunique> is a unique identifier for this payment.
4906 I<session_id> is a session identifier associated with this payment.
4908 I<depend_jobnum> allows payment capture to unlock export jobs
4912 sub realtime_collect {
4913 my( $self, %options ) = @_;
4916 warn "$me realtime_collect:\n";
4917 warn " $_ => $options{$_}\n" foreach keys %options;
4920 $options{amount} = $self->balance unless exists( $options{amount} );
4921 $options{method} = FS::payby->payby2bop($self->payby)
4922 unless exists( $options{method} );
4924 return $self->realtime_bop({%options});
4928 =item _realtime_bop { [ ARG => VALUE ... ] }
4930 Runs a realtime credit card, ACH (electronic check) or phone bill transaction
4931 via a Business::OnlinePayment realtime gateway. See
4932 L<http://420.am/business-onlinepayment> for supported gateways.
4934 Required arguments in the hashref are I<method>, and I<amount>
4936 Available methods are: I<CC>, I<ECHECK> and I<LEC>
4938 Available optional arguments are: I<description>, I<invnum>, I<quiet>, I<paynum_ref>, I<payunique>, I<session_id>
4940 The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
4941 I<zip>, I<payinfo> and I<paydate> are also available. Any of these options,
4942 if set, will override the value from the customer record.
4944 I<description> is a free-text field passed to the gateway. It defaults to
4945 the value defined by the business-onlinepayment-description configuration
4946 option, or "Internet services" if that is unset.
4948 If an I<invnum> is specified, this payment (if successful) is applied to the
4949 specified invoice. If you don't specify an I<invnum> you might want to
4950 call the B<apply_payments> method.
4952 I<quiet> can be set true to surpress email decline notices.
4954 I<paynum_ref> can be set to a scalar reference. It will be filled in with the
4955 resulting paynum, if any.
4957 I<payunique> is a unique identifier for this payment.
4959 I<session_id> is a session identifier associated with this payment.
4961 I<depend_jobnum> allows payment capture to unlock export jobs
4963 (moved from cust_bill) (probably should get realtime_{card,ach,lec} here too)
4967 # some helper routines
4968 sub _payment_gateway {
4969 my ($self, $options) = @_;
4971 $options->{payment_gateway} = $self->agent->payment_gateway( %$options )
4972 unless exists($options->{payment_gateway});
4974 $options->{payment_gateway};
4978 my ($self, $options) = @_;
4981 'login' => $options->{payment_gateway}->gateway_username,
4982 'password' => $options->{payment_gateway}->gateway_password,
4987 my ($self, $options) = @_;
4989 $options->{payment_gateway}->gatewaynum
4990 ? $options->{payment_gateway}->options
4991 : @{ $options->{payment_gateway}->get('options') };
4995 my ($self, $options) = @_;
4997 unless ( $options->{'description'} ) {
4998 if ( $conf->exists('business-onlinepayment-description') ) {
4999 my $dtempl = $conf->config('business-onlinepayment-description');
5001 my $agent = $self->agent->agent;
5003 $options->{'description'} = eval qq("$dtempl");
5005 $options->{'description'} = 'Internet services';
5009 $options->{payinfo} = $self->payinfo unless exists( $options->{payinfo} );
5010 $options->{invnum} ||= '';
5011 $options->{payname} = $self->payname unless exists( $options->{payname} );
5015 my ($self, $options) = @_;
5018 $content{address} = exists($options->{'address1'})
5019 ? $options->{'address1'}
5021 my $address2 = exists($options->{'address2'})
5022 ? $options->{'address2'}
5024 $content{address} .= ", ". $address2 if length($address2);
5026 my $payip = exists($options->{'payip'}) ? $options->{'payip'} : $self->payip;
5027 $content{customer_ip} = $payip if length($payip);
5029 $content{invoice_number} = $options->{'invnum'}
5030 if exists($options->{'invnum'}) && length($options->{'invnum'});
5032 $content{email_customer} =
5033 ( $conf->exists('business-onlinepayment-email_customer')
5034 || $conf->exists('business-onlinepayment-email-override') );
5036 $content{payfirst} = $self->getfield('first');
5037 $content{paylast} = $self->getfield('last');
5039 $content{account_name} = "$content{payfirst} $content{paylast}"
5040 if $options->{method} eq 'ECHECK';
5042 $content{name} = $options->{payname};
5043 $content{name} = $content{account_name} if exists($content{account_name});
5045 $content{city} = exists($options->{city})
5048 $content{state} = exists($options->{state})
5051 $content{zip} = exists($options->{zip})
5054 $content{country} = exists($options->{country})
5055 ? $options->{country}
5057 $content{referer} = 'http://cleanwhisker.420.am/'; #XXX fix referer :/
5058 $content{phone} = $self->daytime || $self->night;
5063 my %bop_method2payby = (
5069 sub _new_realtime_bop {
5073 if (ref($_[0]) eq 'HASH') {
5074 %options = %{$_[0]};
5076 my ( $method, $amount ) = ( shift, shift );
5078 $options{method} = $method;
5079 $options{amount} = $amount;
5083 warn "$me realtime_bop (new): $options{method} $options{amount}\n";
5084 warn " $_ => $options{$_}\n" foreach keys %options;
5087 return $self->fake_bop(%options) if $options{'fake'};
5089 $self->_bop_defaults(\%options);
5092 # set trans_is_recur based on invnum if there is one
5095 my $trans_is_recur = 0;
5096 if ( $options{'invnum'} ) {
5098 my $cust_bill = qsearchs('cust_bill', { 'invnum' => $options{'invnum'} } );
5099 die "invnum ". $options{'invnum'}. " not found" unless $cust_bill;
5102 map { $_->part_pkg }
5104 map { $_->cust_pkg }
5105 $cust_bill->cust_bill_pkg;
5108 if grep { $_->freq ne '0' } @part_pkg;
5116 my $payment_gateway = $self->_payment_gateway( \%options );
5117 my $namespace = $payment_gateway->gateway_namespace;
5119 eval "use $namespace";
5123 # check for banned credit card/ACH
5126 my $ban = qsearchs('banned_pay', {
5127 'payby' => $bop_method2payby{$options{method}},
5128 'payinfo' => md5_base64($options{payinfo}),
5130 return "Banned credit card" if $ban;
5136 my (%bop_content) = $self->_bop_content(\%options);
5138 if ( $options{method} ne 'ECHECK' ) {
5139 $options{payname} =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
5140 or return "Illegal payname $options{payname}";
5141 ($bop_content{payfirst}, $bop_content{paylast}) = ($1, $2);
5144 my @invoicing_list = $self->invoicing_list_emailonly;
5145 if ( $conf->exists('emailinvoiceautoalways')
5146 || $conf->exists('emailinvoiceauto') && ! @invoicing_list
5147 || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
5148 push @invoicing_list, $self->all_emails;
5151 my $email = ($conf->exists('business-onlinepayment-email-override'))
5152 ? $conf->config('business-onlinepayment-email-override')
5153 : $invoicing_list[0];
5157 if ( $namespace eq 'Business::OnlinePayment' && $options{method} eq 'CC' ) {
5159 $content{card_number} = $options{payinfo};
5160 $paydate = exists($options{'paydate'})
5161 ? $options{'paydate'}
5163 $paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
5164 $content{expiration} = "$2/$1";
5166 my $paycvv = exists($options{'paycvv'})
5167 ? $options{'paycvv'}
5169 $content{cvv2} = $paycvv
5172 my $paystart_month = exists($options{'paystart_month'})
5173 ? $options{'paystart_month'}
5174 : $self->paystart_month;
5176 my $paystart_year = exists($options{'paystart_year'})
5177 ? $options{'paystart_year'}
5178 : $self->paystart_year;
5180 $content{card_start} = "$paystart_month/$paystart_year"
5181 if $paystart_month && $paystart_year;
5183 my $payissue = exists($options{'payissue'})
5184 ? $options{'payissue'}
5186 $content{issue_number} = $payissue if $payissue;
5188 if ( $self->_bop_recurring_billing( 'payinfo' => $options{'payinfo'},
5189 'trans_is_recur' => $trans_is_recur,
5193 $content{recurring_billing} = 'YES';
5194 $content{acct_code} = 'rebill'
5195 if $conf->exists('credit_card-recurring_billing_acct_code');
5198 } elsif ( $namespace eq 'Business::OnlinePayment' && $options{method} eq 'ECHECK' ){
5199 ( $content{account_number}, $content{routing_code} ) =
5200 split('@', $options{payinfo});
5201 $content{bank_name} = $options{payname};
5202 $content{bank_state} = exists($options{'paystate'})
5203 ? $options{'paystate'}
5204 : $self->getfield('paystate');
5205 $content{account_type} = exists($options{'paytype'})
5206 ? uc($options{'paytype'}) || 'CHECKING'
5207 : uc($self->getfield('paytype')) || 'CHECKING';
5208 $content{customer_org} = $self->company ? 'B' : 'I';
5209 $content{state_id} = exists($options{'stateid'})
5210 ? $options{'stateid'}
5211 : $self->getfield('stateid');
5212 $content{state_id_state} = exists($options{'stateid_state'})
5213 ? $options{'stateid_state'}
5214 : $self->getfield('stateid_state');
5215 $content{customer_ssn} = exists($options{'ss'})
5218 } elsif ( $namespace eq 'Business::OnlinePayment' && $options{method} eq 'LEC' ) {
5219 $content{phone} = $options{payinfo};
5220 } elsif ( $namespace eq 'Business::OnlineThirdPartyPayment' ) {
5227 # run transaction(s)
5230 my $balance = exists( $options{'balance'} )
5231 ? $options{'balance'}
5234 $self->select_for_update; #mutex ... just until we get our pending record in
5236 #the checks here are intended to catch concurrent payments
5237 #double-form-submission prevention is taken care of in cust_pay_pending::check
5240 return "The customer's balance has changed; $options{method} transaction aborted."
5241 if $self->balance < $balance;
5242 #&& $self->balance < $options{amount}; #might as well anyway?
5244 #also check and make sure there aren't *other* pending payments for this cust
5246 my @pending = qsearch('cust_pay_pending', {
5247 'custnum' => $self->custnum,
5248 'status' => { op=>'!=', value=>'done' }
5250 return "A payment is already being processed for this customer (".
5251 join(', ', map 'paypendingnum '. $_->paypendingnum, @pending ).
5252 "); $options{method} transaction aborted."
5253 if scalar(@pending);
5255 #okay, good to go, if we're a duplicate, cust_pay_pending will kick us out
5257 my $cust_pay_pending = new FS::cust_pay_pending {
5258 'custnum' => $self->custnum,
5259 #'invnum' => $options{'invnum'},
5260 'paid' => $options{amount},
5262 'payby' => $bop_method2payby{$options{method}},
5263 'payinfo' => $options{payinfo},
5264 'paydate' => $paydate,
5265 'recurring_billing' => $content{recurring_billing},
5266 'pkgnum' => $options{'pkgnum'},
5268 'gatewaynum' => $payment_gateway->gatewaynum || '',
5269 'session_id' => $options{session_id} || '',
5270 'jobnum' => $options{depend_jobnum} || '',
5272 $cust_pay_pending->payunique( $options{payunique} )
5273 if defined($options{payunique}) && length($options{payunique});
5274 my $cpp_new_err = $cust_pay_pending->insert; #mutex lost when this is inserted
5275 return $cpp_new_err if $cpp_new_err;
5277 my( $action1, $action2 ) =
5278 split( /\s*\,\s*/, $payment_gateway->gateway_action );
5280 my $transaction = new $namespace( $payment_gateway->gateway_module,
5281 $self->_bop_options(\%options),
5284 $transaction->content(
5285 'type' => $options{method},
5286 $self->_bop_auth(\%options),
5287 'action' => $action1,
5288 'description' => $options{'description'},
5289 'amount' => $options{amount},
5290 #'invoice_number' => $options{'invnum'},
5291 'customer_id' => $self->custnum,
5293 'reference' => $cust_pay_pending->paypendingnum, #for now
5298 $cust_pay_pending->status('pending');
5299 my $cpp_pending_err = $cust_pay_pending->replace;
5300 return $cpp_pending_err if $cpp_pending_err;
5303 my $BOP_TESTING = 0;
5304 my $BOP_TESTING_SUCCESS = 1;
5306 unless ( $BOP_TESTING ) {
5307 $transaction->submit();
5309 if ( $BOP_TESTING_SUCCESS ) {
5310 $transaction->is_success(1);
5311 $transaction->authorization('fake auth');
5313 $transaction->is_success(0);
5314 $transaction->error_message('fake failure');
5318 if ( $transaction->is_success() && $namespace eq 'Business::OnlineThirdPartyPayment' ) {
5320 return { reference => $cust_pay_pending->paypendingnum,
5321 map { $_ => $transaction->$_ } qw ( popup_url collectitems ) };
5323 } elsif ( $transaction->is_success() && $action2 ) {
5325 $cust_pay_pending->status('authorized');
5326 my $cpp_authorized_err = $cust_pay_pending->replace;
5327 return $cpp_authorized_err if $cpp_authorized_err;
5329 my $auth = $transaction->authorization;
5330 my $ordernum = $transaction->can('order_number')
5331 ? $transaction->order_number
5335 new Business::OnlinePayment( $payment_gateway->gateway_module,
5336 $self->_bop_options(\%options),
5341 type => $options{method},
5343 $self->_bop_auth(\%options),
5344 order_number => $ordernum,
5345 amount => $options{amount},
5346 authorization => $auth,
5347 description => $options{'description'},
5350 foreach my $field (qw( authorization_source_code returned_ACI
5351 transaction_identifier validation_code
5352 transaction_sequence_num local_transaction_date
5353 local_transaction_time AVS_result_code )) {
5354 $capture{$field} = $transaction->$field() if $transaction->can($field);
5357 $capture->content( %capture );
5361 unless ( $capture->is_success ) {
5362 my $e = "Authorization successful but capture failed, custnum #".
5363 $self->custnum. ': '. $capture->result_code.
5364 ": ". $capture->error_message;
5372 # remove paycvv after initial transaction
5375 #false laziness w/misc/process/payment.cgi - check both to make sure working
5377 if ( defined $self->dbdef_table->column('paycvv')
5378 && length($self->paycvv)
5379 && ! grep { $_ eq cardtype($options{payinfo}) } $conf->config('cvv-save')
5381 my $error = $self->remove_cvv;
5383 warn "WARNING: error removing cvv: $error\n";
5391 $self->_realtime_bop_result( $cust_pay_pending, $transaction, %options );
5403 if (ref($_[0]) eq 'HASH') {
5404 %options = %{$_[0]};
5406 my ( $method, $amount ) = ( shift, shift );
5408 $options{method} = $method;
5409 $options{amount} = $amount;
5412 if ( $options{'fake_failure'} ) {
5413 return "Error: No error; test failure requested with fake_failure";
5417 #if ( $payment_gateway->gatewaynum ) { # agent override
5418 # $paybatch = $payment_gateway->gatewaynum. '-';
5421 #$paybatch .= "$processor:". $transaction->authorization;
5423 #$paybatch .= ':'. $transaction->order_number
5424 # if $transaction->can('order_number')
5425 # && length($transaction->order_number);
5427 my $paybatch = 'FakeProcessor:54:32';
5429 my $cust_pay = new FS::cust_pay ( {
5430 'custnum' => $self->custnum,
5431 'invnum' => $options{'invnum'},
5432 'paid' => $options{amount},
5434 'payby' => $bop_method2payby{$options{method}},
5435 #'payinfo' => $payinfo,
5436 'payinfo' => '4111111111111111',
5437 'paybatch' => $paybatch,
5438 #'paydate' => $paydate,
5439 'paydate' => '2012-05-01',
5441 $cust_pay->payunique( $options{payunique} ) if length($options{payunique});
5443 my $error = $cust_pay->insert($options{'manual'} ? ( 'manual' => 1 ) : () );
5446 $cust_pay->invnum(''); #try again with no specific invnum
5447 my $error2 = $cust_pay->insert( $options{'manual'} ?
5448 ( 'manual' => 1 ) : ()
5451 # gah, even with transactions.
5452 my $e = 'WARNING: Card/ACH debited but database not updated - '.
5453 "error inserting (fake!) payment: $error2".
5454 " (previously tried insert with invnum #$options{'invnum'}" .
5461 if ( $options{'paynum_ref'} ) {
5462 ${ $options{'paynum_ref'} } = $cust_pay->paynum;
5465 return ''; #no error
5470 # item _realtime_bop_result CUST_PAY_PENDING, BOP_OBJECT [ OPTION => VALUE ... ]
5472 # Wraps up processing of a realtime credit card, ACH (electronic check) or
5473 # phone bill transaction.
5475 sub _realtime_bop_result {
5476 my( $self, $cust_pay_pending, $transaction, %options ) = @_;
5478 warn "$me _realtime_bop_result: pending transaction ".
5479 $cust_pay_pending->paypendingnum. "\n";
5480 warn " $_ => $options{$_}\n" foreach keys %options;
5483 my $payment_gateway = $options{payment_gateway}
5484 or return "no payment gateway in arguments to _realtime_bop_result";
5486 $cust_pay_pending->status($transaction->is_success() ? 'captured' : 'declined');
5487 my $cpp_captured_err = $cust_pay_pending->replace;
5488 return $cpp_captured_err if $cpp_captured_err;
5490 if ( $transaction->is_success() ) {
5493 if ( $payment_gateway->gatewaynum ) { # agent override
5494 $paybatch = $payment_gateway->gatewaynum. '-';
5497 $paybatch .= $payment_gateway->gateway_module. ":".
5498 $transaction->authorization;
5500 $paybatch .= ':'. $transaction->order_number
5501 if $transaction->can('order_number')
5502 && length($transaction->order_number);
5504 my $cust_pay = new FS::cust_pay ( {
5505 'custnum' => $self->custnum,
5506 'invnum' => $options{'invnum'},
5507 'paid' => $cust_pay_pending->paid,
5509 'payby' => $cust_pay_pending->payby,
5510 #'payinfo' => $payinfo,
5511 'paybatch' => $paybatch,
5512 'paydate' => $cust_pay_pending->paydate,
5513 'pkgnum' => $cust_pay_pending->pkgnum,
5515 #doesn't hurt to know, even though the dup check is in cust_pay_pending now
5516 $cust_pay->payunique( $options{payunique} )
5517 if defined($options{payunique}) && length($options{payunique});
5519 my $oldAutoCommit = $FS::UID::AutoCommit;
5520 local $FS::UID::AutoCommit = 0;
5523 #start a transaction, insert the cust_pay and set cust_pay_pending.status to done in a single transction
5525 my $error = $cust_pay->insert($options{'manual'} ? ( 'manual' => 1 ) : () );
5528 $cust_pay->invnum(''); #try again with no specific invnum
5529 my $error2 = $cust_pay->insert( $options{'manual'} ?
5530 ( 'manual' => 1 ) : ()
5533 # gah. but at least we have a record of the state we had to abort in
5534 # from cust_pay_pending now.
5535 my $e = "WARNING: $options{method} captured but payment not recorded -".
5536 " error inserting payment (". $payment_gateway->gateway_module.
5538 " (previously tried insert with invnum #$options{'invnum'}" .
5539 ": $error ) - pending payment saved as paypendingnum ".
5540 $cust_pay_pending->paypendingnum. "\n";
5546 my $jobnum = $cust_pay_pending->jobnum;
5548 my $placeholder = qsearchs( 'queue', { 'jobnum' => $jobnum } );
5550 unless ( $placeholder ) {
5551 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
5552 my $e = "WARNING: $options{method} captured but job $jobnum not ".
5553 "found for paypendingnum ". $cust_pay_pending->paypendingnum. "\n";
5558 $error = $placeholder->delete;
5561 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
5562 my $e = "WARNING: $options{method} captured but could not delete ".
5563 "job $jobnum for paypendingnum ".
5564 $cust_pay_pending->paypendingnum. ": $error\n";
5571 if ( $options{'paynum_ref'} ) {
5572 ${ $options{'paynum_ref'} } = $cust_pay->paynum;
5575 $cust_pay_pending->status('done');
5576 $cust_pay_pending->statustext('captured');
5577 $cust_pay_pending->paynum($cust_pay->paynum);
5578 my $cpp_done_err = $cust_pay_pending->replace;
5580 if ( $cpp_done_err ) {
5582 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
5583 my $e = "WARNING: $options{method} captured but payment not recorded - ".
5584 "error updating status for paypendingnum ".
5585 $cust_pay_pending->paypendingnum. ": $cpp_done_err \n";
5591 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
5593 if ( $options{'apply'} ) {
5594 my $apply_error = $self->apply_payments_and_credits;
5595 if ( $apply_error ) {
5596 warn "WARNING: error applying payment: $apply_error\n";
5597 #but we still should return no error cause the payment otherwise went
5602 return ''; #no error
5608 my $perror = $payment_gateway->gateway_module. " error: ".
5609 $transaction->error_message;
5611 my $jobnum = $cust_pay_pending->jobnum;
5613 my $placeholder = qsearchs( 'queue', { 'jobnum' => $jobnum } );
5615 if ( $placeholder ) {
5616 my $error = $placeholder->depended_delete;
5617 $error ||= $placeholder->delete;
5618 warn "error removing provisioning jobs after declined paypendingnum ".
5619 $cust_pay_pending->paypendingnum. "\n";
5621 my $e = "error finding job $jobnum for declined paypendingnum ".
5622 $cust_pay_pending->paypendingnum. "\n";
5628 unless ( $transaction->error_message ) {
5631 if ( $transaction->can('response_page') ) {
5633 'page' => ( $transaction->can('response_page')
5634 ? $transaction->response_page
5637 'code' => ( $transaction->can('response_code')
5638 ? $transaction->response_code
5641 'headers' => ( $transaction->can('response_headers')
5642 ? $transaction->response_headers
5648 "No additional debugging information available for ".
5649 $payment_gateway->gateway_module;
5652 $perror .= "No error_message returned from ".
5653 $payment_gateway->gateway_module. " -- ".
5654 ( ref($t_response) ? Dumper($t_response) : $t_response );
5658 if ( !$options{'quiet'} && !$realtime_bop_decline_quiet
5659 && $conf->exists('emaildecline')
5660 && grep { $_ ne 'POST' } $self->invoicing_list
5661 && ! grep { $transaction->error_message =~ /$_/ }
5662 $conf->config('emaildecline-exclude')
5664 my @templ = $conf->config('declinetemplate');
5665 my $template = new Text::Template (
5667 SOURCE => [ map "$_\n", @templ ],
5668 ) or return "($perror) can't create template: $Text::Template::ERROR";
5669 $template->compile()
5670 or return "($perror) can't compile template: $Text::Template::ERROR";
5674 scalar( $conf->config('company_name', $self->agentnum ) ),
5675 'company_address' =>
5676 join("\n", $conf->config('company_address', $self->agentnum ) ),
5677 'error' => $transaction->error_message,
5680 my $error = send_email(
5681 'from' => $conf->config('invoice_from', $self->agentnum ),
5682 'to' => [ grep { $_ ne 'POST' } $self->invoicing_list ],
5683 'subject' => 'Your payment could not be processed',
5684 'body' => [ $template->fill_in(HASH => $templ_hash) ],
5687 $perror .= " (also received error sending decline notification: $error)"
5692 $cust_pay_pending->status('done');
5693 $cust_pay_pending->statustext("declined: $perror");
5694 my $cpp_done_err = $cust_pay_pending->replace;
5695 if ( $cpp_done_err ) {
5696 my $e = "WARNING: $options{method} declined but pending payment not ".
5697 "resolved - error updating status for paypendingnum ".
5698 $cust_pay_pending->paypendingnum. ": $cpp_done_err \n";
5700 $perror = "$e ($perror)";
5708 =item realtime_botpp_capture CUST_PAY_PENDING [ OPTION => VALUE ... ]
5710 Verifies successful third party processing of a realtime credit card,
5711 ACH (electronic check) or phone bill transaction via a
5712 Business::OnlineThirdPartyPayment realtime gateway. See
5713 L<http://420.am/business-onlinethirdpartypayment> for supported gateways.
5715 Available options are: I<description>, I<invnum>, I<quiet>, I<paynum_ref>, I<payunique>
5717 The additional options I<payname>, I<city>, I<state>,
5718 I<zip>, I<payinfo> and I<paydate> are also available. Any of these options,
5719 if set, will override the value from the customer record.
5721 I<description> is a free-text field passed to the gateway. It defaults to
5722 "Internet services".
5724 If an I<invnum> is specified, this payment (if successful) is applied to the
5725 specified invoice. If you don't specify an I<invnum> you might want to
5726 call the B<apply_payments> method.
5728 I<quiet> can be set true to surpress email decline notices.
5730 I<paynum_ref> can be set to a scalar reference. It will be filled in with the
5731 resulting paynum, if any.
5733 I<payunique> is a unique identifier for this payment.
5735 Returns a hashref containing elements bill_error (which will be undefined
5736 upon success) and session_id of any associated session.
5740 sub realtime_botpp_capture {
5741 my( $self, $cust_pay_pending, %options ) = @_;
5743 warn "$me realtime_botpp_capture: pending transaction $cust_pay_pending\n";
5744 warn " $_ => $options{$_}\n" foreach keys %options;
5747 eval "use Business::OnlineThirdPartyPayment";
5751 # select the gateway
5754 my $method = FS::payby->payby2bop($cust_pay_pending->payby);
5756 my $payment_gateway = $cust_pay_pending->gatewaynum
5757 ? qsearchs( 'payment_gateway',
5758 { gatewaynum => $cust_pay_pending->gatewaynum }
5760 : $self->agent->payment_gateway( 'method' => $method,
5761 # 'invnum' => $cust_pay_pending->invnum,
5762 # 'payinfo' => $cust_pay_pending->payinfo,
5765 $options{payment_gateway} = $payment_gateway; # for the helper subs
5771 my @invoicing_list = $self->invoicing_list_emailonly;
5772 if ( $conf->exists('emailinvoiceautoalways')
5773 || $conf->exists('emailinvoiceauto') && ! @invoicing_list
5774 || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
5775 push @invoicing_list, $self->all_emails;
5778 my $email = ($conf->exists('business-onlinepayment-email-override'))
5779 ? $conf->config('business-onlinepayment-email-override')
5780 : $invoicing_list[0];
5784 $content{email_customer} =
5785 ( $conf->exists('business-onlinepayment-email_customer')
5786 || $conf->exists('business-onlinepayment-email-override') );
5789 # run transaction(s)
5793 new Business::OnlineThirdPartyPayment( $payment_gateway->gateway_module,
5794 $self->_bop_options(\%options),
5797 $transaction->reference({ %options });
5799 $transaction->content(
5801 $self->_bop_auth(\%options),
5802 'action' => 'Post Authorization',
5803 'description' => $options{'description'},
5804 'amount' => $cust_pay_pending->paid,
5805 #'invoice_number' => $options{'invnum'},
5806 'customer_id' => $self->custnum,
5807 'referer' => 'http://cleanwhisker.420.am/',
5808 'reference' => $cust_pay_pending->paypendingnum,
5810 'phone' => $self->daytime || $self->night,
5812 # plus whatever is required for bogus capture avoidance
5815 $transaction->submit();
5818 $self->_realtime_bop_result( $cust_pay_pending, $transaction, %options );
5821 bill_error => $error,
5822 session_id => $cust_pay_pending->session_id,
5827 =item default_payment_gateway DEPRECATED -- use agent->payment_gateway
5831 sub default_payment_gateway {
5832 my( $self, $method ) = @_;
5834 die "Real-time processing not enabled\n"
5835 unless $conf->exists('business-onlinepayment');
5837 #warn "default_payment_gateway deprecated -- use agent->payment_gateway\n";
5840 my $bop_config = 'business-onlinepayment';
5841 $bop_config .= '-ach'
5842 if $method =~ /^(ECHECK|CHEK)$/ && $conf->exists($bop_config. '-ach');
5843 my ( $processor, $login, $password, $action, @bop_options ) =
5844 $conf->config($bop_config);
5845 $action ||= 'normal authorization';
5846 pop @bop_options if scalar(@bop_options) % 2 && $bop_options[-1] =~ /^\s*$/;
5847 die "No real-time processor is enabled - ".
5848 "did you set the business-onlinepayment configuration value?\n"
5851 ( $processor, $login, $password, $action, @bop_options )
5856 Removes the I<paycvv> field from the database directly.
5858 If there is an error, returns the error, otherwise returns false.
5864 my $sth = dbh->prepare("UPDATE cust_main SET paycvv = '' WHERE custnum = ?")
5865 or return dbh->errstr;
5866 $sth->execute($self->custnum)
5867 or return $sth->errstr;
5872 =item _new_realtime_refund_bop METHOD [ OPTION => VALUE ... ]
5874 Refunds a realtime credit card, ACH (electronic check) or phone bill transaction
5875 via a Business::OnlinePayment realtime gateway. See
5876 L<http://420.am/business-onlinepayment> for supported gateways.
5878 Available methods are: I<CC>, I<ECHECK> and I<LEC>
5880 Available options are: I<amount>, I<reason>, I<paynum>, I<paydate>
5882 Most gateways require a reference to an original payment transaction to refund,
5883 so you probably need to specify a I<paynum>.
5885 I<amount> defaults to the original amount of the payment if not specified.
5887 I<reason> specifies a reason for the refund.
5889 I<paydate> specifies the expiration date for a credit card overriding the
5890 value from the customer record or the payment record. Specified as yyyy-mm-dd
5892 Implementation note: If I<amount> is unspecified or equal to the amount of the
5893 orignal payment, first an attempt is made to "void" the transaction via
5894 the gateway (to cancel a not-yet settled transaction) and then if that fails,
5895 the normal attempt is made to "refund" ("credit") the transaction via the
5896 gateway is attempted.
5898 #The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
5899 #I<zip>, I<payinfo> and I<paydate> are also available. Any of these options,
5900 #if set, will override the value from the customer record.
5902 #If an I<invnum> is specified, this payment (if successful) is applied to the
5903 #specified invoice. If you don't specify an I<invnum> you might want to
5904 #call the B<apply_payments> method.
5908 #some false laziness w/realtime_bop, not enough to make it worth merging
5909 #but some useful small subs should be pulled out
5910 sub _new_realtime_refund_bop {
5914 if (ref($_[0]) ne 'HASH') {
5915 %options = %{$_[0]};
5919 $options{method} = $method;
5923 warn "$me realtime_refund_bop (new): $options{method} refund\n";
5924 warn " $_ => $options{$_}\n" foreach keys %options;
5928 # look up the original payment and optionally a gateway for that payment
5932 my $amount = $options{'amount'};
5934 my( $processor, $login, $password, @bop_options, $namespace ) ;
5935 my( $auth, $order_number ) = ( '', '', '' );
5937 if ( $options{'paynum'} ) {
5939 warn " paynum: $options{paynum}\n" if $DEBUG > 1;
5940 $cust_pay = qsearchs('cust_pay', { paynum=>$options{'paynum'} } )
5941 or return "Unknown paynum $options{'paynum'}";
5942 $amount ||= $cust_pay->paid;
5944 $cust_pay->paybatch =~ /^((\d+)\-)?(\w+):\s*([\w\-\/ ]*)(:([\w\-]+))?$/
5945 or return "Can't parse paybatch for paynum $options{'paynum'}: ".
5946 $cust_pay->paybatch;
5947 my $gatewaynum = '';
5948 ( $gatewaynum, $processor, $auth, $order_number ) = ( $2, $3, $4, $6 );
5950 if ( $gatewaynum ) { #gateway for the payment to be refunded
5952 my $payment_gateway =
5953 qsearchs('payment_gateway', { 'gatewaynum' => $gatewaynum } );
5954 die "payment gateway $gatewaynum not found"
5955 unless $payment_gateway;
5957 $processor = $payment_gateway->gateway_module;
5958 $login = $payment_gateway->gateway_username;
5959 $password = $payment_gateway->gateway_password;
5960 $namespace = $payment_gateway->gateway_namespace;
5961 @bop_options = $payment_gateway->options;
5963 } else { #try the default gateway
5966 my $payment_gateway =
5967 $self->agent->payment_gateway('method' => $options{method});
5969 ( $conf_processor, $login, $password, $namespace ) =
5970 map { my $method = "gateway_$_"; $payment_gateway->$method }
5971 qw( module username password namespace );
5973 @bop_options = $payment_gateway->gatewaynum
5974 ? $payment_gateway->options
5975 : @{ $payment_gateway->get('options') };
5977 return "processor of payment $options{'paynum'} $processor does not".
5978 " match default processor $conf_processor"
5979 unless $processor eq $conf_processor;
5984 } else { # didn't specify a paynum, so look for agent gateway overrides
5985 # like a normal transaction
5987 my $payment_gateway =
5988 $self->agent->payment_gateway( 'method' => $options{method},
5989 #'payinfo' => $payinfo,
5991 my( $processor, $login, $password, $namespace ) =
5992 map { my $method = "gateway_$_"; $payment_gateway->$method }
5993 qw( module username password namespace );
5995 my @bop_options = $payment_gateway->gatewaynum
5996 ? $payment_gateway->options
5997 : @{ $payment_gateway->get('options') };
6000 return "neither amount nor paynum specified" unless $amount;
6002 eval "use $namespace";
6006 'type' => $options{method},
6008 'password' => $password,
6009 'order_number' => $order_number,
6010 'amount' => $amount,
6011 'referer' => 'http://cleanwhisker.420.am/', #XXX fix referer :/
6013 $content{authorization} = $auth
6014 if length($auth); #echeck/ACH transactions have an order # but no auth
6015 #(at least with authorize.net)
6017 my $disable_void_after;
6018 if ($conf->exists('disable_void_after')
6019 && $conf->config('disable_void_after') =~ /^(\d+)$/) {
6020 $disable_void_after = $1;
6023 #first try void if applicable
6024 if ( $cust_pay && $cust_pay->paid == $amount
6026 ( not defined($disable_void_after) )
6027 || ( time < ($cust_pay->_date + $disable_void_after ) )
6030 warn " attempting void\n" if $DEBUG > 1;
6031 my $void = new Business::OnlinePayment( $processor, @bop_options );
6032 $content{'card_number'} = $cust_pay->payinfo
6033 if $cust_pay->payby eq 'CARD'
6034 && $void->can('info') && $void->info('CC_void_requires_card');
6035 $void->content( 'action' => 'void', %content );
6037 if ( $void->is_success ) {
6038 my $error = $cust_pay->void($options{'reason'});
6040 # gah, even with transactions.
6041 my $e = 'WARNING: Card/ACH voided but database not updated - '.
6042 "error voiding payment: $error";
6046 warn " void successful\n" if $DEBUG > 1;
6051 warn " void unsuccessful, trying refund\n"
6055 my $address = $self->address1;
6056 $address .= ", ". $self->address2 if $self->address2;
6058 my($payname, $payfirst, $paylast);
6059 if ( $self->payname && $options{method} ne 'ECHECK' ) {
6060 $payname = $self->payname;
6061 $payname =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
6062 or return "Illegal payname $payname";
6063 ($payfirst, $paylast) = ($1, $2);
6065 $payfirst = $self->getfield('first');
6066 $paylast = $self->getfield('last');
6067 $payname = "$payfirst $paylast";
6070 my @invoicing_list = $self->invoicing_list_emailonly;
6071 if ( $conf->exists('emailinvoiceautoalways')
6072 || $conf->exists('emailinvoiceauto') && ! @invoicing_list
6073 || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
6074 push @invoicing_list, $self->all_emails;
6077 my $email = ($conf->exists('business-onlinepayment-email-override'))
6078 ? $conf->config('business-onlinepayment-email-override')
6079 : $invoicing_list[0];
6081 my $payip = exists($options{'payip'})
6084 $content{customer_ip} = $payip
6088 if ( $options{method} eq 'CC' ) {
6091 $content{card_number} = $payinfo = $cust_pay->payinfo;
6092 (exists($options{'paydate'}) ? $options{'paydate'} : $cust_pay->paydate)
6093 =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/ &&
6094 ($content{expiration} = "$2/$1"); # where available
6096 $content{card_number} = $payinfo = $self->payinfo;
6097 (exists($options{'paydate'}) ? $options{'paydate'} : $self->paydate)
6098 =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
6099 $content{expiration} = "$2/$1";
6102 } elsif ( $options{method} eq 'ECHECK' ) {
6105 $payinfo = $cust_pay->payinfo;
6107 $payinfo = $self->payinfo;
6109 ( $content{account_number}, $content{routing_code} )= split('@', $payinfo );
6110 $content{bank_name} = $self->payname;
6111 $content{account_type} = 'CHECKING';
6112 $content{account_name} = $payname;
6113 $content{customer_org} = $self->company ? 'B' : 'I';
6114 $content{customer_ssn} = $self->ss;
6115 } elsif ( $options{method} eq 'LEC' ) {
6116 $content{phone} = $payinfo = $self->payinfo;
6120 my $refund = new Business::OnlinePayment( $processor, @bop_options );
6121 my %sub_content = $refund->content(
6122 'action' => 'credit',
6123 'customer_id' => $self->custnum,
6124 'last_name' => $paylast,
6125 'first_name' => $payfirst,
6127 'address' => $address,
6128 'city' => $self->city,
6129 'state' => $self->state,
6130 'zip' => $self->zip,
6131 'country' => $self->country,
6133 'phone' => $self->daytime || $self->night,
6136 warn join('', map { " $_ => $sub_content{$_}\n" } keys %sub_content )
6140 return "$processor error: ". $refund->error_message
6141 unless $refund->is_success();
6143 my $paybatch = "$processor:". $refund->authorization;
6144 $paybatch .= ':'. $refund->order_number
6145 if $refund->can('order_number') && $refund->order_number;
6147 while ( $cust_pay && $cust_pay->unapplied < $amount ) {
6148 my @cust_bill_pay = $cust_pay->cust_bill_pay;
6149 last unless @cust_bill_pay;
6150 my $cust_bill_pay = pop @cust_bill_pay;
6151 my $error = $cust_bill_pay->delete;
6155 my $cust_refund = new FS::cust_refund ( {
6156 'custnum' => $self->custnum,
6157 'paynum' => $options{'paynum'},
6158 'refund' => $amount,
6160 'payby' => $bop_method2payby{$options{method}},
6161 'payinfo' => $payinfo,
6162 'paybatch' => $paybatch,
6163 'reason' => $options{'reason'} || 'card or ACH refund',
6165 my $error = $cust_refund->insert;
6167 $cust_refund->paynum(''); #try again with no specific paynum
6168 my $error2 = $cust_refund->insert;
6170 # gah, even with transactions.
6171 my $e = 'WARNING: Card/ACH refunded but database not updated - '.
6172 "error inserting refund ($processor): $error2".
6173 " (previously tried insert with paynum #$options{'paynum'}" .
6184 =item batch_card OPTION => VALUE...
6186 Adds a payment for this invoice to the pending credit card batch (see
6187 L<FS::cust_pay_batch>), or, if the B<realtime> option is set to a true value,
6188 runs the payment using a realtime gateway.
6193 my ($self, %options) = @_;
6196 if (exists($options{amount})) {
6197 $amount = $options{amount};
6199 $amount = sprintf("%.2f", $self->balance - $self->in_transit_payments);
6201 return '' unless $amount > 0;
6203 my $invnum = delete $options{invnum};
6204 my $payby = $options{invnum} || $self->payby; #dubious
6206 if ($options{'realtime'}) {
6207 return $self->realtime_bop( FS::payby->payby2bop($self->payby),
6213 my $oldAutoCommit = $FS::UID::AutoCommit;
6214 local $FS::UID::AutoCommit = 0;
6217 #this needs to handle mysql as well as Pg, like svc_acct.pm
6218 #(make it into a common function if folks need to do batching with mysql)
6219 $dbh->do("LOCK TABLE pay_batch IN SHARE ROW EXCLUSIVE MODE")
6220 or return "Cannot lock pay_batch: " . $dbh->errstr;
6224 'payby' => FS::payby->payby2payment($payby),
6227 my $pay_batch = qsearchs( 'pay_batch', \%pay_batch );
6229 unless ( $pay_batch ) {
6230 $pay_batch = new FS::pay_batch \%pay_batch;
6231 my $error = $pay_batch->insert;
6233 $dbh->rollback if $oldAutoCommit;
6234 die "error creating new batch: $error\n";
6238 my $old_cust_pay_batch = qsearchs('cust_pay_batch', {
6239 'batchnum' => $pay_batch->batchnum,
6240 'custnum' => $self->custnum,
6243 foreach (qw( address1 address2 city state zip country payby payinfo paydate
6245 $options{$_} = '' unless exists($options{$_});
6248 my $cust_pay_batch = new FS::cust_pay_batch ( {
6249 'batchnum' => $pay_batch->batchnum,
6250 'invnum' => $invnum || 0, # is there a better value?
6251 # this field should be
6253 # cust_bill_pay_batch now
6254 'custnum' => $self->custnum,
6255 'last' => $self->getfield('last'),
6256 'first' => $self->getfield('first'),
6257 'address1' => $options{address1} || $self->address1,
6258 'address2' => $options{address2} || $self->address2,
6259 'city' => $options{city} || $self->city,
6260 'state' => $options{state} || $self->state,
6261 'zip' => $options{zip} || $self->zip,
6262 'country' => $options{country} || $self->country,
6263 'payby' => $options{payby} || $self->payby,
6264 'payinfo' => $options{payinfo} || $self->payinfo,
6265 'exp' => $options{paydate} || $self->paydate,
6266 'payname' => $options{payname} || $self->payname,
6267 'amount' => $amount, # consolidating
6270 $cust_pay_batch->paybatchnum($old_cust_pay_batch->paybatchnum)
6271 if $old_cust_pay_batch;
6274 if ($old_cust_pay_batch) {
6275 $error = $cust_pay_batch->replace($old_cust_pay_batch)
6277 $error = $cust_pay_batch->insert;
6281 $dbh->rollback if $oldAutoCommit;
6285 my $unapplied = $self->total_unapplied_credits
6286 + $self->total_unapplied_payments
6287 + $self->in_transit_payments;
6288 foreach my $cust_bill ($self->open_cust_bill) {
6289 #$dbh->commit or die $dbh->errstr if $oldAutoCommit;
6290 my $cust_bill_pay_batch = new FS::cust_bill_pay_batch {
6291 'invnum' => $cust_bill->invnum,
6292 'paybatchnum' => $cust_pay_batch->paybatchnum,
6293 'amount' => $cust_bill->owed,
6296 if ($unapplied >= $cust_bill_pay_batch->amount){
6297 $unapplied -= $cust_bill_pay_batch->amount;
6300 $cust_bill_pay_batch->amount(sprintf ( "%.2f",
6301 $cust_bill_pay_batch->amount - $unapplied )); $unapplied = 0;
6303 $error = $cust_bill_pay_batch->insert;
6305 $dbh->rollback if $oldAutoCommit;
6310 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
6314 =item apply_payments_and_credits [ OPTION => VALUE ... ]
6316 Applies unapplied payments and credits.
6318 In most cases, this new method should be used in place of sequential
6319 apply_payments and apply_credits methods.
6321 A hash of optional arguments may be passed. Currently "manual" is supported.
6322 If true, a payment receipt is sent instead of a statement when
6323 'payment_receipt_email' configuration option is set.
6325 If there is an error, returns the error, otherwise returns false.
6329 sub apply_payments_and_credits {
6330 my( $self, %options ) = @_;
6332 local $SIG{HUP} = 'IGNORE';
6333 local $SIG{INT} = 'IGNORE';
6334 local $SIG{QUIT} = 'IGNORE';
6335 local $SIG{TERM} = 'IGNORE';
6336 local $SIG{TSTP} = 'IGNORE';
6337 local $SIG{PIPE} = 'IGNORE';
6339 my $oldAutoCommit = $FS::UID::AutoCommit;
6340 local $FS::UID::AutoCommit = 0;
6343 $self->select_for_update; #mutex
6345 foreach my $cust_bill ( $self->open_cust_bill ) {
6346 my $error = $cust_bill->apply_payments_and_credits(%options);
6348 $dbh->rollback if $oldAutoCommit;
6349 return "Error applying: $error";
6353 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
6358 =item apply_credits OPTION => VALUE ...
6360 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
6361 to outstanding invoice balances in chronological order (or reverse
6362 chronological order if the I<order> option is set to B<newest>) and returns the
6363 value of any remaining unapplied credits available for refund (see
6364 L<FS::cust_refund>).
6366 Dies if there is an error.
6374 local $SIG{HUP} = 'IGNORE';
6375 local $SIG{INT} = 'IGNORE';
6376 local $SIG{QUIT} = 'IGNORE';
6377 local $SIG{TERM} = 'IGNORE';
6378 local $SIG{TSTP} = 'IGNORE';
6379 local $SIG{PIPE} = 'IGNORE';
6381 my $oldAutoCommit = $FS::UID::AutoCommit;
6382 local $FS::UID::AutoCommit = 0;
6385 $self->select_for_update; #mutex
6387 unless ( $self->total_unapplied_credits ) {
6388 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
6392 my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
6393 qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
6395 my @invoices = $self->open_cust_bill;
6396 @invoices = sort { $b->_date <=> $a->_date } @invoices
6397 if defined($opt{'order'}) && $opt{'order'} eq 'newest';
6399 if ( $conf->exists('pkg-balances') ) {
6400 # limit @credits to those w/ a pkgnum grepped from $self
6402 foreach my $i (@invoices) {
6403 foreach my $li ( $i->cust_bill_pkg ) {
6404 $pkgnums{$li->pkgnum} = 1;
6407 @credits = grep { ! $_->pkgnum || $pkgnums{$_->pkgnum} } @credits;
6412 foreach my $cust_bill ( @invoices ) {
6414 if ( !defined($credit) || $credit->credited == 0) {
6415 $credit = pop @credits or last;
6419 if ( $conf->exists('pkg-balances') && $credit->pkgnum ) {
6420 $owed = $cust_bill->owed_pkgnum($credit->pkgnum);
6422 $owed = $cust_bill->owed;
6424 unless ( $owed > 0 ) {
6425 push @credits, $credit;
6429 my $amount = min( $credit->credited, $owed );
6431 my $cust_credit_bill = new FS::cust_credit_bill ( {
6432 'crednum' => $credit->crednum,
6433 'invnum' => $cust_bill->invnum,
6434 'amount' => $amount,
6436 $cust_credit_bill->pkgnum( $credit->pkgnum )
6437 if $conf->exists('pkg-balances') && $credit->pkgnum;
6438 my $error = $cust_credit_bill->insert;
6440 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
6444 redo if ($cust_bill->owed > 0) && ! $conf->exists('pkg-balances');
6448 my $total_unapplied_credits = $self->total_unapplied_credits;
6450 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
6452 return $total_unapplied_credits;
6455 =item apply_payments [ OPTION => VALUE ... ]
6457 Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
6458 to outstanding invoice balances in chronological order.
6460 #and returns the value of any remaining unapplied payments.
6462 A hash of optional arguments may be passed. Currently "manual" is supported.
6463 If true, a payment receipt is sent instead of a statement when
6464 'payment_receipt_email' configuration option is set.
6466 Dies if there is an error.
6470 sub apply_payments {
6471 my( $self, %options ) = @_;
6473 local $SIG{HUP} = 'IGNORE';
6474 local $SIG{INT} = 'IGNORE';
6475 local $SIG{QUIT} = 'IGNORE';
6476 local $SIG{TERM} = 'IGNORE';
6477 local $SIG{TSTP} = 'IGNORE';
6478 local $SIG{PIPE} = 'IGNORE';
6480 my $oldAutoCommit = $FS::UID::AutoCommit;
6481 local $FS::UID::AutoCommit = 0;
6484 $self->select_for_update; #mutex
6488 my @payments = sort { $b->_date <=> $a->_date }
6489 grep { $_->unapplied > 0 }
6492 my @invoices = sort { $a->_date <=> $b->_date}
6493 grep { $_->owed > 0 }
6496 if ( $conf->exists('pkg-balances') ) {
6497 # limit @payments to those w/ a pkgnum grepped from $self
6499 foreach my $i (@invoices) {
6500 foreach my $li ( $i->cust_bill_pkg ) {
6501 $pkgnums{$li->pkgnum} = 1;
6504 @payments = grep { ! $_->pkgnum || $pkgnums{$_->pkgnum} } @payments;
6509 foreach my $cust_bill ( @invoices ) {
6511 if ( !defined($payment) || $payment->unapplied == 0 ) {
6512 $payment = pop @payments or last;
6516 if ( $conf->exists('pkg-balances') && $payment->pkgnum ) {
6517 $owed = $cust_bill->owed_pkgnum($payment->pkgnum);
6519 $owed = $cust_bill->owed;
6521 unless ( $owed > 0 ) {
6522 push @payments, $payment;
6526 my $amount = min( $payment->unapplied, $owed );
6528 my $cust_bill_pay = new FS::cust_bill_pay ( {
6529 'paynum' => $payment->paynum,
6530 'invnum' => $cust_bill->invnum,
6531 'amount' => $amount,
6533 $cust_bill_pay->pkgnum( $payment->pkgnum )
6534 if $conf->exists('pkg-balances') && $payment->pkgnum;
6535 my $error = $cust_bill_pay->insert(%options);
6537 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
6541 redo if ( $cust_bill->owed > 0) && ! $conf->exists('pkg-balances');
6545 my $total_unapplied_payments = $self->total_unapplied_payments;
6547 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
6549 return $total_unapplied_payments;
6554 Returns the total owed for this customer on all invoices
6555 (see L<FS::cust_bill/owed>).
6561 $self->total_owed_date(2145859200); #12/31/2037
6564 =item total_owed_date TIME
6566 Returns the total owed for this customer on all invoices with date earlier than
6567 TIME. TIME is specified as a UNIX timestamp; see L<perlfunc/"time">). Also
6568 see L<Time::Local> and L<Date::Parse> for conversion functions.
6572 sub total_owed_date {
6576 # my $custnum = $self->custnum;
6578 # my $owed_sql = FS::cust_bill->owed_sql;
6581 # SELECT SUM($owed_sql) FROM cust_bill
6582 # WHERE custnum = $custnum
6583 # AND _date <= $time
6586 # my $sth = dbh->prepare($sql) or die dbh->errstr;
6587 # $sth->execute() or die $sth->errstr;
6589 # return sprintf( '%.2f', $sth->fetchrow_arrayref->[0] );
6592 foreach my $cust_bill (
6593 grep { $_->_date <= $time }
6594 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
6596 $total_bill += $cust_bill->owed;
6598 sprintf( "%.2f", $total_bill );
6602 =item total_owed_pkgnum PKGNUM
6604 Returns the total owed on all invoices for this customer's specific package
6605 when using experimental package balances (see L<FS::cust_bill/owed_pkgnum>).
6609 sub total_owed_pkgnum {
6610 my( $self, $pkgnum ) = @_;
6611 $self->total_owed_date_pkgnum(2145859200, $pkgnum); #12/31/2037
6614 =item total_owed_date_pkgnum TIME PKGNUM
6616 Returns the total owed for this customer's specific package when using
6617 experimental package balances on all invoices with date earlier than
6618 TIME. TIME is specified as a UNIX timestamp; see L<perlfunc/"time">). Also
6619 see L<Time::Local> and L<Date::Parse> for conversion functions.
6623 sub total_owed_date_pkgnum {
6624 my( $self, $time, $pkgnum ) = @_;
6627 foreach my $cust_bill (
6628 grep { $_->_date <= $time }
6629 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
6631 $total_bill += $cust_bill->owed_pkgnum($pkgnum);
6633 sprintf( "%.2f", $total_bill );
6639 Returns the total amount of all payments.
6646 $total += $_->paid foreach $self->cust_pay;
6647 sprintf( "%.2f", $total );
6650 =item total_unapplied_credits
6652 Returns the total outstanding credit (see L<FS::cust_credit>) for this
6653 customer. See L<FS::cust_credit/credited>.
6655 =item total_credited
6657 Old name for total_unapplied_credits. Don't use.
6661 sub total_credited {
6662 #carp "total_credited deprecated, use total_unapplied_credits";
6663 shift->total_unapplied_credits(@_);
6666 sub total_unapplied_credits {
6668 my $total_credit = 0;
6669 $total_credit += $_->credited foreach $self->cust_credit;
6670 sprintf( "%.2f", $total_credit );
6673 =item total_unapplied_credits_pkgnum PKGNUM
6675 Returns the total outstanding credit (see L<FS::cust_credit>) for this
6676 customer. See L<FS::cust_credit/credited>.
6680 sub total_unapplied_credits_pkgnum {
6681 my( $self, $pkgnum ) = @_;
6682 my $total_credit = 0;
6683 $total_credit += $_->credited foreach $self->cust_credit_pkgnum($pkgnum);
6684 sprintf( "%.2f", $total_credit );
6688 =item total_unapplied_payments
6690 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
6691 See L<FS::cust_pay/unapplied>.
6695 sub total_unapplied_payments {
6697 my $total_unapplied = 0;
6698 $total_unapplied += $_->unapplied foreach $self->cust_pay;
6699 sprintf( "%.2f", $total_unapplied );
6702 =item total_unapplied_payments_pkgnum PKGNUM
6704 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer's
6705 specific package when using experimental package balances. See
6706 L<FS::cust_pay/unapplied>.
6710 sub total_unapplied_payments_pkgnum {
6711 my( $self, $pkgnum ) = @_;
6712 my $total_unapplied = 0;
6713 $total_unapplied += $_->unapplied foreach $self->cust_pay_pkgnum($pkgnum);
6714 sprintf( "%.2f", $total_unapplied );
6718 =item total_unapplied_refunds
6720 Returns the total unrefunded refunds (see L<FS::cust_refund>) for this
6721 customer. See L<FS::cust_refund/unapplied>.
6725 sub total_unapplied_refunds {
6727 my $total_unapplied = 0;
6728 $total_unapplied += $_->unapplied foreach $self->cust_refund;
6729 sprintf( "%.2f", $total_unapplied );
6734 Returns the balance for this customer (total_owed plus total_unrefunded, minus
6735 total_unapplied_credits minus total_unapplied_payments).
6743 + $self->total_unapplied_refunds
6744 - $self->total_unapplied_credits
6745 - $self->total_unapplied_payments
6749 =item balance_date TIME
6751 Returns the balance for this customer, only considering invoices with date
6752 earlier than TIME (total_owed_date minus total_credited minus
6753 total_unapplied_payments). TIME is specified as a UNIX timestamp; see
6754 L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion
6763 $self->total_owed_date($time)
6764 + $self->total_unapplied_refunds
6765 - $self->total_unapplied_credits
6766 - $self->total_unapplied_payments
6770 =item balance_date_range START_TIME [ END_TIME [ OPTION => VALUE ... ] ]
6772 Returns the balance for this customer, only considering invoices with date
6773 earlier than START_TIME, and optionally not later than END_TIME
6774 (total_owed_date minus total_unapplied_credits minus total_unapplied_payments).
6776 Times are specified as SQL fragments or numeric
6777 UNIX timestamps; see L<perlfunc/"time">). Also see L<Time::Local> and
6778 L<Date::Parse> for conversion functions. The empty string can be passed
6779 to disable that time constraint completely.
6781 Available options are:
6785 =item unapplied_date
6787 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)
6793 sub balance_date_range {
6795 my $sql = 'SELECT SUM('. $self->balance_date_sql(@_).
6796 ') FROM cust_main WHERE custnum='. $self->custnum;
6797 sprintf( "%.2f", $self->scalar_sql($sql) );
6800 =item balance_pkgnum PKGNUM
6802 Returns the balance for this customer's specific package when using
6803 experimental package balances (total_owed plus total_unrefunded, minus
6804 total_unapplied_credits minus total_unapplied_payments)
6808 sub balance_pkgnum {
6809 my( $self, $pkgnum ) = @_;
6812 $self->total_owed_pkgnum($pkgnum)
6813 # n/a - refunds aren't part of pkg-balances since they don't apply to invoices
6814 # + $self->total_unapplied_refunds_pkgnum($pkgnum)
6815 - $self->total_unapplied_credits_pkgnum($pkgnum)
6816 - $self->total_unapplied_payments_pkgnum($pkgnum)
6820 =item in_transit_payments
6822 Returns the total of requests for payments for this customer pending in
6823 batches in transit to the bank. See L<FS::pay_batch> and L<FS::cust_pay_batch>
6827 sub in_transit_payments {
6829 my $in_transit_payments = 0;
6830 foreach my $pay_batch ( qsearch('pay_batch', {
6833 foreach my $cust_pay_batch ( qsearch('cust_pay_batch', {
6834 'batchnum' => $pay_batch->batchnum,
6835 'custnum' => $self->custnum,
6837 $in_transit_payments += $cust_pay_batch->amount;
6840 sprintf( "%.2f", $in_transit_payments );
6845 Returns a hash of useful information for making a payment.
6855 'CARD' (credit card - automatic), 'DCRD' (credit card - on-demand),
6856 'CHEK' (electronic check - automatic), 'DCHK' (electronic check - on-demand),
6857 'LECB' (Phone bill billing), 'BILL' (billing), or 'COMP' (free).
6861 For credit card transactions:
6873 For electronic check transactions:
6888 $return{balance} = $self->balance;
6890 $return{payname} = $self->payname
6891 || ( $self->first. ' '. $self->get('last') );
6893 $return{$_} = $self->get($_) for qw(address1 address2 city state zip);
6895 $return{payby} = $self->payby;
6896 $return{stateid_state} = $self->stateid_state;
6898 if ( $self->payby =~ /^(CARD|DCRD)$/ ) {
6899 $return{card_type} = cardtype($self->payinfo);
6900 $return{payinfo} = $self->paymask;
6902 @return{'month', 'year'} = $self->paydate_monthyear;
6906 if ( $self->payby =~ /^(CHEK|DCHK)$/ ) {
6907 my ($payinfo1, $payinfo2) = split '@', $self->paymask;
6908 $return{payinfo1} = $payinfo1;
6909 $return{payinfo2} = $payinfo2;
6910 $return{paytype} = $self->paytype;
6911 $return{paystate} = $self->paystate;
6915 #doubleclick protection
6917 $return{paybatch} = "webui-MyAccount-$_date-$$-". rand() * 2**32;
6923 =item paydate_monthyear
6925 Returns a two-element list consisting of the month and year of this customer's
6926 paydate (credit card expiration date for CARD customers)
6930 sub paydate_monthyear {
6932 if ( $self->paydate =~ /^(\d{4})-(\d{1,2})-\d{1,2}$/ ) { #Pg date format
6934 } elsif ( $self->paydate =~ /^(\d{1,2})-(\d{1,2}-)?(\d{4}$)/ ) {
6941 =item tax_exemption TAXNAME
6946 my( $self, $taxname ) = @_;
6948 qsearchs( 'cust_main_exemption', { 'custnum' => $self->custnum,
6949 'taxname' => $taxname,
6954 =item cust_main_exemption
6958 sub cust_main_exemption {
6960 qsearch( 'cust_main_exemption', { 'custnum' => $self->custnum } );
6963 =item invoicing_list [ ARRAYREF ]
6965 If an arguement is given, sets these email addresses as invoice recipients
6966 (see L<FS::cust_main_invoice>). Errors are not fatal and are not reported
6967 (except as warnings), so use check_invoicing_list first.
6969 Returns a list of email addresses (with svcnum entries expanded).
6971 Note: You can clear the invoicing list by passing an empty ARRAYREF. You can
6972 check it without disturbing anything by passing nothing.
6974 This interface may change in the future.
6978 sub invoicing_list {
6979 my( $self, $arrayref ) = @_;
6982 my @cust_main_invoice;
6983 if ( $self->custnum ) {
6984 @cust_main_invoice =
6985 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
6987 @cust_main_invoice = ();
6989 foreach my $cust_main_invoice ( @cust_main_invoice ) {
6990 #warn $cust_main_invoice->destnum;
6991 unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
6992 #warn $cust_main_invoice->destnum;
6993 my $error = $cust_main_invoice->delete;
6994 warn $error if $error;
6997 if ( $self->custnum ) {
6998 @cust_main_invoice =
6999 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
7001 @cust_main_invoice = ();
7003 my %seen = map { $_->address => 1 } @cust_main_invoice;
7004 foreach my $address ( @{$arrayref} ) {
7005 next if exists $seen{$address} && $seen{$address};
7006 $seen{$address} = 1;
7007 my $cust_main_invoice = new FS::cust_main_invoice ( {
7008 'custnum' => $self->custnum,
7011 my $error = $cust_main_invoice->insert;
7012 warn $error if $error;
7016 if ( $self->custnum ) {
7018 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
7025 =item check_invoicing_list ARRAYREF
7027 Checks these arguements as valid input for the invoicing_list method. If there
7028 is an error, returns the error, otherwise returns false.
7032 sub check_invoicing_list {
7033 my( $self, $arrayref ) = @_;
7035 foreach my $address ( @$arrayref ) {
7037 if ($address eq 'FAX' and $self->getfield('fax') eq '') {
7038 return 'Can\'t add FAX invoice destination with a blank FAX number.';
7041 my $cust_main_invoice = new FS::cust_main_invoice ( {
7042 'custnum' => $self->custnum,
7045 my $error = $self->custnum
7046 ? $cust_main_invoice->check
7047 : $cust_main_invoice->checkdest
7049 return $error if $error;
7053 return "Email address required"
7054 if $conf->exists('cust_main-require_invoicing_list_email')
7055 && ! grep { $_ !~ /^([A-Z]+)$/ } @$arrayref;
7060 =item set_default_invoicing_list
7062 Sets the invoicing list to all accounts associated with this customer,
7063 overwriting any previous invoicing list.
7067 sub set_default_invoicing_list {
7069 $self->invoicing_list($self->all_emails);
7074 Returns the email addresses of all accounts provisioned for this customer.
7081 foreach my $cust_pkg ( $self->all_pkgs ) {
7082 my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
7084 map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
7085 grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
7087 $list{$_}=1 foreach map { $_->email } @svc_acct;
7092 =item invoicing_list_addpost
7094 Adds postal invoicing to this customer. If this customer is already configured
7095 to receive postal invoices, does nothing.
7099 sub invoicing_list_addpost {
7101 return if grep { $_ eq 'POST' } $self->invoicing_list;
7102 my @invoicing_list = $self->invoicing_list;
7103 push @invoicing_list, 'POST';
7104 $self->invoicing_list(\@invoicing_list);
7107 =item invoicing_list_emailonly
7109 Returns the list of email invoice recipients (invoicing_list without non-email
7110 destinations such as POST and FAX).
7114 sub invoicing_list_emailonly {
7116 warn "$me invoicing_list_emailonly called"
7118 grep { $_ !~ /^([A-Z]+)$/ } $self->invoicing_list;
7121 =item invoicing_list_emailonly_scalar
7123 Returns the list of email invoice recipients (invoicing_list without non-email
7124 destinations such as POST and FAX) as a comma-separated scalar.
7128 sub invoicing_list_emailonly_scalar {
7130 warn "$me invoicing_list_emailonly_scalar called"
7132 join(', ', $self->invoicing_list_emailonly);
7135 =item referral_custnum_cust_main
7137 Returns the customer who referred this customer (or the empty string, if
7138 this customer was not referred).
7140 Note the difference with referral_cust_main method: This method,
7141 referral_custnum_cust_main returns the single customer (if any) who referred
7142 this customer, while referral_cust_main returns an array of customers referred
7147 sub referral_custnum_cust_main {
7149 return '' unless $self->referral_custnum;
7150 qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
7153 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
7155 Returns an array of customers referred by this customer (referral_custnum set
7156 to this custnum). If DEPTH is given, recurses up to the given depth, returning
7157 customers referred by customers referred by this customer and so on, inclusive.
7158 The default behavior is DEPTH 1 (no recursion).
7160 Note the difference with referral_custnum_cust_main method: This method,
7161 referral_cust_main, returns an array of customers referred BY this customer,
7162 while referral_custnum_cust_main returns the single customer (if any) who
7163 referred this customer.
7167 sub referral_cust_main {
7169 my $depth = @_ ? shift : 1;
7170 my $exclude = @_ ? shift : {};
7173 map { $exclude->{$_->custnum}++; $_; }
7174 grep { ! $exclude->{ $_->custnum } }
7175 qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
7179 map { $_->referral_cust_main($depth-1, $exclude) }
7186 =item referral_cust_main_ncancelled
7188 Same as referral_cust_main, except only returns customers with uncancelled
7193 sub referral_cust_main_ncancelled {
7195 grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
7198 =item referral_cust_pkg [ DEPTH ]
7200 Like referral_cust_main, except returns a flat list of all unsuspended (and
7201 uncancelled) packages for each customer. The number of items in this list may
7202 be useful for comission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
7206 sub referral_cust_pkg {
7208 my $depth = @_ ? shift : 1;
7210 map { $_->unsuspended_pkgs }
7211 grep { $_->unsuspended_pkgs }
7212 $self->referral_cust_main($depth);
7215 =item referring_cust_main
7217 Returns the single cust_main record for the customer who referred this customer
7218 (referral_custnum), or false.
7222 sub referring_cust_main {
7224 return '' unless $self->referral_custnum;
7225 qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
7228 =item credit AMOUNT, REASON [ , OPTION => VALUE ... ]
7230 Applies a credit to this customer. If there is an error, returns the error,
7231 otherwise returns false.
7233 REASON can be a text string, an FS::reason object, or a scalar reference to
7234 a reasonnum. If a text string, it will be automatically inserted as a new
7235 reason, and a 'reason_type' option must be passed to indicate the
7236 FS::reason_type for the new reason.
7238 An I<addlinfo> option may be passed to set the credit's I<addlinfo> field.
7240 Any other options are passed to FS::cust_credit::insert.
7245 my( $self, $amount, $reason, %options ) = @_;
7247 my $cust_credit = new FS::cust_credit {
7248 'custnum' => $self->custnum,
7249 'amount' => $amount,
7252 if ( ref($reason) ) {
7254 if ( ref($reason) eq 'SCALAR' ) {
7255 $cust_credit->reasonnum( $$reason );
7257 $cust_credit->reasonnum( $reason->reasonnum );
7261 $cust_credit->set('reason', $reason)
7264 $cust_credit->addlinfo( delete $options{'addlinfo'} )
7265 if exists($options{'addlinfo'});
7267 $cust_credit->insert(%options);
7271 =item charge HASHREF || AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
7273 Creates a one-time charge for this customer. If there is an error, returns
7274 the error, otherwise returns false.
7276 New-style, with a hashref of options:
7278 my $error = $cust_main->charge(
7282 'start_date' => str2time('7/4/2009'),
7283 'pkg' => 'Description',
7284 'comment' => 'Comment',
7285 'additional' => [], #extra invoice detail
7286 'classnum' => 1, #pkg_class
7288 'setuptax' => '', # or 'Y' for tax exempt
7291 'taxclass' => 'Tax class',
7294 'taxproduct' => 2, #part_pkg_taxproduct
7295 'override' => {}, #XXX describe
7297 #will be filled in with the new object
7298 'cust_pkg_ref' => \$cust_pkg,
7300 #generate an invoice immediately
7302 'invoice_terms' => '', #with these terms
7308 my $error = $cust_main->charge( 54.32, 'Description', 'Comment', 'Tax class' );
7314 my ( $amount, $quantity, $start_date, $classnum );
7315 my ( $pkg, $comment, $additional );
7316 my ( $setuptax, $taxclass ); #internal taxes
7317 my ( $taxproduct, $override ); #vendor (CCH) taxes
7318 my $cust_pkg_ref = '';
7319 my ( $bill_now, $invoice_terms ) = ( 0, '' );
7320 if ( ref( $_[0] ) ) {
7321 $amount = $_[0]->{amount};
7322 $quantity = exists($_[0]->{quantity}) ? $_[0]->{quantity} : 1;
7323 $start_date = exists($_[0]->{start_date}) ? $_[0]->{start_date} : '';
7324 $pkg = exists($_[0]->{pkg}) ? $_[0]->{pkg} : 'One-time charge';
7325 $comment = exists($_[0]->{comment}) ? $_[0]->{comment}
7326 : '$'. sprintf("%.2f",$amount);
7327 $setuptax = exists($_[0]->{setuptax}) ? $_[0]->{setuptax} : '';
7328 $taxclass = exists($_[0]->{taxclass}) ? $_[0]->{taxclass} : '';
7329 $classnum = exists($_[0]->{classnum}) ? $_[0]->{classnum} : '';
7330 $additional = $_[0]->{additional} || [];
7331 $taxproduct = $_[0]->{taxproductnum};
7332 $override = { '' => $_[0]->{tax_override} };
7333 $cust_pkg_ref = exists($_[0]->{cust_pkg_ref}) ? $_[0]->{cust_pkg_ref} : '';
7334 $bill_now = exists($_[0]->{bill_now}) ? $_[0]->{bill_now} : '';
7335 $invoice_terms = exists($_[0]->{invoice_terms}) ? $_[0]->{invoice_terms} : '';
7340 $pkg = @_ ? shift : 'One-time charge';
7341 $comment = @_ ? shift : '$'. sprintf("%.2f",$amount);
7343 $taxclass = @_ ? shift : '';
7347 local $SIG{HUP} = 'IGNORE';
7348 local $SIG{INT} = 'IGNORE';
7349 local $SIG{QUIT} = 'IGNORE';
7350 local $SIG{TERM} = 'IGNORE';
7351 local $SIG{TSTP} = 'IGNORE';
7352 local $SIG{PIPE} = 'IGNORE';
7354 my $oldAutoCommit = $FS::UID::AutoCommit;
7355 local $FS::UID::AutoCommit = 0;
7358 my $part_pkg = new FS::part_pkg ( {
7360 'comment' => $comment,
7364 'classnum' => $classnum ? $classnum : '',
7365 'setuptax' => $setuptax,
7366 'taxclass' => $taxclass,
7367 'taxproductnum' => $taxproduct,
7370 my %options = ( ( map { ("additional_info$_" => $additional->[$_] ) }
7371 ( 0 .. @$additional - 1 )
7373 'additional_count' => scalar(@$additional),
7374 'setup_fee' => $amount,
7377 my $error = $part_pkg->insert( options => \%options,
7378 tax_overrides => $override,
7381 $dbh->rollback if $oldAutoCommit;
7385 my $pkgpart = $part_pkg->pkgpart;
7386 my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
7387 unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
7388 my $type_pkgs = new FS::type_pkgs \%type_pkgs;
7389 $error = $type_pkgs->insert;
7391 $dbh->rollback if $oldAutoCommit;
7396 my $cust_pkg = new FS::cust_pkg ( {
7397 'custnum' => $self->custnum,
7398 'pkgpart' => $pkgpart,
7399 'quantity' => $quantity,
7400 'start_date' => $start_date,
7403 $error = $cust_pkg->insert;
7405 $dbh->rollback if $oldAutoCommit;
7407 } elsif ( $cust_pkg_ref ) {
7408 ${$cust_pkg_ref} = $cust_pkg;
7412 my $error = $self->bill( 'invoice_terms' => $invoice_terms,
7413 'pkg_list' => [ $cust_pkg ],
7416 $dbh->rollback if $oldAutoCommit;
7421 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
7426 #=item charge_postal_fee
7428 #Applies a one time charge this customer. If there is an error,
7429 #returns the error, returns the cust_pkg charge object or false
7430 #if there was no charge.
7434 # This should be a customer event. For that to work requires that bill
7435 # also be a customer event.
7437 sub charge_postal_fee {
7440 my $pkgpart = $conf->config('postal_invoice-fee_pkgpart');
7441 return '' unless ($pkgpart && grep { $_ eq 'POST' } $self->invoicing_list);
7443 my $cust_pkg = new FS::cust_pkg ( {
7444 'custnum' => $self->custnum,
7445 'pkgpart' => $pkgpart,
7449 my $error = $cust_pkg->insert;
7450 $error ? $error : $cust_pkg;
7455 Returns all the invoices (see L<FS::cust_bill>) for this customer.
7461 map { $_ } #return $self->num_cust_bill unless wantarray;
7462 sort { $a->_date <=> $b->_date }
7463 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
7466 =item open_cust_bill
7468 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
7473 sub open_cust_bill {
7477 'table' => 'cust_bill',
7478 'hashref' => { 'custnum' => $self->custnum, },
7479 'extra_sql' => ' AND '. FS::cust_bill->owed_sql. ' > 0',
7480 'order_by' => 'ORDER BY _date ASC',
7485 =item cust_statements
7487 Returns all the statements (see L<FS::cust_statement>) for this customer.
7491 sub cust_statement {
7493 map { $_ } #return $self->num_cust_statement unless wantarray;
7494 sort { $a->_date <=> $b->_date }
7495 qsearch('cust_statement', { 'custnum' => $self->custnum, } )
7500 Returns all the credits (see L<FS::cust_credit>) for this customer.
7506 map { $_ } #return $self->num_cust_credit unless wantarray;
7507 sort { $a->_date <=> $b->_date }
7508 qsearch( 'cust_credit', { 'custnum' => $self->custnum } )
7511 =item cust_credit_pkgnum
7513 Returns all the credits (see L<FS::cust_credit>) for this customer's specific
7514 package when using experimental package balances.
7518 sub cust_credit_pkgnum {
7519 my( $self, $pkgnum ) = @_;
7520 map { $_ } #return $self->num_cust_credit_pkgnum($pkgnum) unless wantarray;
7521 sort { $a->_date <=> $b->_date }
7522 qsearch( 'cust_credit', { 'custnum' => $self->custnum,
7523 'pkgnum' => $pkgnum,
7530 Returns all the payments (see L<FS::cust_pay>) for this customer.
7536 return $self->num_cust_pay unless wantarray;
7537 sort { $a->_date <=> $b->_date }
7538 qsearch( 'cust_pay', { 'custnum' => $self->custnum } )
7543 Returns the number of payments (see L<FS::cust_pay>) for this customer. Also
7544 called automatically when the cust_pay method is used in a scalar context.
7550 my $sql = "SELECT COUNT(*) FROM cust_pay WHERE custnum = ?";
7551 my $sth = dbh->prepare($sql) or die dbh->errstr;
7552 $sth->execute($self->custnum) or die $sth->errstr;
7553 $sth->fetchrow_arrayref->[0];
7556 =item cust_pay_pkgnum
7558 Returns all the payments (see L<FS::cust_pay>) for this customer's specific
7559 package when using experimental package balances.
7563 sub cust_pay_pkgnum {
7564 my( $self, $pkgnum ) = @_;
7565 map { $_ } #return $self->num_cust_pay_pkgnum($pkgnum) unless wantarray;
7566 sort { $a->_date <=> $b->_date }
7567 qsearch( 'cust_pay', { 'custnum' => $self->custnum,
7568 'pkgnum' => $pkgnum,
7575 Returns all voided payments (see L<FS::cust_pay_void>) for this customer.
7581 map { $_ } #return $self->num_cust_pay_void unless wantarray;
7582 sort { $a->_date <=> $b->_date }
7583 qsearch( 'cust_pay_void', { 'custnum' => $self->custnum } )
7586 =item cust_pay_batch
7588 Returns all batched payments (see L<FS::cust_pay_void>) for this customer.
7592 sub cust_pay_batch {
7594 map { $_ } #return $self->num_cust_pay_batch unless wantarray;
7595 sort { $a->paybatchnum <=> $b->paybatchnum }
7596 qsearch( 'cust_pay_batch', { 'custnum' => $self->custnum } )
7599 =item cust_pay_pending
7601 Returns all pending payments (see L<FS::cust_pay_pending>) for this customer
7602 (without status "done").
7606 sub cust_pay_pending {
7608 return $self->num_cust_pay_pending unless wantarray;
7609 sort { $a->_date <=> $b->_date }
7610 qsearch( 'cust_pay_pending', {
7611 'custnum' => $self->custnum,
7612 'status' => { op=>'!=', value=>'done' },
7617 =item num_cust_pay_pending
7619 Returns the number of pending payments (see L<FS::cust_pay_pending>) for this
7620 customer (without status "done"). Also called automatically when the
7621 cust_pay_pending method is used in a scalar context.
7625 sub num_cust_pay_pending {
7627 my $sql = " SELECT COUNT(*) FROM cust_pay_pending ".
7628 " WHERE custnum = ? AND status != 'done' ";
7629 my $sth = dbh->prepare($sql) or die dbh->errstr;
7630 $sth->execute($self->custnum) or die $sth->errstr;
7631 $sth->fetchrow_arrayref->[0];
7636 Returns all the refunds (see L<FS::cust_refund>) for this customer.
7642 map { $_ } #return $self->num_cust_refund unless wantarray;
7643 sort { $a->_date <=> $b->_date }
7644 qsearch( 'cust_refund', { 'custnum' => $self->custnum } )
7647 =item display_custnum
7649 Returns the displayed customer number for this customer: agent_custid if
7650 cust_main-default_agent_custid is set and it has a value, custnum otherwise.
7654 sub display_custnum {
7656 if ( $conf->exists('cust_main-default_agent_custid') && $self->agent_custid ){
7657 return $self->agent_custid;
7659 return $self->custnum;
7665 Returns a name string for this customer, either "Company (Last, First)" or
7672 my $name = $self->contact;
7673 $name = $self->company. " ($name)" if $self->company;
7679 Returns a name string for this (service/shipping) contact, either
7680 "Company (Last, First)" or "Last, First".
7686 if ( $self->get('ship_last') ) {
7687 my $name = $self->ship_contact;
7688 $name = $self->ship_company. " ($name)" if $self->ship_company;
7697 Returns a name string for this customer, either "Company" or "First Last".
7703 $self->company !~ /^\s*$/ ? $self->company : $self->contact_firstlast;
7706 =item ship_name_short
7708 Returns a name string for this (service/shipping) contact, either "Company"
7713 sub ship_name_short {
7715 if ( $self->get('ship_last') ) {
7716 $self->ship_company !~ /^\s*$/
7717 ? $self->ship_company
7718 : $self->ship_contact_firstlast;
7720 $self->name_company_or_firstlast;
7726 Returns this customer's full (billing) contact name only, "Last, First"
7732 $self->get('last'). ', '. $self->first;
7737 Returns this customer's full (shipping) contact name only, "Last, First"
7743 $self->get('ship_last')
7744 ? $self->get('ship_last'). ', '. $self->ship_first
7748 =item contact_firstlast
7750 Returns this customers full (billing) contact name only, "First Last".
7754 sub contact_firstlast {
7756 $self->first. ' '. $self->get('last');
7759 =item ship_contact_firstlast
7761 Returns this customer's full (shipping) contact name only, "First Last".
7765 sub ship_contact_firstlast {
7767 $self->get('ship_last')
7768 ? $self->first. ' '. $self->get('ship_last')
7769 : $self->contact_firstlast;
7774 Returns this customer's full country name
7780 code2country($self->country);
7783 =item geocode DATA_VENDOR
7785 Returns a value for the customer location as encoded by DATA_VENDOR.
7786 Currently this only makes sense for "CCH" as DATA_VENDOR.
7791 my ($self, $data_vendor) = (shift, shift); #always cch for now
7793 my $geocode = $self->get('geocode'); #XXX only one data_vendor for geocode
7794 return $geocode if $geocode;
7796 my $prefix = ( $conf->exists('tax-ship_address') && length($self->ship_last) )
7800 my ($zip,$plus4) = split /-/, $self->get("${prefix}zip")
7801 if $self->country eq 'US';
7803 #CCH specific location stuff
7804 my $extra_sql = "AND plus4lo <= '$plus4' AND plus4hi >= '$plus4'";
7806 my @cust_tax_location =
7808 'table' => 'cust_tax_location',
7809 'hashref' => { 'zip' => $zip, 'data_vendor' => $data_vendor },
7810 'extra_sql' => $extra_sql,
7811 'order_by' => 'ORDER BY plus4hi',#overlapping with distinct ends
7814 $geocode = $cust_tax_location[0]->geocode
7815 if scalar(@cust_tax_location);
7824 Returns a status string for this customer, currently:
7828 =item prospect - No packages have ever been ordered
7830 =item active - One or more recurring packages is active
7832 =item inactive - No active recurring packages, but otherwise unsuspended/uncancelled (the inactive status is new - previously inactive customers were mis-identified as cancelled)
7834 =item suspended - All non-cancelled recurring packages are suspended
7836 =item cancelled - All recurring packages are cancelled
7842 sub status { shift->cust_status(@_); }
7846 for my $status (qw( prospect active inactive suspended cancelled )) {
7847 my $method = $status.'_sql';
7848 my $numnum = ( my $sql = $self->$method() ) =~ s/cust_main\.custnum/?/g;
7849 my $sth = dbh->prepare("SELECT $sql") or die dbh->errstr;
7850 $sth->execute( ($self->custnum) x $numnum )
7851 or die "Error executing 'SELECT $sql': ". $sth->errstr;
7852 return $status if $sth->fetchrow_arrayref->[0];
7856 =item ucfirst_cust_status
7858 =item ucfirst_status
7860 Returns the status with the first character capitalized.
7864 sub ucfirst_status { shift->ucfirst_cust_status(@_); }
7866 sub ucfirst_cust_status {
7868 ucfirst($self->cust_status);
7873 Returns a hex triplet color string for this customer's status.
7877 use vars qw(%statuscolor);
7878 tie %statuscolor, 'Tie::IxHash',
7879 'prospect' => '7e0079', #'000000', #black? naw, purple
7880 'active' => '00CC00', #green
7881 'inactive' => '0000CC', #blue
7882 'suspended' => 'FF9900', #yellow
7883 'cancelled' => 'FF0000', #red
7886 sub statuscolor { shift->cust_statuscolor(@_); }
7888 sub cust_statuscolor {
7890 $statuscolor{$self->cust_status};
7895 Returns an array of hashes representing the customer's RT tickets.
7902 my $num = $conf->config('cust_main-max_tickets') || 10;
7905 if ( $conf->config('ticket_system') ) {
7906 unless ( $conf->config('ticket_system-custom_priority_field') ) {
7908 @tickets = @{ FS::TicketSystem->customer_tickets($self->custnum, $num) };
7912 foreach my $priority (
7913 $conf->config('ticket_system-custom_priority_field-values'), ''
7915 last if scalar(@tickets) >= $num;
7917 @{ FS::TicketSystem->customer_tickets( $self->custnum,
7918 $num - scalar(@tickets),
7928 # Return services representing svc_accts in customer support packages
7929 sub support_services {
7931 my %packages = map { $_ => 1 } $conf->config('support_packages');
7933 grep { $_->pkg_svc && $_->pkg_svc->primary_svc eq 'Y' }
7934 grep { $_->part_svc->svcdb eq 'svc_acct' }
7935 map { $_->cust_svc }
7936 grep { exists $packages{ $_->pkgpart } }
7937 $self->ncancelled_pkgs;
7941 # Return a list of latitude/longitude for one of the services (if any)
7942 sub service_coordinates {
7946 grep { $_->latitude && $_->longitude }
7948 map { $_->cust_svc }
7949 $self->ncancelled_pkgs;
7951 scalar(@svc_X) ? ( $svc_X[0]->latitude, $svc_X[0]->longitude ) : ()
7956 =head1 CLASS METHODS
7962 Class method that returns the list of possible status strings for customers
7963 (see L<the status method|/status>). For example:
7965 @statuses = FS::cust_main->statuses();
7970 #my $self = shift; #could be class...
7976 Returns an SQL expression identifying prospective cust_main records (customers
7977 with no packages ever ordered)
7981 use vars qw($select_count_pkgs);
7982 $select_count_pkgs =
7983 "SELECT COUNT(*) FROM cust_pkg
7984 WHERE cust_pkg.custnum = cust_main.custnum";
7986 sub select_count_pkgs_sql {
7990 sub prospect_sql { "
7991 0 = ( $select_count_pkgs )
7996 Returns an SQL expression identifying active cust_main records (customers with
7997 active recurring packages).
8002 0 < ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. "
8008 Returns an SQL expression identifying inactive cust_main records (customers with
8009 no active recurring packages, but otherwise unsuspended/uncancelled).
8013 sub inactive_sql { "
8014 0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " )
8016 0 < ( $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " )
8022 Returns an SQL expression identifying suspended cust_main records.
8027 sub suspended_sql { susp_sql(@_); }
8029 0 < ( $select_count_pkgs AND ". FS::cust_pkg->suspended_sql. " )
8031 0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " )
8037 Returns an SQL expression identifying cancelled cust_main records.
8041 sub cancelled_sql { cancel_sql(@_); }
8044 my $recurring_sql = FS::cust_pkg->recurring_sql;
8045 my $cancelled_sql = FS::cust_pkg->cancelled_sql;
8048 0 < ( $select_count_pkgs )
8049 AND 0 < ( $select_count_pkgs AND $recurring_sql AND $cancelled_sql )
8050 AND 0 = ( $select_count_pkgs AND $recurring_sql
8051 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
8053 AND 0 = ( $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " )
8059 =item uncancelled_sql
8061 Returns an SQL expression identifying un-cancelled cust_main records.
8065 sub uncancelled_sql { uncancel_sql(@_); }
8066 sub uncancel_sql { "
8067 ( 0 < ( $select_count_pkgs
8068 AND ( cust_pkg.cancel IS NULL
8069 OR cust_pkg.cancel = 0
8072 OR 0 = ( $select_count_pkgs )
8078 Returns an SQL fragment to retreive the balance.
8083 ( SELECT COALESCE( SUM(charged), 0 ) FROM cust_bill
8084 WHERE cust_bill.custnum = cust_main.custnum )
8085 - ( SELECT COALESCE( SUM(paid), 0 ) FROM cust_pay
8086 WHERE cust_pay.custnum = cust_main.custnum )
8087 - ( SELECT COALESCE( SUM(amount), 0 ) FROM cust_credit
8088 WHERE cust_credit.custnum = cust_main.custnum )
8089 + ( SELECT COALESCE( SUM(refund), 0 ) FROM cust_refund
8090 WHERE cust_refund.custnum = cust_main.custnum )
8093 =item balance_date_sql START_TIME [ END_TIME [ OPTION => VALUE ... ] ]
8095 Returns an SQL fragment to retreive the balance for this customer, only
8096 considering invoices with date earlier than START_TIME, and optionally not
8097 later than END_TIME (total_owed_date minus total_unapplied_credits minus
8098 total_unapplied_payments).
8100 Times are specified as SQL fragments or numeric
8101 UNIX timestamps; see L<perlfunc/"time">). Also see L<Time::Local> and
8102 L<Date::Parse> for conversion functions. The empty string can be passed
8103 to disable that time constraint completely.
8105 Available options are:
8109 =item unapplied_date
8111 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)
8116 set to true to remove all customer comparison clauses, for totals
8121 WHERE clause hashref (elements "AND"ed together) (typically used with the total option)
8126 JOIN clause (typically used with the total option)
8132 sub balance_date_sql {
8133 my( $class, $start, $end, %opt ) = @_;
8135 my $owed = FS::cust_bill->owed_sql;
8136 my $unapp_refund = FS::cust_refund->unapplied_sql;
8137 my $unapp_credit = FS::cust_credit->unapplied_sql;
8138 my $unapp_pay = FS::cust_pay->unapplied_sql;
8140 my $j = $opt{'join'} || '';
8142 my $owed_wh = $class->_money_table_where( 'cust_bill', $start,$end,%opt );
8143 my $refund_wh = $class->_money_table_where( 'cust_refund', $start,$end,%opt );
8144 my $credit_wh = $class->_money_table_where( 'cust_credit', $start,$end,%opt );
8145 my $pay_wh = $class->_money_table_where( 'cust_pay', $start,$end,%opt );
8147 " ( SELECT COALESCE(SUM($owed), 0) FROM cust_bill $j $owed_wh )
8148 + ( SELECT COALESCE(SUM($unapp_refund), 0) FROM cust_refund $j $refund_wh )
8149 - ( SELECT COALESCE(SUM($unapp_credit), 0) FROM cust_credit $j $credit_wh )
8150 - ( SELECT COALESCE(SUM($unapp_pay), 0) FROM cust_pay $j $pay_wh )
8155 =item unapplied_payments_date_sql START_TIME [ END_TIME ]
8157 Returns an SQL fragment to retreive the total unapplied payments for this
8158 customer, only considering invoices with date earlier than START_TIME, and
8159 optionally not later than END_TIME.
8161 Times are specified as SQL fragments or numeric
8162 UNIX timestamps; see L<perlfunc/"time">). Also see L<Time::Local> and
8163 L<Date::Parse> for conversion functions. The empty string can be passed
8164 to disable that time constraint completely.
8166 Available options are:
8170 sub unapplied_payments_date_sql {
8171 my( $class, $start, $end, ) = @_;
8173 my $unapp_pay = FS::cust_pay->unapplied_sql;
8175 my $pay_where = $class->_money_table_where( 'cust_pay', $start, $end,
8176 'unapplied_date'=>1 );
8178 " ( SELECT COALESCE(SUM($unapp_pay), 0) FROM cust_pay $pay_where ) ";
8181 =item _money_table_where TABLE START_TIME [ END_TIME [ OPTION => VALUE ... ] ]
8183 Helper method for balance_date_sql; name (and usage) subject to change
8184 (suggestions welcome).
8186 Returns a WHERE clause for the specified monetary TABLE (cust_bill,
8187 cust_refund, cust_credit or cust_pay).
8189 If TABLE is "cust_bill" or the unapplied_date option is true, only
8190 considers records with date earlier than START_TIME, and optionally not
8191 later than END_TIME .
8195 sub _money_table_where {
8196 my( $class, $table, $start, $end, %opt ) = @_;
8199 push @where, "cust_main.custnum = $table.custnum" unless $opt{'total'};
8200 if ( $table eq 'cust_bill' || $opt{'unapplied_date'} ) {
8201 push @where, "$table._date <= $start" if defined($start) && length($start);
8202 push @where, "$table._date > $end" if defined($end) && length($end);
8204 push @where, @{$opt{'where'}} if $opt{'where'};
8205 my $where = scalar(@where) ? 'WHERE '. join(' AND ', @where ) : '';
8211 =item search HASHREF
8215 Returns a qsearch hash expression to search for parameters specified in HREF.
8216 Valid parameters are
8224 =item cancelled_pkgs
8230 listref of start date, end date
8240 =item current_balance
8242 listref (list returned by FS::UI::Web::parse_lt_gt($cgi, 'current_balance'))
8246 =item flattened_pkgs
8255 my ($class, $params) = @_;
8266 if ( $params->{'agentnum'} =~ /^(\d+)$/ and $1 ) {
8268 "cust_main.agentnum = $1";
8275 #prospect active inactive suspended cancelled
8276 if ( grep { $params->{'status'} eq $_ } FS::cust_main->statuses() ) {
8277 my $method = $params->{'status'}. '_sql';
8278 #push @where, $class->$method();
8279 push @where, FS::cust_main->$method();
8283 # parse cancelled package checkbox
8288 $pkgwhere .= "AND (cancel = 0 or cancel is null)"
8289 unless $params->{'cancelled_pkgs'};
8292 # parse without census tract checkbox
8295 push @where, "(censustract = '' or censustract is null)"
8296 if $params->{'no_censustract'};
8302 foreach my $field (qw( signupdate )) {
8304 next unless exists($params->{$field});
8306 my($beginning, $ending) = @{$params->{$field}};
8309 "cust_main.$field IS NOT NULL",
8310 "cust_main.$field >= $beginning",
8311 "cust_main.$field <= $ending";
8313 $orderby ||= "ORDER BY cust_main.$field";
8321 if ( $params->{'payby'} ) {
8323 my @payby = ref( $params->{'payby'} )
8324 ? @{ $params->{'payby'} }
8325 : ( $params->{'payby'} );
8327 @payby = grep /^([A-Z]{4})$/, @{ $params->{'payby'} };
8329 push @where, '( '. join(' OR ', map "cust_main.payby = '$_'", @payby). ' )'
8334 my @payby = grep /^([A-Z]{4})$/, @{ $params->{'payby'} };
8336 push @where, '( '. join(' OR ', map "cust_main.payby = '$_'", @payby). ' )';
8340 # paydate_year / paydate_month
8343 if ( $params->{'paydate_year'} =~ /^(\d{4})$/ ) {
8345 $params->{'paydate_month'} =~ /^(\d\d?)$/
8346 or die "paydate_year without paydate_month?";
8350 'paydate IS NOT NULL',
8352 "CAST(paydate AS timestamp) < CAST('$year-$month-01' AS timestamp )"
8360 if ( $params->{'invoice_terms'} =~ /^([\w ]+)$/ ) {
8362 if ( $1 eq 'NULL' ) {
8364 "( cust_main.invoice_terms IS NULL OR cust_main.invoice_terms = '' )";
8367 "cust_main.invoice_terms IS NOT NULL",
8368 "cust_main.invoice_terms = '$1'";
8376 if ( $params->{'current_balance'} ) {
8378 #my $balance_sql = $class->balance_sql();
8379 my $balance_sql = FS::cust_main->balance_sql();
8381 my @current_balance =
8382 ref( $params->{'current_balance'} )
8383 ? @{ $params->{'current_balance'} }
8384 : ( $params->{'current_balance'} );
8386 push @where, map { s/current_balance/$balance_sql/; $_ }
8395 if ( $params->{'custbatch'} =~ /^([\w\/\-\:\.]+)$/ and $1 ) {
8397 "cust_main.custbatch = '$1'";
8401 # setup queries, subs, etc. for the search
8404 $orderby ||= 'ORDER BY custnum';
8406 # here is the agent virtualization
8407 push @where, $FS::CurrentUser::CurrentUser->agentnums_sql;
8409 my $extra_sql = scalar(@where) ? ' WHERE '. join(' AND ', @where) : '';
8411 my $addl_from = 'LEFT JOIN cust_pkg USING ( custnum ) ';
8413 my $count_query = "SELECT COUNT(*) FROM cust_main $extra_sql";
8415 my $select = join(', ',
8416 'cust_main.custnum',
8417 FS::UI::Web::cust_sql_fields($params->{'cust_fields'}),
8420 my(@extra_headers) = ();
8421 my(@extra_fields) = ();
8423 if ($params->{'flattened_pkgs'}) {
8425 if ($dbh->{Driver}->{Name} eq 'Pg') {
8427 $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";
8429 }elsif ($dbh->{Driver}->{Name} =~ /^mysql/i) {
8430 $select .= ", GROUP_CONCAT(pkg SEPARATOR '|') as magic";
8431 $addl_from .= " LEFT JOIN part_pkg using ( pkgpart )";
8433 warn "warning: unknown database type ". $dbh->{Driver}->{Name}.
8434 "omitting packing information from report.";
8437 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";
8439 my $sth = dbh->prepare($header_query) or die dbh->errstr;
8440 $sth->execute() or die $sth->errstr;
8441 my $headerrow = $sth->fetchrow_arrayref;
8442 my $headercount = $headerrow ? $headerrow->[0] : 0;
8443 while($headercount) {
8444 unshift @extra_headers, "Package ". $headercount;
8445 unshift @extra_fields, eval q!sub {my $c = shift;
8446 my @a = split '\|', $c->magic;
8447 my $p = $a[!.--$headercount. q!];
8455 'table' => 'cust_main',
8456 'select' => $select,
8458 'extra_sql' => $extra_sql,
8459 'order_by' => $orderby,
8460 'count_query' => $count_query,
8461 'extra_headers' => \@extra_headers,
8462 'extra_fields' => \@extra_fields,
8467 =item email_search_result HASHREF
8471 Emails a notice to the specified customers.
8473 Valid parameters are those of the L<search> method, plus the following:
8495 Optional job queue job for status updates.
8499 Returns an error message, or false for success.
8501 If an error occurs during any email, stops the enture send and returns that
8502 error. Presumably if you're getting SMTP errors aborting is better than
8503 retrying everything.
8507 sub email_search_result {
8508 my($class, $params) = @_;
8510 my $from = delete $params->{from};
8511 my $subject = delete $params->{subject};
8512 my $html_body = delete $params->{html_body};
8513 my $text_body = delete $params->{text_body};
8515 my $job = delete $params->{'job'};
8517 $params->{'payby'} = [ split(/\0/, $params->{'payby'}) ]
8518 unless ref($params->{'payby'});
8520 my $sql_query = $class->search($params);
8522 my $count_query = delete($sql_query->{'count_query'});
8523 my $count_sth = dbh->prepare($count_query)
8524 or die "Error preparing $count_query: ". dbh->errstr;
8526 or die "Error executing $count_query: ". $count_sth->errstr;
8527 my $count_arrayref = $count_sth->fetchrow_arrayref;
8528 my $num_cust = $count_arrayref->[0];
8530 #my @extra_headers = @{ delete($sql_query->{'extra_headers'}) };
8531 #my @extra_fields = @{ delete($sql_query->{'extra_fields'}) };
8534 my( $num, $last, $min_sec ) = (0, time, 5); #progresbar foo
8536 #eventually order+limit magic to reduce memory use?
8537 foreach my $cust_main ( qsearch($sql_query) ) {
8539 my $to = $cust_main->invoicing_list_emailonly_scalar;
8542 my $error = send_email(
8546 'subject' => $subject,
8547 'html_body' => $html_body,
8548 'text_body' => $text_body,
8551 return $error if $error;
8553 if ( $job ) { #progressbar foo
8555 if ( time - $min_sec > $last ) {
8556 my $error = $job->update_statustext(
8557 int( 100 * $num / $num_cust )
8559 die $error if $error;
8569 use Storable qw(thaw);
8572 sub process_email_search_result {
8574 #warn "$me process_re_X $method for job $job\n" if $DEBUG;
8576 my $param = thaw(decode_base64(shift));
8577 warn Dumper($param) if $DEBUG;
8579 $param->{'job'} = $job;
8581 $param->{'payby'} = [ split(/\0/, $param->{'payby'}) ]
8582 unless ref($param->{'payby'});
8584 my $error = FS::cust_main->email_search_result( $param );
8585 die $error if $error;
8589 =item fuzzy_search FUZZY_HASHREF [ HASHREF, SELECT, EXTRA_SQL, CACHE_OBJ ]
8591 Performs a fuzzy (approximate) search and returns the matching FS::cust_main
8592 records. Currently, I<first>, I<last>, I<company> and/or I<address1> may be
8593 specified (the appropriate ship_ field is also searched).
8595 Additional options are the same as FS::Record::qsearch
8600 my( $self, $fuzzy, $hash, @opt) = @_;
8605 check_and_rebuild_fuzzyfiles();
8606 foreach my $field ( keys %$fuzzy ) {
8608 my $all = $self->all_X($field);
8609 next unless scalar(@$all);
8612 $match{$_}=1 foreach ( amatch( $fuzzy->{$field}, ['i'], @$all ) );
8615 foreach ( keys %match ) {
8616 push @fcust, qsearch('cust_main', { %$hash, $field=>$_}, @opt);
8617 push @fcust, qsearch('cust_main', { %$hash, "ship_$field"=>$_}, @opt);
8620 push @cust_main, grep { ! $fsaw{$_->custnum}++ } @fcust;
8623 # we want the components of $fuzzy ANDed, not ORed, but still don't want dupes
8625 @cust_main = grep { ++$saw{$_->custnum} == scalar(keys %$fuzzy) } @cust_main;
8633 Returns a masked version of the named field
8638 my ($self,$field) = @_;
8642 'x'x(length($self->getfield($field))-4).
8643 substr($self->getfield($field), (length($self->getfield($field))-4));
8653 =item smart_search OPTION => VALUE ...
8655 Accepts the following options: I<search>, the string to search for. The string
8656 will be searched for as a customer number, phone number, name or company name,
8657 as an exact, or, in some cases, a substring or fuzzy match (see the source code
8658 for the exact heuristics used); I<no_fuzzy_on_exact>, causes smart_search to
8659 skip fuzzy matching when an exact match is found.
8661 Any additional options are treated as an additional qualifier on the search
8664 Returns a (possibly empty) array of FS::cust_main objects.
8671 #here is the agent virtualization
8672 my $agentnums_sql = $FS::CurrentUser::CurrentUser->agentnums_sql;
8676 my $skip_fuzzy = delete $options{'no_fuzzy_on_exact'};
8677 my $search = delete $options{'search'};
8678 ( my $alphanum_search = $search ) =~ s/\W//g;
8680 if ( $alphanum_search =~ /^1?(\d{3})(\d{3})(\d{4})(\d*)$/ ) { #phone# search
8682 #false laziness w/Record::ut_phone
8683 my $phonen = "$1-$2-$3";
8684 $phonen .= " x$4" if $4;
8686 push @cust_main, qsearch( {
8687 'table' => 'cust_main',
8688 'hashref' => { %options },
8689 'extra_sql' => ( scalar(keys %options) ? ' AND ' : ' WHERE ' ).
8691 join(' OR ', map "$_ = '$phonen'",
8692 qw( daytime night fax
8693 ship_daytime ship_night ship_fax )
8696 " AND $agentnums_sql", #agent virtualization
8699 unless ( @cust_main || $phonen =~ /x\d+$/ ) { #no exact match
8700 #try looking for matches with extensions unless one was specified
8702 push @cust_main, qsearch( {
8703 'table' => 'cust_main',
8704 'hashref' => { %options },
8705 'extra_sql' => ( scalar(keys %options) ? ' AND ' : ' WHERE ' ).
8707 join(' OR ', map "$_ LIKE '$phonen\%'",
8709 ship_daytime ship_night )
8712 " AND $agentnums_sql", #agent virtualization
8717 # custnum search (also try agent_custid), with some tweaking options if your
8718 # legacy cust "numbers" have letters
8721 if ( $search =~ /^\s*(\d+)\s*$/
8722 || ( $conf->config('cust_main-agent_custid-format') eq 'ww?d+'
8723 && $search =~ /^\s*(\w\w?\d+)\s*$/
8725 || ( $conf->exists('address1-search' )
8726 && $search =~ /^\s*(\d+\-?\w*)\s*$/ #i.e. 1234A or 9432-D
8733 if ( $num =~ /^(\d+)$/ && $num <= 2147483647 ) { #need a bigint custnum? wow
8734 push @cust_main, qsearch( {
8735 'table' => 'cust_main',
8736 'hashref' => { 'custnum' => $num, %options },
8737 'extra_sql' => " AND $agentnums_sql", #agent virtualization
8741 push @cust_main, qsearch( {
8742 'table' => 'cust_main',
8743 'hashref' => { 'agent_custid' => $num, %options },
8744 'extra_sql' => " AND $agentnums_sql", #agent virtualization
8747 if ( $conf->exists('address1-search') ) {
8748 my $len = length($num);
8750 foreach my $prefix ( '', 'ship_' ) {
8751 push @cust_main, qsearch( {
8752 'table' => 'cust_main',
8753 'hashref' => { %options, },
8755 ( keys(%options) ? ' AND ' : ' WHERE ' ).
8756 " LOWER(SUBSTRING(${prefix}address1 FROM 1 FOR $len)) = '$num' ".
8757 " AND $agentnums_sql",
8762 } elsif ( $search =~ /^\s*(\S.*\S)\s+\((.+), ([^,]+)\)\s*$/ ) {
8764 my($company, $last, $first) = ( $1, $2, $3 );
8766 # "Company (Last, First)"
8767 #this is probably something a browser remembered,
8768 #so just do an exact search (but case-insensitive, so USPS standardization
8769 #doesn't throw a wrench in the works)
8771 foreach my $prefix ( '', 'ship_' ) {
8772 push @cust_main, qsearch( {
8773 'table' => 'cust_main',
8774 'hashref' => { %options },
8776 ( keys(%options) ? ' AND ' : ' WHERE ' ).
8778 " LOWER(${prefix}first) = ". dbh->quote(lc($first)),
8779 " LOWER(${prefix}last) = ". dbh->quote(lc($last)),
8780 " LOWER(${prefix}company) = ". dbh->quote(lc($company)),
8786 } elsif ( $search =~ /^\s*(\S.*\S)\s*$/ ) { # value search
8787 # try (ship_){last,company}
8791 # # remove "(Last, First)" in "Company (Last, First)", otherwise the
8792 # # full strings the browser remembers won't work
8793 # $value =~ s/\([\w \,\.\-\']*\)$//; #false laziness w/Record::ut_name
8795 use Lingua::EN::NameParse;
8796 my $NameParse = new Lingua::EN::NameParse(
8798 allow_reversed => 1,
8801 my($last, $first) = ( '', '' );
8802 #maybe disable this too and just rely on NameParse?
8803 if ( $value =~ /^(.+),\s*([^,]+)$/ ) { # Last, First
8805 ($last, $first) = ( $1, $2 );
8807 #} elsif ( $value =~ /^(.+)\s+(.+)$/ ) {
8808 } elsif ( ! $NameParse->parse($value) ) {
8810 my %name = $NameParse->components;
8811 $first = $name{'given_name_1'};
8812 $last = $name{'surname_1'};
8816 if ( $first && $last ) {
8818 my($q_last, $q_first) = ( dbh->quote($last), dbh->quote($first) );
8821 my $sql = scalar(keys %options) ? ' AND ' : ' WHERE ';
8823 ( ( LOWER(last) = $q_last AND LOWER(first) = $q_first )
8824 OR ( LOWER(ship_last) = $q_last AND LOWER(ship_first) = $q_first )
8827 push @cust_main, qsearch( {
8828 'table' => 'cust_main',
8829 'hashref' => \%options,
8830 'extra_sql' => "$sql AND $agentnums_sql", #agent virtualization
8833 # or it just be something that was typed in... (try that in a sec)
8837 my $q_value = dbh->quote($value);
8840 my $sql = scalar(keys %options) ? ' AND ' : ' WHERE ';
8841 $sql .= " ( LOWER(last) = $q_value
8842 OR LOWER(company) = $q_value
8843 OR LOWER(ship_last) = $q_value
8844 OR LOWER(ship_company) = $q_value
8846 $sql .= " OR LOWER(address1) = $q_value
8847 OR LOWER(ship_address1) = $q_value
8849 if $conf->exists('address1-search');
8852 push @cust_main, qsearch( {
8853 'table' => 'cust_main',
8854 'hashref' => \%options,
8855 'extra_sql' => "$sql AND $agentnums_sql", #agent virtualization
8858 #no exact match, trying substring/fuzzy
8859 #always do substring & fuzzy (unless they're explicity config'ed off)
8860 #getting complaints searches are not returning enough
8861 unless ( @cust_main && $skip_fuzzy || $conf->exists('disable-fuzzy') ) {
8863 #still some false laziness w/search (was search/cust_main.cgi)
8868 { 'company' => { op=>'ILIKE', value=>"%$value%" }, },
8869 { 'ship_company' => { op=>'ILIKE', value=>"%$value%" }, },
8872 if ( $first && $last ) {
8875 { 'first' => { op=>'ILIKE', value=>"%$first%" },
8876 'last' => { op=>'ILIKE', value=>"%$last%" },
8878 { 'ship_first' => { op=>'ILIKE', value=>"%$first%" },
8879 'ship_last' => { op=>'ILIKE', value=>"%$last%" },
8886 { 'last' => { op=>'ILIKE', value=>"%$value%" }, },
8887 { 'ship_last' => { op=>'ILIKE', value=>"%$value%" }, },
8891 if ( $conf->exists('address1-search') ) {
8893 { 'address1' => { op=>'ILIKE', value=>"%$value%" }, },
8894 { 'ship_address1' => { op=>'ILIKE', value=>"%$value%" }, },
8898 foreach my $hashref ( @hashrefs ) {
8900 push @cust_main, qsearch( {
8901 'table' => 'cust_main',
8902 'hashref' => { %$hashref,
8905 'extra_sql' => " AND $agentnums_sql", #agent virtualizaiton
8914 " AND $agentnums_sql", #extra_sql #agent virtualization
8917 if ( $first && $last ) {
8918 push @cust_main, FS::cust_main->fuzzy_search(
8919 { 'last' => $last, #fuzzy hashref
8920 'first' => $first }, #
8924 foreach my $field ( 'last', 'company' ) {
8926 FS::cust_main->fuzzy_search( { $field => $value }, @fuzopts );
8928 if ( $conf->exists('address1-search') ) {
8930 FS::cust_main->fuzzy_search( { 'address1' => $value }, @fuzopts );
8937 #eliminate duplicates
8939 @cust_main = grep { !$saw{$_->custnum}++ } @cust_main;
8947 Accepts the following options: I<email>, the email address to search for. The
8948 email address will be searched for as an email invoice destination and as an
8951 #Any additional options are treated as an additional qualifier on the search
8952 #(i.e. I<agentnum>).
8954 Returns a (possibly empty) array of FS::cust_main objects (but usually just
8964 my $email = delete $options{'email'};
8966 #we're only being used by RT at the moment... no agent virtualization yet
8967 #my $agentnums_sql = $FS::CurrentUser::CurrentUser->agentnums_sql;
8971 if ( $email =~ /([^@]+)\@([^@]+)/ ) {
8973 my ( $user, $domain ) = ( $1, $2 );
8975 warn "$me smart_search: searching for $user in domain $domain"
8981 'table' => 'cust_main_invoice',
8982 'hashref' => { 'dest' => $email },
8989 map $_->cust_svc->cust_pkg,
8991 'table' => 'svc_acct',
8992 'hashref' => { 'username' => $user, },
8994 'AND ( SELECT domain FROM svc_domain
8995 WHERE svc_acct.domsvc = svc_domain.svcnum
8996 ) = '. dbh->quote($domain),
9002 @cust_main = grep { !$saw{$_->custnum}++ } @cust_main;
9004 warn "$me smart_search: found ". scalar(@cust_main). " unique customers"
9011 =item check_and_rebuild_fuzzyfiles
9015 sub check_and_rebuild_fuzzyfiles {
9016 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
9017 rebuild_fuzzyfiles() if grep { ! -e "$dir/cust_main.$_" } @fuzzyfields
9020 =item rebuild_fuzzyfiles
9024 sub rebuild_fuzzyfiles {
9026 use Fcntl qw(:flock);
9028 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
9029 mkdir $dir, 0700 unless -d $dir;
9031 foreach my $fuzzy ( @fuzzyfields ) {
9033 open(LOCK,">>$dir/cust_main.$fuzzy")
9034 or die "can't open $dir/cust_main.$fuzzy: $!";
9036 or die "can't lock $dir/cust_main.$fuzzy: $!";
9038 open (CACHE,">$dir/cust_main.$fuzzy.tmp")
9039 or die "can't open $dir/cust_main.$fuzzy.tmp: $!";
9041 foreach my $field ( $fuzzy, "ship_$fuzzy" ) {
9042 my $sth = dbh->prepare("SELECT $field FROM cust_main".
9043 " WHERE $field != '' AND $field IS NOT NULL");
9044 $sth->execute or die $sth->errstr;
9046 while ( my $row = $sth->fetchrow_arrayref ) {
9047 print CACHE $row->[0]. "\n";
9052 close CACHE or die "can't close $dir/cust_main.$fuzzy.tmp: $!";
9054 rename "$dir/cust_main.$fuzzy.tmp", "$dir/cust_main.$fuzzy";
9065 my( $self, $field ) = @_;
9066 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
9067 open(CACHE,"<$dir/cust_main.$field")
9068 or die "can't open $dir/cust_main.$field: $!";
9069 my @array = map { chomp; $_; } <CACHE>;
9074 =item append_fuzzyfiles FIRSTNAME LASTNAME COMPANY ADDRESS1
9078 sub append_fuzzyfiles {
9079 #my( $first, $last, $company ) = @_;
9081 &check_and_rebuild_fuzzyfiles;
9083 use Fcntl qw(:flock);
9085 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
9087 foreach my $field (@fuzzyfields) {
9092 open(CACHE,">>$dir/cust_main.$field")
9093 or die "can't open $dir/cust_main.$field: $!";
9094 flock(CACHE,LOCK_EX)
9095 or die "can't lock $dir/cust_main.$field: $!";
9097 print CACHE "$value\n";
9099 flock(CACHE,LOCK_UN)
9100 or die "can't unlock $dir/cust_main.$field: $!";
9115 #warn join('-',keys %$param);
9116 my $fh = $param->{filehandle};
9117 my @fields = @{$param->{fields}};
9119 eval "use Text::CSV_XS;";
9122 my $csv = new Text::CSV_XS;
9129 local $SIG{HUP} = 'IGNORE';
9130 local $SIG{INT} = 'IGNORE';
9131 local $SIG{QUIT} = 'IGNORE';
9132 local $SIG{TERM} = 'IGNORE';
9133 local $SIG{TSTP} = 'IGNORE';
9134 local $SIG{PIPE} = 'IGNORE';
9136 my $oldAutoCommit = $FS::UID::AutoCommit;
9137 local $FS::UID::AutoCommit = 0;
9140 #while ( $columns = $csv->getline($fh) ) {
9142 while ( defined($line=<$fh>) ) {
9144 $csv->parse($line) or do {
9145 $dbh->rollback if $oldAutoCommit;
9146 return "can't parse: ". $csv->error_input();
9149 my @columns = $csv->fields();
9150 #warn join('-',@columns);
9153 foreach my $field ( @fields ) {
9154 $row{$field} = shift @columns;
9157 my $cust_main = qsearchs('cust_main', { 'custnum' => $row{'custnum'} } );
9158 unless ( $cust_main ) {
9159 $dbh->rollback if $oldAutoCommit;
9160 return "unknown custnum $row{'custnum'}";
9163 if ( $row{'amount'} > 0 ) {
9164 my $error = $cust_main->charge($row{'amount'}, $row{'pkg'});
9166 $dbh->rollback if $oldAutoCommit;
9170 } elsif ( $row{'amount'} < 0 ) {
9171 my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ),
9174 $dbh->rollback if $oldAutoCommit;
9184 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
9186 return "Empty file!" unless $imported;
9192 =item notify CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
9194 Sends a templated email notification to the customer (see L<Text::Template>).
9196 OPTIONS is a hash and may include
9198 I<from> - the email sender (default is invoice_from)
9200 I<to> - comma-separated scalar or arrayref of recipients
9201 (default is invoicing_list)
9203 I<subject> - The subject line of the sent email notification
9204 (default is "Notice from company_name")
9206 I<extra_fields> - a hashref of name/value pairs which will be substituted
9209 The following variables are vavailable in the template.
9211 I<$first> - the customer first name
9212 I<$last> - the customer last name
9213 I<$company> - the customer company
9214 I<$payby> - a description of the method of payment for the customer
9215 # would be nice to use FS::payby::shortname
9216 I<$payinfo> - the account information used to collect for this customer
9217 I<$expdate> - the expiration of the customer payment in seconds from epoch
9222 my ($self, $template, %options) = @_;
9224 return unless $conf->exists($template);
9226 my $from = $conf->config('invoice_from', $self->agentnum)
9227 if $conf->exists('invoice_from', $self->agentnum);
9228 $from = $options{from} if exists($options{from});
9230 my $to = join(',', $self->invoicing_list_emailonly);
9231 $to = $options{to} if exists($options{to});
9233 my $subject = "Notice from " . $conf->config('company_name', $self->agentnum)
9234 if $conf->exists('company_name', $self->agentnum);
9235 $subject = $options{subject} if exists($options{subject});
9237 my $notify_template = new Text::Template (TYPE => 'ARRAY',
9238 SOURCE => [ map "$_\n",
9239 $conf->config($template)]
9241 or die "can't create new Text::Template object: Text::Template::ERROR";
9242 $notify_template->compile()
9243 or die "can't compile template: Text::Template::ERROR";
9245 $FS::notify_template::_template::company_name =
9246 $conf->config('company_name', $self->agentnum);
9247 $FS::notify_template::_template::company_address =
9248 join("\n", $conf->config('company_address', $self->agentnum) ). "\n";
9250 my $paydate = $self->paydate || '2037-12-31';
9251 $FS::notify_template::_template::first = $self->first;
9252 $FS::notify_template::_template::last = $self->last;
9253 $FS::notify_template::_template::company = $self->company;
9254 $FS::notify_template::_template::payinfo = $self->mask_payinfo;
9255 my $payby = $self->payby;
9256 my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
9257 my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
9259 #credit cards expire at the end of the month/year of their exp date
9260 if ($payby eq 'CARD' || $payby eq 'DCRD') {
9261 $FS::notify_template::_template::payby = 'credit card';
9262 ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
9263 $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
9265 }elsif ($payby eq 'COMP') {
9266 $FS::notify_template::_template::payby = 'complimentary account';
9268 $FS::notify_template::_template::payby = 'current method';
9270 $FS::notify_template::_template::expdate = $expire_time;
9272 for (keys %{$options{extra_fields}}){
9274 ${"FS::notify_template::_template::$_"} = $options{extra_fields}->{$_};
9277 send_email(from => $from,
9279 subject => $subject,
9280 body => $notify_template->fill_in( PACKAGE =>
9281 'FS::notify_template::_template' ),
9286 =item generate_letter CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
9288 Generates a templated notification to the customer (see L<Text::Template>).
9290 OPTIONS is a hash and may include
9292 I<extra_fields> - a hashref of name/value pairs which will be substituted
9293 into the template. These values may override values mentioned below
9294 and those from the customer record.
9296 The following variables are available in the template instead of or in addition
9297 to the fields of the customer record.
9299 I<$payby> - a description of the method of payment for the customer
9300 # would be nice to use FS::payby::shortname
9301 I<$payinfo> - the masked account information used to collect for this customer
9302 I<$expdate> - the expiration of the customer payment method in seconds from epoch
9303 I<$returnaddress> - the return address defaults to invoice_latexreturnaddress or company_address
9307 sub generate_letter {
9308 my ($self, $template, %options) = @_;
9310 return unless $conf->exists($template);
9312 my $letter_template = new Text::Template
9314 SOURCE => [ map "$_\n", $conf->config($template)],
9315 DELIMITERS => [ '[@--', '--@]' ],
9317 or die "can't create new Text::Template object: Text::Template::ERROR";
9319 $letter_template->compile()
9320 or die "can't compile template: Text::Template::ERROR";
9322 my %letter_data = map { $_ => $self->$_ } $self->fields;
9323 $letter_data{payinfo} = $self->mask_payinfo;
9325 #my $paydate = $self->paydate || '2037-12-31';
9326 my $paydate = $self->paydate =~ /^\S+$/ ? $self->paydate : '2037-12-31';
9328 my $payby = $self->payby;
9329 my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
9330 my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
9332 #credit cards expire at the end of the month/year of their exp date
9333 if ($payby eq 'CARD' || $payby eq 'DCRD') {
9334 $letter_data{payby} = 'credit card';
9335 ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
9336 $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
9338 }elsif ($payby eq 'COMP') {
9339 $letter_data{payby} = 'complimentary account';
9341 $letter_data{payby} = 'current method';
9343 $letter_data{expdate} = $expire_time;
9345 for (keys %{$options{extra_fields}}){
9346 $letter_data{$_} = $options{extra_fields}->{$_};
9349 unless(exists($letter_data{returnaddress})){
9350 my $retadd = join("\n", $conf->config_orbase( 'invoice_latexreturnaddress',
9351 $self->agent_template)
9353 if ( length($retadd) ) {
9354 $letter_data{returnaddress} = $retadd;
9355 } elsif ( grep /\S/, $conf->config('company_address', $self->agentnum) ) {
9356 $letter_data{returnaddress} =
9357 join( '\\*'."\n", map s/( {2,})/'~' x length($1)/eg,
9358 $conf->config('company_address', $self->agentnum)
9361 $letter_data{returnaddress} = '~';
9365 $letter_data{conf_dir} = "$FS::UID::conf_dir/conf.$FS::UID::datasrc";
9367 $letter_data{company_name} = $conf->config('company_name', $self->agentnum);
9369 my $dir = $FS::UID::conf_dir."/cache.". $FS::UID::datasrc;
9370 my $fh = new File::Temp( TEMPLATE => 'letter.'. $self->custnum. '.XXXXXXXX',
9374 ) or die "can't open temp file: $!\n";
9376 $letter_template->fill_in( OUTPUT => $fh, HASH => \%letter_data );
9378 $fh->filename =~ /^(.*).tex$/ or die "unparsable filename: ". $fh->filename;
9382 =item print_ps TEMPLATE
9384 Returns an postscript letter filled in from TEMPLATE, as a scalar.
9390 my $file = $self->generate_letter(@_);
9391 FS::Misc::generate_ps($file);
9394 =item print TEMPLATE
9396 Prints the filled in template.
9398 TEMPLATE is the name of a L<Text::Template> to fill in and print.
9402 sub queueable_print {
9405 my $self = qsearchs('cust_main', { 'custnum' => $opt{custnum} } )
9406 or die "invalid customer number: " . $opt{custvnum};
9408 my $error = $self->print( $opt{template} );
9409 die $error if $error;
9413 my ($self, $template) = (shift, shift);
9414 do_print [ $self->print_ps($template) ];
9417 #these three subs should just go away once agent stuff is all config overrides
9419 sub agent_template {
9421 $self->_agent_plandata('agent_templatename');
9424 sub agent_invoice_from {
9426 $self->_agent_plandata('agent_invoice_from');
9429 sub _agent_plandata {
9430 my( $self, $option ) = @_;
9432 #yuck. this whole thing needs to be reconciled better with 1.9's idea of
9433 #agent-specific Conf
9435 use FS::part_event::Condition;
9437 my $agentnum = $self->agentnum;
9440 if ( driver_name =~ /^Pg/i ) {
9442 } elsif ( driver_name =~ /^mysql/i ) {
9445 die "don't know how to use regular expressions in ". driver_name. " databases";
9448 my $part_event_option =
9450 'select' => 'part_event_option.*',
9451 'table' => 'part_event_option',
9453 LEFT JOIN part_event USING ( eventpart )
9454 LEFT JOIN part_event_option AS peo_agentnum
9455 ON ( part_event.eventpart = peo_agentnum.eventpart
9456 AND peo_agentnum.optionname = 'agentnum'
9457 AND peo_agentnum.optionvalue }. $regexp. q{ '(^|,)}. $agentnum. q{(,|$)'
9459 LEFT JOIN part_event_condition
9460 ON ( part_event.eventpart = part_event_condition.eventpart
9461 AND part_event_condition.conditionname = 'cust_bill_age'
9463 LEFT JOIN part_event_condition_option
9464 ON ( part_event_condition.eventconditionnum = part_event_condition_option.eventconditionnum
9465 AND part_event_condition_option.optionname = 'age'
9468 #'hashref' => { 'optionname' => $option },
9469 #'hashref' => { 'part_event_option.optionname' => $option },
9471 " WHERE part_event_option.optionname = ". dbh->quote($option).
9472 " AND action = 'cust_bill_send_agent' ".
9473 " AND ( disabled IS NULL OR disabled != 'Y' ) ".
9474 " AND peo_agentnum.optionname = 'agentnum' ".
9475 " AND ( agentnum IS NULL OR agentnum = $agentnum ) ".
9477 CASE WHEN part_event_condition_option.optionname IS NULL
9479 ELSE ". FS::part_event::Condition->age2seconds_sql('part_event_condition_option.optionvalue').
9481 , part_event.weight".
9485 unless ( $part_event_option ) {
9486 return $self->agent->invoice_template || ''
9487 if $option eq 'agent_templatename';
9491 $part_event_option->optionvalue;
9496 ## actual sub, not a method, designed to be called from the queue.
9497 ## sets up the customer, and calls the bill_and_collect
9498 my (%args) = @_; #, ($time, $invoice_time, $check_freq, $resetup) = @_;
9499 my $cust_main = qsearchs( 'cust_main', { custnum => $args{'custnum'} } );
9500 $cust_main->bill_and_collect(
9505 sub _upgrade_data { #class method
9506 my ($class, %opts) = @_;
9508 my $sql = 'UPDATE h_cust_main SET paycvv = NULL WHERE paycvv IS NOT NULL';
9509 my $sth = dbh->prepare($sql) or die dbh->errstr;
9510 $sth->execute or die $sth->errstr;
9520 The delete method should possibly take an FS::cust_main object reference
9521 instead of a scalar customer number.
9523 Bill and collect options should probably be passed as references instead of a
9526 There should probably be a configuration file with a list of allowed credit
9529 No multiple currency support (probably a larger project than just this module).
9531 payinfo_masked false laziness with cust_pay.pm and cust_refund.pm
9533 Birthdates rely on negative epoch values.
9535 The payby for card/check batches is broken. With mixed batching, bad
9538 B<collect> I<invoice_time> should be renamed I<time>, like B<bill>.
9542 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
9543 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
9544 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.