5 use vars qw( @ISA @EXPORT_OK $DEBUG $me $conf @encrypted_fields
6 $import $skip_fuzzyfiles $ignore_expired_card @paytypes);
7 use vars qw( $realtime_bop_decline_quiet ); #ugh
11 use Scalar::Util qw( blessed );
12 use Time::Local qw(timelocal);
15 use Digest::MD5 qw(md5_base64);
18 use File::Temp qw( tempfile );
19 use String::Approx qw(amatch);
20 use Business::CreditCard 0.28;
22 use FS::UID qw( getotaker dbh driver_name );
23 use FS::Record qw( qsearchs qsearch dbdef );
24 use FS::Misc qw( generate_email send_email generate_ps do_print );
25 use FS::Msgcat qw(gettext);
30 use FS::cust_bill_pkg;
31 use FS::cust_bill_pkg_display;
32 use FS::cust_bill_pkg_tax_location;
34 use FS::cust_pay_pending;
35 use FS::cust_pay_void;
36 use FS::cust_pay_batch;
39 use FS::part_referral;
40 use FS::cust_main_county;
41 use FS::cust_location;
43 use FS::cust_tax_location;
44 use FS::part_pkg_taxrate;
46 use FS::cust_main_invoice;
47 use FS::cust_credit_bill;
48 use FS::cust_bill_pay;
49 use FS::prepay_credit;
53 use FS::part_event_condition;
56 use FS::payment_gateway;
57 use FS::agent_payment_gateway;
59 use FS::payinfo_Mixin;
62 @ISA = qw( FS::payinfo_Mixin FS::Record );
64 @EXPORT_OK = qw( smart_search );
66 $realtime_bop_decline_quiet = 0;
68 # 1 is mostly method/subroutine entry and options
69 # 2 traces progress of some operations
70 # 3 is even more information including possibly sensitive data
72 $me = '[FS::cust_main]';
76 $ignore_expired_card = 0;
78 @encrypted_fields = ('payinfo', 'paycvv');
79 sub nohistory_fields { ('paycvv'); }
81 @paytypes = ('', 'Personal checking', 'Personal savings', 'Business checking', 'Business savings');
83 #ask FS::UID to run this stuff for us later
84 #$FS::UID::callback{'FS::cust_main'} = sub {
85 install_callback FS::UID sub {
87 #yes, need it for stuff below (prolly should be cached)
92 my ( $hashref, $cache ) = @_;
93 if ( exists $hashref->{'pkgnum'} ) {
94 #@{ $self->{'_pkgnum'} } = ();
95 my $subcache = $cache->subcache( 'pkgnum', 'cust_pkg', $hashref->{custnum});
96 $self->{'_pkgnum'} = $subcache;
97 #push @{ $self->{'_pkgnum'} },
98 FS::cust_pkg->new_or_cached($hashref, $subcache) if $hashref->{pkgnum};
104 FS::cust_main - Object methods for cust_main records
110 $record = new FS::cust_main \%hash;
111 $record = new FS::cust_main { 'column' => 'value' };
113 $error = $record->insert;
115 $error = $new_record->replace($old_record);
117 $error = $record->delete;
119 $error = $record->check;
121 @cust_pkg = $record->all_pkgs;
123 @cust_pkg = $record->ncancelled_pkgs;
125 @cust_pkg = $record->suspended_pkgs;
127 $error = $record->bill;
128 $error = $record->bill %options;
129 $error = $record->bill 'time' => $time;
131 $error = $record->collect;
132 $error = $record->collect %options;
133 $error = $record->collect 'invoice_time' => $time,
138 An FS::cust_main object represents a customer. FS::cust_main inherits from
139 FS::Record. The following fields are currently supported:
145 Primary key (assigned automatically for new customers)
149 Agent (see L<FS::agent>)
153 Advertising source (see L<FS::part_referral>)
165 Cocial security number (optional)
181 (optional, see L<FS::cust_main_county>)
185 (see L<FS::cust_main_county>)
191 (see L<FS::cust_main_county>)
227 (optional, see L<FS::cust_main_county>)
231 (see L<FS::cust_main_county>)
237 (see L<FS::cust_main_county>)
253 Payment Type (See L<FS::payinfo_Mixin> for valid payby values)
257 Payment Information (See L<FS::payinfo_Mixin> for data format)
261 Masked payinfo (See L<FS::payinfo_Mixin> for how this works)
265 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
269 Expiration date, mm/yyyy, m/yyyy, mm/yy or m/yy
273 Start date month (maestro/solo cards only)
277 Start date year (maestro/solo cards only)
281 Issue number (maestro/solo cards only)
285 Name on card or billing name
289 IP address from which payment information was received
293 Tax exempt, empty or `Y'
297 Order taker (assigned automatically, see L<FS::UID>)
303 =item referral_custnum
305 Referring customer number
309 Enable individual CDR spooling, empty or `Y'
313 A suggestion to events (see L<FS::part_bill_event">) to delay until this unix timestamp
317 Discourage individual CDR printing, empty or `Y'
327 Creates a new customer. To add the customer to the database, see L<"insert">.
329 Note that this stores the hash reference, not a distinct copy of the hash it
330 points to. You can ask the object for a copy with the I<hash> method.
334 sub table { 'cust_main'; }
336 =item insert [ CUST_PKG_HASHREF [ , INVOICING_LIST_ARYREF ] [ , OPTION => VALUE ... ] ]
338 Adds this customer to the database. If there is an error, returns the error,
339 otherwise returns false.
341 CUST_PKG_HASHREF: If you pass a Tie::RefHash data structure to the insert
342 method containing FS::cust_pkg and FS::svc_I<tablename> objects, all records
343 are inserted atomicly, or the transaction is rolled back. Passing an empty
344 hash reference is equivalent to not supplying this parameter. There should be
345 a better explanation of this, but until then, here's an example:
348 tie %hash, 'Tie::RefHash'; #this part is important
350 $cust_pkg => [ $svc_acct ],
353 $cust_main->insert( \%hash );
355 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
356 be set as the invoicing list (see L<"invoicing_list">). Errors return as
357 expected and rollback the entire transaction; it is not necessary to call
358 check_invoicing_list first. The invoicing_list is set after the records in the
359 CUST_PKG_HASHREF above are inserted, so it is now possible to set an
360 invoicing_list destination to the newly-created svc_acct. Here's an example:
362 $cust_main->insert( {}, [ $email, 'POST' ] );
364 Currently available options are: I<depend_jobnum> and I<noexport>.
366 If I<depend_jobnum> is set, all provisioning jobs will have a dependancy
367 on the supplied jobnum (they will not run until the specific job completes).
368 This can be used to defer provisioning until some action completes (such
369 as running the customer's credit card successfully).
371 The I<noexport> option is deprecated. If I<noexport> is set true, no
372 provisioning jobs (exports) are scheduled. (You can schedule them later with
373 the B<reexport> method.)
379 my $cust_pkgs = @_ ? shift : {};
380 my $invoicing_list = @_ ? shift : '';
382 warn "$me insert called with options ".
383 join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
386 local $SIG{HUP} = 'IGNORE';
387 local $SIG{INT} = 'IGNORE';
388 local $SIG{QUIT} = 'IGNORE';
389 local $SIG{TERM} = 'IGNORE';
390 local $SIG{TSTP} = 'IGNORE';
391 local $SIG{PIPE} = 'IGNORE';
393 my $oldAutoCommit = $FS::UID::AutoCommit;
394 local $FS::UID::AutoCommit = 0;
397 my $prepay_identifier = '';
398 my( $amount, $seconds, $upbytes, $downbytes, $totalbytes ) = (0, 0, 0, 0, 0);
400 if ( $self->payby eq 'PREPAY' ) {
402 $self->payby('BILL');
403 $prepay_identifier = $self->payinfo;
406 warn " looking up prepaid card $prepay_identifier\n"
409 my $error = $self->get_prepay( $prepay_identifier,
410 'amount_ref' => \$amount,
411 'seconds_ref' => \$seconds,
412 'upbytes_ref' => \$upbytes,
413 'downbytes_ref' => \$downbytes,
414 'totalbytes_ref' => \$totalbytes,
417 $dbh->rollback if $oldAutoCommit;
418 #return "error applying prepaid card (transaction rolled back): $error";
422 $payby = 'PREP' if $amount;
424 } elsif ( $self->payby =~ /^(CASH|WEST|MCRD)$/ ) {
427 $self->payby('BILL');
428 $amount = $self->paid;
432 warn " inserting $self\n"
435 $self->signupdate(time) unless $self->signupdate;
437 $self->auto_agent_custid()
438 if $conf->config('cust_main-auto_agent_custid') && ! $self->agent_custid;
440 my $error = $self->SUPER::insert;
442 $dbh->rollback if $oldAutoCommit;
443 #return "inserting cust_main record (transaction rolled back): $error";
447 warn " setting invoicing list\n"
450 if ( $invoicing_list ) {
451 $error = $self->check_invoicing_list( $invoicing_list );
453 $dbh->rollback if $oldAutoCommit;
454 #return "checking invoicing_list (transaction rolled back): $error";
457 $self->invoicing_list( $invoicing_list );
460 if ( $conf->config('cust_main-skeleton_tables')
461 && $conf->config('cust_main-skeleton_custnum') ) {
463 warn " inserting skeleton records\n"
466 my $error = $self->start_copy_skel;
468 $dbh->rollback if $oldAutoCommit;
474 warn " ordering packages\n"
477 $error = $self->order_pkgs( $cust_pkgs,
479 'seconds_ref' => \$seconds,
480 'upbytes_ref' => \$upbytes,
481 'downbytes_ref' => \$downbytes,
482 'totalbytes_ref' => \$totalbytes,
485 $dbh->rollback if $oldAutoCommit;
490 $dbh->rollback if $oldAutoCommit;
491 return "No svc_acct record to apply pre-paid time";
493 if ( $upbytes || $downbytes || $totalbytes ) {
494 $dbh->rollback if $oldAutoCommit;
495 return "No svc_acct record to apply pre-paid data";
499 warn " inserting initial $payby payment of $amount\n"
501 $error = $self->insert_cust_pay($payby, $amount, $prepay_identifier);
503 $dbh->rollback if $oldAutoCommit;
504 return "inserting payment (transaction rolled back): $error";
508 unless ( $import || $skip_fuzzyfiles ) {
509 warn " queueing fuzzyfiles update\n"
511 $error = $self->queue_fuzzyfiles_update;
513 $dbh->rollback if $oldAutoCommit;
514 return "updating fuzzy search cache: $error";
518 warn " insert complete; committing transaction\n"
521 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
526 use File::CounterFile;
527 sub auto_agent_custid {
530 my $format = $conf->config('cust_main-auto_agent_custid');
532 if ( $format eq '1YMMXXXXXXXX' ) {
534 my $counter = new File::CounterFile 'cust_main.agent_custid';
537 my $ym = 100000000000 + time2str('%y%m00000000', time);
538 if ( $ym > $counter->value ) {
539 $counter->{'value'} = $agent_custid = $ym;
540 $counter->{'updated'} = 1;
542 $agent_custid = $counter->inc;
548 die "Unknown cust_main-auto_agent_custid format: $format";
551 $self->agent_custid($agent_custid);
555 sub start_copy_skel {
558 #'mg_user_preference' => {},
559 #'mg_user_indicator_profile.user_indicator_profile_id' => { 'mg_profile_indicator.profile_indicator_id' => { 'mg_profile_details.profile_detail_id' }, },
560 #'mg_watchlist_header.watchlist_header_id' => { 'mg_watchlist_details.watchlist_details_id' },
561 #'mg_user_grid_header.grid_header_id' => { 'mg_user_grid_details.user_grid_details_id' },
562 #'mg_portfolio_header.portfolio_header_id' => { 'mg_portfolio_trades.portfolio_trades_id' => { 'mg_portfolio_trades_positions.portfolio_trades_positions_id' } },
563 my @tables = eval(join('\n',$conf->config('cust_main-skeleton_tables')));
566 _copy_skel( 'cust_main', #tablename
567 $conf->config('cust_main-skeleton_custnum'), #sourceid
568 $self->custnum, #destid
569 @tables, #child tables
573 #recursive subroutine, not a method
575 my( $table, $sourceid, $destid, %child_tables ) = @_;
578 if ( $table =~ /^(\w+)\.(\w+)$/ ) {
579 ( $table, $primary_key ) = ( $1, $2 );
581 my $dbdef_table = dbdef->table($table);
582 $primary_key = $dbdef_table->primary_key
583 or return "$table has no primary key".
584 " (or do you need to run dbdef-create?)";
587 warn " _copy_skel: $table.$primary_key $sourceid to $destid for ".
588 join (', ', keys %child_tables). "\n"
591 foreach my $child_table_def ( keys %child_tables ) {
595 if ( $child_table_def =~ /^(\w+)\.(\w+)$/ ) {
596 ( $child_table, $child_pkey ) = ( $1, $2 );
598 $child_table = $child_table_def;
600 $child_pkey = dbdef->table($child_table)->primary_key;
601 # or return "$table has no primary key".
602 # " (or do you need to run dbdef-create?)\n";
606 if ( keys %{ $child_tables{$child_table_def} } ) {
608 return "$child_table has no primary key".
609 " (run dbdef-create or try specifying it?)\n"
612 #false laziness w/Record::insert and only works on Pg
613 #refactor the proper last-inserted-id stuff out of Record::insert if this
614 # ever gets use for anything besides a quick kludge for one customer
615 my $default = dbdef->table($child_table)->column($child_pkey)->default;
616 $default =~ /^nextval\(\(?'"?([\w\.]+)"?'/i
617 or return "can't parse $child_table.$child_pkey default value ".
618 " for sequence name: $default";
623 my @sel_columns = grep { $_ ne $primary_key }
624 dbdef->table($child_table)->columns;
625 my $sel_columns = join(', ', @sel_columns );
627 my @ins_columns = grep { $_ ne $child_pkey } @sel_columns;
628 my $ins_columns = ' ( '. join(', ', $primary_key, @ins_columns ). ' ) ';
629 my $placeholders = ' ( ?, '. join(', ', map '?', @ins_columns ). ' ) ';
631 my $sel_st = "SELECT $sel_columns FROM $child_table".
632 " WHERE $primary_key = $sourceid";
635 my $sel_sth = dbh->prepare( $sel_st )
636 or return dbh->errstr;
638 $sel_sth->execute or return $sel_sth->errstr;
640 while ( my $row = $sel_sth->fetchrow_hashref ) {
642 warn " selected row: ".
643 join(', ', map { "$_=".$row->{$_} } keys %$row ). "\n"
647 "INSERT INTO $child_table $ins_columns VALUES $placeholders";
648 my $ins_sth =dbh->prepare($statement)
649 or return dbh->errstr;
650 my @param = ( $destid, map $row->{$_}, @ins_columns );
651 warn " $statement: [ ". join(', ', @param). " ]\n"
653 $ins_sth->execute( @param )
654 or return $ins_sth->errstr;
656 #next unless keys %{ $child_tables{$child_table} };
657 next unless $sequence;
659 #another section of that laziness
660 my $seq_sql = "SELECT currval('$sequence')";
661 my $seq_sth = dbh->prepare($seq_sql) or return dbh->errstr;
662 $seq_sth->execute or return $seq_sth->errstr;
663 my $insertid = $seq_sth->fetchrow_arrayref->[0];
665 # don't drink soap! recurse! recurse! okay!
667 _copy_skel( $child_table_def,
668 $row->{$child_pkey}, #sourceid
670 %{ $child_tables{$child_table_def} },
672 return $error if $error;
682 =item order_pkg HASHREF | OPTION => VALUE ...
684 Orders a single package.
686 Options may be passed as a list of key/value pairs or as a hash reference.
697 Optional FS::cust_location object
701 Optional arryaref of FS::svc_* service objects.
705 If this option is set to a job queue jobnum (see L<FS::queue>), all provisioning
706 jobs will have a dependancy on the supplied job (they will not run until the
707 specific job completes). This can be used to defer provisioning until some
708 action completes (such as running the customer's credit card successfully).
716 my $opt = ref($_[0]) ? shift : { @_ };
718 warn "$me order_pkg called with options ".
719 join(', ', map { "$_: $opt->{$_}" } keys %$opt ). "\n"
722 my $cust_pkg = $opt->{'cust_pkg'};
723 my $svcs = $opt->{'svcs'} || [];
725 my %svc_options = ();
726 $svc_options{'depend_jobnum'} = $opt->{'depend_jobnum'}
727 if exists($opt->{'depend_jobnum'}) && $opt->{'depend_jobnum'};
729 local $SIG{HUP} = 'IGNORE';
730 local $SIG{INT} = 'IGNORE';
731 local $SIG{QUIT} = 'IGNORE';
732 local $SIG{TERM} = 'IGNORE';
733 local $SIG{TSTP} = 'IGNORE';
734 local $SIG{PIPE} = 'IGNORE';
736 my $oldAutoCommit = $FS::UID::AutoCommit;
737 local $FS::UID::AutoCommit = 0;
740 if ( $opt->{'cust_location'} &&
741 ( ! $cust_pkg->locationnum || $cust_pkg->locationnum == -1 ) ) {
742 my $error = $opt->{'cust_location'}->insert;
744 $dbh->rollback if $oldAutoCommit;
745 return "inserting cust_location (transaction rolled back): $error";
747 $cust_pkg->locationnum($opt->{'cust_location'}->locationnum);
750 $cust_pkg->custnum( $self->custnum );
752 my $error = $cust_pkg->insert;
754 $dbh->rollback if $oldAutoCommit;
755 return "inserting cust_pkg (transaction rolled back): $error";
758 foreach my $svc_something ( @{ $opt->{'svcs'} } ) {
759 if ( $svc_something->svcnum ) {
760 my $old_cust_svc = $svc_something->cust_svc;
761 my $new_cust_svc = new FS::cust_svc { $old_cust_svc->hash };
762 $new_cust_svc->pkgnum( $cust_pkg->pkgnum);
763 $error = $new_cust_svc->replace($old_cust_svc);
765 $svc_something->pkgnum( $cust_pkg->pkgnum );
766 if ( $svc_something->isa('FS::svc_acct') ) {
767 foreach ( grep { $opt->{$_.'_ref'} && ${ $opt->{$_.'_ref'} } }
768 qw( seconds upbytes downbytes totalbytes ) ) {
769 $svc_something->$_( $svc_something->$_() + ${ $opt->{$_.'_ref'} } );
770 ${ $opt->{$_.'_ref'} } = 0;
773 $error = $svc_something->insert(%svc_options);
776 $dbh->rollback if $oldAutoCommit;
777 return "inserting svc_ (transaction rolled back): $error";
781 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
786 #deprecated #=item order_pkgs HASHREF [ , SECONDSREF ] [ , OPTION => VALUE ... ]
787 =item order_pkgs HASHREF [ , OPTION => VALUE ... ]
789 Like the insert method on an existing record, this method orders multiple
790 packages and included services atomicaly. Pass a Tie::RefHash data structure
791 to this method containing FS::cust_pkg and FS::svc_I<tablename> objects.
792 There should be a better explanation of this, but until then, here's an
796 tie %hash, 'Tie::RefHash'; #this part is important
798 $cust_pkg => [ $svc_acct ],
801 $cust_main->order_pkgs( \%hash, 'noexport'=>1 );
803 Services can be new, in which case they are inserted, or existing unaudited
804 services, in which case they are linked to the newly-created package.
806 Currently available options are: I<depend_jobnum>, I<noexport>, I<seconds_ref>,
807 I<upbytes_ref>, I<downbytes_ref>, and I<totalbytes_ref>.
809 If I<depend_jobnum> is set, all provisioning jobs will have a dependancy
810 on the supplied jobnum (they will not run until the specific job completes).
811 This can be used to defer provisioning until some action completes (such
812 as running the customer's credit card successfully).
814 The I<noexport> option is deprecated. If I<noexport> is set true, no
815 provisioning jobs (exports) are scheduled. (You can schedule them later with
816 the B<reexport> method for each cust_pkg object. Using the B<reexport> method
817 on the cust_main object is not recommended, as existing services will also be
820 If I<seconds_ref>, I<upbytes_ref>, I<downbytes_ref>, or I<totalbytes_ref> is
821 provided, the scalars (provided by references) will be incremented by the
822 values of the prepaid card.`
828 my $cust_pkgs = shift;
829 my $seconds_ref = ref($_[0]) ? shift : ''; #deprecated
831 $seconds_ref ||= $options{'seconds_ref'};
833 warn "$me order_pkgs called with options ".
834 join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
837 local $SIG{HUP} = 'IGNORE';
838 local $SIG{INT} = 'IGNORE';
839 local $SIG{QUIT} = 'IGNORE';
840 local $SIG{TERM} = 'IGNORE';
841 local $SIG{TSTP} = 'IGNORE';
842 local $SIG{PIPE} = 'IGNORE';
844 my $oldAutoCommit = $FS::UID::AutoCommit;
845 local $FS::UID::AutoCommit = 0;
848 local $FS::svc_Common::noexport_hack = 1 if $options{'noexport'};
850 foreach my $cust_pkg ( keys %$cust_pkgs ) {
852 my $error = $self->order_pkg(
853 'cust_pkg' => $cust_pkg,
854 'svcs' => $cust_pkgs->{$cust_pkg},
855 'seconds_ref' => $seconds_ref,
856 map { $_ => $options{$_} } qw( upbytes_ref downbytes_ref totalbytes_ref
861 $dbh->rollback if $oldAutoCommit;
867 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
871 =item recharge_prepay IDENTIFIER | PREPAY_CREDIT_OBJ [ , AMOUNTREF, SECONDSREF, UPBYTEREF, DOWNBYTEREF ]
873 Recharges this (existing) customer with the specified prepaid card (see
874 L<FS::prepay_credit>), specified either by I<identifier> or as an
875 FS::prepay_credit object. If there is an error, returns the error, otherwise
878 Optionally, five scalar references can be passed as well. They will have their
879 values filled in with the amount, number of seconds, and number of upload,
880 download, and total bytes applied by this prepaid card.
884 #the ref bullshit here should be refactored like get_prepay. MyAccount.pm is
885 #the only place that uses these args
886 sub recharge_prepay {
887 my( $self, $prepay_credit, $amountref, $secondsref,
888 $upbytesref, $downbytesref, $totalbytesref ) = @_;
890 local $SIG{HUP} = 'IGNORE';
891 local $SIG{INT} = 'IGNORE';
892 local $SIG{QUIT} = 'IGNORE';
893 local $SIG{TERM} = 'IGNORE';
894 local $SIG{TSTP} = 'IGNORE';
895 local $SIG{PIPE} = 'IGNORE';
897 my $oldAutoCommit = $FS::UID::AutoCommit;
898 local $FS::UID::AutoCommit = 0;
901 my( $amount, $seconds, $upbytes, $downbytes, $totalbytes) = ( 0, 0, 0, 0, 0 );
903 my $error = $self->get_prepay( $prepay_credit,
904 'amount_ref' => \$amount,
905 'seconds_ref' => \$seconds,
906 'upbytes_ref' => \$upbytes,
907 'downbytes_ref' => \$downbytes,
908 'totalbytes_ref' => \$totalbytes,
910 || $self->increment_seconds($seconds)
911 || $self->increment_upbytes($upbytes)
912 || $self->increment_downbytes($downbytes)
913 || $self->increment_totalbytes($totalbytes)
914 || $self->insert_cust_pay_prepay( $amount,
916 ? $prepay_credit->identifier
921 $dbh->rollback if $oldAutoCommit;
925 if ( defined($amountref) ) { $$amountref = $amount; }
926 if ( defined($secondsref) ) { $$secondsref = $seconds; }
927 if ( defined($upbytesref) ) { $$upbytesref = $upbytes; }
928 if ( defined($downbytesref) ) { $$downbytesref = $downbytes; }
929 if ( defined($totalbytesref) ) { $$totalbytesref = $totalbytes; }
931 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
936 =item get_prepay IDENTIFIER | PREPAY_CREDIT_OBJ [ , OPTION => VALUE ... ]
938 Looks up and deletes a prepaid card (see L<FS::prepay_credit>),
939 specified either by I<identifier> or as an FS::prepay_credit object.
941 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
942 incremented by the values of the prepaid card.
944 If the prepaid card specifies an I<agentnum> (see L<FS::agent>), it is used to
945 check or set this customer's I<agentnum>.
947 If there is an error, returns the error, otherwise returns false.
953 my( $self, $prepay_credit, %opt ) = @_;
955 local $SIG{HUP} = 'IGNORE';
956 local $SIG{INT} = 'IGNORE';
957 local $SIG{QUIT} = 'IGNORE';
958 local $SIG{TERM} = 'IGNORE';
959 local $SIG{TSTP} = 'IGNORE';
960 local $SIG{PIPE} = 'IGNORE';
962 my $oldAutoCommit = $FS::UID::AutoCommit;
963 local $FS::UID::AutoCommit = 0;
966 unless ( ref($prepay_credit) ) {
968 my $identifier = $prepay_credit;
970 $prepay_credit = qsearchs(
972 { 'identifier' => $prepay_credit },
977 unless ( $prepay_credit ) {
978 $dbh->rollback if $oldAutoCommit;
979 return "Invalid prepaid card: ". $identifier;
984 if ( $prepay_credit->agentnum ) {
985 if ( $self->agentnum && $self->agentnum != $prepay_credit->agentnum ) {
986 $dbh->rollback if $oldAutoCommit;
987 return "prepaid card not valid for agent ". $self->agentnum;
989 $self->agentnum($prepay_credit->agentnum);
992 my $error = $prepay_credit->delete;
994 $dbh->rollback if $oldAutoCommit;
995 return "removing prepay_credit (transaction rolled back): $error";
998 ${ $opt{$_.'_ref'} } += $prepay_credit->$_()
999 for grep $opt{$_.'_ref'}, qw( amount seconds upbytes downbytes totalbytes );
1001 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1006 =item increment_upbytes SECONDS
1008 Updates this customer's single or primary account (see L<FS::svc_acct>) by
1009 the specified number of upbytes. If there is an error, returns the error,
1010 otherwise returns false.
1014 sub increment_upbytes {
1015 _increment_column( shift, 'upbytes', @_);
1018 =item increment_downbytes SECONDS
1020 Updates this customer's single or primary account (see L<FS::svc_acct>) by
1021 the specified number of downbytes. If there is an error, returns the error,
1022 otherwise returns false.
1026 sub increment_downbytes {
1027 _increment_column( shift, 'downbytes', @_);
1030 =item increment_totalbytes SECONDS
1032 Updates this customer's single or primary account (see L<FS::svc_acct>) by
1033 the specified number of totalbytes. If there is an error, returns the error,
1034 otherwise returns false.
1038 sub increment_totalbytes {
1039 _increment_column( shift, 'totalbytes', @_);
1042 =item increment_seconds SECONDS
1044 Updates this customer's single or primary account (see L<FS::svc_acct>) by
1045 the specified number of seconds. If there is an error, returns the error,
1046 otherwise returns false.
1050 sub increment_seconds {
1051 _increment_column( shift, 'seconds', @_);
1054 =item _increment_column AMOUNT
1056 Updates this customer's single or primary account (see L<FS::svc_acct>) by
1057 the specified number of seconds or bytes. If there is an error, returns
1058 the error, otherwise returns false.
1062 sub _increment_column {
1063 my( $self, $column, $amount ) = @_;
1064 warn "$me increment_column called: $column, $amount\n"
1067 return '' unless $amount;
1069 my @cust_pkg = grep { $_->part_pkg->svcpart('svc_acct') }
1070 $self->ncancelled_pkgs;
1072 if ( ! @cust_pkg ) {
1073 return 'No packages with primary or single services found'.
1074 ' to apply pre-paid time';
1075 } elsif ( scalar(@cust_pkg) > 1 ) {
1076 #maybe have a way to specify the package/account?
1077 return 'Multiple packages found to apply pre-paid time';
1080 my $cust_pkg = $cust_pkg[0];
1081 warn " found package pkgnum ". $cust_pkg->pkgnum. "\n"
1085 $cust_pkg->cust_svc( $cust_pkg->part_pkg->svcpart('svc_acct') );
1087 if ( ! @cust_svc ) {
1088 return 'No account found to apply pre-paid time';
1089 } elsif ( scalar(@cust_svc) > 1 ) {
1090 return 'Multiple accounts found to apply pre-paid time';
1093 my $svc_acct = $cust_svc[0]->svc_x;
1094 warn " found service svcnum ". $svc_acct->pkgnum.
1095 ' ('. $svc_acct->email. ")\n"
1098 $column = "increment_$column";
1099 $svc_acct->$column($amount);
1103 =item insert_cust_pay_prepay AMOUNT [ PAYINFO ]
1105 Inserts a prepayment in the specified amount for this customer. An optional
1106 second argument can specify the prepayment identifier for tracking purposes.
1107 If there is an error, returns the error, otherwise returns false.
1111 sub insert_cust_pay_prepay {
1112 shift->insert_cust_pay('PREP', @_);
1115 =item insert_cust_pay_cash AMOUNT [ PAYINFO ]
1117 Inserts a cash payment in the specified amount for this customer. An optional
1118 second argument can specify the payment identifier for tracking purposes.
1119 If there is an error, returns the error, otherwise returns false.
1123 sub insert_cust_pay_cash {
1124 shift->insert_cust_pay('CASH', @_);
1127 =item insert_cust_pay_west AMOUNT [ PAYINFO ]
1129 Inserts a Western Union payment in the specified amount for this customer. An
1130 optional second argument can specify the prepayment identifier for tracking
1131 purposes. If there is an error, returns the error, otherwise returns false.
1135 sub insert_cust_pay_west {
1136 shift->insert_cust_pay('WEST', @_);
1139 sub insert_cust_pay {
1140 my( $self, $payby, $amount ) = splice(@_, 0, 3);
1141 my $payinfo = scalar(@_) ? shift : '';
1143 my $cust_pay = new FS::cust_pay {
1144 'custnum' => $self->custnum,
1145 'paid' => sprintf('%.2f', $amount),
1146 #'_date' => #date the prepaid card was purchased???
1148 'payinfo' => $payinfo,
1156 This method is deprecated. See the I<depend_jobnum> option to the insert and
1157 order_pkgs methods for a better way to defer provisioning.
1159 Re-schedules all exports by calling the B<reexport> method of all associated
1160 packages (see L<FS::cust_pkg>). If there is an error, returns the error;
1161 otherwise returns false.
1168 carp "WARNING: FS::cust_main::reexport is deprectated; ".
1169 "use the depend_jobnum option to insert or order_pkgs to delay export";
1171 local $SIG{HUP} = 'IGNORE';
1172 local $SIG{INT} = 'IGNORE';
1173 local $SIG{QUIT} = 'IGNORE';
1174 local $SIG{TERM} = 'IGNORE';
1175 local $SIG{TSTP} = 'IGNORE';
1176 local $SIG{PIPE} = 'IGNORE';
1178 my $oldAutoCommit = $FS::UID::AutoCommit;
1179 local $FS::UID::AutoCommit = 0;
1182 foreach my $cust_pkg ( $self->ncancelled_pkgs ) {
1183 my $error = $cust_pkg->reexport;
1185 $dbh->rollback if $oldAutoCommit;
1190 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1195 =item delete NEW_CUSTNUM
1197 This deletes the customer. If there is an error, returns the error, otherwise
1200 This will completely remove all traces of the customer record. This is not
1201 what you want when a customer cancels service; for that, cancel all of the
1202 customer's packages (see L</cancel>).
1204 If the customer has any uncancelled packages, you need to pass a new (valid)
1205 customer number for those packages to be transferred to. Cancelled packages
1206 will be deleted. Did I mention that this is NOT what you want when a customer
1207 cancels service and that you really should be looking see L<FS::cust_pkg/cancel>?
1209 You can't delete a customer with invoices (see L<FS::cust_bill>),
1210 or credits (see L<FS::cust_credit>), payments (see L<FS::cust_pay>) or
1211 refunds (see L<FS::cust_refund>).
1218 local $SIG{HUP} = 'IGNORE';
1219 local $SIG{INT} = 'IGNORE';
1220 local $SIG{QUIT} = 'IGNORE';
1221 local $SIG{TERM} = 'IGNORE';
1222 local $SIG{TSTP} = 'IGNORE';
1223 local $SIG{PIPE} = 'IGNORE';
1225 my $oldAutoCommit = $FS::UID::AutoCommit;
1226 local $FS::UID::AutoCommit = 0;
1229 if ( $self->cust_bill ) {
1230 $dbh->rollback if $oldAutoCommit;
1231 return "Can't delete a customer with invoices";
1233 if ( $self->cust_credit ) {
1234 $dbh->rollback if $oldAutoCommit;
1235 return "Can't delete a customer with credits";
1237 if ( $self->cust_pay ) {
1238 $dbh->rollback if $oldAutoCommit;
1239 return "Can't delete a customer with payments";
1241 if ( $self->cust_refund ) {
1242 $dbh->rollback if $oldAutoCommit;
1243 return "Can't delete a customer with refunds";
1246 my @cust_pkg = $self->ncancelled_pkgs;
1248 my $new_custnum = shift;
1249 unless ( qsearchs( 'cust_main', { 'custnum' => $new_custnum } ) ) {
1250 $dbh->rollback if $oldAutoCommit;
1251 return "Invalid new customer number: $new_custnum";
1253 foreach my $cust_pkg ( @cust_pkg ) {
1254 my %hash = $cust_pkg->hash;
1255 $hash{'custnum'} = $new_custnum;
1256 my $new_cust_pkg = new FS::cust_pkg ( \%hash );
1257 my $error = $new_cust_pkg->replace($cust_pkg,
1258 options => { $cust_pkg->options },
1261 $dbh->rollback if $oldAutoCommit;
1266 my @cancelled_cust_pkg = $self->all_pkgs;
1267 foreach my $cust_pkg ( @cancelled_cust_pkg ) {
1268 my $error = $cust_pkg->delete;
1270 $dbh->rollback if $oldAutoCommit;
1275 foreach my $cust_main_invoice ( #(email invoice destinations, not invoices)
1276 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } )
1278 my $error = $cust_main_invoice->delete;
1280 $dbh->rollback if $oldAutoCommit;
1285 my $error = $self->SUPER::delete;
1287 $dbh->rollback if $oldAutoCommit;
1291 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1296 =item replace [ OLD_RECORD ] [ INVOICING_LIST_ARYREF ]
1298 Replaces the OLD_RECORD with this one in the database. If there is an error,
1299 returns the error, otherwise returns false.
1301 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
1302 be set as the invoicing list (see L<"invoicing_list">). Errors return as
1303 expected and rollback the entire transaction; it is not necessary to call
1304 check_invoicing_list first. Here's an example:
1306 $new_cust_main->replace( $old_cust_main, [ $email, 'POST' ] );
1313 my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
1315 : $self->replace_old;
1319 warn "$me replace called\n"
1322 my $curuser = $FS::CurrentUser::CurrentUser;
1323 if ( $self->payby eq 'COMP'
1324 && $self->payby ne $old->payby
1325 && ! $curuser->access_right('Complimentary customer')
1328 return "You are not permitted to create complimentary accounts.";
1331 local($ignore_expired_card) = 1
1332 if $old->payby =~ /^(CARD|DCRD)$/
1333 && $self->payby =~ /^(CARD|DCRD)$/
1334 && ( $old->payinfo eq $self->payinfo || $old->paymask eq $self->paymask );
1336 local $SIG{HUP} = 'IGNORE';
1337 local $SIG{INT} = 'IGNORE';
1338 local $SIG{QUIT} = 'IGNORE';
1339 local $SIG{TERM} = 'IGNORE';
1340 local $SIG{TSTP} = 'IGNORE';
1341 local $SIG{PIPE} = 'IGNORE';
1343 my $oldAutoCommit = $FS::UID::AutoCommit;
1344 local $FS::UID::AutoCommit = 0;
1347 my $error = $self->SUPER::replace($old);
1350 $dbh->rollback if $oldAutoCommit;
1354 if ( @param ) { # INVOICING_LIST_ARYREF
1355 my $invoicing_list = shift @param;
1356 $error = $self->check_invoicing_list( $invoicing_list );
1358 $dbh->rollback if $oldAutoCommit;
1361 $self->invoicing_list( $invoicing_list );
1364 if ( $self->payby =~ /^(CARD|CHEK|LECB)$/ &&
1365 grep { $self->get($_) ne $old->get($_) } qw(payinfo paydate payname) ) {
1366 # card/check/lec info has changed, want to retry realtime_ invoice events
1367 my $error = $self->retry_realtime;
1369 $dbh->rollback if $oldAutoCommit;
1374 unless ( $import || $skip_fuzzyfiles ) {
1375 $error = $self->queue_fuzzyfiles_update;
1377 $dbh->rollback if $oldAutoCommit;
1378 return "updating fuzzy search cache: $error";
1382 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1387 =item queue_fuzzyfiles_update
1389 Used by insert & replace to update the fuzzy search cache
1393 sub queue_fuzzyfiles_update {
1396 local $SIG{HUP} = 'IGNORE';
1397 local $SIG{INT} = 'IGNORE';
1398 local $SIG{QUIT} = 'IGNORE';
1399 local $SIG{TERM} = 'IGNORE';
1400 local $SIG{TSTP} = 'IGNORE';
1401 local $SIG{PIPE} = 'IGNORE';
1403 my $oldAutoCommit = $FS::UID::AutoCommit;
1404 local $FS::UID::AutoCommit = 0;
1407 my $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
1408 my $error = $queue->insert( map $self->getfield($_),
1409 qw(first last company)
1412 $dbh->rollback if $oldAutoCommit;
1413 return "queueing job (transaction rolled back): $error";
1416 if ( $self->ship_last ) {
1417 $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
1418 $error = $queue->insert( map $self->getfield("ship_$_"),
1419 qw(first last company)
1422 $dbh->rollback if $oldAutoCommit;
1423 return "queueing job (transaction rolled back): $error";
1427 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1434 Checks all fields to make sure this is a valid customer record. If there is
1435 an error, returns the error, otherwise returns false. Called by the insert
1436 and replace methods.
1443 warn "$me check BEFORE: \n". $self->_dump
1447 $self->ut_numbern('custnum')
1448 || $self->ut_number('agentnum')
1449 || $self->ut_textn('agent_custid')
1450 || $self->ut_number('refnum')
1451 || $self->ut_textn('custbatch')
1452 || $self->ut_name('last')
1453 || $self->ut_name('first')
1454 || $self->ut_snumbern('birthdate')
1455 || $self->ut_snumbern('signupdate')
1456 || $self->ut_textn('company')
1457 || $self->ut_text('address1')
1458 || $self->ut_textn('address2')
1459 || $self->ut_text('city')
1460 || $self->ut_textn('county')
1461 || $self->ut_textn('state')
1462 || $self->ut_country('country')
1463 || $self->ut_anything('comments')
1464 || $self->ut_numbern('referral_custnum')
1465 || $self->ut_textn('stateid')
1466 || $self->ut_textn('stateid_state')
1467 || $self->ut_textn('invoice_terms')
1468 || $self->ut_alphan('geocode')
1471 #barf. need message catalogs. i18n. etc.
1472 $error .= "Please select an advertising source."
1473 if $error =~ /^Illegal or empty \(numeric\) refnum: /;
1474 return $error if $error;
1476 return "Unknown agent"
1477 unless qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
1479 return "Unknown refnum"
1480 unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } );
1482 return "Unknown referring custnum: ". $self->referral_custnum
1483 unless ! $self->referral_custnum
1484 || qsearchs( 'cust_main', { 'custnum' => $self->referral_custnum } );
1486 if ( $self->ss eq '' ) {
1491 $ss =~ /^(\d{3})(\d{2})(\d{4})$/
1492 or return "Illegal social security number: ". $self->ss;
1493 $self->ss("$1-$2-$3");
1497 # bad idea to disable, causes billing to fail because of no tax rates later
1498 # unless ( $import ) {
1499 unless ( qsearch('cust_main_county', {
1500 'country' => $self->country,
1503 return "Unknown state/county/country: ".
1504 $self->state. "/". $self->county. "/". $self->country
1505 unless qsearch('cust_main_county',{
1506 'state' => $self->state,
1507 'county' => $self->county,
1508 'country' => $self->country,
1514 $self->ut_phonen('daytime', $self->country)
1515 || $self->ut_phonen('night', $self->country)
1516 || $self->ut_phonen('fax', $self->country)
1517 || $self->ut_zip('zip', $self->country)
1519 return $error if $error;
1521 if ( $conf->exists('cust_main-require_phone')
1522 && ! length($self->daytime) && ! length($self->night)
1525 my $daytime_label = FS::Msgcat::_gettext('daytime') =~ /^(daytime)?$/
1527 : FS::Msgcat::_gettext('daytime');
1528 my $night_label = FS::Msgcat::_gettext('night') =~ /^(night)?$/
1530 : FS::Msgcat::_gettext('night');
1532 return "$daytime_label or $night_label is required"
1536 if ( $self->has_ship_address
1537 && scalar ( grep { $self->getfield($_) ne $self->getfield("ship_$_") }
1538 $self->addr_fields )
1542 $self->ut_name('ship_last')
1543 || $self->ut_name('ship_first')
1544 || $self->ut_textn('ship_company')
1545 || $self->ut_text('ship_address1')
1546 || $self->ut_textn('ship_address2')
1547 || $self->ut_text('ship_city')
1548 || $self->ut_textn('ship_county')
1549 || $self->ut_textn('ship_state')
1550 || $self->ut_country('ship_country')
1552 return $error if $error;
1554 #false laziness with above
1555 unless ( qsearchs('cust_main_county', {
1556 'country' => $self->ship_country,
1559 return "Unknown ship_state/ship_county/ship_country: ".
1560 $self->ship_state. "/". $self->ship_county. "/". $self->ship_country
1561 unless qsearch('cust_main_county',{
1562 'state' => $self->ship_state,
1563 'county' => $self->ship_county,
1564 'country' => $self->ship_country,
1570 $self->ut_phonen('ship_daytime', $self->ship_country)
1571 || $self->ut_phonen('ship_night', $self->ship_country)
1572 || $self->ut_phonen('ship_fax', $self->ship_country)
1573 || $self->ut_zip('ship_zip', $self->ship_country)
1575 return $error if $error;
1577 return "Unit # is required."
1578 if $self->ship_address2 =~ /^\s*$/
1579 && $conf->exists('cust_main-require_address2');
1581 } else { # ship_ info eq billing info, so don't store dup info in database
1583 $self->setfield("ship_$_", '')
1584 foreach $self->addr_fields;
1586 return "Unit # is required."
1587 if $self->address2 =~ /^\s*$/
1588 && $conf->exists('cust_main-require_address2');
1592 #$self->payby =~ /^(CARD|DCRD|CHEK|DCHK|LECB|BILL|COMP|PREPAY|CASH|WEST|MCRD)$/
1593 # or return "Illegal payby: ". $self->payby;
1595 FS::payby->can_payby($self->table, $self->payby)
1596 or return "Illegal payby: ". $self->payby;
1598 $error = $self->ut_numbern('paystart_month')
1599 || $self->ut_numbern('paystart_year')
1600 || $self->ut_numbern('payissue')
1601 || $self->ut_textn('paytype')
1603 return $error if $error;
1605 if ( $self->payip eq '' ) {
1608 $error = $self->ut_ip('payip');
1609 return $error if $error;
1612 # If it is encrypted and the private key is not availaible then we can't
1613 # check the credit card.
1615 my $check_payinfo = 1;
1617 if ($self->is_encrypted($self->payinfo)) {
1621 if ( $check_payinfo && $self->payby =~ /^(CARD|DCRD)$/ ) {
1623 my $payinfo = $self->payinfo;
1624 $payinfo =~ s/\D//g;
1625 $payinfo =~ /^(\d{13,16})$/
1626 or return gettext('invalid_card'); # . ": ". $self->payinfo;
1628 $self->payinfo($payinfo);
1630 or return gettext('invalid_card'); # . ": ". $self->payinfo;
1632 return gettext('unknown_card_type')
1633 if cardtype($self->payinfo) eq "Unknown";
1635 my $ban = qsearchs('banned_pay', $self->_banned_pay_hashref);
1637 return 'Banned credit card: banned on '.
1638 time2str('%a %h %o at %r', $ban->_date).
1639 ' by '. $ban->otaker.
1640 ' (ban# '. $ban->bannum. ')';
1643 if (length($self->paycvv) && !$self->is_encrypted($self->paycvv)) {
1644 if ( cardtype($self->payinfo) eq 'American Express card' ) {
1645 $self->paycvv =~ /^(\d{4})$/
1646 or return "CVV2 (CID) for American Express cards is four digits.";
1649 $self->paycvv =~ /^(\d{3})$/
1650 or return "CVV2 (CVC2/CID) is three digits.";
1657 my $cardtype = cardtype($payinfo);
1658 if ( $cardtype =~ /^(Switch|Solo)$/i ) {
1660 return "Start date or issue number is required for $cardtype cards"
1661 unless $self->paystart_month && $self->paystart_year or $self->payissue;
1663 return "Start month must be between 1 and 12"
1664 if $self->paystart_month
1665 and $self->paystart_month < 1 || $self->paystart_month > 12;
1667 return "Start year must be 1990 or later"
1668 if $self->paystart_year
1669 and $self->paystart_year < 1990;
1671 return "Issue number must be beween 1 and 99"
1673 and $self->payissue < 1 || $self->payissue > 99;
1676 $self->paystart_month('');
1677 $self->paystart_year('');
1678 $self->payissue('');
1681 } elsif ( $check_payinfo && $self->payby =~ /^(CHEK|DCHK)$/ ) {
1683 my $payinfo = $self->payinfo;
1684 $payinfo =~ s/[^\d\@]//g;
1685 if ( $conf->exists('echeck-nonus') ) {
1686 $payinfo =~ /^(\d+)\@(\d+)$/ or return 'invalid echeck account@aba';
1687 $payinfo = "$1\@$2";
1689 $payinfo =~ /^(\d+)\@(\d{9})$/ or return 'invalid echeck account@aba';
1690 $payinfo = "$1\@$2";
1692 $self->payinfo($payinfo);
1695 my $ban = qsearchs('banned_pay', $self->_banned_pay_hashref);
1697 return 'Banned ACH account: banned on '.
1698 time2str('%a %h %o at %r', $ban->_date).
1699 ' by '. $ban->otaker.
1700 ' (ban# '. $ban->bannum. ')';
1703 } elsif ( $self->payby eq 'LECB' ) {
1705 my $payinfo = $self->payinfo;
1706 $payinfo =~ s/\D//g;
1707 $payinfo =~ /^1?(\d{10})$/ or return 'invalid btn billing telephone number';
1709 $self->payinfo($payinfo);
1712 } elsif ( $self->payby eq 'BILL' ) {
1714 $error = $self->ut_textn('payinfo');
1715 return "Illegal P.O. number: ". $self->payinfo if $error;
1718 } elsif ( $self->payby eq 'COMP' ) {
1720 my $curuser = $FS::CurrentUser::CurrentUser;
1721 if ( ! $self->custnum
1722 && ! $curuser->access_right('Complimentary customer')
1725 return "You are not permitted to create complimentary accounts."
1728 $error = $self->ut_textn('payinfo');
1729 return "Illegal comp account issuer: ". $self->payinfo if $error;
1732 } elsif ( $self->payby eq 'PREPAY' ) {
1734 my $payinfo = $self->payinfo;
1735 $payinfo =~ s/\W//g; #anything else would just confuse things
1736 $self->payinfo($payinfo);
1737 $error = $self->ut_alpha('payinfo');
1738 return "Illegal prepayment identifier: ". $self->payinfo if $error;
1739 return "Unknown prepayment identifier"
1740 unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } );
1745 if ( $self->paydate eq '' || $self->paydate eq '-' ) {
1746 return "Expiration date required"
1747 unless $self->payby =~ /^(BILL|PREPAY|CHEK|DCHK|LECB|CASH|WEST|MCRD)$/;
1751 if ( $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/ ) {
1752 ( $m, $y ) = ( $1, length($2) == 4 ? $2 : "20$2" );
1753 } elsif ( $self->paydate =~ /^(20)?(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) {
1754 ( $m, $y ) = ( $3, "20$2" );
1756 return "Illegal expiration date: ". $self->paydate;
1758 $self->paydate("$y-$m-01");
1759 my($nowm,$nowy)=(localtime(time))[4,5]; $nowm++; $nowy+=1900;
1760 return gettext('expired_card')
1762 && !$ignore_expired_card
1763 && ( $y<$nowy || ( $y==$nowy && $1<$nowm ) );
1766 if ( $self->payname eq '' && $self->payby !~ /^(CHEK|DCHK)$/ &&
1767 ( ! $conf->exists('require_cardname')
1768 || $self->payby !~ /^(CARD|DCRD)$/ )
1770 $self->payname( $self->first. " ". $self->getfield('last') );
1772 $self->payname =~ /^([\w \,\.\-\'\&]+)$/
1773 or return gettext('illegal_name'). " payname: ". $self->payname;
1777 foreach my $flag (qw( tax spool_cdr squelch_cdr archived )) {
1778 $self->$flag() =~ /^(Y?)$/ or return "Illegal $flag: ". $self->$flag();
1782 $self->otaker(getotaker) unless $self->otaker;
1784 warn "$me check AFTER: \n". $self->_dump
1787 $self->SUPER::check;
1792 Returns a list of fields which have ship_ duplicates.
1797 qw( last first company
1798 address1 address2 city county state zip country
1803 =item has_ship_address
1805 Returns true if this customer record has a separate shipping address.
1809 sub has_ship_address {
1811 scalar( grep { $self->getfield("ship_$_") ne '' } $self->addr_fields );
1814 =item all_pkgs [ EXTRA_QSEARCH_PARAMS_HASHREF ]
1816 Returns all packages (see L<FS::cust_pkg>) for this customer.
1822 my $extra_qsearch = ref($_[0]) ? shift : {};
1824 return $self->num_pkgs unless wantarray || keys(%$extra_qsearch);
1827 if ( $self->{'_pkgnum'} ) {
1828 @cust_pkg = values %{ $self->{'_pkgnum'}->cache };
1830 @cust_pkg = $self->_cust_pkg($extra_qsearch);
1833 sort sort_packages @cust_pkg;
1838 Synonym for B<all_pkgs>.
1843 shift->all_pkgs(@_);
1848 Returns all locations (see L<FS::cust_location>) for this customer.
1854 qsearch('cust_location', { 'custnum' => $self->custnum } );
1857 =item ncancelled_pkgs [ EXTRA_QSEARCH_PARAMS_HASHREF ]
1859 Returns all non-cancelled packages (see L<FS::cust_pkg>) for this customer.
1863 sub ncancelled_pkgs {
1865 my $extra_qsearch = ref($_[0]) ? shift : {};
1867 return $self->num_ncancelled_pkgs unless wantarray;
1870 if ( $self->{'_pkgnum'} ) {
1872 warn "$me ncancelled_pkgs: returning cached objects"
1875 @cust_pkg = grep { ! $_->getfield('cancel') }
1876 values %{ $self->{'_pkgnum'}->cache };
1880 warn "$me ncancelled_pkgs: searching for packages with custnum ".
1881 $self->custnum. "\n"
1884 $extra_qsearch->{'extra_sql'} .= ' AND ( cancel IS NULL OR cancel = 0 ) ';
1886 @cust_pkg = $self->_cust_pkg($extra_qsearch);
1890 sort sort_packages @cust_pkg;
1896 my $extra_qsearch = ref($_[0]) ? shift : {};
1898 $extra_qsearch->{'select'} ||= '*';
1899 $extra_qsearch->{'select'} .=
1900 ',( SELECT COUNT(*) FROM cust_svc WHERE cust_pkg.pkgnum = cust_svc.pkgnum )
1904 $_->{'_num_cust_svc'} = $_->get('_num_cust_svc');
1909 'table' => 'cust_pkg',
1910 'hashref' => { 'custnum' => $self->custnum },
1915 # This should be generalized to use config options to determine order.
1918 if ( $a->get('cancel') xor $b->get('cancel') ) {
1919 return -1 if $b->get('cancel');
1920 return 1 if $a->get('cancel');
1921 #shouldn't get here...
1924 my $a_num_cust_svc = $a->num_cust_svc;
1925 my $b_num_cust_svc = $b->num_cust_svc;
1926 return 0 if !$a_num_cust_svc && !$b_num_cust_svc;
1927 return -1 if $a_num_cust_svc && !$b_num_cust_svc;
1928 return 1 if !$a_num_cust_svc && $b_num_cust_svc;
1929 my @a_cust_svc = $a->cust_svc;
1930 my @b_cust_svc = $b->cust_svc;
1931 $a_cust_svc[0]->svc_x->label cmp $b_cust_svc[0]->svc_x->label;
1936 =item suspended_pkgs
1938 Returns all suspended packages (see L<FS::cust_pkg>) for this customer.
1942 sub suspended_pkgs {
1944 grep { $_->susp } $self->ncancelled_pkgs;
1947 =item unflagged_suspended_pkgs
1949 Returns all unflagged suspended packages (see L<FS::cust_pkg>) for this
1950 customer (thouse packages without the `manual_flag' set).
1954 sub unflagged_suspended_pkgs {
1956 return $self->suspended_pkgs
1957 unless dbdef->table('cust_pkg')->column('manual_flag');
1958 grep { ! $_->manual_flag } $self->suspended_pkgs;
1961 =item unsuspended_pkgs
1963 Returns all unsuspended (and uncancelled) packages (see L<FS::cust_pkg>) for
1968 sub unsuspended_pkgs {
1970 grep { ! $_->susp } $self->ncancelled_pkgs;
1973 =item num_cancelled_pkgs
1975 Returns the number of cancelled packages (see L<FS::cust_pkg>) for this
1980 sub num_cancelled_pkgs {
1981 shift->num_pkgs("cust_pkg.cancel IS NOT NULL AND cust_pkg.cancel != 0");
1984 sub num_ncancelled_pkgs {
1985 shift->num_pkgs("( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )");
1989 my( $self ) = shift;
1990 my $sql = scalar(@_) ? shift : '';
1991 $sql = "AND $sql" if $sql && $sql !~ /^\s*$/ && $sql !~ /^\s*AND/i;
1992 my $sth = dbh->prepare(
1993 "SELECT COUNT(*) FROM cust_pkg WHERE custnum = ? $sql"
1994 ) or die dbh->errstr;
1995 $sth->execute($self->custnum) or die $sth->errstr;
1996 $sth->fetchrow_arrayref->[0];
2001 Unsuspends all unflagged suspended packages (see L</unflagged_suspended_pkgs>
2002 and L<FS::cust_pkg>) for this customer. Always returns a list: an empty list
2003 on success or a list of errors.
2009 grep { $_->unsuspend } $self->suspended_pkgs;
2014 Suspends all unsuspended packages (see L<FS::cust_pkg>) for this customer.
2016 Returns a list: an empty list on success or a list of errors.
2022 grep { $_->suspend(@_) } $self->unsuspended_pkgs;
2025 =item suspend_if_pkgpart HASHREF | PKGPART [ , PKGPART ... ]
2027 Suspends all unsuspended packages (see L<FS::cust_pkg>) matching the listed
2028 PKGPARTs (see L<FS::part_pkg>). Preferred usage is to pass a hashref instead
2029 of a list of pkgparts; the hashref has the following keys:
2033 =item pkgparts - listref of pkgparts
2035 =item (other options are passed to the suspend method)
2040 Returns a list: an empty list on success or a list of errors.
2044 sub suspend_if_pkgpart {
2046 my (@pkgparts, %opt);
2047 if (ref($_[0]) eq 'HASH'){
2048 @pkgparts = @{$_[0]{pkgparts}};
2053 grep { $_->suspend(%opt) }
2054 grep { my $pkgpart = $_->pkgpart; grep { $pkgpart eq $_ } @pkgparts }
2055 $self->unsuspended_pkgs;
2058 =item suspend_unless_pkgpart HASHREF | PKGPART [ , PKGPART ... ]
2060 Suspends all unsuspended packages (see L<FS::cust_pkg>) unless they match the
2061 given PKGPARTs (see L<FS::part_pkg>). Preferred usage is to pass a hashref
2062 instead of a list of pkgparts; the hashref has the following keys:
2066 =item pkgparts - listref of pkgparts
2068 =item (other options are passed to the suspend method)
2072 Returns a list: an empty list on success or a list of errors.
2076 sub suspend_unless_pkgpart {
2078 my (@pkgparts, %opt);
2079 if (ref($_[0]) eq 'HASH'){
2080 @pkgparts = @{$_[0]{pkgparts}};
2085 grep { $_->suspend(%opt) }
2086 grep { my $pkgpart = $_->pkgpart; ! grep { $pkgpart eq $_ } @pkgparts }
2087 $self->unsuspended_pkgs;
2090 =item cancel [ OPTION => VALUE ... ]
2092 Cancels all uncancelled packages (see L<FS::cust_pkg>) for this customer.
2094 Available options are:
2098 =item quiet - can be set true to supress email cancellation notices.
2100 =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.
2102 =item ban - can be set true to ban this customer's credit card or ACH information, if present.
2106 Always returns a list: an empty list on success or a list of errors.
2111 my( $self, %opt ) = @_;
2113 warn "$me cancel called on customer ". $self->custnum. " with options ".
2114 join(', ', map { "$_: $opt{$_}" } keys %opt ). "\n"
2117 return ( 'access denied' )
2118 unless $FS::CurrentUser::CurrentUser->access_right('Cancel customer');
2120 if ( $opt{'ban'} && $self->payby =~ /^(CARD|DCRD|CHEK|DCHK)$/ ) {
2122 #should try decryption (we might have the private key)
2123 # and if not maybe queue a job for the server that does?
2124 return ( "Can't (yet) ban encrypted credit cards" )
2125 if $self->is_encrypted($self->payinfo);
2127 my $ban = new FS::banned_pay $self->_banned_pay_hashref;
2128 my $error = $ban->insert;
2129 return ( $error ) if $error;
2133 my @pkgs = $self->ncancelled_pkgs;
2135 warn "$me cancelling ". scalar($self->ncancelled_pkgs). "/".
2136 scalar(@pkgs). " packages for customer ". $self->custnum. "\n"
2139 grep { $_ } map { $_->cancel(%opt) } $self->ncancelled_pkgs;
2142 sub _banned_pay_hashref {
2153 'payby' => $payby2ban{$self->payby},
2154 'payinfo' => md5_base64($self->payinfo),
2155 #don't ever *search* on reason! #'reason' =>
2161 Returns all notes (see L<FS::cust_main_note>) for this customer.
2168 qsearch( 'cust_main_note',
2169 { 'custnum' => $self->custnum },
2171 'ORDER BY _DATE DESC'
2177 Returns the agent (see L<FS::agent>) for this customer.
2183 qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
2186 =item bill_and_collect
2188 Cancels and suspends any packages due, generates bills, applies payments and
2191 Warns on errors (Does not currently: If there is an error, returns the error, otherwise returns false.)
2193 Options are passed as name-value pairs. Currently available options are:
2199 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:
2203 $cust_main->bill( 'time' => str2time('April 20th, 2001') );
2207 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.
2211 "1d" for the traditional, daily events (the default), or "1m" for the new monthly events (part_event.check_freq)
2215 If set true, re-charges setup fees.
2219 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)
2225 sub bill_and_collect {
2226 my( $self, %options ) = @_;
2228 #$options{actual_time} not $options{time} because freeside-daily -d is for
2229 #pre-printing invoices
2230 $self->cancel_expired_pkgs( $options{actual_time} );
2231 $self->suspend_adjourned_pkgs( $options{actual_time} );
2233 my $error = $self->bill( %options );
2234 warn "Error billing, custnum ". $self->custnum. ": $error" if $error;
2236 $self->apply_payments_and_credits;
2238 unless ( $conf->config('cancelled_cust-noevents')
2239 && ! $self->num_ncancelled_pkgs
2242 $error = $self->collect( %options );
2243 warn "Error collecting, custnum". $self->custnum. ": $error" if $error;
2249 sub cancel_expired_pkgs {
2250 my ( $self, $time ) = @_;
2252 my @cancel_pkgs = grep { $_->expire && $_->expire <= $time }
2253 $self->ncancelled_pkgs;
2255 foreach my $cust_pkg ( @cancel_pkgs ) {
2256 my $cpr = $cust_pkg->last_cust_pkg_reason('expire');
2257 my $error = $cust_pkg->cancel($cpr ? ( 'reason' => $cpr->reasonnum,
2258 'reason_otaker' => $cpr->otaker
2262 warn "Error cancelling expired pkg ". $cust_pkg->pkgnum.
2263 " for custnum ". $self->custnum. ": $error"
2269 sub suspend_adjourned_pkgs {
2270 my ( $self, $time ) = @_;
2274 && ( ( $_->part_pkg->is_prepaid
2279 && $_->adjourn <= $time
2283 $self->ncancelled_pkgs;
2285 foreach my $cust_pkg ( @susp_pkgs ) {
2286 my $cpr = $cust_pkg->last_cust_pkg_reason('adjourn')
2287 if ($cust_pkg->adjourn && $cust_pkg->adjourn < $^T);
2288 my $error = $cust_pkg->suspend($cpr ? ( 'reason' => $cpr->reasonnum,
2289 'reason_otaker' => $cpr->otaker
2294 warn "Error suspending package ". $cust_pkg->pkgnum.
2295 " for custnum ". $self->custnum. ": $error"
2303 Generates invoices (see L<FS::cust_bill>) for this customer. Usually used in
2304 conjunction with the collect method by calling B<bill_and_collect>.
2306 If there is an error, returns the error, otherwise returns false.
2308 Options are passed as name-value pairs. Currently available options are:
2314 If set true, re-charges setup fees.
2318 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:
2322 $cust_main->bill( 'time' => str2time('April 20th, 2001') );
2326 An array ref of specific packages (objects) to attempt billing, instead trying all of them.
2328 $cust_main->bill( pkg_list => [$pkg1, $pkg2] );
2332 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.
2339 my( $self, %options ) = @_;
2340 return '' if $self->payby eq 'COMP';
2341 warn "$me bill customer ". $self->custnum. "\n"
2344 my $time = $options{'time'} || time;
2345 my $invoice_time = $options{'invoice_time'} || $time;
2348 local $SIG{HUP} = 'IGNORE';
2349 local $SIG{INT} = 'IGNORE';
2350 local $SIG{QUIT} = 'IGNORE';
2351 local $SIG{TERM} = 'IGNORE';
2352 local $SIG{TSTP} = 'IGNORE';
2353 local $SIG{PIPE} = 'IGNORE';
2355 my $oldAutoCommit = $FS::UID::AutoCommit;
2356 local $FS::UID::AutoCommit = 0;
2359 $self->select_for_update; #mutex
2361 my @cust_bill_pkg = ();
2364 # find the packages which are due for billing, find out how much they are
2365 # & generate invoice database.
2368 my( $total_setup, $total_recur, $postal_charge ) = ( 0, 0, 0 );
2370 my @precommit_hooks = ();
2372 my @cust_pkgs = qsearch('cust_pkg', { 'custnum' => $self->custnum } );
2373 foreach my $cust_pkg (@cust_pkgs) {
2375 #NO!! next if $cust_pkg->cancel;
2376 next if $cust_pkg->getfield('cancel');
2378 warn " bill package ". $cust_pkg->pkgnum. "\n" if $DEBUG > 1;
2380 #? to avoid use of uninitialized value errors... ?
2381 $cust_pkg->setfield('bill', '')
2382 unless defined($cust_pkg->bill);
2384 #my $part_pkg = $cust_pkg->part_pkg;
2386 my $real_pkgpart = $cust_pkg->pkgpart;
2387 my %hash = $cust_pkg->hash;
2389 foreach my $part_pkg ( $cust_pkg->part_pkg->self_and_bill_linked ) {
2391 $cust_pkg->set($_, $hash{$_}) foreach qw ( setup last_bill bill );
2394 $self->_make_lines( 'part_pkg' => $part_pkg,
2395 'cust_pkg' => $cust_pkg,
2396 'precommit_hooks' => \@precommit_hooks,
2397 'line_items' => \@cust_bill_pkg,
2398 'setup' => \$total_setup,
2399 'recur' => \$total_recur,
2400 'tax_matrix' => \%taxlisthash,
2402 'options' => \%options,
2405 $dbh->rollback if $oldAutoCommit;
2409 } #foreach my $part_pkg
2411 } #foreach my $cust_pkg
2413 unless ( @cust_bill_pkg ) { #don't create an invoice w/o line items
2414 #but do commit any package date cycling that happened
2415 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2419 my $postal_pkg = $self->charge_postal_fee();
2420 if ( $postal_pkg && !ref( $postal_pkg ) ) {
2421 $dbh->rollback if $oldAutoCommit;
2422 return "can't charge postal invoice fee for customer ".
2423 $self->custnum. ": $postal_pkg";
2426 ( scalar( grep { $_->recur && $_->recur > 0 } @cust_bill_pkg) ||
2427 !$conf->exists('postal_invoice-recurring_only')
2431 foreach my $part_pkg ( $postal_pkg->part_pkg->self_and_bill_linked ) {
2433 $self->_make_lines( 'part_pkg' => $part_pkg,
2434 'cust_pkg' => $postal_pkg,
2435 'precommit_hooks' => \@precommit_hooks,
2436 'line_items' => \@cust_bill_pkg,
2437 'setup' => \$total_setup,
2438 'recur' => \$total_recur,
2439 'tax_matrix' => \%taxlisthash,
2441 'options' => \%options,
2444 $dbh->rollback if $oldAutoCommit;
2450 warn "having a look at the taxes we found...\n" if $DEBUG > 2;
2452 # keys are tax names (as printed on invoices / itemdesc )
2453 # values are listrefs of taxlisthash keys (internal identifiers)
2456 # keys are taxlisthash keys (internal identifiers)
2457 # values are (cumulative) amounts
2460 # keys are taxlisthash keys (internal identifiers)
2461 # values are listrefs of cust_bill_pkg_tax_location hashrefs
2462 my %tax_location = ();
2464 foreach my $tax ( keys %taxlisthash ) {
2465 my $tax_object = shift @{ $taxlisthash{$tax} };
2466 warn "found ". $tax_object->taxname. " as $tax\n" if $DEBUG > 2;
2467 warn " ". join('/', @{ $taxlisthash{$tax} } ). "\n" if $DEBUG > 2;
2468 my $hashref_or_error =
2469 $tax_object->taxline( $taxlisthash{$tax},
2470 'custnum' => $self->custnum,
2471 'invoice_time' => $invoice_time
2473 unless ( ref($hashref_or_error) ) {
2474 $dbh->rollback if $oldAutoCommit;
2475 return $hashref_or_error;
2477 unshift @{ $taxlisthash{$tax} }, $tax_object;
2479 my $name = $hashref_or_error->{'name'};
2480 my $amount = $hashref_or_error->{'amount'};
2482 #warn "adding $amount as $name\n";
2483 $taxname{ $name } ||= [];
2484 push @{ $taxname{ $name } }, $tax;
2486 $tax{ $tax } += $amount;
2488 $tax_location{ $tax } ||= [];
2489 if ( $tax_object->get('pkgnum') || $tax_object->get('locationnum') ) {
2490 push @{ $tax_location{ $tax } },
2492 'taxnum' => $tax_object->taxnum,
2493 'taxtype' => ref($tax_object),
2494 'pkgnum' => $tax_object->get('pkgnum'),
2495 'locationnum' => $tax_object->get('locationnum'),
2496 'amount' => sprintf('%.2f', $amount ),
2502 #move the cust_tax_exempt_pkg records to the cust_bill_pkgs we will commit
2503 my %packagemap = map { $_->pkgnum => $_ } @cust_bill_pkg;
2504 foreach my $tax ( keys %taxlisthash ) {
2505 foreach ( @{ $taxlisthash{$tax} }[1 ... scalar(@{ $taxlisthash{$tax} })] ) {
2506 next unless ref($_) eq 'FS::cust_bill_pkg'; # shouldn't happen
2508 push @{ $packagemap{$_->pkgnum}->_cust_tax_exempt_pkg },
2509 splice( @{ $_->_cust_tax_exempt_pkg } );
2513 #some taxes are taxed
2516 warn "finding taxed taxes...\n" if $DEBUG > 2;
2517 foreach my $tax ( keys %taxlisthash ) {
2518 my $tax_object = shift @{ $taxlisthash{$tax} };
2519 warn "found possible taxed tax ". $tax_object->taxname. " we call $tax\n"
2521 next unless $tax_object->can('tax_on_tax');
2523 foreach my $tot ( $tax_object->tax_on_tax( $self ) ) {
2524 my $totname = ref( $tot ). ' '. $tot->taxnum;
2526 warn "checking $totname which we call ". $tot->taxname. " as applicable\n"
2528 next unless exists( $taxlisthash{ $totname } ); # only increase
2530 warn "adding $totname to taxed taxes\n" if $DEBUG > 2;
2531 if ( exists( $totlisthash{ $totname } ) ) {
2532 push @{ $totlisthash{ $totname } }, $tax{ $tax };
2534 $totlisthash{ $totname } = [ $tot, $tax{ $tax } ];
2539 warn "having a look at taxed taxes...\n" if $DEBUG > 2;
2540 foreach my $tax ( keys %totlisthash ) {
2541 my $tax_object = shift @{ $totlisthash{$tax} };
2542 warn "found previously found taxed tax ". $tax_object->taxname. "\n"
2544 my $hashref_or_error =
2545 $tax_object->taxline( $totlisthash{$tax},
2546 'custnum' => $self->custnum,
2547 'invoice_time' => $invoice_time
2549 unless (ref($hashref_or_error)) {
2550 $dbh->rollback if $oldAutoCommit;
2551 return $hashref_or_error;
2554 warn "adding taxed tax amount ". $hashref_or_error->{'amount'}.
2555 " as ". $tax_object->taxname. "\n"
2557 $tax{ $tax } += $hashref_or_error->{'amount'};
2560 #consolidate and create tax line items
2561 warn "consolidating and generating...\n" if $DEBUG > 2;
2562 foreach my $taxname ( keys %taxname ) {
2565 my @cust_bill_pkg_tax_location = ();
2566 warn "adding $taxname\n" if $DEBUG > 1;
2567 foreach my $taxitem ( @{ $taxname{$taxname} } ) {
2568 next if $seen{$taxitem}++;
2569 warn "adding $tax{$taxitem}\n" if $DEBUG > 1;
2570 $tax += $tax{$taxitem};
2571 push @cust_bill_pkg_tax_location,
2572 map { new FS::cust_bill_pkg_tax_location $_ }
2573 @{ $tax_location{ $taxitem } };
2577 $tax = sprintf('%.2f', $tax );
2578 $total_setup = sprintf('%.2f', $total_setup+$tax );
2580 push @cust_bill_pkg, new FS::cust_bill_pkg {
2586 'itemdesc' => $taxname,
2587 'cust_bill_pkg_tax_location' => \@cust_bill_pkg_tax_location,
2592 my $charged = sprintf('%.2f', $total_setup + $total_recur );
2594 #create the new invoice
2595 my $cust_bill = new FS::cust_bill ( {
2596 'custnum' => $self->custnum,
2597 '_date' => ( $invoice_time ),
2598 'charged' => $charged,
2600 my $error = $cust_bill->insert;
2602 $dbh->rollback if $oldAutoCommit;
2603 return "can't create invoice for customer #". $self->custnum. ": $error";
2606 foreach my $cust_bill_pkg ( @cust_bill_pkg ) {
2607 $cust_bill_pkg->invnum($cust_bill->invnum);
2608 my $error = $cust_bill_pkg->insert;
2610 $dbh->rollback if $oldAutoCommit;
2611 return "can't create invoice line item: $error";
2616 foreach my $hook ( @precommit_hooks ) {
2618 &{$hook}; #($self) ?
2621 $dbh->rollback if $oldAutoCommit;
2622 return "$@ running precommit hook $hook\n";
2626 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2632 my ($self, %params) = @_;
2634 my $part_pkg = $params{part_pkg} or die "no part_pkg specified";
2635 my $cust_pkg = $params{cust_pkg} or die "no cust_pkg specified";
2636 my $precommit_hooks = $params{precommit_hooks} or die "no package specified";
2637 my $cust_bill_pkgs = $params{line_items} or die "no line buffer specified";
2638 my $total_setup = $params{setup} or die "no setup accumulator specified";
2639 my $total_recur = $params{recur} or die "no recur accumulator specified";
2640 my $taxlisthash = $params{tax_matrix} or die "no tax accumulator specified";
2641 my $time = $params{'time'} or die "no time specified";
2642 my (%options) = %{$params{options}}; #hmmm only for 'resetup'
2645 my $real_pkgpart = $cust_pkg->pkgpart;
2646 my %hash = $cust_pkg->hash;
2647 my $old_cust_pkg = new FS::cust_pkg \%hash;
2653 $cust_pkg->pkgpart($part_pkg->pkgpart);
2661 if ( ! $cust_pkg->setup &&
2663 ( $conf->exists('disable_setup_suspended_pkgs') &&
2664 ! $cust_pkg->getfield('susp')
2665 ) || ! $conf->exists('disable_setup_suspended_pkgs')
2667 || $options{'resetup'}
2670 warn " bill setup\n" if $DEBUG > 1;
2673 $setup = eval { $cust_pkg->calc_setup( $time, \@details ) };
2674 return "$@ running calc_setup for $cust_pkg\n"
2677 $unitsetup = $cust_pkg->part_pkg->unit_setup || $setup; #XXX uuh
2679 $cust_pkg->setfield('setup', $time)
2680 unless $cust_pkg->setup;
2681 #do need it, but it won't get written to the db
2682 #|| $cust_pkg->pkgpart != $real_pkgpart;
2687 # bill recurring fee
2690 #XXX unit stuff here too
2694 if ( ! $cust_pkg->getfield('susp') and
2695 ( $part_pkg->getfield('freq') ne '0' &&
2696 ( $cust_pkg->getfield('bill') || 0 ) <= $time
2698 || ( $part_pkg->plan eq 'voip_cdr'
2699 && $part_pkg->option('bill_every_call')
2703 # XXX should this be a package event? probably. events are called
2704 # at collection time at the moment, though...
2705 $part_pkg->reset_usage($cust_pkg, 'debug'=>$DEBUG)
2706 if $part_pkg->can('reset_usage');
2707 #don't want to reset usage just cause we want a line item??
2708 #&& $part_pkg->pkgpart == $real_pkgpart;
2710 warn " bill recur\n" if $DEBUG > 1;
2713 # XXX shared with $recur_prog
2714 $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
2716 #over two params! lets at least switch to a hashref for the rest...
2717 my $increment_next_bill = ( $part_pkg->freq ne '0'
2718 && ( $cust_pkg->getfield('bill') || 0 ) <= $time
2720 my %param = ( 'precommit_hooks' => $precommit_hooks,
2721 'increment_next_bill' => $increment_next_bill,
2724 $recur = eval { $cust_pkg->calc_recur( \$sdate, \@details, \%param ) };
2725 return "$@ running calc_recur for $cust_pkg\n"
2728 if ( $increment_next_bill ) {
2730 my $next_bill = $part_pkg->add_freq($sdate);
2731 return "unparsable frequency: ". $part_pkg->freq
2732 if $next_bill == -1;
2734 #pro-rating magic - if $recur_prog fiddled $sdate, want to use that
2735 # only for figuring next bill date, nothing else, so, reset $sdate again
2737 $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
2738 #no need, its in $hash{last_bill}# my $last_bill = $cust_pkg->last_bill;
2739 $cust_pkg->last_bill($sdate);
2741 $cust_pkg->setfield('bill', $next_bill );
2747 warn "\$setup is undefined" unless defined($setup);
2748 warn "\$recur is undefined" unless defined($recur);
2749 warn "\$cust_pkg->bill is undefined" unless defined($cust_pkg->bill);
2752 # If there's line items, create em cust_bill_pkg records
2753 # If $cust_pkg has been modified, update it (if we're a real pkgpart)
2758 if ( $cust_pkg->modified && $cust_pkg->pkgpart == $real_pkgpart ) {
2759 # hmm.. and if just the options are modified in some weird price plan?
2761 warn " package ". $cust_pkg->pkgnum. " modified; updating\n"
2764 my $error = $cust_pkg->replace( $old_cust_pkg,
2765 'options' => { $cust_pkg->options },
2767 return "Error modifying pkgnum ". $cust_pkg->pkgnum. ": $error"
2768 if $error; #just in case
2771 $setup = sprintf( "%.2f", $setup );
2772 $recur = sprintf( "%.2f", $recur );
2773 if ( $setup < 0 && ! $conf->exists('allow_negative_charges') ) {
2774 return "negative setup $setup for pkgnum ". $cust_pkg->pkgnum;
2776 if ( $recur < 0 && ! $conf->exists('allow_negative_charges') ) {
2777 return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum;
2780 if ( $setup != 0 || $recur != 0 ) {
2782 warn " charges (setup=$setup, recur=$recur); adding line items\n"
2785 my @cust_pkg_detail = map { $_->detail } $cust_pkg->cust_pkg_detail('I');
2787 warn " adding customer package invoice detail: $_\n"
2788 foreach @cust_pkg_detail;
2790 push @details, @cust_pkg_detail;
2792 my $cust_bill_pkg = new FS::cust_bill_pkg {
2793 'pkgnum' => $cust_pkg->pkgnum,
2795 'unitsetup' => $unitsetup,
2797 'unitrecur' => $unitrecur,
2798 'quantity' => $cust_pkg->quantity,
2799 'details' => \@details,
2802 if ( $part_pkg->option('recur_temporality', 1) eq 'preceding' ) {
2803 $cust_bill_pkg->sdate( $hash{last_bill} );
2804 $cust_bill_pkg->edate( $sdate - 86399 ); #60s*60m*24h-1
2805 } else { #if ( $part_pkg->option('recur_temporality', 1) eq 'upcoming' ) {
2806 $cust_bill_pkg->sdate( $sdate );
2807 $cust_bill_pkg->edate( $cust_pkg->bill );
2810 $cust_bill_pkg->pkgpart_override($part_pkg->pkgpart)
2811 unless $part_pkg->pkgpart == $real_pkgpart;
2813 $$total_setup += $setup;
2814 $$total_recur += $recur;
2821 $self->_handle_taxes($part_pkg, $taxlisthash, $cust_bill_pkg, $cust_pkg);
2822 return $error if $error;
2824 push @$cust_bill_pkgs, $cust_bill_pkg;
2826 } #if $setup != 0 || $recur != 0
2836 my $part_pkg = shift;
2837 my $taxlisthash = shift;
2838 my $cust_bill_pkg = shift;
2839 my $cust_pkg = shift;
2841 my %cust_bill_pkg = ();
2845 #push @classes, $cust_bill_pkg->usage_classes if $cust_bill_pkg->type eq 'U';
2846 push @classes, $cust_bill_pkg->usage_classes if $cust_bill_pkg->usage;
2847 push @classes, 'setup' if $cust_bill_pkg->setup;
2848 push @classes, 'recur' if $cust_bill_pkg->recur;
2850 if ( $self->tax !~ /Y/i && $self->payby ne 'COMP' ) {
2852 if ( $conf->exists('enable_taxproducts')
2853 && ( scalar($part_pkg->part_pkg_taxoverride)
2854 || $part_pkg->has_taxproduct
2859 if ( $conf->exists('tax-pkg_address') && $cust_pkg->locationnum ) {
2860 return "fatal: Can't (yet) use tax-pkg_address with taxproducts";
2863 foreach my $class (@classes) {
2864 my $err_or_ref = $self->_gather_taxes( $part_pkg, $class );
2865 return $err_or_ref unless ref($err_or_ref);
2866 $taxes{$class} = $err_or_ref;
2869 unless (exists $taxes{''}) {
2870 my $err_or_ref = $self->_gather_taxes( $part_pkg, '' );
2871 return $err_or_ref unless ref($err_or_ref);
2872 $taxes{''} = $err_or_ref;
2877 my @loc_keys = qw( state county country );
2879 if ( $conf->exists('tax-pkg_address') && $cust_pkg->locationnum ) {
2880 my $cust_location = $cust_pkg->cust_location;
2881 %taxhash = map { $_ => $cust_location->$_() } @loc_keys;
2884 ( $conf->exists('tax-ship_address') && length($self->ship_last) )
2887 %taxhash = map { $_ => $self->get("$prefix$_") } @loc_keys;
2890 $taxhash{'taxclass'} = $part_pkg->taxclass;
2892 my @taxes = qsearch( 'cust_main_county', \%taxhash );
2894 my %taxhash_elim = %taxhash;
2896 my @elim = qw( taxclass county state );
2897 while ( !scalar(@taxes) && scalar(@elim) ) {
2898 $taxhash_elim{ shift(@elim) } = '';
2899 @taxes = qsearch( 'cust_main_county', \%taxhash_elim );
2902 if ( $conf->exists('tax-pkg_address') && $cust_pkg->locationnum ) {
2904 $_->set('pkgnum', $cust_pkg->pkgnum );
2905 $_->set('locationnum', $cust_pkg->locationnum );
2909 $taxes{''} = [ @taxes ];
2910 $taxes{'setup'} = [ @taxes ];
2911 $taxes{'recur'} = [ @taxes ];
2912 $taxes{$_} = [ @taxes ] foreach (@classes);
2914 # maybe eliminate this entirely, along with all the 0% records
2917 "fatal: can't find tax rate for state/county/country/taxclass ".
2918 join('/', map $taxhash{$_}, qw(state county country taxclass) );
2921 } #if $conf->exists('enable_taxproducts') ...
2926 if ( $conf->exists('separate_usage') ) {
2927 my $section = $cust_pkg->part_pkg->option('usage_section', 'Hush!');
2928 my $summary = $cust_pkg->part_pkg->option('summarize_usage', 'Hush!');
2929 push @display, new FS::cust_bill_pkg_display { type => 'S' };
2930 push @display, new FS::cust_bill_pkg_display { type => 'R' };
2931 push @display, new FS::cust_bill_pkg_display { type => 'U',
2934 if ($section && $summary) {
2935 $display[2]->post_total('Y');
2936 push @display, new FS::cust_bill_pkg_display { type => 'U',
2941 $cust_bill_pkg->set('display', \@display);
2943 my %tax_cust_bill_pkg = $cust_bill_pkg->disintegrate;
2944 foreach my $key (keys %tax_cust_bill_pkg) {
2945 my @taxes = @{ $taxes{$key} || [] };
2946 my $tax_cust_bill_pkg = $tax_cust_bill_pkg{$key};
2948 foreach my $tax ( @taxes ) {
2950 my $taxname = ref( $tax ). ' '. $tax->taxnum;
2951 # $taxname .= ' pkgnum'. $cust_pkg->pkgnum.
2952 # ' locationnum'. $cust_pkg->locationnum
2953 # if $conf->exists('tax-pkg_address') && $cust_pkg->locationnum;
2955 if ( exists( $taxlisthash->{ $taxname } ) ) {
2956 push @{ $taxlisthash->{ $taxname } }, $tax_cust_bill_pkg;
2958 $taxlisthash->{ $taxname } = [ $tax, $tax_cust_bill_pkg ];
2968 my $part_pkg = shift;
2972 my $geocode = $self->geocode('cch');
2974 my @taxclassnums = map { $_->taxclassnum }
2975 $part_pkg->part_pkg_taxoverride($class);
2977 unless (@taxclassnums) {
2978 @taxclassnums = map { $_->taxclassnum }
2979 $part_pkg->part_pkg_taxrate('cch', $geocode, $class);
2981 warn "Found taxclassnum values of ". join(',', @taxclassnums)
2986 join(' OR ', map { "taxclassnum = $_" } @taxclassnums ). ")";
2988 @taxes = qsearch({ 'table' => 'tax_rate',
2989 'hashref' => { 'geocode' => $geocode, },
2990 'extra_sql' => $extra_sql,
2992 if scalar(@taxclassnums);
2994 warn "Found taxes ".
2995 join(',', map{ ref($_). " ". $_->get($_->primary_key) } @taxes). "\n"
3002 =item collect OPTIONS
3004 (Attempt to) collect money for this customer's outstanding invoices (see
3005 L<FS::cust_bill>). Usually used after the bill method.
3007 Actions are now triggered by billing events; see L<FS::part_event> and the
3008 billing events web interface. Old-style invoice events (see
3009 L<FS::part_bill_event>) have been deprecated.
3011 If there is an error, returns the error, otherwise returns false.
3013 Options are passed as name-value pairs.
3015 Currently available options are:
3021 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.
3025 Retry card/echeck/LEC transactions even when not scheduled by invoice events.
3029 set true to surpress email card/ACH decline notices.
3033 "1d" for the traditional, daily events (the default), or "1m" for the new monthly events (part_event.check_freq)
3037 allows for one time override of normal customer billing method
3041 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)
3049 my( $self, %options ) = @_;
3050 my $invoice_time = $options{'invoice_time'} || time;
3053 local $SIG{HUP} = 'IGNORE';
3054 local $SIG{INT} = 'IGNORE';
3055 local $SIG{QUIT} = 'IGNORE';
3056 local $SIG{TERM} = 'IGNORE';
3057 local $SIG{TSTP} = 'IGNORE';
3058 local $SIG{PIPE} = 'IGNORE';
3060 my $oldAutoCommit = $FS::UID::AutoCommit;
3061 local $FS::UID::AutoCommit = 0;
3064 $self->select_for_update; #mutex
3067 my $balance = $self->balance;
3068 warn "$me collect customer ". $self->custnum. ": balance $balance\n"
3071 if ( exists($options{'retry_card'}) ) {
3072 carp 'retry_card option passed to collect is deprecated; use retry';
3073 $options{'retry'} ||= $options{'retry_card'};
3075 if ( exists($options{'retry'}) && $options{'retry'} ) {
3076 my $error = $self->retry_realtime;
3078 $dbh->rollback if $oldAutoCommit;
3083 # false laziness w/pay_batch::import_results
3085 my $due_cust_event = $self->due_cust_event(
3086 'debug' => ( $options{'debug'} || 0 ),
3087 'time' => $invoice_time,
3088 'check_freq' => $options{'check_freq'},
3090 unless( ref($due_cust_event) ) {
3091 $dbh->rollback if $oldAutoCommit;
3092 return $due_cust_event;
3095 foreach my $cust_event ( @$due_cust_event ) {
3099 #re-eval event conditions (a previous event could have changed things)
3100 unless ( $cust_event->test_conditions( 'time' => $invoice_time ) ) {
3101 #don't leave stray "new/locked" records around
3102 my $error = $cust_event->delete;
3104 #gah, even with transactions
3105 $dbh->commit if $oldAutoCommit; #well.
3112 local $realtime_bop_decline_quiet = 1 if $options{'quiet'};
3113 warn " running cust_event ". $cust_event->eventnum. "\n"
3117 #if ( my $error = $cust_event->do_event(%options) ) { #XXX %options?
3118 if ( my $error = $cust_event->do_event() ) {
3119 #XXX wtf is this? figure out a proper dealio with return value
3121 # gah, even with transactions.
3122 $dbh->commit if $oldAutoCommit; #well.
3129 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3134 =item due_cust_event [ HASHREF | OPTION => VALUE ... ]
3136 Inserts database records for and returns an ordered listref of new events due
3137 for this customer, as FS::cust_event objects (see L<FS::cust_event>). If no
3138 events are due, an empty listref is returned. If there is an error, returns a
3139 scalar error message.
3141 To actually run the events, call each event's test_condition method, and if
3142 still true, call the event's do_event method.
3144 Options are passed as a hashref or as a list of name-value pairs. Available
3151 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.
3155 "Current time" for the events.
3159 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)
3163 Only return events for the specified eventtable (by default, events of all eventtables are returned)
3167 Explicitly pass the objects to be tested (typically used with eventtable).
3171 Set to true to return the objects, but not actually insert them into the
3178 sub due_cust_event {
3180 my %opt = ref($_[0]) ? %{ $_[0] } : @_;
3183 #my $DEBUG = $opt{'debug'}
3184 local($DEBUG) = $opt{'debug'}
3185 if defined($opt{'debug'}) && $opt{'debug'} > $DEBUG;
3187 warn "$me due_cust_event called with options ".
3188 join(', ', map { "$_: $opt{$_}" } keys %opt). "\n"
3191 $opt{'time'} ||= time;
3193 local $SIG{HUP} = 'IGNORE';
3194 local $SIG{INT} = 'IGNORE';
3195 local $SIG{QUIT} = 'IGNORE';
3196 local $SIG{TERM} = 'IGNORE';
3197 local $SIG{TSTP} = 'IGNORE';
3198 local $SIG{PIPE} = 'IGNORE';
3200 my $oldAutoCommit = $FS::UID::AutoCommit;
3201 local $FS::UID::AutoCommit = 0;
3204 $self->select_for_update #mutex
3205 unless $opt{testonly};
3208 # 1: find possible events (initial search)
3211 my @cust_event = ();
3213 my @eventtable = $opt{'eventtable'}
3214 ? ( $opt{'eventtable'} )
3215 : FS::part_event->eventtables_runorder;
3217 foreach my $eventtable ( @eventtable ) {
3220 if ( $opt{'objects'} ) {
3222 @objects = @{ $opt{'objects'} };
3226 #my @objects = $self->eventtable(); # sub cust_main { @{ [ $self ] }; }
3227 @objects = ( $eventtable eq 'cust_main' )
3229 : ( $self->$eventtable() );
3233 my @e_cust_event = ();
3235 my $cross = "CROSS JOIN $eventtable";
3236 $cross .= ' LEFT JOIN cust_main USING ( custnum )'
3237 unless $eventtable eq 'cust_main';
3239 foreach my $object ( @objects ) {
3241 #this first search uses the condition_sql magic for optimization.
3242 #the more possible events we can eliminate in this step the better
3244 my $cross_where = '';
3245 my $pkey = $object->primary_key;
3246 $cross_where = "$eventtable.$pkey = ". $object->$pkey();
3248 my $join = FS::part_event_condition->join_conditions_sql( $eventtable );
3250 FS::part_event_condition->where_conditions_sql( $eventtable,
3251 'time'=>$opt{'time'}
3253 my $order = FS::part_event_condition->order_conditions_sql( $eventtable );
3255 $extra_sql = "AND $extra_sql" if $extra_sql;
3257 #here is the agent virtualization
3258 $extra_sql .= " AND ( part_event.agentnum IS NULL
3259 OR part_event.agentnum = ". $self->agentnum. ' )';
3261 $extra_sql .= " $order";
3263 warn "searching for events for $eventtable ". $object->$pkey. "\n"
3264 if $opt{'debug'} > 2;
3265 my @part_event = qsearch( {
3266 'debug' => ( $opt{'debug'} > 3 ? 1 : 0 ),
3267 'select' => 'part_event.*',
3268 'table' => 'part_event',
3269 'addl_from' => "$cross $join",
3270 'hashref' => { 'check_freq' => ( $opt{'check_freq'} || '1d' ),
3271 'eventtable' => $eventtable,
3274 'extra_sql' => "AND $cross_where $extra_sql",
3278 my $pkey = $object->primary_key;
3279 warn " ". scalar(@part_event).
3280 " possible events found for $eventtable ". $object->$pkey(). "\n";
3283 push @e_cust_event, map { $_->new_cust_event($object) } @part_event;
3287 warn " ". scalar(@e_cust_event).
3288 " subtotal possible cust events found for $eventtable\n"
3291 push @cust_event, @e_cust_event;
3295 warn " ". scalar(@cust_event).
3296 " total possible cust events found in initial search\n"
3300 # 2: test conditions
3305 @cust_event = grep $_->test_conditions( 'time' => $opt{'time'},
3306 'stats_hashref' => \%unsat ),
3309 warn " ". scalar(@cust_event). " cust events left satisfying conditions\n"
3312 warn " invalid conditions not eliminated with condition_sql:\n".
3313 join('', map " $_: ".$unsat{$_}."\n", keys %unsat )
3320 unless( $opt{testonly} ) {
3321 foreach my $cust_event ( @cust_event ) {
3323 my $error = $cust_event->insert();
3325 $dbh->rollback if $oldAutoCommit;
3332 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3338 warn " returning events: ". Dumper(@cust_event). "\n"
3345 =item retry_realtime
3347 Schedules realtime / batch credit card / electronic check / LEC billing
3348 events for for retry. Useful if card information has changed or manual
3349 retry is desired. The 'collect' method must be called to actually retry
3352 Implementation details: For either this customer, or for each of this
3353 customer's open invoices, changes the status of the first "done" (with
3354 statustext error) realtime processing event to "failed".
3358 sub retry_realtime {
3361 local $SIG{HUP} = 'IGNORE';
3362 local $SIG{INT} = 'IGNORE';
3363 local $SIG{QUIT} = 'IGNORE';
3364 local $SIG{TERM} = 'IGNORE';
3365 local $SIG{TSTP} = 'IGNORE';
3366 local $SIG{PIPE} = 'IGNORE';
3368 my $oldAutoCommit = $FS::UID::AutoCommit;
3369 local $FS::UID::AutoCommit = 0;
3372 #a little false laziness w/due_cust_event (not too bad, really)
3374 my $join = FS::part_event_condition->join_conditions_sql;
3375 my $order = FS::part_event_condition->order_conditions_sql;
3378 . join ( ' OR ' , map {
3379 "( part_event.eventtable = " . dbh->quote($_)
3380 . " AND tablenum IN( SELECT " . dbdef->table($_)->primary_key . " from $_ where custnum = " . dbh->quote( $self->custnum ) . "))" ;
3381 } FS::part_event->eventtables)
3384 #here is the agent virtualization
3385 my $agent_virt = " ( part_event.agentnum IS NULL
3386 OR part_event.agentnum = ". $self->agentnum. ' )';
3388 #XXX this shouldn't be hardcoded, actions should declare it...
3389 my @realtime_events = qw(
3390 cust_bill_realtime_card
3391 cust_bill_realtime_check
3392 cust_bill_realtime_lec
3396 my $is_realtime_event = ' ( '. join(' OR ', map "part_event.action = '$_'",
3401 my @cust_event = qsearchs({
3402 'table' => 'cust_event',
3403 'select' => 'cust_event.*',
3404 'addl_from' => "LEFT JOIN part_event USING ( eventpart ) $join",
3405 'hashref' => { 'status' => 'done' },
3406 'extra_sql' => " AND statustext IS NOT NULL AND statustext != '' ".
3407 " AND $mine AND $is_realtime_event AND $agent_virt $order" # LIMIT 1"
3410 my %seen_invnum = ();
3411 foreach my $cust_event (@cust_event) {
3413 #max one for the customer, one for each open invoice
3414 my $cust_X = $cust_event->cust_X;
3415 next if $seen_invnum{ $cust_event->part_event->eventtable eq 'cust_bill'
3419 or $cust_event->part_event->eventtable eq 'cust_bill'
3422 my $error = $cust_event->retry;
3424 $dbh->rollback if $oldAutoCommit;
3425 return "error scheduling event for retry: $error";
3430 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3435 # some horrid false laziness here to avoid refactor fallout
3436 # eventually realtime realtime_bop and realtime_refund_bop should go
3437 # away and be replaced by _new_realtime_bop and _new_realtime_refund_bop
3439 =item realtime_bop METHOD AMOUNT [ OPTION => VALUE ... ]
3441 Runs a realtime credit card, ACH (electronic check) or phone bill transaction
3442 via a Business::OnlinePayment realtime gateway. See
3443 L<http://420.am/business-onlinepayment> for supported gateways.
3445 Available methods are: I<CC>, I<ECHECK> and I<LEC>
3447 Available options are: I<description>, I<invnum>, I<quiet>, I<paynum_ref>, I<payunique>
3449 The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
3450 I<zip>, I<payinfo> and I<paydate> are also available. Any of these options,
3451 if set, will override the value from the customer record.
3453 I<description> is a free-text field passed to the gateway. It defaults to
3454 "Internet services".
3456 If an I<invnum> is specified, this payment (if successful) is applied to the
3457 specified invoice. If you don't specify an I<invnum> you might want to
3458 call the B<apply_payments> method.
3460 I<quiet> can be set true to surpress email decline notices.
3462 I<paynum_ref> can be set to a scalar reference. It will be filled in with the
3463 resulting paynum, if any.
3465 I<payunique> is a unique identifier for this payment.
3467 (moved from cust_bill) (probably should get realtime_{card,ach,lec} here too)
3474 return $self->_new_realtime_bop(@_)
3475 if $self->_new_bop_required();
3477 my( $method, $amount, %options ) = @_;
3479 warn "$me realtime_bop: $method $amount\n";
3480 warn " $_ => $options{$_}\n" foreach keys %options;
3483 $options{'description'} ||= 'Internet services';
3485 return $self->fake_bop($method, $amount, %options) if $options{'fake'};
3487 eval "use Business::OnlinePayment";
3490 my $payinfo = exists($options{'payinfo'})
3491 ? $options{'payinfo'}
3494 my %method2payby = (
3501 # check for banned credit card/ACH
3504 my $ban = qsearchs('banned_pay', {
3505 'payby' => $method2payby{$method},
3506 'payinfo' => md5_base64($payinfo),
3508 return "Banned credit card" if $ban;
3511 # set taxclass and trans_is_recur based on invnum if there is one
3515 my $trans_is_recur = 0;
3516 if ( $options{'invnum'} ) {
3518 my $cust_bill = qsearchs('cust_bill', { 'invnum' => $options{'invnum'} } );
3519 die "invnum ". $options{'invnum'}. " not found" unless $cust_bill;
3522 map { $_->part_pkg }
3524 map { $_->cust_pkg }
3525 $cust_bill->cust_bill_pkg;
3527 my @taxclasses = map $_->taxclass, @part_pkg;
3528 $taxclass = $taxclasses[0]
3529 unless grep { $taxclasses[0] ne $_ } @taxclasses; #unless there are
3530 #different taxclasses
3532 if grep { $_->freq ne '0' } @part_pkg;
3540 #look for an agent gateway override first
3542 if ( $method eq 'CC' ) {
3543 $cardtype = cardtype($payinfo);
3544 } elsif ( $method eq 'ECHECK' ) {
3547 $cardtype = $method;
3551 qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
3552 cardtype => $cardtype,
3553 taxclass => $taxclass, } )
3554 || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
3556 taxclass => $taxclass, } )
3557 || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
3558 cardtype => $cardtype,
3560 || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
3562 taxclass => '', } );
3564 my $payment_gateway = '';
3565 my( $processor, $login, $password, $action, @bop_options );
3566 if ( $override ) { #use a payment gateway override
3568 $payment_gateway = $override->payment_gateway;
3570 $processor = $payment_gateway->gateway_module;
3571 $login = $payment_gateway->gateway_username;
3572 $password = $payment_gateway->gateway_password;
3573 $action = $payment_gateway->gateway_action;
3574 @bop_options = $payment_gateway->options;
3576 } else { #use the standard settings from the config
3578 ( $processor, $login, $password, $action, @bop_options ) =
3579 $self->default_payment_gateway($method);
3587 my $address = exists($options{'address1'})
3588 ? $options{'address1'}
3590 my $address2 = exists($options{'address2'})
3591 ? $options{'address2'}
3593 $address .= ", ". $address2 if length($address2);
3595 my $o_payname = exists($options{'payname'})
3596 ? $options{'payname'}
3598 my($payname, $payfirst, $paylast);
3599 if ( $o_payname && $method ne 'ECHECK' ) {
3600 ($payname = $o_payname) =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
3601 or return "Illegal payname $payname";
3602 ($payfirst, $paylast) = ($1, $2);
3604 $payfirst = $self->getfield('first');
3605 $paylast = $self->getfield('last');
3606 $payname = "$payfirst $paylast";
3609 my @invoicing_list = $self->invoicing_list_emailonly;
3610 if ( $conf->exists('emailinvoiceautoalways')
3611 || $conf->exists('emailinvoiceauto') && ! @invoicing_list
3612 || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
3613 push @invoicing_list, $self->all_emails;
3616 my $email = ($conf->exists('business-onlinepayment-email-override'))
3617 ? $conf->config('business-onlinepayment-email-override')
3618 : $invoicing_list[0];
3622 my $payip = exists($options{'payip'})
3625 $content{customer_ip} = $payip
3628 $content{invoice_number} = $options{'invnum'}
3629 if exists($options{'invnum'}) && length($options{'invnum'});
3631 $content{email_customer} =
3632 ( $conf->exists('business-onlinepayment-email_customer')
3633 || $conf->exists('business-onlinepayment-email-override') );
3636 if ( $method eq 'CC' ) {
3638 $content{card_number} = $payinfo;
3639 $paydate = exists($options{'paydate'})
3640 ? $options{'paydate'}
3642 $paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
3643 $content{expiration} = "$2/$1";
3645 my $paycvv = exists($options{'paycvv'})
3646 ? $options{'paycvv'}
3648 $content{cvv2} = $paycvv
3651 my $paystart_month = exists($options{'paystart_month'})
3652 ? $options{'paystart_month'}
3653 : $self->paystart_month;
3655 my $paystart_year = exists($options{'paystart_year'})
3656 ? $options{'paystart_year'}
3657 : $self->paystart_year;
3659 $content{card_start} = "$paystart_month/$paystart_year"
3660 if $paystart_month && $paystart_year;
3662 my $payissue = exists($options{'payissue'})
3663 ? $options{'payissue'}
3665 $content{issue_number} = $payissue if $payissue;
3667 if ( $self->_bop_recurring_billing( 'payinfo' => $payinfo,
3668 'trans_is_recur' => $trans_is_recur,
3672 $content{recurring_billing} = 'YES';
3673 $content{acct_code} = 'rebill'
3674 if $conf->exists('credit_card-recurring_billing_acct_code');
3677 } elsif ( $method eq 'ECHECK' ) {
3678 ( $content{account_number}, $content{routing_code} ) =
3679 split('@', $payinfo);
3680 $content{bank_name} = $o_payname;
3681 $content{bank_state} = exists($options{'paystate'})
3682 ? $options{'paystate'}
3683 : $self->getfield('paystate');
3684 $content{account_type} = exists($options{'paytype'})
3685 ? uc($options{'paytype'}) || 'CHECKING'
3686 : uc($self->getfield('paytype')) || 'CHECKING';
3687 $content{account_name} = $payname;
3688 $content{customer_org} = $self->company ? 'B' : 'I';
3689 $content{state_id} = exists($options{'stateid'})
3690 ? $options{'stateid'}
3691 : $self->getfield('stateid');
3692 $content{state_id_state} = exists($options{'stateid_state'})
3693 ? $options{'stateid_state'}
3694 : $self->getfield('stateid_state');
3695 $content{customer_ssn} = exists($options{'ss'})
3698 } elsif ( $method eq 'LEC' ) {
3699 $content{phone} = $payinfo;
3703 # run transaction(s)
3706 my $balance = exists( $options{'balance'} )
3707 ? $options{'balance'}
3710 $self->select_for_update; #mutex ... just until we get our pending record in
3712 #the checks here are intended to catch concurrent payments
3713 #double-form-submission prevention is taken care of in cust_pay_pending::check
3716 return "The customer's balance has changed; $method transaction aborted."
3717 if $self->balance < $balance;
3718 #&& $self->balance < $amount; #might as well anyway?
3720 #also check and make sure there aren't *other* pending payments for this cust
3722 my @pending = qsearch('cust_pay_pending', {
3723 'custnum' => $self->custnum,
3724 'status' => { op=>'!=', value=>'done' }
3726 return "A payment is already being processed for this customer (".
3727 join(', ', map 'paypendingnum '. $_->paypendingnum, @pending ).
3728 "); $method transaction aborted."
3729 if scalar(@pending);
3731 #okay, good to go, if we're a duplicate, cust_pay_pending will kick us out
3733 my $cust_pay_pending = new FS::cust_pay_pending {
3734 'custnum' => $self->custnum,
3735 #'invnum' => $options{'invnum'},
3738 'payby' => $method2payby{$method},
3739 'payinfo' => $payinfo,
3740 'paydate' => $paydate,
3741 'recurring_billing' => $content{recurring_billing},
3743 'gatewaynum' => ( $payment_gateway ? $payment_gateway->gatewaynum : '' ),
3745 $cust_pay_pending->payunique( $options{payunique} )
3746 if defined($options{payunique}) && length($options{payunique});
3747 my $cpp_new_err = $cust_pay_pending->insert; #mutex lost when this is inserted
3748 return $cpp_new_err if $cpp_new_err;
3750 my( $action1, $action2 ) = split(/\s*\,\s*/, $action );
3752 my $transaction = new Business::OnlinePayment( $processor, @bop_options );
3753 $transaction->content(
3756 'password' => $password,
3757 'action' => $action1,
3758 'description' => $options{'description'},
3759 'amount' => $amount,
3760 #'invoice_number' => $options{'invnum'},
3761 'customer_id' => $self->custnum,
3762 'last_name' => $paylast,
3763 'first_name' => $payfirst,
3765 'address' => $address,
3766 'city' => ( exists($options{'city'})
3769 'state' => ( exists($options{'state'})
3772 'zip' => ( exists($options{'zip'})
3775 'country' => ( exists($options{'country'})
3776 ? $options{'country'}
3778 'referer' => 'http://cleanwhisker.420.am/', #XXX fix referer :/
3780 'phone' => $self->daytime || $self->night,
3784 $cust_pay_pending->status('pending');
3785 my $cpp_pending_err = $cust_pay_pending->replace;
3786 return $cpp_pending_err if $cpp_pending_err;
3789 my $BOP_TESTING = 0;
3790 my $BOP_TESTING_SUCCESS = 1;
3792 unless ( $BOP_TESTING ) {
3793 $transaction->submit();
3795 if ( $BOP_TESTING_SUCCESS ) {
3796 $transaction->is_success(1);
3797 $transaction->authorization('fake auth');
3799 $transaction->is_success(0);
3800 $transaction->error_message('fake failure');
3804 if ( $transaction->is_success() && $action2 ) {
3806 $cust_pay_pending->status('authorized');
3807 my $cpp_authorized_err = $cust_pay_pending->replace;
3808 return $cpp_authorized_err if $cpp_authorized_err;
3810 my $auth = $transaction->authorization;
3811 my $ordernum = $transaction->can('order_number')
3812 ? $transaction->order_number
3816 new Business::OnlinePayment( $processor, @bop_options );
3823 password => $password,
3824 order_number => $ordernum,
3826 authorization => $auth,
3827 description => $options{'description'},
3830 foreach my $field (qw( authorization_source_code returned_ACI
3831 transaction_identifier validation_code
3832 transaction_sequence_num local_transaction_date
3833 local_transaction_time AVS_result_code )) {
3834 $capture{$field} = $transaction->$field() if $transaction->can($field);
3837 $capture->content( %capture );
3841 unless ( $capture->is_success ) {
3842 my $e = "Authorization successful but capture failed, custnum #".
3843 $self->custnum. ': '. $capture->result_code.
3844 ": ". $capture->error_message;
3851 $cust_pay_pending->status($transaction->is_success() ? 'captured' : 'declined');
3852 my $cpp_captured_err = $cust_pay_pending->replace;
3853 return $cpp_captured_err if $cpp_captured_err;
3856 # remove paycvv after initial transaction
3859 #false laziness w/misc/process/payment.cgi - check both to make sure working
3861 if ( defined $self->dbdef_table->column('paycvv')
3862 && length($self->paycvv)
3863 && ! grep { $_ eq cardtype($payinfo) } $conf->config('cvv-save')
3865 my $error = $self->remove_cvv;
3867 warn "WARNING: error removing cvv: $error\n";
3875 if ( $transaction->is_success() ) {
3878 if ( $payment_gateway ) { # agent override
3879 $paybatch = $payment_gateway->gatewaynum. '-';
3882 $paybatch .= "$processor:". $transaction->authorization;
3884 $paybatch .= ':'. $transaction->order_number
3885 if $transaction->can('order_number')
3886 && length($transaction->order_number);
3888 my $cust_pay = new FS::cust_pay ( {
3889 'custnum' => $self->custnum,
3890 'invnum' => $options{'invnum'},
3893 'payby' => $method2payby{$method},
3894 'payinfo' => $payinfo,
3895 'paybatch' => $paybatch,
3896 'paydate' => $paydate,
3898 #doesn't hurt to know, even though the dup check is in cust_pay_pending now
3899 $cust_pay->payunique( $options{payunique} )
3900 if defined($options{payunique}) && length($options{payunique});
3902 my $oldAutoCommit = $FS::UID::AutoCommit;
3903 local $FS::UID::AutoCommit = 0;
3906 #start a transaction, insert the cust_pay and set cust_pay_pending.status to done in a single transction
3908 my $error = $cust_pay->insert($options{'manual'} ? ( 'manual' => 1 ) : () );
3911 $cust_pay->invnum(''); #try again with no specific invnum
3912 my $error2 = $cust_pay->insert( $options{'manual'} ?
3913 ( 'manual' => 1 ) : ()
3916 # gah. but at least we have a record of the state we had to abort in
3917 # from cust_pay_pending now.
3918 my $e = "WARNING: $method captured but payment not recorded - ".
3919 "error inserting payment ($processor): $error2".
3920 " (previously tried insert with invnum #$options{'invnum'}" .
3921 ": $error ) - pending payment saved as paypendingnum ".
3922 $cust_pay_pending->paypendingnum. "\n";
3928 if ( $options{'paynum_ref'} ) {
3929 ${ $options{'paynum_ref'} } = $cust_pay->paynum;
3932 $cust_pay_pending->status('done');
3933 $cust_pay_pending->statustext('captured');
3934 $cust_pay_pending->paynum($cust_pay->paynum);
3935 my $cpp_done_err = $cust_pay_pending->replace;
3937 if ( $cpp_done_err ) {
3939 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
3940 my $e = "WARNING: $method captured but payment not recorded - ".
3941 "error updating status for paypendingnum ".
3942 $cust_pay_pending->paypendingnum. ": $cpp_done_err \n";
3948 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3949 return ''; #no error
3955 my $perror = "$processor error: ". $transaction->error_message;
3957 unless ( $transaction->error_message ) {
3960 if ( $transaction->can('response_page') ) {
3962 'page' => ( $transaction->can('response_page')
3963 ? $transaction->response_page
3966 'code' => ( $transaction->can('response_code')
3967 ? $transaction->response_code
3970 'headers' => ( $transaction->can('response_headers')
3971 ? $transaction->response_headers
3977 "No additional debugging information available for $processor";
3980 $perror .= "No error_message returned from $processor -- ".
3981 ( ref($t_response) ? Dumper($t_response) : $t_response );
3985 if ( !$options{'quiet'} && !$realtime_bop_decline_quiet
3986 && $conf->exists('emaildecline')
3987 && grep { $_ ne 'POST' } $self->invoicing_list
3988 && ! grep { $transaction->error_message =~ /$_/ }
3989 $conf->config('emaildecline-exclude')
3991 my @templ = $conf->config('declinetemplate');
3992 my $template = new Text::Template (
3994 SOURCE => [ map "$_\n", @templ ],
3995 ) or return "($perror) can't create template: $Text::Template::ERROR";
3996 $template->compile()
3997 or return "($perror) can't compile template: $Text::Template::ERROR";
3999 my $templ_hash = { error => $transaction->error_message };
4001 my $error = send_email(
4002 'from' => $conf->config('invoice_from', $self->agentnum ),
4003 'to' => [ grep { $_ ne 'POST' } $self->invoicing_list ],
4004 'subject' => 'Your payment could not be processed',
4005 'body' => [ $template->fill_in(HASH => $templ_hash) ],
4008 $perror .= " (also received error sending decline notification: $error)"
4013 $cust_pay_pending->status('done');
4014 $cust_pay_pending->statustext("declined: $perror");
4015 my $cpp_done_err = $cust_pay_pending->replace;
4016 if ( $cpp_done_err ) {
4017 my $e = "WARNING: $method declined but pending payment not resolved - ".
4018 "error updating status for paypendingnum ".
4019 $cust_pay_pending->paypendingnum. ": $cpp_done_err \n";
4021 $perror = "$e ($perror)";
4029 sub _bop_recurring_billing {
4030 my( $self, %opt ) = @_;
4032 my $method = $conf->config('credit_card-recurring_billing_flag');
4034 if ( $method eq 'transaction_is_recur' ) {
4036 return 1 if $opt{'trans_is_recur'};
4040 my %hash = ( 'custnum' => $self->custnum,
4045 if qsearch('cust_pay', { %hash, 'payinfo' => $opt{'payinfo'} } )
4046 || qsearch('cust_pay', { %hash, 'paymask' => $self->mask_payinfo('CARD',
4057 =item realtime_refund_bop METHOD [ OPTION => VALUE ... ]
4059 Refunds a realtime credit card, ACH (electronic check) or phone bill transaction
4060 via a Business::OnlinePayment realtime gateway. See
4061 L<http://420.am/business-onlinepayment> for supported gateways.
4063 Available methods are: I<CC>, I<ECHECK> and I<LEC>
4065 Available options are: I<amount>, I<reason>, I<paynum>, I<paydate>
4067 Most gateways require a reference to an original payment transaction to refund,
4068 so you probably need to specify a I<paynum>.
4070 I<amount> defaults to the original amount of the payment if not specified.
4072 I<reason> specifies a reason for the refund.
4074 I<paydate> specifies the expiration date for a credit card overriding the
4075 value from the customer record or the payment record. Specified as yyyy-mm-dd
4077 Implementation note: If I<amount> is unspecified or equal to the amount of the
4078 orignal payment, first an attempt is made to "void" the transaction via
4079 the gateway (to cancel a not-yet settled transaction) and then if that fails,
4080 the normal attempt is made to "refund" ("credit") the transaction via the
4081 gateway is attempted.
4083 #The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
4084 #I<zip>, I<payinfo> and I<paydate> are also available. Any of these options,
4085 #if set, will override the value from the customer record.
4087 #If an I<invnum> is specified, this payment (if successful) is applied to the
4088 #specified invoice. If you don't specify an I<invnum> you might want to
4089 #call the B<apply_payments> method.
4093 #some false laziness w/realtime_bop, not enough to make it worth merging
4094 #but some useful small subs should be pulled out
4095 sub realtime_refund_bop {
4098 return $self->_new_realtime_refund_bop(@_)
4099 if $self->_new_bop_required();
4101 my( $method, %options ) = @_;
4103 warn "$me realtime_refund_bop: $method refund\n";
4104 warn " $_ => $options{$_}\n" foreach keys %options;
4107 eval "use Business::OnlinePayment";
4111 # look up the original payment and optionally a gateway for that payment
4115 my $amount = $options{'amount'};
4117 my( $processor, $login, $password, @bop_options ) ;
4118 my( $auth, $order_number ) = ( '', '', '' );
4120 if ( $options{'paynum'} ) {
4122 warn " paynum: $options{paynum}\n" if $DEBUG > 1;
4123 $cust_pay = qsearchs('cust_pay', { paynum=>$options{'paynum'} } )
4124 or return "Unknown paynum $options{'paynum'}";
4125 $amount ||= $cust_pay->paid;
4127 $cust_pay->paybatch =~ /^((\d+)\-)?(\w+):\s*([\w\-\/ ]*)(:([\w\-]+))?$/
4128 or return "Can't parse paybatch for paynum $options{'paynum'}: ".
4129 $cust_pay->paybatch;
4130 my $gatewaynum = '';
4131 ( $gatewaynum, $processor, $auth, $order_number ) = ( $2, $3, $4, $6 );
4133 if ( $gatewaynum ) { #gateway for the payment to be refunded
4135 my $payment_gateway =
4136 qsearchs('payment_gateway', { 'gatewaynum' => $gatewaynum } );
4137 die "payment gateway $gatewaynum not found"
4138 unless $payment_gateway;
4140 $processor = $payment_gateway->gateway_module;
4141 $login = $payment_gateway->gateway_username;
4142 $password = $payment_gateway->gateway_password;
4143 @bop_options = $payment_gateway->options;
4145 } else { #try the default gateway
4147 my( $conf_processor, $unused_action );
4148 ( $conf_processor, $login, $password, $unused_action, @bop_options ) =
4149 $self->default_payment_gateway($method);
4151 return "processor of payment $options{'paynum'} $processor does not".
4152 " match default processor $conf_processor"
4153 unless $processor eq $conf_processor;
4158 } else { # didn't specify a paynum, so look for agent gateway overrides
4159 # like a normal transaction
4162 if ( $method eq 'CC' ) {
4163 $cardtype = cardtype($self->payinfo);
4164 } elsif ( $method eq 'ECHECK' ) {
4167 $cardtype = $method;
4170 qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
4171 cardtype => $cardtype,
4173 || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
4175 taxclass => '', } );
4177 if ( $override ) { #use a payment gateway override
4179 my $payment_gateway = $override->payment_gateway;
4181 $processor = $payment_gateway->gateway_module;
4182 $login = $payment_gateway->gateway_username;
4183 $password = $payment_gateway->gateway_password;
4184 #$action = $payment_gateway->gateway_action;
4185 @bop_options = $payment_gateway->options;
4187 } else { #use the standard settings from the config
4190 ( $processor, $login, $password, $unused_action, @bop_options ) =
4191 $self->default_payment_gateway($method);
4196 return "neither amount nor paynum specified" unless $amount;
4201 'password' => $password,
4202 'order_number' => $order_number,
4203 'amount' => $amount,
4204 'referer' => 'http://cleanwhisker.420.am/', #XXX fix referer :/
4206 $content{authorization} = $auth
4207 if length($auth); #echeck/ACH transactions have an order # but no auth
4208 #(at least with authorize.net)
4210 my $disable_void_after;
4211 if ($conf->exists('disable_void_after')
4212 && $conf->config('disable_void_after') =~ /^(\d+)$/) {
4213 $disable_void_after = $1;
4216 #first try void if applicable
4217 if ( $cust_pay && $cust_pay->paid == $amount
4219 ( not defined($disable_void_after) )
4220 || ( time < ($cust_pay->_date + $disable_void_after ) )
4223 warn " attempting void\n" if $DEBUG > 1;
4224 my $void = new Business::OnlinePayment( $processor, @bop_options );
4225 $void->content( 'action' => 'void', %content );
4227 if ( $void->is_success ) {
4228 my $error = $cust_pay->void($options{'reason'});
4230 # gah, even with transactions.
4231 my $e = 'WARNING: Card/ACH voided but database not updated - '.
4232 "error voiding payment: $error";
4236 warn " void successful\n" if $DEBUG > 1;
4241 warn " void unsuccessful, trying refund\n"
4245 my $address = $self->address1;
4246 $address .= ", ". $self->address2 if $self->address2;
4248 my($payname, $payfirst, $paylast);
4249 if ( $self->payname && $method ne 'ECHECK' ) {
4250 $payname = $self->payname;
4251 $payname =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
4252 or return "Illegal payname $payname";
4253 ($payfirst, $paylast) = ($1, $2);
4255 $payfirst = $self->getfield('first');
4256 $paylast = $self->getfield('last');
4257 $payname = "$payfirst $paylast";
4260 my @invoicing_list = $self->invoicing_list_emailonly;
4261 if ( $conf->exists('emailinvoiceautoalways')
4262 || $conf->exists('emailinvoiceauto') && ! @invoicing_list
4263 || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
4264 push @invoicing_list, $self->all_emails;
4267 my $email = ($conf->exists('business-onlinepayment-email-override'))
4268 ? $conf->config('business-onlinepayment-email-override')
4269 : $invoicing_list[0];
4271 my $payip = exists($options{'payip'})
4274 $content{customer_ip} = $payip
4278 if ( $method eq 'CC' ) {
4281 $content{card_number} = $payinfo = $cust_pay->payinfo;
4282 (exists($options{'paydate'}) ? $options{'paydate'} : $cust_pay->paydate)
4283 =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/ &&
4284 ($content{expiration} = "$2/$1"); # where available
4286 $content{card_number} = $payinfo = $self->payinfo;
4287 (exists($options{'paydate'}) ? $options{'paydate'} : $self->paydate)
4288 =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
4289 $content{expiration} = "$2/$1";
4292 } elsif ( $method eq 'ECHECK' ) {
4295 $payinfo = $cust_pay->payinfo;
4297 $payinfo = $self->payinfo;
4299 ( $content{account_number}, $content{routing_code} )= split('@', $payinfo );
4300 $content{bank_name} = $self->payname;
4301 $content{account_type} = 'CHECKING';
4302 $content{account_name} = $payname;
4303 $content{customer_org} = $self->company ? 'B' : 'I';
4304 $content{customer_ssn} = $self->ss;
4305 } elsif ( $method eq 'LEC' ) {
4306 $content{phone} = $payinfo = $self->payinfo;
4310 my $refund = new Business::OnlinePayment( $processor, @bop_options );
4311 my %sub_content = $refund->content(
4312 'action' => 'credit',
4313 'customer_id' => $self->custnum,
4314 'last_name' => $paylast,
4315 'first_name' => $payfirst,
4317 'address' => $address,
4318 'city' => $self->city,
4319 'state' => $self->state,
4320 'zip' => $self->zip,
4321 'country' => $self->country,
4323 'phone' => $self->daytime || $self->night,
4326 warn join('', map { " $_ => $sub_content{$_}\n" } keys %sub_content )
4330 return "$processor error: ". $refund->error_message
4331 unless $refund->is_success();
4333 my %method2payby = (
4339 my $paybatch = "$processor:". $refund->authorization;
4340 $paybatch .= ':'. $refund->order_number
4341 if $refund->can('order_number') && $refund->order_number;
4343 while ( $cust_pay && $cust_pay->unapplied < $amount ) {
4344 my @cust_bill_pay = $cust_pay->cust_bill_pay;
4345 last unless @cust_bill_pay;
4346 my $cust_bill_pay = pop @cust_bill_pay;
4347 my $error = $cust_bill_pay->delete;
4351 my $cust_refund = new FS::cust_refund ( {
4352 'custnum' => $self->custnum,
4353 'paynum' => $options{'paynum'},
4354 'refund' => $amount,
4356 'payby' => $method2payby{$method},
4357 'payinfo' => $payinfo,
4358 'paybatch' => $paybatch,
4359 'reason' => $options{'reason'} || 'card or ACH refund',
4361 my $error = $cust_refund->insert;
4363 $cust_refund->paynum(''); #try again with no specific paynum
4364 my $error2 = $cust_refund->insert;
4366 # gah, even with transactions.
4367 my $e = 'WARNING: Card/ACH refunded but database not updated - '.
4368 "error inserting refund ($processor): $error2".
4369 " (previously tried insert with paynum #$options{'paynum'}" .
4380 # does the configuration indicate the new bop routines are required?
4382 sub _new_bop_required {
4385 my $botpp = 'Business::OnlineThirdPartyPayment';
4388 if ( $conf->config('business-onlinepayment-namespace') eq $botpp ||
4389 scalar( grep { $_->gateway_namespace eq $botpp }
4390 qsearch( 'payment_gateway', { 'disabled' => '' } )
4399 =item realtime_collect [ OPTION => VALUE ... ]
4401 Runs a realtime credit card, ACH (electronic check) or phone bill transaction
4402 via a Business::OnlinePayment or Business::OnlineThirdPartyPayment realtime
4403 gateway. See L<http://420.am/business-onlinepayment> and
4404 L<http://420.am/business-onlinethirdpartypayment> for supported gateways.
4406 On failure returns an error message.
4408 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.
4410 Available options are: I<method>, I<amount>, I<description>, I<invnum>, I<quiet>, I<paynum_ref>, I<payunique>, I<session_id>
4412 I<method> is one of: I<CC>, I<ECHECK> and I<LEC>. If none is specified
4413 then it is deduced from the customer record.
4415 If no I<amount> is specified, then the customer balance is used.
4417 The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
4418 I<zip>, I<payinfo> and I<paydate> are also available. Any of these options,
4419 if set, will override the value from the customer record.
4421 I<description> is a free-text field passed to the gateway. It defaults to
4422 "Internet services".
4424 If an I<invnum> is specified, this payment (if successful) is applied to the
4425 specified invoice. If you don't specify an I<invnum> you might want to
4426 call the B<apply_payments> method.
4428 I<quiet> can be set true to surpress email decline notices.
4430 I<paynum_ref> can be set to a scalar reference. It will be filled in with the
4431 resulting paynum, if any.
4433 I<payunique> is a unique identifier for this payment.
4435 I<session_id> is a session identifier associated with this payment.
4437 I<depend_jobnum> allows payment capture to unlock export jobs
4441 sub realtime_collect {
4442 my( $self, %options ) = @_;
4445 warn "$me realtime_collect:\n";
4446 warn " $_ => $options{$_}\n" foreach keys %options;
4449 $options{amount} = $self->balance unless exists( $options{amount} );
4450 $options{method} = FS::payby->payby2bop($self->payby)
4451 unless exists( $options{method} );
4453 return $self->realtime_bop({%options});
4457 =item _realtime_bop { [ ARG => VALUE ... ] }
4459 Runs a realtime credit card, ACH (electronic check) or phone bill transaction
4460 via a Business::OnlinePayment realtime gateway. See
4461 L<http://420.am/business-onlinepayment> for supported gateways.
4463 Required arguments in the hashref are I<method>, and I<amount>
4465 Available methods are: I<CC>, I<ECHECK> and I<LEC>
4467 Available optional arguments are: I<description>, I<invnum>, I<quiet>, I<paynum_ref>, I<payunique>, I<session_id>
4469 The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
4470 I<zip>, I<payinfo> and I<paydate> are also available. Any of these options,
4471 if set, will override the value from the customer record.
4473 I<description> is a free-text field passed to the gateway. It defaults to
4474 "Internet services".
4476 If an I<invnum> is specified, this payment (if successful) is applied to the
4477 specified invoice. If you don't specify an I<invnum> you might want to
4478 call the B<apply_payments> method.
4480 I<quiet> can be set true to surpress email decline notices.
4482 I<paynum_ref> can be set to a scalar reference. It will be filled in with the
4483 resulting paynum, if any.
4485 I<payunique> is a unique identifier for this payment.
4487 I<session_id> is a session identifier associated with this payment.
4489 I<depend_jobnum> allows payment capture to unlock export jobs
4491 (moved from cust_bill) (probably should get realtime_{card,ach,lec} here too)
4495 # some helper routines
4496 sub _payment_gateway {
4497 my ($self, $options) = @_;
4499 $options->{payment_gateway} = $self->agent->payment_gateway( %$options )
4500 unless exists($options->{payment_gateway});
4502 $options->{payment_gateway};
4506 my ($self, $options) = @_;
4509 'login' => $options->{payment_gateway}->gateway_username,
4510 'password' => $options->{payment_gateway}->gateway_password,
4515 my ($self, $options) = @_;
4517 $options->{payment_gateway}->gatewaynum
4518 ? $options->{payment_gateway}->options
4519 : @{ $options->{payment_gateway}->get('options') };
4523 my ($self, $options) = @_;
4525 $options->{description} ||= 'Internet services';
4526 $options->{payinfo} = $self->payinfo unless exists( $options->{payinfo} );
4527 $options->{invnum} ||= '';
4528 $options->{payname} = $self->payname unless exists( $options->{payname} );
4532 my ($self, $options) = @_;
4535 $content{address} = exists($options->{'address1'})
4536 ? $options->{'address1'}
4538 my $address2 = exists($options->{'address2'})
4539 ? $options->{'address2'}
4541 $content{address} .= ", ". $address2 if length($address2);
4543 my $payip = exists($options->{'payip'}) ? $options->{'payip'} : $self->payip;
4544 $content{customer_ip} = $payip if length($payip);
4546 $content{invoice_number} = $options->{'invnum'}
4547 if exists($options->{'invnum'}) && length($options->{'invnum'});
4549 $content{email_customer} =
4550 ( $conf->exists('business-onlinepayment-email_customer')
4551 || $conf->exists('business-onlinepayment-email-override') );
4553 $content{payfirst} = $self->getfield('first');
4554 $content{paylast} = $self->getfield('last');
4556 $content{account_name} = "$content{payfirst} $content{paylast}"
4557 if $options->{method} eq 'ECHECK';
4559 $content{name} = $options->{payname};
4560 $content{name} = $content{account_name} if exists($content{account_name});
4562 $content{city} = exists($options->{city})
4565 $content{state} = exists($options->{state})
4568 $content{zip} = exists($options->{zip})
4571 $content{country} = exists($options->{country})
4572 ? $options->{country}
4574 $content{referer} = 'http://cleanwhisker.420.am/'; #XXX fix referer :/
4575 $content{phone} = $self->daytime || $self->night;
4580 my %bop_method2payby = (
4586 sub _new_realtime_bop {
4590 if (ref($_[0]) eq 'HASH') {
4591 %options = %{$_[0]};
4593 my ( $method, $amount ) = ( shift, shift );
4595 $options{method} = $method;
4596 $options{amount} = $amount;
4600 warn "$me realtime_bop (new): $options{method} $options{amount}\n";
4601 warn " $_ => $options{$_}\n" foreach keys %options;
4604 return $self->fake_bop(%options) if $options{'fake'};
4606 $self->_bop_defaults(\%options);
4609 # set trans_is_recur based on invnum if there is one
4612 my $trans_is_recur = 0;
4613 if ( $options{'invnum'} ) {
4615 my $cust_bill = qsearchs('cust_bill', { 'invnum' => $options{'invnum'} } );
4616 die "invnum ". $options{'invnum'}. " not found" unless $cust_bill;
4619 map { $_->part_pkg }
4621 map { $_->cust_pkg }
4622 $cust_bill->cust_bill_pkg;
4625 if grep { $_->freq ne '0' } @part_pkg;
4633 my $payment_gateway = $self->_payment_gateway( \%options );
4634 my $namespace = $payment_gateway->gateway_namespace;
4636 eval "use $namespace";
4640 # check for banned credit card/ACH
4643 my $ban = qsearchs('banned_pay', {
4644 'payby' => $bop_method2payby{$options{method}},
4645 'payinfo' => md5_base64($options{payinfo}),
4647 return "Banned credit card" if $ban;
4653 my (%bop_content) = $self->_bop_content(\%options);
4655 if ( $options{method} ne 'ECHECK' ) {
4656 $options{payname} =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
4657 or return "Illegal payname $options{payname}";
4658 ($bop_content{payfirst}, $bop_content{paylast}) = ($1, $2);
4661 my @invoicing_list = $self->invoicing_list_emailonly;
4662 if ( $conf->exists('emailinvoiceautoalways')
4663 || $conf->exists('emailinvoiceauto') && ! @invoicing_list
4664 || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
4665 push @invoicing_list, $self->all_emails;
4668 my $email = ($conf->exists('business-onlinepayment-email-override'))
4669 ? $conf->config('business-onlinepayment-email-override')
4670 : $invoicing_list[0];
4674 if ( $namespace eq 'Business::OnlinePayment' && $options{method} eq 'CC' ) {
4676 $content{card_number} = $options{payinfo};
4677 $paydate = exists($options{'paydate'})
4678 ? $options{'paydate'}
4680 $paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
4681 $content{expiration} = "$2/$1";
4683 my $paycvv = exists($options{'paycvv'})
4684 ? $options{'paycvv'}
4686 $content{cvv2} = $paycvv
4689 my $paystart_month = exists($options{'paystart_month'})
4690 ? $options{'paystart_month'}
4691 : $self->paystart_month;
4693 my $paystart_year = exists($options{'paystart_year'})
4694 ? $options{'paystart_year'}
4695 : $self->paystart_year;
4697 $content{card_start} = "$paystart_month/$paystart_year"
4698 if $paystart_month && $paystart_year;
4700 my $payissue = exists($options{'payissue'})
4701 ? $options{'payissue'}
4703 $content{issue_number} = $payissue if $payissue;
4705 if ( $self->_bop_recurring_billing( 'payinfo' => $options{'payinfo'},
4706 'trans_is_recur' => $trans_is_recur,
4710 $content{recurring_billing} = 'YES';
4711 $content{acct_code} = 'rebill'
4712 if $conf->exists('credit_card-recurring_billing_acct_code');
4715 } elsif ( $namespace eq 'Business::OnlinePayment' && $options{method} eq 'ECHECK' ){
4716 ( $content{account_number}, $content{routing_code} ) =
4717 split('@', $options{payinfo});
4718 $content{bank_name} = $options{payname};
4719 $content{bank_state} = exists($options{'paystate'})
4720 ? $options{'paystate'}
4721 : $self->getfield('paystate');
4722 $content{account_type} = exists($options{'paytype'})
4723 ? uc($options{'paytype'}) || 'CHECKING'
4724 : uc($self->getfield('paytype')) || 'CHECKING';
4725 $content{customer_org} = $self->company ? 'B' : 'I';
4726 $content{state_id} = exists($options{'stateid'})
4727 ? $options{'stateid'}
4728 : $self->getfield('stateid');
4729 $content{state_id_state} = exists($options{'stateid_state'})
4730 ? $options{'stateid_state'}
4731 : $self->getfield('stateid_state');
4732 $content{customer_ssn} = exists($options{'ss'})
4735 } elsif ( $namespace eq 'Business::OnlinePayment' && $options{method} eq 'LEC' ) {
4736 $content{phone} = $options{payinfo};
4737 } elsif ( $namespace eq 'Business::OnlineThirdPartyPayment' ) {
4744 # run transaction(s)
4747 my $balance = exists( $options{'balance'} )
4748 ? $options{'balance'}
4751 $self->select_for_update; #mutex ... just until we get our pending record in
4753 #the checks here are intended to catch concurrent payments
4754 #double-form-submission prevention is taken care of in cust_pay_pending::check
4757 return "The customer's balance has changed; $options{method} transaction aborted."
4758 if $self->balance < $balance;
4759 #&& $self->balance < $options{amount}; #might as well anyway?
4761 #also check and make sure there aren't *other* pending payments for this cust
4763 my @pending = qsearch('cust_pay_pending', {
4764 'custnum' => $self->custnum,
4765 'status' => { op=>'!=', value=>'done' }
4767 return "A payment is already being processed for this customer (".
4768 join(', ', map 'paypendingnum '. $_->paypendingnum, @pending ).
4769 "); $options{method} transaction aborted."
4770 if scalar(@pending);
4772 #okay, good to go, if we're a duplicate, cust_pay_pending will kick us out
4774 my $cust_pay_pending = new FS::cust_pay_pending {
4775 'custnum' => $self->custnum,
4776 #'invnum' => $options{'invnum'},
4777 'paid' => $options{amount},
4779 'payby' => $bop_method2payby{$options{method}},
4780 'payinfo' => $options{payinfo},
4781 'paydate' => $paydate,
4782 'recurring_billing' => $content{recurring_billing},
4784 'gatewaynum' => $payment_gateway->gatewaynum || '',
4785 'session_id' => $options{session_id} || '',
4786 'jobnum' => $options{depend_jobnum} || '',
4788 $cust_pay_pending->payunique( $options{payunique} )
4789 if defined($options{payunique}) && length($options{payunique});
4790 my $cpp_new_err = $cust_pay_pending->insert; #mutex lost when this is inserted
4791 return $cpp_new_err if $cpp_new_err;
4793 my( $action1, $action2 ) =
4794 split( /\s*\,\s*/, $payment_gateway->gateway_action );
4796 my $transaction = new $namespace( $payment_gateway->gateway_module,
4797 $self->_bop_options(\%options),
4800 $transaction->content(
4801 'type' => $options{method},
4802 $self->_bop_auth(\%options),
4803 'action' => $action1,
4804 'description' => $options{'description'},
4805 'amount' => $options{amount},
4806 #'invoice_number' => $options{'invnum'},
4807 'customer_id' => $self->custnum,
4809 'reference' => $cust_pay_pending->paypendingnum, #for now
4814 $cust_pay_pending->status('pending');
4815 my $cpp_pending_err = $cust_pay_pending->replace;
4816 return $cpp_pending_err if $cpp_pending_err;
4819 my $BOP_TESTING = 0;
4820 my $BOP_TESTING_SUCCESS = 1;
4822 unless ( $BOP_TESTING ) {
4823 $transaction->submit();
4825 if ( $BOP_TESTING_SUCCESS ) {
4826 $transaction->is_success(1);
4827 $transaction->authorization('fake auth');
4829 $transaction->is_success(0);
4830 $transaction->error_message('fake failure');
4834 if ( $transaction->is_success() && $namespace eq 'Business::OnlineThirdPartyPayment' ) {
4836 return { reference => $cust_pay_pending->paypendingnum,
4837 map { $_ => $transaction->$_ } qw ( popup_url collectitems ) };
4839 } elsif ( $transaction->is_success() && $action2 ) {
4841 $cust_pay_pending->status('authorized');
4842 my $cpp_authorized_err = $cust_pay_pending->replace;
4843 return $cpp_authorized_err if $cpp_authorized_err;
4845 my $auth = $transaction->authorization;
4846 my $ordernum = $transaction->can('order_number')
4847 ? $transaction->order_number
4851 new Business::OnlinePayment( $payment_gateway->gateway_module,
4852 $self->_bop_options(\%options),
4857 type => $options{method},
4859 $self->_bop_auth(\%options),
4860 order_number => $ordernum,
4861 amount => $options{amount},
4862 authorization => $auth,
4863 description => $options{'description'},
4866 foreach my $field (qw( authorization_source_code returned_ACI
4867 transaction_identifier validation_code
4868 transaction_sequence_num local_transaction_date
4869 local_transaction_time AVS_result_code )) {
4870 $capture{$field} = $transaction->$field() if $transaction->can($field);
4873 $capture->content( %capture );
4877 unless ( $capture->is_success ) {
4878 my $e = "Authorization successful but capture failed, custnum #".
4879 $self->custnum. ': '. $capture->result_code.
4880 ": ". $capture->error_message;
4888 # remove paycvv after initial transaction
4891 #false laziness w/misc/process/payment.cgi - check both to make sure working
4893 if ( defined $self->dbdef_table->column('paycvv')
4894 && length($self->paycvv)
4895 && ! grep { $_ eq cardtype($options{payinfo}) } $conf->config('cvv-save')
4897 my $error = $self->remove_cvv;
4899 warn "WARNING: error removing cvv: $error\n";
4907 $self->_realtime_bop_result( $cust_pay_pending, $transaction, %options );
4919 if (ref($_[0]) eq 'HASH') {
4920 %options = %{$_[0]};
4922 my ( $method, $amount ) = ( shift, shift );
4924 $options{method} = $method;
4925 $options{amount} = $amount;
4928 if ( $options{'fake_failure'} ) {
4929 return "Error: No error; test failure requested with fake_failure";
4933 #if ( $payment_gateway->gatewaynum ) { # agent override
4934 # $paybatch = $payment_gateway->gatewaynum. '-';
4937 #$paybatch .= "$processor:". $transaction->authorization;
4939 #$paybatch .= ':'. $transaction->order_number
4940 # if $transaction->can('order_number')
4941 # && length($transaction->order_number);
4943 my $paybatch = 'FakeProcessor:54:32';
4945 my $cust_pay = new FS::cust_pay ( {
4946 'custnum' => $self->custnum,
4947 'invnum' => $options{'invnum'},
4948 'paid' => $options{amount},
4950 'payby' => $bop_method2payby{$options{method}},
4951 #'payinfo' => $payinfo,
4952 'payinfo' => '4111111111111111',
4953 'paybatch' => $paybatch,
4954 #'paydate' => $paydate,
4955 'paydate' => '2012-05-01',
4957 $cust_pay->payunique( $options{payunique} ) if length($options{payunique});
4959 my $error = $cust_pay->insert($options{'manual'} ? ( 'manual' => 1 ) : () );
4962 $cust_pay->invnum(''); #try again with no specific invnum
4963 my $error2 = $cust_pay->insert( $options{'manual'} ?
4964 ( 'manual' => 1 ) : ()
4967 # gah, even with transactions.
4968 my $e = 'WARNING: Card/ACH debited but database not updated - '.
4969 "error inserting (fake!) payment: $error2".
4970 " (previously tried insert with invnum #$options{'invnum'}" .
4977 if ( $options{'paynum_ref'} ) {
4978 ${ $options{'paynum_ref'} } = $cust_pay->paynum;
4981 return ''; #no error
4986 # item _realtime_bop_result CUST_PAY_PENDING, BOP_OBJECT [ OPTION => VALUE ... ]
4988 # Wraps up processing of a realtime credit card, ACH (electronic check) or
4989 # phone bill transaction.
4991 sub _realtime_bop_result {
4992 my( $self, $cust_pay_pending, $transaction, %options ) = @_;
4994 warn "$me _realtime_bop_result: pending transaction ".
4995 $cust_pay_pending->paypendingnum. "\n";
4996 warn " $_ => $options{$_}\n" foreach keys %options;
4999 my $payment_gateway = $options{payment_gateway}
5000 or return "no payment gateway in arguments to _realtime_bop_result";
5002 $cust_pay_pending->status($transaction->is_success() ? 'captured' : 'declined');
5003 my $cpp_captured_err = $cust_pay_pending->replace;
5004 return $cpp_captured_err if $cpp_captured_err;
5006 if ( $transaction->is_success() ) {
5009 if ( $payment_gateway->gatewaynum ) { # agent override
5010 $paybatch = $payment_gateway->gatewaynum. '-';
5013 $paybatch .= $payment_gateway->gateway_module. ":".
5014 $transaction->authorization;
5016 $paybatch .= ':'. $transaction->order_number
5017 if $transaction->can('order_number')
5018 && length($transaction->order_number);
5020 my $cust_pay = new FS::cust_pay ( {
5021 'custnum' => $self->custnum,
5022 'invnum' => $options{'invnum'},
5023 'paid' => $cust_pay_pending->paid,
5025 'payby' => $cust_pay_pending->payby,
5026 #'payinfo' => $payinfo,
5027 'paybatch' => $paybatch,
5028 'paydate' => $cust_pay_pending->paydate,
5030 #doesn't hurt to know, even though the dup check is in cust_pay_pending now
5031 $cust_pay->payunique( $options{payunique} )
5032 if defined($options{payunique}) && length($options{payunique});
5034 my $oldAutoCommit = $FS::UID::AutoCommit;
5035 local $FS::UID::AutoCommit = 0;
5038 #start a transaction, insert the cust_pay and set cust_pay_pending.status to done in a single transction
5040 my $error = $cust_pay->insert($options{'manual'} ? ( 'manual' => 1 ) : () );
5043 $cust_pay->invnum(''); #try again with no specific invnum
5044 my $error2 = $cust_pay->insert( $options{'manual'} ?
5045 ( 'manual' => 1 ) : ()
5048 # gah. but at least we have a record of the state we had to abort in
5049 # from cust_pay_pending now.
5050 my $e = "WARNING: $options{method} captured but payment not recorded -".
5051 " error inserting payment (". $payment_gateway->gateway_module.
5053 " (previously tried insert with invnum #$options{'invnum'}" .
5054 ": $error ) - pending payment saved as paypendingnum ".
5055 $cust_pay_pending->paypendingnum. "\n";
5061 my $jobnum = $cust_pay_pending->jobnum;
5063 my $placeholder = qsearchs( 'queue', { 'jobnum' => $jobnum } );
5065 unless ( $placeholder ) {
5066 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
5067 my $e = "WARNING: $options{method} captured but job $jobnum not ".
5068 "found for paypendingnum ". $cust_pay_pending->paypendingnum. "\n";
5073 $error = $placeholder->delete;
5076 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
5077 my $e = "WARNING: $options{method} captured but could not delete ".
5078 "job $jobnum for paypendingnum ".
5079 $cust_pay_pending->paypendingnum. ": $error\n";
5086 if ( $options{'paynum_ref'} ) {
5087 ${ $options{'paynum_ref'} } = $cust_pay->paynum;
5090 $cust_pay_pending->status('done');
5091 $cust_pay_pending->statustext('captured');
5092 $cust_pay_pending->paynum($cust_pay->paynum);
5093 my $cpp_done_err = $cust_pay_pending->replace;
5095 if ( $cpp_done_err ) {
5097 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
5098 my $e = "WARNING: $options{method} captured but payment not recorded - ".
5099 "error updating status for paypendingnum ".
5100 $cust_pay_pending->paypendingnum. ": $cpp_done_err \n";
5106 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
5107 return ''; #no error
5113 my $perror = $payment_gateway->gateway_module. " error: ".
5114 $transaction->error_message;
5116 my $jobnum = $cust_pay_pending->jobnum;
5118 my $placeholder = qsearchs( 'queue', { 'jobnum' => $jobnum } );
5120 if ( $placeholder ) {
5121 my $error = $placeholder->depended_delete;
5122 $error ||= $placeholder->delete;
5123 warn "error removing provisioning jobs after declined paypendingnum ".
5124 $cust_pay_pending->paypendingnum. "\n";
5126 my $e = "error finding job $jobnum for declined paypendingnum ".
5127 $cust_pay_pending->paypendingnum. "\n";
5133 unless ( $transaction->error_message ) {
5136 if ( $transaction->can('response_page') ) {
5138 'page' => ( $transaction->can('response_page')
5139 ? $transaction->response_page
5142 'code' => ( $transaction->can('response_code')
5143 ? $transaction->response_code
5146 'headers' => ( $transaction->can('response_headers')
5147 ? $transaction->response_headers
5153 "No additional debugging information available for ".
5154 $payment_gateway->gateway_module;
5157 $perror .= "No error_message returned from ".
5158 $payment_gateway->gateway_module. " -- ".
5159 ( ref($t_response) ? Dumper($t_response) : $t_response );
5163 if ( !$options{'quiet'} && !$realtime_bop_decline_quiet
5164 && $conf->exists('emaildecline')
5165 && grep { $_ ne 'POST' } $self->invoicing_list
5166 && ! grep { $transaction->error_message =~ /$_/ }
5167 $conf->config('emaildecline-exclude')
5169 my @templ = $conf->config('declinetemplate');
5170 my $template = new Text::Template (
5172 SOURCE => [ map "$_\n", @templ ],
5173 ) or return "($perror) can't create template: $Text::Template::ERROR";
5174 $template->compile()
5175 or return "($perror) can't compile template: $Text::Template::ERROR";
5177 my $templ_hash = { error => $transaction->error_message };
5179 my $error = send_email(
5180 'from' => $conf->config('invoice_from', $self->agentnum ),
5181 'to' => [ grep { $_ ne 'POST' } $self->invoicing_list ],
5182 'subject' => 'Your payment could not be processed',
5183 'body' => [ $template->fill_in(HASH => $templ_hash) ],
5186 $perror .= " (also received error sending decline notification: $error)"
5191 $cust_pay_pending->status('done');
5192 $cust_pay_pending->statustext("declined: $perror");
5193 my $cpp_done_err = $cust_pay_pending->replace;
5194 if ( $cpp_done_err ) {
5195 my $e = "WARNING: $options{method} declined but pending payment not ".
5196 "resolved - error updating status for paypendingnum ".
5197 $cust_pay_pending->paypendingnum. ": $cpp_done_err \n";
5199 $perror = "$e ($perror)";
5207 =item realtime_botpp_capture CUST_PAY_PENDING [ OPTION => VALUE ... ]
5209 Verifies successful third party processing of a realtime credit card,
5210 ACH (electronic check) or phone bill transaction via a
5211 Business::OnlineThirdPartyPayment realtime gateway. See
5212 L<http://420.am/business-onlinethirdpartypayment> for supported gateways.
5214 Available options are: I<description>, I<invnum>, I<quiet>, I<paynum_ref>, I<payunique>
5216 The additional options I<payname>, I<city>, I<state>,
5217 I<zip>, I<payinfo> and I<paydate> are also available. Any of these options,
5218 if set, will override the value from the customer record.
5220 I<description> is a free-text field passed to the gateway. It defaults to
5221 "Internet services".
5223 If an I<invnum> is specified, this payment (if successful) is applied to the
5224 specified invoice. If you don't specify an I<invnum> you might want to
5225 call the B<apply_payments> method.
5227 I<quiet> can be set true to surpress email decline notices.
5229 I<paynum_ref> can be set to a scalar reference. It will be filled in with the
5230 resulting paynum, if any.
5232 I<payunique> is a unique identifier for this payment.
5234 Returns a hashref containing elements bill_error (which will be undefined
5235 upon success) and session_id of any associated session.
5239 sub realtime_botpp_capture {
5240 my( $self, $cust_pay_pending, %options ) = @_;
5242 warn "$me realtime_botpp_capture: pending transaction $cust_pay_pending\n";
5243 warn " $_ => $options{$_}\n" foreach keys %options;
5246 eval "use Business::OnlineThirdPartyPayment";
5250 # select the gateway
5253 my $method = FS::payby->payby2bop($cust_pay_pending->payby);
5255 my $payment_gateway = $cust_pay_pending->gatewaynum
5256 ? qsearchs( 'payment_gateway',
5257 { gatewaynum => $cust_pay_pending->gatewaynum }
5259 : $self->agent->payment_gateway( 'method' => $method,
5260 # 'invnum' => $cust_pay_pending->invnum,
5261 # 'payinfo' => $cust_pay_pending->payinfo,
5264 $options{payment_gateway} = $payment_gateway; # for the helper subs
5270 my @invoicing_list = $self->invoicing_list_emailonly;
5271 if ( $conf->exists('emailinvoiceautoalways')
5272 || $conf->exists('emailinvoiceauto') && ! @invoicing_list
5273 || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
5274 push @invoicing_list, $self->all_emails;
5277 my $email = ($conf->exists('business-onlinepayment-email-override'))
5278 ? $conf->config('business-onlinepayment-email-override')
5279 : $invoicing_list[0];
5283 $content{email_customer} =
5284 ( $conf->exists('business-onlinepayment-email_customer')
5285 || $conf->exists('business-onlinepayment-email-override') );
5288 # run transaction(s)
5292 new Business::OnlineThirdPartyPayment( $payment_gateway->gateway_module,
5293 $self->_bop_options(\%options),
5296 $transaction->reference({ %options });
5298 $transaction->content(
5300 $self->_bop_auth(\%options),
5301 'action' => 'Post Authorization',
5302 'description' => $options{'description'},
5303 'amount' => $cust_pay_pending->paid,
5304 #'invoice_number' => $options{'invnum'},
5305 'customer_id' => $self->custnum,
5306 'referer' => 'http://cleanwhisker.420.am/',
5307 'reference' => $cust_pay_pending->paypendingnum,
5309 'phone' => $self->daytime || $self->night,
5311 # plus whatever is required for bogus capture avoidance
5314 $transaction->submit();
5317 $self->_realtime_bop_result( $cust_pay_pending, $transaction, %options );
5320 bill_error => $error,
5321 session_id => $cust_pay_pending->session_id,
5326 =item default_payment_gateway DEPRECATED -- use agent->payment_gateway
5330 sub default_payment_gateway {
5331 my( $self, $method ) = @_;
5333 die "Real-time processing not enabled\n"
5334 unless $conf->exists('business-onlinepayment');
5336 #warn "default_payment_gateway deprecated -- use agent->payment_gateway\n";
5339 my $bop_config = 'business-onlinepayment';
5340 $bop_config .= '-ach'
5341 if $method =~ /^(ECHECK|CHEK)$/ && $conf->exists($bop_config. '-ach');
5342 my ( $processor, $login, $password, $action, @bop_options ) =
5343 $conf->config($bop_config);
5344 $action ||= 'normal authorization';
5345 pop @bop_options if scalar(@bop_options) % 2 && $bop_options[-1] =~ /^\s*$/;
5346 die "No real-time processor is enabled - ".
5347 "did you set the business-onlinepayment configuration value?\n"
5350 ( $processor, $login, $password, $action, @bop_options )
5355 Removes the I<paycvv> field from the database directly.
5357 If there is an error, returns the error, otherwise returns false.
5363 my $sth = dbh->prepare("UPDATE cust_main SET paycvv = '' WHERE custnum = ?")
5364 or return dbh->errstr;
5365 $sth->execute($self->custnum)
5366 or return $sth->errstr;
5371 =item _new_realtime_refund_bop METHOD [ OPTION => VALUE ... ]
5373 Refunds a realtime credit card, ACH (electronic check) or phone bill transaction
5374 via a Business::OnlinePayment realtime gateway. See
5375 L<http://420.am/business-onlinepayment> for supported gateways.
5377 Available methods are: I<CC>, I<ECHECK> and I<LEC>
5379 Available options are: I<amount>, I<reason>, I<paynum>, I<paydate>
5381 Most gateways require a reference to an original payment transaction to refund,
5382 so you probably need to specify a I<paynum>.
5384 I<amount> defaults to the original amount of the payment if not specified.
5386 I<reason> specifies a reason for the refund.
5388 I<paydate> specifies the expiration date for a credit card overriding the
5389 value from the customer record or the payment record. Specified as yyyy-mm-dd
5391 Implementation note: If I<amount> is unspecified or equal to the amount of the
5392 orignal payment, first an attempt is made to "void" the transaction via
5393 the gateway (to cancel a not-yet settled transaction) and then if that fails,
5394 the normal attempt is made to "refund" ("credit") the transaction via the
5395 gateway is attempted.
5397 #The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
5398 #I<zip>, I<payinfo> and I<paydate> are also available. Any of these options,
5399 #if set, will override the value from the customer record.
5401 #If an I<invnum> is specified, this payment (if successful) is applied to the
5402 #specified invoice. If you don't specify an I<invnum> you might want to
5403 #call the B<apply_payments> method.
5407 #some false laziness w/realtime_bop, not enough to make it worth merging
5408 #but some useful small subs should be pulled out
5409 sub _new_realtime_refund_bop {
5413 if (ref($_[0]) ne 'HASH') {
5414 %options = %{$_[0]};
5418 $options{method} = $method;
5422 warn "$me realtime_refund_bop (new): $options{method} refund\n";
5423 warn " $_ => $options{$_}\n" foreach keys %options;
5427 # look up the original payment and optionally a gateway for that payment
5431 my $amount = $options{'amount'};
5433 my( $processor, $login, $password, @bop_options, $namespace ) ;
5434 my( $auth, $order_number ) = ( '', '', '' );
5436 if ( $options{'paynum'} ) {
5438 warn " paynum: $options{paynum}\n" if $DEBUG > 1;
5439 $cust_pay = qsearchs('cust_pay', { paynum=>$options{'paynum'} } )
5440 or return "Unknown paynum $options{'paynum'}";
5441 $amount ||= $cust_pay->paid;
5443 $cust_pay->paybatch =~ /^((\d+)\-)?(\w+):\s*([\w\-\/ ]*)(:([\w\-]+))?$/
5444 or return "Can't parse paybatch for paynum $options{'paynum'}: ".
5445 $cust_pay->paybatch;
5446 my $gatewaynum = '';
5447 ( $gatewaynum, $processor, $auth, $order_number ) = ( $2, $3, $4, $6 );
5449 if ( $gatewaynum ) { #gateway for the payment to be refunded
5451 my $payment_gateway =
5452 qsearchs('payment_gateway', { 'gatewaynum' => $gatewaynum } );
5453 die "payment gateway $gatewaynum not found"
5454 unless $payment_gateway;
5456 $processor = $payment_gateway->gateway_module;
5457 $login = $payment_gateway->gateway_username;
5458 $password = $payment_gateway->gateway_password;
5459 $namespace = $payment_gateway->gateway_namespace;
5460 @bop_options = $payment_gateway->options;
5462 } else { #try the default gateway
5465 my $payment_gateway =
5466 $self->agent->payment_gateway('method' => $options{method});
5468 ( $conf_processor, $login, $password, $namespace ) =
5469 map { my $method = "gateway_$_"; $payment_gateway->$method }
5470 qw( module username password namespace );
5472 @bop_options = $payment_gateway->gatewaynum
5473 ? $payment_gateway->options
5474 : @{ $payment_gateway->get('options') };
5476 return "processor of payment $options{'paynum'} $processor does not".
5477 " match default processor $conf_processor"
5478 unless $processor eq $conf_processor;
5483 } else { # didn't specify a paynum, so look for agent gateway overrides
5484 # like a normal transaction
5486 my $payment_gateway =
5487 $self->agent->payment_gateway( 'method' => $options{method},
5488 #'payinfo' => $payinfo,
5490 my( $processor, $login, $password, $namespace ) =
5491 map { my $method = "gateway_$_"; $payment_gateway->$method }
5492 qw( module username password namespace );
5494 my @bop_options = $payment_gateway->gatewaynum
5495 ? $payment_gateway->options
5496 : @{ $payment_gateway->get('options') };
5499 return "neither amount nor paynum specified" unless $amount;
5501 eval "use $namespace";
5505 'type' => $options{method},
5507 'password' => $password,
5508 'order_number' => $order_number,
5509 'amount' => $amount,
5510 'referer' => 'http://cleanwhisker.420.am/', #XXX fix referer :/
5512 $content{authorization} = $auth
5513 if length($auth); #echeck/ACH transactions have an order # but no auth
5514 #(at least with authorize.net)
5516 my $disable_void_after;
5517 if ($conf->exists('disable_void_after')
5518 && $conf->config('disable_void_after') =~ /^(\d+)$/) {
5519 $disable_void_after = $1;
5522 #first try void if applicable
5523 if ( $cust_pay && $cust_pay->paid == $amount
5525 ( not defined($disable_void_after) )
5526 || ( time < ($cust_pay->_date + $disable_void_after ) )
5529 warn " attempting void\n" if $DEBUG > 1;
5530 my $void = new Business::OnlinePayment( $processor, @bop_options );
5531 $void->content( 'action' => 'void', %content );
5533 if ( $void->is_success ) {
5534 my $error = $cust_pay->void($options{'reason'});
5536 # gah, even with transactions.
5537 my $e = 'WARNING: Card/ACH voided but database not updated - '.
5538 "error voiding payment: $error";
5542 warn " void successful\n" if $DEBUG > 1;
5547 warn " void unsuccessful, trying refund\n"
5551 my $address = $self->address1;
5552 $address .= ", ". $self->address2 if $self->address2;
5554 my($payname, $payfirst, $paylast);
5555 if ( $self->payname && $options{method} ne 'ECHECK' ) {
5556 $payname = $self->payname;
5557 $payname =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
5558 or return "Illegal payname $payname";
5559 ($payfirst, $paylast) = ($1, $2);
5561 $payfirst = $self->getfield('first');
5562 $paylast = $self->getfield('last');
5563 $payname = "$payfirst $paylast";
5566 my @invoicing_list = $self->invoicing_list_emailonly;
5567 if ( $conf->exists('emailinvoiceautoalways')
5568 || $conf->exists('emailinvoiceauto') && ! @invoicing_list
5569 || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
5570 push @invoicing_list, $self->all_emails;
5573 my $email = ($conf->exists('business-onlinepayment-email-override'))
5574 ? $conf->config('business-onlinepayment-email-override')
5575 : $invoicing_list[0];
5577 my $payip = exists($options{'payip'})
5580 $content{customer_ip} = $payip
5584 if ( $options{method} eq 'CC' ) {
5587 $content{card_number} = $payinfo = $cust_pay->payinfo;
5588 (exists($options{'paydate'}) ? $options{'paydate'} : $cust_pay->paydate)
5589 =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/ &&
5590 ($content{expiration} = "$2/$1"); # where available
5592 $content{card_number} = $payinfo = $self->payinfo;
5593 (exists($options{'paydate'}) ? $options{'paydate'} : $self->paydate)
5594 =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
5595 $content{expiration} = "$2/$1";
5598 } elsif ( $options{method} eq 'ECHECK' ) {
5601 $payinfo = $cust_pay->payinfo;
5603 $payinfo = $self->payinfo;
5605 ( $content{account_number}, $content{routing_code} )= split('@', $payinfo );
5606 $content{bank_name} = $self->payname;
5607 $content{account_type} = 'CHECKING';
5608 $content{account_name} = $payname;
5609 $content{customer_org} = $self->company ? 'B' : 'I';
5610 $content{customer_ssn} = $self->ss;
5611 } elsif ( $options{method} eq 'LEC' ) {
5612 $content{phone} = $payinfo = $self->payinfo;
5616 my $refund = new Business::OnlinePayment( $processor, @bop_options );
5617 my %sub_content = $refund->content(
5618 'action' => 'credit',
5619 'customer_id' => $self->custnum,
5620 'last_name' => $paylast,
5621 'first_name' => $payfirst,
5623 'address' => $address,
5624 'city' => $self->city,
5625 'state' => $self->state,
5626 'zip' => $self->zip,
5627 'country' => $self->country,
5629 'phone' => $self->daytime || $self->night,
5632 warn join('', map { " $_ => $sub_content{$_}\n" } keys %sub_content )
5636 return "$processor error: ". $refund->error_message
5637 unless $refund->is_success();
5639 my $paybatch = "$processor:". $refund->authorization;
5640 $paybatch .= ':'. $refund->order_number
5641 if $refund->can('order_number') && $refund->order_number;
5643 while ( $cust_pay && $cust_pay->unapplied < $amount ) {
5644 my @cust_bill_pay = $cust_pay->cust_bill_pay;
5645 last unless @cust_bill_pay;
5646 my $cust_bill_pay = pop @cust_bill_pay;
5647 my $error = $cust_bill_pay->delete;
5651 my $cust_refund = new FS::cust_refund ( {
5652 'custnum' => $self->custnum,
5653 'paynum' => $options{'paynum'},
5654 'refund' => $amount,
5656 'payby' => $bop_method2payby{$options{method}},
5657 'payinfo' => $payinfo,
5658 'paybatch' => $paybatch,
5659 'reason' => $options{'reason'} || 'card or ACH refund',
5661 my $error = $cust_refund->insert;
5663 $cust_refund->paynum(''); #try again with no specific paynum
5664 my $error2 = $cust_refund->insert;
5666 # gah, even with transactions.
5667 my $e = 'WARNING: Card/ACH refunded but database not updated - '.
5668 "error inserting refund ($processor): $error2".
5669 " (previously tried insert with paynum #$options{'paynum'}" .
5680 =item batch_card OPTION => VALUE...
5682 Adds a payment for this invoice to the pending credit card batch (see
5683 L<FS::cust_pay_batch>), or, if the B<realtime> option is set to a true value,
5684 runs the payment using a realtime gateway.
5689 my ($self, %options) = @_;
5692 if (exists($options{amount})) {
5693 $amount = $options{amount};
5695 $amount = sprintf("%.2f", $self->balance - $self->in_transit_payments);
5697 return '' unless $amount > 0;
5699 my $invnum = delete $options{invnum};
5700 my $payby = $options{invnum} || $self->payby; #dubious
5702 if ($options{'realtime'}) {
5703 return $self->realtime_bop( FS::payby->payby2bop($self->payby),
5709 my $oldAutoCommit = $FS::UID::AutoCommit;
5710 local $FS::UID::AutoCommit = 0;
5713 #this needs to handle mysql as well as Pg, like svc_acct.pm
5714 #(make it into a common function if folks need to do batching with mysql)
5715 $dbh->do("LOCK TABLE pay_batch IN SHARE ROW EXCLUSIVE MODE")
5716 or return "Cannot lock pay_batch: " . $dbh->errstr;
5720 'payby' => FS::payby->payby2payment($payby),
5723 my $pay_batch = qsearchs( 'pay_batch', \%pay_batch );
5725 unless ( $pay_batch ) {
5726 $pay_batch = new FS::pay_batch \%pay_batch;
5727 my $error = $pay_batch->insert;
5729 $dbh->rollback if $oldAutoCommit;
5730 die "error creating new batch: $error\n";
5734 my $old_cust_pay_batch = qsearchs('cust_pay_batch', {
5735 'batchnum' => $pay_batch->batchnum,
5736 'custnum' => $self->custnum,
5739 foreach (qw( address1 address2 city state zip country payby payinfo paydate
5741 $options{$_} = '' unless exists($options{$_});
5744 my $cust_pay_batch = new FS::cust_pay_batch ( {
5745 'batchnum' => $pay_batch->batchnum,
5746 'invnum' => $invnum || 0, # is there a better value?
5747 # this field should be
5749 # cust_bill_pay_batch now
5750 'custnum' => $self->custnum,
5751 'last' => $self->getfield('last'),
5752 'first' => $self->getfield('first'),
5753 'address1' => $options{address1} || $self->address1,
5754 'address2' => $options{address2} || $self->address2,
5755 'city' => $options{city} || $self->city,
5756 'state' => $options{state} || $self->state,
5757 'zip' => $options{zip} || $self->zip,
5758 'country' => $options{country} || $self->country,
5759 'payby' => $options{payby} || $self->payby,
5760 'payinfo' => $options{payinfo} || $self->payinfo,
5761 'exp' => $options{paydate} || $self->paydate,
5762 'payname' => $options{payname} || $self->payname,
5763 'amount' => $amount, # consolidating
5766 $cust_pay_batch->paybatchnum($old_cust_pay_batch->paybatchnum)
5767 if $old_cust_pay_batch;
5770 if ($old_cust_pay_batch) {
5771 $error = $cust_pay_batch->replace($old_cust_pay_batch)
5773 $error = $cust_pay_batch->insert;
5777 $dbh->rollback if $oldAutoCommit;
5781 my $unapplied = $self->total_unapplied_credits
5782 + $self->total_unapplied_payments
5783 + $self->in_transit_payments;
5784 foreach my $cust_bill ($self->open_cust_bill) {
5785 #$dbh->commit or die $dbh->errstr if $oldAutoCommit;
5786 my $cust_bill_pay_batch = new FS::cust_bill_pay_batch {
5787 'invnum' => $cust_bill->invnum,
5788 'paybatchnum' => $cust_pay_batch->paybatchnum,
5789 'amount' => $cust_bill->owed,
5792 if ($unapplied >= $cust_bill_pay_batch->amount){
5793 $unapplied -= $cust_bill_pay_batch->amount;
5796 $cust_bill_pay_batch->amount(sprintf ( "%.2f",
5797 $cust_bill_pay_batch->amount - $unapplied )); $unapplied = 0;
5799 $error = $cust_bill_pay_batch->insert;
5801 $dbh->rollback if $oldAutoCommit;
5806 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
5810 =item apply_payments_and_credits
5812 Applies unapplied payments and credits.
5814 In most cases, this new method should be used in place of sequential
5815 apply_payments and apply_credits methods.
5817 If there is an error, returns the error, otherwise returns false.
5821 sub apply_payments_and_credits {
5824 local $SIG{HUP} = 'IGNORE';
5825 local $SIG{INT} = 'IGNORE';
5826 local $SIG{QUIT} = 'IGNORE';
5827 local $SIG{TERM} = 'IGNORE';
5828 local $SIG{TSTP} = 'IGNORE';
5829 local $SIG{PIPE} = 'IGNORE';
5831 my $oldAutoCommit = $FS::UID::AutoCommit;
5832 local $FS::UID::AutoCommit = 0;
5835 $self->select_for_update; #mutex
5837 foreach my $cust_bill ( $self->open_cust_bill ) {
5838 my $error = $cust_bill->apply_payments_and_credits;
5840 $dbh->rollback if $oldAutoCommit;
5841 return "Error applying: $error";
5845 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
5850 =item apply_credits OPTION => VALUE ...
5852 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
5853 to outstanding invoice balances in chronological order (or reverse
5854 chronological order if the I<order> option is set to B<newest>) and returns the
5855 value of any remaining unapplied credits available for refund (see
5856 L<FS::cust_refund>).
5858 Dies if there is an error.
5866 local $SIG{HUP} = 'IGNORE';
5867 local $SIG{INT} = 'IGNORE';
5868 local $SIG{QUIT} = 'IGNORE';
5869 local $SIG{TERM} = 'IGNORE';
5870 local $SIG{TSTP} = 'IGNORE';
5871 local $SIG{PIPE} = 'IGNORE';
5873 my $oldAutoCommit = $FS::UID::AutoCommit;
5874 local $FS::UID::AutoCommit = 0;
5877 $self->select_for_update; #mutex
5879 unless ( $self->total_unapplied_credits ) {
5880 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
5884 my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
5885 qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
5887 my @invoices = $self->open_cust_bill;
5888 @invoices = sort { $b->_date <=> $a->_date } @invoices
5889 if defined($opt{'order'}) && $opt{'order'} eq 'newest';
5892 foreach my $cust_bill ( @invoices ) {
5895 if ( !defined($credit) || $credit->credited == 0) {
5896 $credit = pop @credits or last;
5899 if ($cust_bill->owed >= $credit->credited) {
5900 $amount=$credit->credited;
5902 $amount=$cust_bill->owed;
5905 my $cust_credit_bill = new FS::cust_credit_bill ( {
5906 'crednum' => $credit->crednum,
5907 'invnum' => $cust_bill->invnum,
5908 'amount' => $amount,
5910 my $error = $cust_credit_bill->insert;
5912 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
5916 redo if ($cust_bill->owed > 0);
5920 my $total_unapplied_credits = $self->total_unapplied_credits;
5922 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
5924 return $total_unapplied_credits;
5927 =item apply_payments
5929 Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
5930 to outstanding invoice balances in chronological order.
5932 #and returns the value of any remaining unapplied payments.
5934 Dies if there is an error.
5938 sub apply_payments {
5941 local $SIG{HUP} = 'IGNORE';
5942 local $SIG{INT} = 'IGNORE';
5943 local $SIG{QUIT} = 'IGNORE';
5944 local $SIG{TERM} = 'IGNORE';
5945 local $SIG{TSTP} = 'IGNORE';
5946 local $SIG{PIPE} = 'IGNORE';
5948 my $oldAutoCommit = $FS::UID::AutoCommit;
5949 local $FS::UID::AutoCommit = 0;
5952 $self->select_for_update; #mutex
5956 my @payments = sort { $b->_date <=> $a->_date }
5957 grep { $_->unapplied > 0 }
5960 my @invoices = sort { $a->_date <=> $b->_date}
5961 grep { $_->owed > 0 }
5966 foreach my $cust_bill ( @invoices ) {
5969 if ( !defined($payment) || $payment->unapplied == 0 ) {
5970 $payment = pop @payments or last;
5973 if ( $cust_bill->owed >= $payment->unapplied ) {
5974 $amount = $payment->unapplied;
5976 $amount = $cust_bill->owed;
5979 my $cust_bill_pay = new FS::cust_bill_pay ( {
5980 'paynum' => $payment->paynum,
5981 'invnum' => $cust_bill->invnum,
5982 'amount' => $amount,
5984 my $error = $cust_bill_pay->insert;
5986 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
5990 redo if ( $cust_bill->owed > 0);
5994 my $total_unapplied_payments = $self->total_unapplied_payments;
5996 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
5998 return $total_unapplied_payments;
6003 Returns the total owed for this customer on all invoices
6004 (see L<FS::cust_bill/owed>).
6010 $self->total_owed_date(2145859200); #12/31/2037
6013 =item total_owed_date TIME
6015 Returns the total owed for this customer on all invoices with date earlier than
6016 TIME. TIME is specified as a UNIX timestamp; see L<perlfunc/"time">). Also
6017 see L<Time::Local> and L<Date::Parse> for conversion functions.
6021 sub total_owed_date {
6025 foreach my $cust_bill (
6026 grep { $_->_date <= $time }
6027 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
6029 $total_bill += $cust_bill->owed;
6031 sprintf( "%.2f", $total_bill );
6036 Returns the total amount of all payments.
6043 $total += $_->paid foreach $self->cust_pay;
6044 sprintf( "%.2f", $total );
6047 =item total_unapplied_credits
6049 Returns the total outstanding credit (see L<FS::cust_credit>) for this
6050 customer. See L<FS::cust_credit/credited>.
6052 =item total_credited
6054 Old name for total_unapplied_credits. Don't use.
6058 sub total_credited {
6059 #carp "total_credited deprecated, use total_unapplied_credits";
6060 shift->total_unapplied_credits(@_);
6063 sub total_unapplied_credits {
6065 my $total_credit = 0;
6066 $total_credit += $_->credited foreach $self->cust_credit;
6067 sprintf( "%.2f", $total_credit );
6070 =item total_unapplied_payments
6072 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
6073 See L<FS::cust_pay/unapplied>.
6077 sub total_unapplied_payments {
6079 my $total_unapplied = 0;
6080 $total_unapplied += $_->unapplied foreach $self->cust_pay;
6081 sprintf( "%.2f", $total_unapplied );
6084 =item total_unapplied_refunds
6086 Returns the total unrefunded refunds (see L<FS::cust_refund>) for this
6087 customer. See L<FS::cust_refund/unapplied>.
6091 sub total_unapplied_refunds {
6093 my $total_unapplied = 0;
6094 $total_unapplied += $_->unapplied foreach $self->cust_refund;
6095 sprintf( "%.2f", $total_unapplied );
6100 Returns the balance for this customer (total_owed plus total_unrefunded, minus
6101 total_unapplied_credits minus total_unapplied_payments).
6109 + $self->total_unapplied_refunds
6110 - $self->total_unapplied_credits
6111 - $self->total_unapplied_payments
6115 =item balance_date TIME
6117 Returns the balance for this customer, only considering invoices with date
6118 earlier than TIME (total_owed_date minus total_credited minus
6119 total_unapplied_payments). TIME is specified as a UNIX timestamp; see
6120 L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion
6129 $self->total_owed_date($time)
6130 + $self->total_unapplied_refunds
6131 - $self->total_unapplied_credits
6132 - $self->total_unapplied_payments
6136 =item in_transit_payments
6138 Returns the total of requests for payments for this customer pending in
6139 batches in transit to the bank. See L<FS::pay_batch> and L<FS::cust_pay_batch>
6143 sub in_transit_payments {
6145 my $in_transit_payments = 0;
6146 foreach my $pay_batch ( qsearch('pay_batch', {
6149 foreach my $cust_pay_batch ( qsearch('cust_pay_batch', {
6150 'batchnum' => $pay_batch->batchnum,
6151 'custnum' => $self->custnum,
6153 $in_transit_payments += $cust_pay_batch->amount;
6156 sprintf( "%.2f", $in_transit_payments );
6161 Returns a hash of useful information for making a payment.
6171 'CARD' (credit card - automatic), 'DCRD' (credit card - on-demand),
6172 'CHEK' (electronic check - automatic), 'DCHK' (electronic check - on-demand),
6173 'LECB' (Phone bill billing), 'BILL' (billing), or 'COMP' (free).
6177 For credit card transactions:
6189 For electronic check transactions:
6204 $return{balance} = $self->balance;
6206 $return{payname} = $self->payname
6207 || ( $self->first. ' '. $self->get('last') );
6209 $return{$_} = $self->get($_) for qw(address1 address2 city state zip);
6211 $return{payby} = $self->payby;
6212 $return{stateid_state} = $self->stateid_state;
6214 if ( $self->payby =~ /^(CARD|DCRD)$/ ) {
6215 $return{card_type} = cardtype($self->payinfo);
6216 $return{payinfo} = $self->paymask;
6218 @return{'month', 'year'} = $self->paydate_monthyear;
6222 if ( $self->payby =~ /^(CHEK|DCHK)$/ ) {
6223 my ($payinfo1, $payinfo2) = split '@', $self->paymask;
6224 $return{payinfo1} = $payinfo1;
6225 $return{payinfo2} = $payinfo2;
6226 $return{paytype} = $self->paytype;
6227 $return{paystate} = $self->paystate;
6231 #doubleclick protection
6233 $return{paybatch} = "webui-MyAccount-$_date-$$-". rand() * 2**32;
6239 =item paydate_monthyear
6241 Returns a two-element list consisting of the month and year of this customer's
6242 paydate (credit card expiration date for CARD customers)
6246 sub paydate_monthyear {
6248 if ( $self->paydate =~ /^(\d{4})-(\d{1,2})-\d{1,2}$/ ) { #Pg date format
6250 } elsif ( $self->paydate =~ /^(\d{1,2})-(\d{1,2}-)?(\d{4}$)/ ) {
6257 =item invoicing_list [ ARRAYREF ]
6259 If an arguement is given, sets these email addresses as invoice recipients
6260 (see L<FS::cust_main_invoice>). Errors are not fatal and are not reported
6261 (except as warnings), so use check_invoicing_list first.
6263 Returns a list of email addresses (with svcnum entries expanded).
6265 Note: You can clear the invoicing list by passing an empty ARRAYREF. You can
6266 check it without disturbing anything by passing nothing.
6268 This interface may change in the future.
6272 sub invoicing_list {
6273 my( $self, $arrayref ) = @_;
6276 my @cust_main_invoice;
6277 if ( $self->custnum ) {
6278 @cust_main_invoice =
6279 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
6281 @cust_main_invoice = ();
6283 foreach my $cust_main_invoice ( @cust_main_invoice ) {
6284 #warn $cust_main_invoice->destnum;
6285 unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
6286 #warn $cust_main_invoice->destnum;
6287 my $error = $cust_main_invoice->delete;
6288 warn $error if $error;
6291 if ( $self->custnum ) {
6292 @cust_main_invoice =
6293 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
6295 @cust_main_invoice = ();
6297 my %seen = map { $_->address => 1 } @cust_main_invoice;
6298 foreach my $address ( @{$arrayref} ) {
6299 next if exists $seen{$address} && $seen{$address};
6300 $seen{$address} = 1;
6301 my $cust_main_invoice = new FS::cust_main_invoice ( {
6302 'custnum' => $self->custnum,
6305 my $error = $cust_main_invoice->insert;
6306 warn $error if $error;
6310 if ( $self->custnum ) {
6312 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
6319 =item check_invoicing_list ARRAYREF
6321 Checks these arguements as valid input for the invoicing_list method. If there
6322 is an error, returns the error, otherwise returns false.
6326 sub check_invoicing_list {
6327 my( $self, $arrayref ) = @_;
6329 foreach my $address ( @$arrayref ) {
6331 if ($address eq 'FAX' and $self->getfield('fax') eq '') {
6332 return 'Can\'t add FAX invoice destination with a blank FAX number.';
6335 my $cust_main_invoice = new FS::cust_main_invoice ( {
6336 'custnum' => $self->custnum,
6339 my $error = $self->custnum
6340 ? $cust_main_invoice->check
6341 : $cust_main_invoice->checkdest
6343 return $error if $error;
6347 return "Email address required"
6348 if $conf->exists('cust_main-require_invoicing_list_email')
6349 && ! grep { $_ !~ /^([A-Z]+)$/ } @$arrayref;
6354 =item set_default_invoicing_list
6356 Sets the invoicing list to all accounts associated with this customer,
6357 overwriting any previous invoicing list.
6361 sub set_default_invoicing_list {
6363 $self->invoicing_list($self->all_emails);
6368 Returns the email addresses of all accounts provisioned for this customer.
6375 foreach my $cust_pkg ( $self->all_pkgs ) {
6376 my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
6378 map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
6379 grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
6381 $list{$_}=1 foreach map { $_->email } @svc_acct;
6386 =item invoicing_list_addpost
6388 Adds postal invoicing to this customer. If this customer is already configured
6389 to receive postal invoices, does nothing.
6393 sub invoicing_list_addpost {
6395 return if grep { $_ eq 'POST' } $self->invoicing_list;
6396 my @invoicing_list = $self->invoicing_list;
6397 push @invoicing_list, 'POST';
6398 $self->invoicing_list(\@invoicing_list);
6401 =item invoicing_list_emailonly
6403 Returns the list of email invoice recipients (invoicing_list without non-email
6404 destinations such as POST and FAX).
6408 sub invoicing_list_emailonly {
6410 warn "$me invoicing_list_emailonly called"
6412 grep { $_ !~ /^([A-Z]+)$/ } $self->invoicing_list;
6415 =item invoicing_list_emailonly_scalar
6417 Returns the list of email invoice recipients (invoicing_list without non-email
6418 destinations such as POST and FAX) as a comma-separated scalar.
6422 sub invoicing_list_emailonly_scalar {
6424 warn "$me invoicing_list_emailonly_scalar called"
6426 join(', ', $self->invoicing_list_emailonly);
6429 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
6431 Returns an array of customers referred by this customer (referral_custnum set
6432 to this custnum). If DEPTH is given, recurses up to the given depth, returning
6433 customers referred by customers referred by this customer and so on, inclusive.
6434 The default behavior is DEPTH 1 (no recursion).
6438 sub referral_cust_main {
6440 my $depth = @_ ? shift : 1;
6441 my $exclude = @_ ? shift : {};
6444 map { $exclude->{$_->custnum}++; $_; }
6445 grep { ! $exclude->{ $_->custnum } }
6446 qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
6450 map { $_->referral_cust_main($depth-1, $exclude) }
6457 =item referral_cust_main_ncancelled
6459 Same as referral_cust_main, except only returns customers with uncancelled
6464 sub referral_cust_main_ncancelled {
6466 grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
6469 =item referral_cust_pkg [ DEPTH ]
6471 Like referral_cust_main, except returns a flat list of all unsuspended (and
6472 uncancelled) packages for each customer. The number of items in this list may
6473 be useful for comission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
6477 sub referral_cust_pkg {
6479 my $depth = @_ ? shift : 1;
6481 map { $_->unsuspended_pkgs }
6482 grep { $_->unsuspended_pkgs }
6483 $self->referral_cust_main($depth);
6486 =item referring_cust_main
6488 Returns the single cust_main record for the customer who referred this customer
6489 (referral_custnum), or false.
6493 sub referring_cust_main {
6495 return '' unless $self->referral_custnum;
6496 qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
6499 =item credit AMOUNT, REASON [ , OPTION => VALUE ... ]
6501 Applies a credit to this customer. If there is an error, returns the error,
6502 otherwise returns false.
6504 REASON can be a text string, an FS::reason object, or a scalar reference to
6505 a reasonnum. If a text string, it will be automatically inserted as a new
6506 reason, and a 'reason_type' option must be passed to indicate the
6507 FS::reason_type for the new reason.
6509 An I<addlinfo> option may be passed to set the credit's I<addlinfo> field.
6511 Any other options are passed to FS::cust_credit::insert.
6516 my( $self, $amount, $reason, %options ) = @_;
6518 my $cust_credit = new FS::cust_credit {
6519 'custnum' => $self->custnum,
6520 'amount' => $amount,
6523 if ( ref($reason) ) {
6525 if ( ref($reason) eq 'SCALAR' ) {
6526 $cust_credit->reasonnum( $$reason );
6528 $cust_credit->reasonnum( $reason->reasonnum );
6532 $cust_credit->set('reason', $reason)
6535 $cust_credit->addlinfo( delete $options{'addlinfo'} )
6536 if exists($options{'addlinfo'});
6538 $cust_credit->insert(%options);
6542 =item charge AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
6544 Creates a one-time charge for this customer. If there is an error, returns
6545 the error, otherwise returns false.
6551 my ( $amount, $quantity, $pkg, $comment, $classnum, $additional );
6552 my ( $setuptax, $taxclass ); #internal taxes
6553 my ( $taxproduct, $override ); #vendor (CCH) taxes
6554 if ( ref( $_[0] ) ) {
6555 $amount = $_[0]->{amount};
6556 $quantity = exists($_[0]->{quantity}) ? $_[0]->{quantity} : 1;
6557 $pkg = exists($_[0]->{pkg}) ? $_[0]->{pkg} : 'One-time charge';
6558 $comment = exists($_[0]->{comment}) ? $_[0]->{comment}
6559 : '$'. sprintf("%.2f",$amount);
6560 $setuptax = exists($_[0]->{setuptax}) ? $_[0]->{setuptax} : '';
6561 $taxclass = exists($_[0]->{taxclass}) ? $_[0]->{taxclass} : '';
6562 $classnum = exists($_[0]->{classnum}) ? $_[0]->{classnum} : '';
6563 $additional = $_[0]->{additional};
6564 $taxproduct = $_[0]->{taxproductnum};
6565 $override = { '' => $_[0]->{tax_override} };
6569 $pkg = @_ ? shift : 'One-time charge';
6570 $comment = @_ ? shift : '$'. sprintf("%.2f",$amount);
6572 $taxclass = @_ ? shift : '';
6576 local $SIG{HUP} = 'IGNORE';
6577 local $SIG{INT} = 'IGNORE';
6578 local $SIG{QUIT} = 'IGNORE';
6579 local $SIG{TERM} = 'IGNORE';
6580 local $SIG{TSTP} = 'IGNORE';
6581 local $SIG{PIPE} = 'IGNORE';
6583 my $oldAutoCommit = $FS::UID::AutoCommit;
6584 local $FS::UID::AutoCommit = 0;
6587 my $part_pkg = new FS::part_pkg ( {
6589 'comment' => $comment,
6593 'classnum' => $classnum ? $classnum : '',
6594 'setuptax' => $setuptax,
6595 'taxclass' => $taxclass,
6596 'taxproductnum' => $taxproduct,
6599 my %options = ( ( map { ("additional_info$_" => $additional->[$_] ) }
6600 ( 0 .. @$additional - 1 )
6602 'additional_count' => scalar(@$additional),
6603 'setup_fee' => $amount,
6606 my $error = $part_pkg->insert( options => \%options,
6607 tax_overrides => $override,
6610 $dbh->rollback if $oldAutoCommit;
6614 my $pkgpart = $part_pkg->pkgpart;
6615 my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
6616 unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
6617 my $type_pkgs = new FS::type_pkgs \%type_pkgs;
6618 $error = $type_pkgs->insert;
6620 $dbh->rollback if $oldAutoCommit;
6625 my $cust_pkg = new FS::cust_pkg ( {
6626 'custnum' => $self->custnum,
6627 'pkgpart' => $pkgpart,
6628 'quantity' => $quantity,
6631 $error = $cust_pkg->insert;
6633 $dbh->rollback if $oldAutoCommit;
6637 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
6642 #=item charge_postal_fee
6644 #Applies a one time charge this customer. If there is an error,
6645 #returns the error, returns the cust_pkg charge object or false
6646 #if there was no charge.
6650 # This should be a customer event. For that to work requires that bill
6651 # also be a customer event.
6653 sub charge_postal_fee {
6656 my $pkgpart = $conf->config('postal_invoice-fee_pkgpart');
6657 return '' unless ($pkgpart && grep { $_ eq 'POST' } $self->invoicing_list);
6659 my $cust_pkg = new FS::cust_pkg ( {
6660 'custnum' => $self->custnum,
6661 'pkgpart' => $pkgpart,
6665 my $error = $cust_pkg->insert;
6666 $error ? $error : $cust_pkg;
6671 Returns all the invoices (see L<FS::cust_bill>) for this customer.
6677 sort { $a->_date <=> $b->_date }
6678 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
6681 =item open_cust_bill
6683 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
6688 sub open_cust_bill {
6690 grep { $_->owed > 0 } $self->cust_bill;
6695 Returns all the credits (see L<FS::cust_credit>) for this customer.
6701 sort { $a->_date <=> $b->_date }
6702 qsearch( 'cust_credit', { 'custnum' => $self->custnum } )
6707 Returns all the payments (see L<FS::cust_pay>) for this customer.
6713 sort { $a->_date <=> $b->_date }
6714 qsearch( 'cust_pay', { 'custnum' => $self->custnum } )
6719 Returns all voided payments (see L<FS::cust_pay_void>) for this customer.
6725 sort { $a->_date <=> $b->_date }
6726 qsearch( 'cust_pay_void', { 'custnum' => $self->custnum } )
6729 =item cust_pay_batch
6731 Returns all batched payments (see L<FS::cust_pay_void>) for this customer.
6735 sub cust_pay_batch {
6737 sort { $a->_date <=> $b->_date }
6738 qsearch( 'cust_pay_batch', { 'custnum' => $self->custnum } )
6741 =item cust_pay_pending
6743 Returns all pending payments (see L<FS::cust_pay_pending>) for this customer
6744 (without status "done").
6748 sub cust_pay_pending {
6750 return $self->num_cust_pay_pending unless wantarray;
6751 sort { $a->_date <=> $b->_date }
6752 qsearch( 'cust_pay_pending', {
6753 'custnum' => $self->custnum,
6754 'status' => { op=>'!=', value=>'done' },
6759 =item num_cust_pay_pending
6761 Returns the number of pending payments (see L<FS::cust_pay_pending>) for this
6762 customer (without status "done"). Also called automatically when the
6763 cust_pay_pending method is used in a scalar context.
6767 sub num_cust_pay_pending {
6769 my $sql = " SELECT COUNT(*) FROM cust_pay_pending ".
6770 " WHERE custnum = ? AND status != 'done' ";
6771 my $sth = dbh->prepare($sql) or die dbh->errstr;
6772 $sth->execute($self->custnum) or die $sth->errstr;
6773 $sth->fetchrow_arrayref->[0];
6778 Returns all the refunds (see L<FS::cust_refund>) for this customer.
6784 sort { $a->_date <=> $b->_date }
6785 qsearch( 'cust_refund', { 'custnum' => $self->custnum } )
6788 =item display_custnum
6790 Returns the displayed customer number for this customer: agent_custid if
6791 cust_main-default_agent_custid is set and it has a value, custnum otherwise.
6795 sub display_custnum {
6797 if ( $conf->exists('cust_main-default_agent_custid') && $self->agent_custid ){
6798 return $self->agent_custid;
6800 return $self->custnum;
6806 Returns a name string for this customer, either "Company (Last, First)" or
6813 my $name = $self->contact;
6814 $name = $self->company. " ($name)" if $self->company;
6820 Returns a name string for this (service/shipping) contact, either
6821 "Company (Last, First)" or "Last, First".
6827 if ( $self->get('ship_last') ) {
6828 my $name = $self->ship_contact;
6829 $name = $self->ship_company. " ($name)" if $self->ship_company;
6838 Returns a name string for this customer, either "Company" or "First Last".
6844 $self->company !~ /^\s*$/ ? $self->company : $self->contact_firstlast;
6847 =item ship_name_short
6849 Returns a name string for this (service/shipping) contact, either "Company"
6854 sub ship_name_short {
6856 if ( $self->get('ship_last') ) {
6857 $self->ship_company !~ /^\s*$/
6858 ? $self->ship_company
6859 : $self->ship_contact_firstlast;
6861 $self->name_company_or_firstlast;
6867 Returns this customer's full (billing) contact name only, "Last, First"
6873 $self->get('last'). ', '. $self->first;
6878 Returns this customer's full (shipping) contact name only, "Last, First"
6884 $self->get('ship_last')
6885 ? $self->get('ship_last'). ', '. $self->ship_first
6889 =item contact_firstlast
6891 Returns this customers full (billing) contact name only, "First Last".
6895 sub contact_firstlast {
6897 $self->first. ' '. $self->get('last');
6900 =item ship_contact_firstlast
6902 Returns this customer's full (shipping) contact name only, "First Last".
6906 sub ship_contact_firstlast {
6908 $self->get('ship_last')
6909 ? $self->first. ' '. $self->get('ship_last')
6910 : $self->contact_firstlast;
6915 Returns this customer's full country name
6921 code2country($self->country);
6924 =item geocode DATA_VENDOR
6926 Returns a value for the customer location as encoded by DATA_VENDOR.
6927 Currently this only makes sense for "CCH" as DATA_VENDOR.
6932 my ($self, $data_vendor) = (shift, shift); #always cch for now
6934 my $geocode = $self->get('geocode'); #XXX only one data_vendor for geocode
6935 return $geocode if $geocode;
6937 my $prefix = ( $conf->exists('tax-ship_address') && length($self->ship_last) )
6941 my ($zip,$plus4) = split /-/, $self->get("${prefix}zip")
6942 if $self->country eq 'US';
6944 #CCH specific location stuff
6945 my $extra_sql = "AND plus4lo <= '$plus4' AND plus4hi >= '$plus4'";
6947 my @cust_tax_location =
6949 'table' => 'cust_tax_location',
6950 'hashref' => { 'zip' => $zip, 'data_vendor' => $data_vendor },
6951 'extra_sql' => $extra_sql,
6952 'order_by' => 'ORDER BY plus4hi',#overlapping with distinct ends
6955 $geocode = $cust_tax_location[0]->geocode
6956 if scalar(@cust_tax_location);
6965 Returns a status string for this customer, currently:
6969 =item prospect - No packages have ever been ordered
6971 =item active - One or more recurring packages is active
6973 =item inactive - No active recurring packages, but otherwise unsuspended/uncancelled (the inactive status is new - previously inactive customers were mis-identified as cancelled)
6975 =item suspended - All non-cancelled recurring packages are suspended
6977 =item cancelled - All recurring packages are cancelled
6983 sub status { shift->cust_status(@_); }
6987 for my $status (qw( prospect active inactive suspended cancelled )) {
6988 my $method = $status.'_sql';
6989 my $numnum = ( my $sql = $self->$method() ) =~ s/cust_main\.custnum/?/g;
6990 my $sth = dbh->prepare("SELECT $sql") or die dbh->errstr;
6991 $sth->execute( ($self->custnum) x $numnum )
6992 or die "Error executing 'SELECT $sql': ". $sth->errstr;
6993 return $status if $sth->fetchrow_arrayref->[0];
6997 =item ucfirst_cust_status
6999 =item ucfirst_status
7001 Returns the status with the first character capitalized.
7005 sub ucfirst_status { shift->ucfirst_cust_status(@_); }
7007 sub ucfirst_cust_status {
7009 ucfirst($self->cust_status);
7014 Returns a hex triplet color string for this customer's status.
7018 use vars qw(%statuscolor);
7019 tie %statuscolor, 'Tie::IxHash',
7020 'prospect' => '7e0079', #'000000', #black? naw, purple
7021 'active' => '00CC00', #green
7022 'inactive' => '0000CC', #blue
7023 'suspended' => 'FF9900', #yellow
7024 'cancelled' => 'FF0000', #red
7027 sub statuscolor { shift->cust_statuscolor(@_); }
7029 sub cust_statuscolor {
7031 $statuscolor{$self->cust_status};
7036 Returns an array of hashes representing the customer's RT tickets.
7043 my $num = $conf->config('cust_main-max_tickets') || 10;
7046 if ( $conf->config('ticket_system') ) {
7047 unless ( $conf->config('ticket_system-custom_priority_field') ) {
7049 @tickets = @{ FS::TicketSystem->customer_tickets($self->custnum, $num) };
7053 foreach my $priority (
7054 $conf->config('ticket_system-custom_priority_field-values'), ''
7056 last if scalar(@tickets) >= $num;
7058 @{ FS::TicketSystem->customer_tickets( $self->custnum,
7059 $num - scalar(@tickets),
7069 # Return services representing svc_accts in customer support packages
7070 sub support_services {
7072 my %packages = map { $_ => 1 } $conf->config('support_packages');
7074 grep { $_->pkg_svc && $_->pkg_svc->primary_svc eq 'Y' }
7075 grep { $_->part_svc->svcdb eq 'svc_acct' }
7076 map { $_->cust_svc }
7077 grep { exists $packages{ $_->pkgpart } }
7078 $self->ncancelled_pkgs;
7084 =head1 CLASS METHODS
7090 Class method that returns the list of possible status strings for customers
7091 (see L<the status method|/status>). For example:
7093 @statuses = FS::cust_main->statuses();
7098 #my $self = shift; #could be class...
7104 Returns an SQL expression identifying prospective cust_main records (customers
7105 with no packages ever ordered)
7109 use vars qw($select_count_pkgs);
7110 $select_count_pkgs =
7111 "SELECT COUNT(*) FROM cust_pkg
7112 WHERE cust_pkg.custnum = cust_main.custnum";
7114 sub select_count_pkgs_sql {
7118 sub prospect_sql { "
7119 0 = ( $select_count_pkgs )
7124 Returns an SQL expression identifying active cust_main records (customers with
7125 active recurring packages).
7130 0 < ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. "
7136 Returns an SQL expression identifying inactive cust_main records (customers with
7137 no active recurring packages, but otherwise unsuspended/uncancelled).
7141 sub inactive_sql { "
7142 0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " )
7144 0 < ( $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " )
7150 Returns an SQL expression identifying suspended cust_main records.
7155 sub suspended_sql { susp_sql(@_); }
7157 0 < ( $select_count_pkgs AND ". FS::cust_pkg->suspended_sql. " )
7159 0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " )
7165 Returns an SQL expression identifying cancelled cust_main records.
7169 sub cancelled_sql { cancel_sql(@_); }
7172 my $recurring_sql = FS::cust_pkg->recurring_sql;
7173 my $cancelled_sql = FS::cust_pkg->cancelled_sql;
7176 0 < ( $select_count_pkgs )
7177 AND 0 < ( $select_count_pkgs AND $recurring_sql AND $cancelled_sql )
7178 AND 0 = ( $select_count_pkgs AND $recurring_sql
7179 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
7181 AND 0 = ( $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " )
7187 =item uncancelled_sql
7189 Returns an SQL expression identifying un-cancelled cust_main records.
7193 sub uncancelled_sql { uncancel_sql(@_); }
7194 sub uncancel_sql { "
7195 ( 0 < ( $select_count_pkgs
7196 AND ( cust_pkg.cancel IS NULL
7197 OR cust_pkg.cancel = 0
7200 OR 0 = ( $select_count_pkgs )
7206 Returns an SQL fragment to retreive the balance.
7211 ( SELECT COALESCE( SUM(charged), 0 ) FROM cust_bill
7212 WHERE cust_bill.custnum = cust_main.custnum )
7213 - ( SELECT COALESCE( SUM(paid), 0 ) FROM cust_pay
7214 WHERE cust_pay.custnum = cust_main.custnum )
7215 - ( SELECT COALESCE( SUM(amount), 0 ) FROM cust_credit
7216 WHERE cust_credit.custnum = cust_main.custnum )
7217 + ( SELECT COALESCE( SUM(refund), 0 ) FROM cust_refund
7218 WHERE cust_refund.custnum = cust_main.custnum )
7221 =item balance_date_sql START_TIME [ END_TIME [ OPTION => VALUE ... ] ]
7223 Returns an SQL fragment to retreive the balance for this customer, only
7224 considering invoices with date earlier than START_TIME, and optionally not
7225 later than END_TIME (total_owed_date minus total_unapplied_credits minus
7226 total_unapplied_payments).
7228 Times are specified as SQL fragments or numeric
7229 UNIX timestamps; see L<perlfunc/"time">). Also see L<Time::Local> and
7230 L<Date::Parse> for conversion functions. The empty string can be passed
7231 to disable that time constraint completely.
7233 Available options are:
7237 =item unapplied_date
7239 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)
7244 set to true to remove all customer comparison clauses, for totals
7249 WHERE clause hashref (elements "AND"ed together) (typically used with the total option)
7254 JOIN clause (typically used with the total option)
7260 sub balance_date_sql {
7261 my( $class, $start, $end, %opt ) = @_;
7263 my $owed = FS::cust_bill->owed_sql;
7264 my $unapp_refund = FS::cust_refund->unapplied_sql;
7265 my $unapp_credit = FS::cust_credit->unapplied_sql;
7266 my $unapp_pay = FS::cust_pay->unapplied_sql;
7268 my $j = $opt{'join'} || '';
7270 my $owed_wh = $class->_money_table_where( 'cust_bill', $start,$end,%opt );
7271 my $refund_wh = $class->_money_table_where( 'cust_refund', $start,$end,%opt );
7272 my $credit_wh = $class->_money_table_where( 'cust_credit', $start,$end,%opt );
7273 my $pay_wh = $class->_money_table_where( 'cust_pay', $start,$end,%opt );
7275 " ( SELECT COALESCE(SUM($owed), 0) FROM cust_bill $j $owed_wh )
7276 + ( SELECT COALESCE(SUM($unapp_refund), 0) FROM cust_refund $j $refund_wh )
7277 - ( SELECT COALESCE(SUM($unapp_credit), 0) FROM cust_credit $j $credit_wh )
7278 - ( SELECT COALESCE(SUM($unapp_pay), 0) FROM cust_pay $j $pay_wh )
7283 =item _money_table_where TABLE START_TIME [ END_TIME [ OPTION => VALUE ... ] ]
7285 Helper method for balance_date_sql; name (and usage) subject to change
7286 (suggestions welcome).
7288 Returns a WHERE clause for the specified monetary TABLE (cust_bill,
7289 cust_refund, cust_credit or cust_pay).
7291 If TABLE is "cust_bill" or the unapplied_date option is true, only
7292 considers records with date earlier than START_TIME, and optionally not
7293 later than END_TIME .
7297 sub _money_table_where {
7298 my( $class, $table, $start, $end, %opt ) = @_;
7301 push @where, "cust_main.custnum = $table.custnum" unless $opt{'total'};
7302 if ( $table eq 'cust_bill' || $opt{'unapplied_date'} ) {
7303 push @where, "$table._date <= $start" if defined($start) && length($start);
7304 push @where, "$table._date > $end" if defined($end) && length($end);
7306 push @where, @{$opt{'where'}} if $opt{'where'};
7307 my $where = scalar(@where) ? 'WHERE '. join(' AND ', @where ) : '';
7313 =item search_sql HASHREF
7317 Returns a qsearch hash expression to search for parameters specified in HREF.
7318 Valid parameters are
7326 =item cancelled_pkgs
7332 listref of start date, end date
7338 =item current_balance
7340 listref (list returned by FS::UI::Web::parse_lt_gt($cgi, 'current_balance'))
7344 =item flattened_pkgs
7353 my ($class, $params) = @_;
7364 if ( $params->{'agentnum'} =~ /^(\d+)$/ and $1 ) {
7366 "cust_main.agentnum = $1";
7373 #prospect active inactive suspended cancelled
7374 if ( grep { $params->{'status'} eq $_ } FS::cust_main->statuses() ) {
7375 my $method = $params->{'status'}. '_sql';
7376 #push @where, $class->$method();
7377 push @where, FS::cust_main->$method();
7381 # parse cancelled package checkbox
7386 $pkgwhere .= "AND (cancel = 0 or cancel is null)"
7387 unless $params->{'cancelled_pkgs'};
7393 foreach my $field (qw( signupdate )) {
7395 next unless exists($params->{$field});
7397 my($beginning, $ending) = @{$params->{$field}};
7400 "cust_main.$field IS NOT NULL",
7401 "cust_main.$field >= $beginning",
7402 "cust_main.$field <= $ending";
7404 $orderby ||= "ORDER BY cust_main.$field";
7412 my @payby = grep /^([A-Z]{4})$/, @{ $params->{'payby'} };
7414 push @where, '( '. join(' OR ', map "cust_main.payby = '$_'", @payby). ' )';
7421 #my $balance_sql = $class->balance_sql();
7422 my $balance_sql = FS::cust_main->balance_sql();
7424 push @where, map { s/current_balance/$balance_sql/; $_ }
7425 @{ $params->{'current_balance'} };
7431 if ( $params->{'custbatch'} =~ /^([\w\/\-\:\.]+)$/ and $1 ) {
7433 "cust_main.custbatch = '$1'";
7437 # setup queries, subs, etc. for the search
7440 $orderby ||= 'ORDER BY custnum';
7442 # here is the agent virtualization
7443 push @where, $FS::CurrentUser::CurrentUser->agentnums_sql;
7445 my $extra_sql = scalar(@where) ? ' WHERE '. join(' AND ', @where) : '';
7447 my $addl_from = 'LEFT JOIN cust_pkg USING ( custnum ) ';
7449 my $count_query = "SELECT COUNT(*) FROM cust_main $extra_sql";
7451 my $select = join(', ',
7452 'cust_main.custnum',
7453 FS::UI::Web::cust_sql_fields($params->{'cust_fields'}),
7456 my(@extra_headers) = ();
7457 my(@extra_fields) = ();
7459 if ($params->{'flattened_pkgs'}) {
7461 if ($dbh->{Driver}->{Name} eq 'Pg') {
7463 $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";
7465 }elsif ($dbh->{Driver}->{Name} =~ /^mysql/i) {
7466 $select .= ", GROUP_CONCAT(pkg SEPARATOR '|') as magic";
7467 $addl_from .= " LEFT JOIN part_pkg using ( pkgpart )";
7469 warn "warning: unknown database type ". $dbh->{Driver}->{Name}.
7470 "omitting packing information from report.";
7473 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";
7475 my $sth = dbh->prepare($header_query) or die dbh->errstr;
7476 $sth->execute() or die $sth->errstr;
7477 my $headerrow = $sth->fetchrow_arrayref;
7478 my $headercount = $headerrow ? $headerrow->[0] : 0;
7479 while($headercount) {
7480 unshift @extra_headers, "Package ". $headercount;
7481 unshift @extra_fields, eval q!sub {my $c = shift;
7482 my @a = split '\|', $c->magic;
7483 my $p = $a[!.--$headercount. q!];
7491 'table' => 'cust_main',
7492 'select' => $select,
7494 'extra_sql' => $extra_sql,
7495 'order_by' => $orderby,
7496 'count_query' => $count_query,
7497 'extra_headers' => \@extra_headers,
7498 'extra_fields' => \@extra_fields,
7503 =item email_search_sql HASHREF
7507 Emails a notice to the specified customers.
7509 Valid parameters are those of the L<search_sql> method, plus the following:
7531 Optional job queue job for status updates.
7535 Returns an error message, or false for success.
7537 If an error occurs during any email, stops the enture send and returns that
7538 error. Presumably if you're getting SMTP errors aborting is better than
7539 retrying everything.
7543 sub email_search_sql {
7544 my($class, $params) = @_;
7546 my $from = delete $params->{from};
7547 my $subject = delete $params->{subject};
7548 my $html_body = delete $params->{html_body};
7549 my $text_body = delete $params->{text_body};
7551 my $job = delete $params->{'job'};
7553 my $sql_query = $class->search_sql($params);
7555 my $count_query = delete($sql_query->{'count_query'});
7556 my $count_sth = dbh->prepare($count_query)
7557 or die "Error preparing $count_query: ". dbh->errstr;
7559 or die "Error executing $count_query: ". $count_sth->errstr;
7560 my $count_arrayref = $count_sth->fetchrow_arrayref;
7561 my $num_cust = $count_arrayref->[0];
7563 #my @extra_headers = @{ delete($sql_query->{'extra_headers'}) };
7564 #my @extra_fields = @{ delete($sql_query->{'extra_fields'}) };
7567 my( $num, $last, $min_sec ) = (0, time, 5); #progresbar foo
7569 #eventually order+limit magic to reduce memory use?
7570 foreach my $cust_main ( qsearch($sql_query) ) {
7572 my $to = $cust_main->invoicing_list_emailonly_scalar;
7575 my $error = send_email(
7579 'subject' => $subject,
7580 'html_body' => $html_body,
7581 'text_body' => $text_body,
7584 return $error if $error;
7586 if ( $job ) { #progressbar foo
7588 if ( time - $min_sec > $last ) {
7589 my $error = $job->update_statustext(
7590 int( 100 * $num / $num_cust )
7592 die $error if $error;
7602 use Storable qw(thaw);
7605 sub process_email_search_sql {
7607 #warn "$me process_re_X $method for job $job\n" if $DEBUG;
7609 my $param = thaw(decode_base64(shift));
7610 warn Dumper($param) if $DEBUG;
7612 $param->{'job'} = $job;
7614 my $error = FS::cust_main->email_search_sql( $param );
7615 die $error if $error;
7619 =item fuzzy_search FUZZY_HASHREF [ HASHREF, SELECT, EXTRA_SQL, CACHE_OBJ ]
7621 Performs a fuzzy (approximate) search and returns the matching FS::cust_main
7622 records. Currently, I<first>, I<last> and/or I<company> may be specified (the
7623 appropriate ship_ field is also searched).
7625 Additional options are the same as FS::Record::qsearch
7630 my( $self, $fuzzy, $hash, @opt) = @_;
7635 check_and_rebuild_fuzzyfiles();
7636 foreach my $field ( keys %$fuzzy ) {
7638 my $all = $self->all_X($field);
7639 next unless scalar(@$all);
7642 $match{$_}=1 foreach ( amatch( $fuzzy->{$field}, ['i'], @$all ) );
7645 foreach ( keys %match ) {
7646 push @fcust, qsearch('cust_main', { %$hash, $field=>$_}, @opt);
7647 push @fcust, qsearch('cust_main', { %$hash, "ship_$field"=>$_}, @opt);
7650 push @cust_main, grep { ! $fsaw{$_->custnum}++ } @fcust;
7653 # we want the components of $fuzzy ANDed, not ORed, but still don't want dupes
7655 @cust_main = grep { ++$saw{$_->custnum} == scalar(keys %$fuzzy) } @cust_main;
7663 Returns a masked version of the named field
7668 my ($self,$field) = @_;
7672 'x'x(length($self->getfield($field))-4).
7673 substr($self->getfield($field), (length($self->getfield($field))-4));
7683 =item smart_search OPTION => VALUE ...
7685 Accepts the following options: I<search>, the string to search for. The string
7686 will be searched for as a customer number, phone number, name or company name,
7687 as an exact, or, in some cases, a substring or fuzzy match (see the source code
7688 for the exact heuristics used); I<no_fuzzy_on_exact>, causes smart_search to
7689 skip fuzzy matching when an exact match is found.
7691 Any additional options are treated as an additional qualifier on the search
7694 Returns a (possibly empty) array of FS::cust_main objects.
7701 #here is the agent virtualization
7702 my $agentnums_sql = $FS::CurrentUser::CurrentUser->agentnums_sql;
7706 my $skip_fuzzy = delete $options{'no_fuzzy_on_exact'};
7707 my $search = delete $options{'search'};
7708 ( my $alphanum_search = $search ) =~ s/\W//g;
7710 if ( $alphanum_search =~ /^1?(\d{3})(\d{3})(\d{4})(\d*)$/ ) { #phone# search
7712 #false laziness w/Record::ut_phone
7713 my $phonen = "$1-$2-$3";
7714 $phonen .= " x$4" if $4;
7716 push @cust_main, qsearch( {
7717 'table' => 'cust_main',
7718 'hashref' => { %options },
7719 'extra_sql' => ( scalar(keys %options) ? ' AND ' : ' WHERE ' ).
7721 join(' OR ', map "$_ = '$phonen'",
7722 qw( daytime night fax
7723 ship_daytime ship_night ship_fax )
7726 " AND $agentnums_sql", #agent virtualization
7729 unless ( @cust_main || $phonen =~ /x\d+$/ ) { #no exact match
7730 #try looking for matches with extensions unless one was specified
7732 push @cust_main, qsearch( {
7733 'table' => 'cust_main',
7734 'hashref' => { %options },
7735 'extra_sql' => ( scalar(keys %options) ? ' AND ' : ' WHERE ' ).
7737 join(' OR ', map "$_ LIKE '$phonen\%'",
7739 ship_daytime ship_night )
7742 " AND $agentnums_sql", #agent virtualization
7747 # custnum search (also try agent_custid), with some tweaking options if your
7748 # legacy cust "numbers" have letters
7751 if ( $search =~ /^\s*(\d+)\s*$/
7752 || ( $conf->config('cust_main-agent_custid-format') eq 'ww?d+'
7753 && $search =~ /^\s*(\w\w?\d+)\s*$/
7760 if ( $num <= 2147483647 ) { #need a bigint custnum? wow.
7761 push @cust_main, qsearch( {
7762 'table' => 'cust_main',
7763 'hashref' => { 'custnum' => $num, %options },
7764 'extra_sql' => " AND $agentnums_sql", #agent virtualization
7768 push @cust_main, qsearch( {
7769 'table' => 'cust_main',
7770 'hashref' => { 'agent_custid' => $num, %options },
7771 'extra_sql' => " AND $agentnums_sql", #agent virtualization
7774 } elsif ( $search =~ /^\s*(\S.*\S)\s+\((.+), ([^,]+)\)\s*$/ ) {
7776 my($company, $last, $first) = ( $1, $2, $3 );
7778 # "Company (Last, First)"
7779 #this is probably something a browser remembered,
7780 #so just do an exact search
7782 foreach my $prefix ( '', 'ship_' ) {
7783 push @cust_main, qsearch( {
7784 'table' => 'cust_main',
7785 'hashref' => { $prefix.'first' => $first,
7786 $prefix.'last' => $last,
7787 $prefix.'company' => $company,
7790 'extra_sql' => " AND $agentnums_sql",
7794 } elsif ( $search =~ /^\s*(\S.*\S)\s*$/ ) { # value search
7795 # try (ship_){last,company}
7799 # # remove "(Last, First)" in "Company (Last, First)", otherwise the
7800 # # full strings the browser remembers won't work
7801 # $value =~ s/\([\w \,\.\-\']*\)$//; #false laziness w/Record::ut_name
7803 use Lingua::EN::NameParse;
7804 my $NameParse = new Lingua::EN::NameParse(
7806 allow_reversed => 1,
7809 my($last, $first) = ( '', '' );
7810 #maybe disable this too and just rely on NameParse?
7811 if ( $value =~ /^(.+),\s*([^,]+)$/ ) { # Last, First
7813 ($last, $first) = ( $1, $2 );
7815 #} elsif ( $value =~ /^(.+)\s+(.+)$/ ) {
7816 } elsif ( ! $NameParse->parse($value) ) {
7818 my %name = $NameParse->components;
7819 $first = $name{'given_name_1'};
7820 $last = $name{'surname_1'};
7824 if ( $first && $last ) {
7826 my($q_last, $q_first) = ( dbh->quote($last), dbh->quote($first) );
7829 my $sql = scalar(keys %options) ? ' AND ' : ' WHERE ';
7831 ( ( LOWER(last) = $q_last AND LOWER(first) = $q_first )
7832 OR ( LOWER(ship_last) = $q_last AND LOWER(ship_first) = $q_first )
7835 push @cust_main, qsearch( {
7836 'table' => 'cust_main',
7837 'hashref' => \%options,
7838 'extra_sql' => "$sql AND $agentnums_sql", #agent virtualization
7841 # or it just be something that was typed in... (try that in a sec)
7845 my $q_value = dbh->quote($value);
7848 my $sql = scalar(keys %options) ? ' AND ' : ' WHERE ';
7849 $sql .= " ( LOWER(last) = $q_value
7850 OR LOWER(company) = $q_value
7851 OR LOWER(ship_last) = $q_value
7852 OR LOWER(ship_company) = $q_value
7855 push @cust_main, qsearch( {
7856 'table' => 'cust_main',
7857 'hashref' => \%options,
7858 'extra_sql' => "$sql AND $agentnums_sql", #agent virtualization
7861 #no exact match, trying substring/fuzzy
7862 #always do substring & fuzzy (unless they're explicity config'ed off)
7863 #getting complaints searches are not returning enough
7864 unless ( @cust_main && $skip_fuzzy || $conf->exists('disable-fuzzy') ) {
7866 #still some false laziness w/search_sql (was search/cust_main.cgi)
7871 { 'company' => { op=>'ILIKE', value=>"%$value%" }, },
7872 { 'ship_company' => { op=>'ILIKE', value=>"%$value%" }, },
7875 if ( $first && $last ) {
7878 { 'first' => { op=>'ILIKE', value=>"%$first%" },
7879 'last' => { op=>'ILIKE', value=>"%$last%" },
7881 { 'ship_first' => { op=>'ILIKE', value=>"%$first%" },
7882 'ship_last' => { op=>'ILIKE', value=>"%$last%" },
7889 { 'last' => { op=>'ILIKE', value=>"%$value%" }, },
7890 { 'ship_last' => { op=>'ILIKE', value=>"%$value%" }, },
7894 foreach my $hashref ( @hashrefs ) {
7896 push @cust_main, qsearch( {
7897 'table' => 'cust_main',
7898 'hashref' => { %$hashref,
7901 'extra_sql' => " AND $agentnums_sql", #agent virtualizaiton
7910 " AND $agentnums_sql", #extra_sql #agent virtualization
7913 if ( $first && $last ) {
7914 push @cust_main, FS::cust_main->fuzzy_search(
7915 { 'last' => $last, #fuzzy hashref
7916 'first' => $first }, #
7920 foreach my $field ( 'last', 'company' ) {
7922 FS::cust_main->fuzzy_search( { $field => $value }, @fuzopts );
7927 #eliminate duplicates
7929 @cust_main = grep { !$saw{$_->custnum}++ } @cust_main;
7939 Accepts the following options: I<email>, the email address to search for. The
7940 email address will be searched for as an email invoice destination and as an
7943 #Any additional options are treated as an additional qualifier on the search
7944 #(i.e. I<agentnum>).
7946 Returns a (possibly empty) array of FS::cust_main objects (but usually just
7956 my $email = delete $options{'email'};
7958 #we're only being used by RT at the moment... no agent virtualization yet
7959 #my $agentnums_sql = $FS::CurrentUser::CurrentUser->agentnums_sql;
7963 if ( $email =~ /([^@]+)\@([^@]+)/ ) {
7965 my ( $user, $domain ) = ( $1, $2 );
7967 warn "$me smart_search: searching for $user in domain $domain"
7973 'table' => 'cust_main_invoice',
7974 'hashref' => { 'dest' => $email },
7981 map $_->cust_svc->cust_pkg,
7983 'table' => 'svc_acct',
7984 'hashref' => { 'username' => $user, },
7986 'AND ( SELECT domain FROM svc_domain
7987 WHERE svc_acct.domsvc = svc_domain.svcnum
7988 ) = '. dbh->quote($domain),
7994 @cust_main = grep { !$saw{$_->custnum}++ } @cust_main;
7996 warn "$me smart_search: found ". scalar(@cust_main). " unique customers"
8003 =item check_and_rebuild_fuzzyfiles
8007 use vars qw(@fuzzyfields);
8008 @fuzzyfields = ( 'last', 'first', 'company' );
8010 sub check_and_rebuild_fuzzyfiles {
8011 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
8012 rebuild_fuzzyfiles() if grep { ! -e "$dir/cust_main.$_" } @fuzzyfields
8015 =item rebuild_fuzzyfiles
8019 sub rebuild_fuzzyfiles {
8021 use Fcntl qw(:flock);
8023 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
8024 mkdir $dir, 0700 unless -d $dir;
8026 foreach my $fuzzy ( @fuzzyfields ) {
8028 open(LOCK,">>$dir/cust_main.$fuzzy")
8029 or die "can't open $dir/cust_main.$fuzzy: $!";
8031 or die "can't lock $dir/cust_main.$fuzzy: $!";
8033 open (CACHE,">$dir/cust_main.$fuzzy.tmp")
8034 or die "can't open $dir/cust_main.$fuzzy.tmp: $!";
8036 foreach my $field ( $fuzzy, "ship_$fuzzy" ) {
8037 my $sth = dbh->prepare("SELECT $field FROM cust_main".
8038 " WHERE $field != '' AND $field IS NOT NULL");
8039 $sth->execute or die $sth->errstr;
8041 while ( my $row = $sth->fetchrow_arrayref ) {
8042 print CACHE $row->[0]. "\n";
8047 close CACHE or die "can't close $dir/cust_main.$fuzzy.tmp: $!";
8049 rename "$dir/cust_main.$fuzzy.tmp", "$dir/cust_main.$fuzzy";
8060 my( $self, $field ) = @_;
8061 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
8062 open(CACHE,"<$dir/cust_main.$field")
8063 or die "can't open $dir/cust_main.$field: $!";
8064 my @array = map { chomp; $_; } <CACHE>;
8069 =item append_fuzzyfiles LASTNAME COMPANY
8073 sub append_fuzzyfiles {
8074 #my( $first, $last, $company ) = @_;
8076 &check_and_rebuild_fuzzyfiles;
8078 use Fcntl qw(:flock);
8080 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
8082 foreach my $field (qw( first last company )) {
8087 open(CACHE,">>$dir/cust_main.$field")
8088 or die "can't open $dir/cust_main.$field: $!";
8089 flock(CACHE,LOCK_EX)
8090 or die "can't lock $dir/cust_main.$field: $!";
8092 print CACHE "$value\n";
8094 flock(CACHE,LOCK_UN)
8095 or die "can't unlock $dir/cust_main.$field: $!";
8110 #warn join('-',keys %$param);
8111 my $fh = $param->{filehandle};
8112 my @fields = @{$param->{fields}};
8114 eval "use Text::CSV_XS;";
8117 my $csv = new Text::CSV_XS;
8124 local $SIG{HUP} = 'IGNORE';
8125 local $SIG{INT} = 'IGNORE';
8126 local $SIG{QUIT} = 'IGNORE';
8127 local $SIG{TERM} = 'IGNORE';
8128 local $SIG{TSTP} = 'IGNORE';
8129 local $SIG{PIPE} = 'IGNORE';
8131 my $oldAutoCommit = $FS::UID::AutoCommit;
8132 local $FS::UID::AutoCommit = 0;
8135 #while ( $columns = $csv->getline($fh) ) {
8137 while ( defined($line=<$fh>) ) {
8139 $csv->parse($line) or do {
8140 $dbh->rollback if $oldAutoCommit;
8141 return "can't parse: ". $csv->error_input();
8144 my @columns = $csv->fields();
8145 #warn join('-',@columns);
8148 foreach my $field ( @fields ) {
8149 $row{$field} = shift @columns;
8152 my $cust_main = qsearchs('cust_main', { 'custnum' => $row{'custnum'} } );
8153 unless ( $cust_main ) {
8154 $dbh->rollback if $oldAutoCommit;
8155 return "unknown custnum $row{'custnum'}";
8158 if ( $row{'amount'} > 0 ) {
8159 my $error = $cust_main->charge($row{'amount'}, $row{'pkg'});
8161 $dbh->rollback if $oldAutoCommit;
8165 } elsif ( $row{'amount'} < 0 ) {
8166 my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ),
8169 $dbh->rollback if $oldAutoCommit;
8179 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
8181 return "Empty file!" unless $imported;
8187 =item notify CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
8189 Sends a templated email notification to the customer (see L<Text::Template>).
8191 OPTIONS is a hash and may include
8193 I<from> - the email sender (default is invoice_from)
8195 I<to> - comma-separated scalar or arrayref of recipients
8196 (default is invoicing_list)
8198 I<subject> - The subject line of the sent email notification
8199 (default is "Notice from company_name")
8201 I<extra_fields> - a hashref of name/value pairs which will be substituted
8204 The following variables are vavailable in the template.
8206 I<$first> - the customer first name
8207 I<$last> - the customer last name
8208 I<$company> - the customer company
8209 I<$payby> - a description of the method of payment for the customer
8210 # would be nice to use FS::payby::shortname
8211 I<$payinfo> - the account information used to collect for this customer
8212 I<$expdate> - the expiration of the customer payment in seconds from epoch
8217 my ($self, $template, %options) = @_;
8219 return unless $conf->exists($template);
8221 my $from = $conf->config('invoice_from', $self->agentnum)
8222 if $conf->exists('invoice_from', $self->agentnum);
8223 $from = $options{from} if exists($options{from});
8225 my $to = join(',', $self->invoicing_list_emailonly);
8226 $to = $options{to} if exists($options{to});
8228 my $subject = "Notice from " . $conf->config('company_name', $self->agentnum)
8229 if $conf->exists('company_name', $self->agentnum);
8230 $subject = $options{subject} if exists($options{subject});
8232 my $notify_template = new Text::Template (TYPE => 'ARRAY',
8233 SOURCE => [ map "$_\n",
8234 $conf->config($template)]
8236 or die "can't create new Text::Template object: Text::Template::ERROR";
8237 $notify_template->compile()
8238 or die "can't compile template: Text::Template::ERROR";
8240 $FS::notify_template::_template::company_name =
8241 $conf->config('company_name', $self->agentnum);
8242 $FS::notify_template::_template::company_address =
8243 join("\n", $conf->config('company_address', $self->agentnum) ). "\n";
8245 my $paydate = $self->paydate || '2037-12-31';
8246 $FS::notify_template::_template::first = $self->first;
8247 $FS::notify_template::_template::last = $self->last;
8248 $FS::notify_template::_template::company = $self->company;
8249 $FS::notify_template::_template::payinfo = $self->mask_payinfo;
8250 my $payby = $self->payby;
8251 my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
8252 my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
8254 #credit cards expire at the end of the month/year of their exp date
8255 if ($payby eq 'CARD' || $payby eq 'DCRD') {
8256 $FS::notify_template::_template::payby = 'credit card';
8257 ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
8258 $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
8260 }elsif ($payby eq 'COMP') {
8261 $FS::notify_template::_template::payby = 'complimentary account';
8263 $FS::notify_template::_template::payby = 'current method';
8265 $FS::notify_template::_template::expdate = $expire_time;
8267 for (keys %{$options{extra_fields}}){
8269 ${"FS::notify_template::_template::$_"} = $options{extra_fields}->{$_};
8272 send_email(from => $from,
8274 subject => $subject,
8275 body => $notify_template->fill_in( PACKAGE =>
8276 'FS::notify_template::_template' ),
8281 =item generate_letter CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
8283 Generates a templated notification to the customer (see L<Text::Template>).
8285 OPTIONS is a hash and may include
8287 I<extra_fields> - a hashref of name/value pairs which will be substituted
8288 into the template. These values may override values mentioned below
8289 and those from the customer record.
8291 The following variables are available in the template instead of or in addition
8292 to the fields of the customer record.
8294 I<$payby> - a description of the method of payment for the customer
8295 # would be nice to use FS::payby::shortname
8296 I<$payinfo> - the masked account information used to collect for this customer
8297 I<$expdate> - the expiration of the customer payment method in seconds from epoch
8298 I<$returnaddress> - the return address defaults to invoice_latexreturnaddress or company_address
8302 sub generate_letter {
8303 my ($self, $template, %options) = @_;
8305 return unless $conf->exists($template);
8307 my $letter_template = new Text::Template
8309 SOURCE => [ map "$_\n", $conf->config($template)],
8310 DELIMITERS => [ '[@--', '--@]' ],
8312 or die "can't create new Text::Template object: Text::Template::ERROR";
8314 $letter_template->compile()
8315 or die "can't compile template: Text::Template::ERROR";
8317 my %letter_data = map { $_ => $self->$_ } $self->fields;
8318 $letter_data{payinfo} = $self->mask_payinfo;
8320 #my $paydate = $self->paydate || '2037-12-31';
8321 my $paydate = $self->paydate =~ /^\S+$/ ? $self->paydate : '2037-12-31';
8323 my $payby = $self->payby;
8324 my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
8325 my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
8327 #credit cards expire at the end of the month/year of their exp date
8328 if ($payby eq 'CARD' || $payby eq 'DCRD') {
8329 $letter_data{payby} = 'credit card';
8330 ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
8331 $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
8333 }elsif ($payby eq 'COMP') {
8334 $letter_data{payby} = 'complimentary account';
8336 $letter_data{payby} = 'current method';
8338 $letter_data{expdate} = $expire_time;
8340 for (keys %{$options{extra_fields}}){
8341 $letter_data{$_} = $options{extra_fields}->{$_};
8344 unless(exists($letter_data{returnaddress})){
8345 my $retadd = join("\n", $conf->config_orbase( 'invoice_latexreturnaddress',
8346 $self->agent_template)
8348 if ( length($retadd) ) {
8349 $letter_data{returnaddress} = $retadd;
8350 } elsif ( grep /\S/, $conf->config('company_address', $self->agentnum) ) {
8351 $letter_data{returnaddress} =
8352 join( '\\*'."\n", map s/( {2,})/'~' x length($1)/eg,
8353 $conf->config('company_address', $self->agentnum)
8356 $letter_data{returnaddress} = '~';
8360 $letter_data{conf_dir} = "$FS::UID::conf_dir/conf.$FS::UID::datasrc";
8362 $letter_data{company_name} = $conf->config('company_name', $self->agentnum);
8364 my $dir = $FS::UID::conf_dir."/cache.". $FS::UID::datasrc;
8365 my $fh = new File::Temp( TEMPLATE => 'letter.'. $self->custnum. '.XXXXXXXX',
8369 ) or die "can't open temp file: $!\n";
8371 $letter_template->fill_in( OUTPUT => $fh, HASH => \%letter_data );
8373 $fh->filename =~ /^(.*).tex$/ or die "unparsable filename: ". $fh->filename;
8377 =item print_ps TEMPLATE
8379 Returns an postscript letter filled in from TEMPLATE, as a scalar.
8385 my $file = $self->generate_letter(@_);
8386 FS::Misc::generate_ps($file);
8389 =item print TEMPLATE
8391 Prints the filled in template.
8393 TEMPLATE is the name of a L<Text::Template> to fill in and print.
8397 sub queueable_print {
8400 my $self = qsearchs('cust_main', { 'custnum' => $opt{custnum} } )
8401 or die "invalid customer number: " . $opt{custvnum};
8403 my $error = $self->print( $opt{template} );
8404 die $error if $error;
8408 my ($self, $template) = (shift, shift);
8409 do_print [ $self->print_ps($template) ];
8412 #these three subs should just go away once agent stuff is all config overrides
8414 sub agent_template {
8416 $self->_agent_plandata('agent_templatename');
8419 sub agent_invoice_from {
8421 $self->_agent_plandata('agent_invoice_from');
8424 sub _agent_plandata {
8425 my( $self, $option ) = @_;
8427 #yuck. this whole thing needs to be reconciled better with 1.9's idea of
8428 #agent-specific Conf
8430 use FS::part_event::Condition;
8432 my $agentnum = $self->agentnum;
8435 if ( driver_name =~ /^Pg/i ) {
8437 } elsif ( driver_name =~ /^mysql/i ) {
8440 die "don't know how to use regular expressions in ". driver_name. " databases";
8443 my $part_event_option =
8445 'select' => 'part_event_option.*',
8446 'table' => 'part_event_option',
8448 LEFT JOIN part_event USING ( eventpart )
8449 LEFT JOIN part_event_option AS peo_agentnum
8450 ON ( part_event.eventpart = peo_agentnum.eventpart
8451 AND peo_agentnum.optionname = 'agentnum'
8452 AND peo_agentnum.optionvalue }. $regexp. q{ '(^|,)}. $agentnum. q{(,|$)'
8454 LEFT JOIN part_event_condition
8455 ON ( part_event.eventpart = part_event_condition.eventpart
8456 AND part_event_condition.conditionname = 'cust_bill_age'
8458 LEFT JOIN part_event_condition_option
8459 ON ( part_event_condition.eventconditionnum = part_event_condition_option.eventconditionnum
8460 AND part_event_condition_option.optionname = 'age'
8463 #'hashref' => { 'optionname' => $option },
8464 #'hashref' => { 'part_event_option.optionname' => $option },
8466 " WHERE part_event_option.optionname = ". dbh->quote($option).
8467 " AND action = 'cust_bill_send_agent' ".
8468 " AND ( disabled IS NULL OR disabled != 'Y' ) ".
8469 " AND peo_agentnum.optionname = 'agentnum' ".
8470 " AND ( agentnum IS NULL OR agentnum = $agentnum ) ".
8472 CASE WHEN part_event_condition_option.optionname IS NULL
8474 ELSE ". FS::part_event::Condition->age2seconds_sql('part_event_condition_option.optionvalue').
8476 , part_event.weight".
8480 unless ( $part_event_option ) {
8481 return $self->agent->invoice_template || ''
8482 if $option eq 'agent_templatename';
8486 $part_event_option->optionvalue;
8491 ## actual sub, not a method, designed to be called from the queue.
8492 ## sets up the customer, and calls the bill_and_collect
8493 my (%args) = @_; #, ($time, $invoice_time, $check_freq, $resetup) = @_;
8494 my $cust_main = qsearchs( 'cust_main', { custnum => $args{'custnum'} } );
8495 $cust_main->bill_and_collect(
8500 sub _upgrade_data { #class method
8501 my ($class, %opts) = @_;
8503 my $sql = 'UPDATE h_cust_main SET paycvv = NULL WHERE paycvv IS NOT NULL';
8504 my $sth = dbh->prepare($sql) or die dbh->errstr;
8505 $sth->execute or die $sth->errstr;
8515 The delete method should possibly take an FS::cust_main object reference
8516 instead of a scalar customer number.
8518 Bill and collect options should probably be passed as references instead of a
8521 There should probably be a configuration file with a list of allowed credit
8524 No multiple currency support (probably a larger project than just this module).
8526 payinfo_masked false laziness with cust_pay.pm and cust_refund.pm
8528 Birthdates rely on negative epoch values.
8530 The payby for card/check batches is broken. With mixed batching, bad
8533 B<collect> I<invoice_time> should be renamed I<time>, like B<bill>.
8537 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
8538 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
8539 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.