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 ) = @_;
2232 #$options{actual_time} not $options{time} because freeside-daily -d is for
2233 #pre-printing invoices
2234 my @cancel_pkgs = grep { $_->expire && $_->expire <= $options{actual_time} }
2235 $self->ncancelled_pkgs;
2237 foreach my $cust_pkg ( @cancel_pkgs ) {
2238 my $cpr = $cust_pkg->last_cust_pkg_reason('expire');
2239 my $error = $cust_pkg->cancel($cpr ? ( 'reason' => $cpr->reasonnum,
2240 'reason_otaker' => $cpr->otaker
2244 warn "Error cancelling expired pkg ". $cust_pkg->pkgnum.
2245 " for custnum ". $self->custnum. ": $error"
2253 #$options{actual_time} not $options{time} because freeside-daily -d is for
2254 #pre-printing invoices
2257 && ( ( $_->part_pkg->is_prepaid
2259 && $_->bill < $options{actual_time}
2262 && $_->adjourn <= $options{actual_time}
2266 $self->ncancelled_pkgs;
2268 foreach my $cust_pkg ( @susp_pkgs ) {
2269 my $cpr = $cust_pkg->last_cust_pkg_reason('adjourn')
2270 if ($cust_pkg->adjourn && $cust_pkg->adjourn < $^T);
2271 my $error = $cust_pkg->suspend($cpr ? ( 'reason' => $cpr->reasonnum,
2272 'reason_otaker' => $cpr->otaker
2277 warn "Error suspending package ". $cust_pkg->pkgnum.
2278 " for custnum ". $self->custnum. ": $error"
2286 my $error = $self->bill( %options );
2287 warn "Error billing, custnum ". $self->custnum. ": $error" if $error;
2289 $self->apply_payments_and_credits;
2291 $error = $self->collect( %options );
2292 warn "Error collecting, custnum". $self->custnum. ": $error" if $error;
2298 Generates invoices (see L<FS::cust_bill>) for this customer. Usually used in
2299 conjunction with the collect method by calling B<bill_and_collect>.
2301 If there is an error, returns the error, otherwise returns false.
2303 Options are passed as name-value pairs. Currently available options are:
2309 If set true, re-charges setup fees.
2313 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:
2317 $cust_main->bill( 'time' => str2time('April 20th, 2001') );
2321 An array ref of specific packages (objects) to attempt billing, instead trying all of them.
2323 $cust_main->bill( pkg_list => [$pkg1, $pkg2] );
2327 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.
2334 my( $self, %options ) = @_;
2335 return '' if $self->payby eq 'COMP';
2336 warn "$me bill customer ". $self->custnum. "\n"
2339 my $time = $options{'time'} || time;
2340 my $invoice_time = $options{'invoice_time'} || $time;
2343 local $SIG{HUP} = 'IGNORE';
2344 local $SIG{INT} = 'IGNORE';
2345 local $SIG{QUIT} = 'IGNORE';
2346 local $SIG{TERM} = 'IGNORE';
2347 local $SIG{TSTP} = 'IGNORE';
2348 local $SIG{PIPE} = 'IGNORE';
2350 my $oldAutoCommit = $FS::UID::AutoCommit;
2351 local $FS::UID::AutoCommit = 0;
2354 $self->select_for_update; #mutex
2356 my @cust_bill_pkg = ();
2359 # find the packages which are due for billing, find out how much they are
2360 # & generate invoice database.
2363 my( $total_setup, $total_recur, $postal_charge ) = ( 0, 0, 0 );
2365 my @precommit_hooks = ();
2367 my @cust_pkgs = qsearch('cust_pkg', { 'custnum' => $self->custnum } );
2368 foreach my $cust_pkg (@cust_pkgs) {
2370 #NO!! next if $cust_pkg->cancel;
2371 next if $cust_pkg->getfield('cancel');
2373 warn " bill package ". $cust_pkg->pkgnum. "\n" if $DEBUG > 1;
2375 #? to avoid use of uninitialized value errors... ?
2376 $cust_pkg->setfield('bill', '')
2377 unless defined($cust_pkg->bill);
2379 #my $part_pkg = $cust_pkg->part_pkg;
2381 my $real_pkgpart = $cust_pkg->pkgpart;
2382 my %hash = $cust_pkg->hash;
2384 foreach my $part_pkg ( $cust_pkg->part_pkg->self_and_bill_linked ) {
2386 $cust_pkg->set($_, $hash{$_}) foreach qw ( setup last_bill bill );
2389 $self->_make_lines( 'part_pkg' => $part_pkg,
2390 'cust_pkg' => $cust_pkg,
2391 'precommit_hooks' => \@precommit_hooks,
2392 'line_items' => \@cust_bill_pkg,
2393 'setup' => \$total_setup,
2394 'recur' => \$total_recur,
2395 'tax_matrix' => \%taxlisthash,
2397 'options' => \%options,
2400 $dbh->rollback if $oldAutoCommit;
2404 } #foreach my $part_pkg
2406 } #foreach my $cust_pkg
2408 unless ( @cust_bill_pkg ) { #don't create an invoice w/o line items
2409 #but do commit any package date cycling that happened
2410 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2414 my $postal_pkg = $self->charge_postal_fee();
2415 if ( $postal_pkg && !ref( $postal_pkg ) ) {
2416 $dbh->rollback if $oldAutoCommit;
2417 return "can't charge postal invoice fee for customer ".
2418 $self->custnum. ": $postal_pkg";
2421 ( scalar( grep { $_->recur && $_->recur > 0 } @cust_bill_pkg) ||
2422 !$conf->exists('postal_invoice-recurring_only')
2426 foreach my $part_pkg ( $postal_pkg->part_pkg->self_and_bill_linked ) {
2428 $self->_make_lines( 'part_pkg' => $part_pkg,
2429 'cust_pkg' => $postal_pkg,
2430 'precommit_hooks' => \@precommit_hooks,
2431 'line_items' => \@cust_bill_pkg,
2432 'setup' => \$total_setup,
2433 'recur' => \$total_recur,
2434 'tax_matrix' => \%taxlisthash,
2436 'options' => \%options,
2439 $dbh->rollback if $oldAutoCommit;
2445 warn "having a look at the taxes we found...\n" if $DEBUG > 2;
2447 # keys are tax names (as printed on invoices / itemdesc )
2448 # values are listrefs of taxlisthash keys (internal identifiers)
2451 # keys are taxlisthash keys (internal identifiers)
2452 # values are (cumulative) amounts
2455 # keys are taxlisthash keys (internal identifiers)
2456 # values are listrefs of cust_bill_pkg_tax_location hashrefs
2457 my %tax_location = ();
2459 foreach my $tax ( keys %taxlisthash ) {
2460 my $tax_object = shift @{ $taxlisthash{$tax} };
2461 warn "found ". $tax_object->taxname. " as $tax\n" if $DEBUG > 2;
2462 warn " ". join('/', @{ $taxlisthash{$tax} } ). "\n" if $DEBUG > 2;
2463 my $hashref_or_error =
2464 $tax_object->taxline( $taxlisthash{$tax},
2465 'custnum' => $self->custnum,
2466 'invoice_time' => $invoice_time
2468 unless ( ref($hashref_or_error) ) {
2469 $dbh->rollback if $oldAutoCommit;
2470 return $hashref_or_error;
2472 unshift @{ $taxlisthash{$tax} }, $tax_object;
2474 my $name = $hashref_or_error->{'name'};
2475 my $amount = $hashref_or_error->{'amount'};
2477 #warn "adding $amount as $name\n";
2478 $taxname{ $name } ||= [];
2479 push @{ $taxname{ $name } }, $tax;
2481 $tax{ $tax } += $amount;
2483 $tax_location{ $tax } ||= [];
2484 if ( $tax_object->get('pkgnum') || $tax_object->get('locationnum') ) {
2485 push @{ $tax_location{ $tax } },
2487 'taxnum' => $tax_object->taxnum,
2488 'taxtype' => ref($tax_object),
2489 'pkgnum' => $tax_object->get('pkgnum'),
2490 'locationnum' => $tax_object->get('locationnum'),
2491 'amount' => sprintf('%.2f', $amount ),
2497 #move the cust_tax_exempt_pkg records to the cust_bill_pkgs we will commit
2498 my %packagemap = map { $_->pkgnum => $_ } @cust_bill_pkg;
2499 foreach my $tax ( keys %taxlisthash ) {
2500 foreach ( @{ $taxlisthash{$tax} }[1 ... scalar(@{ $taxlisthash{$tax} })] ) {
2501 next unless ref($_) eq 'FS::cust_bill_pkg'; # shouldn't happen
2503 push @{ $packagemap{$_->pkgnum}->_cust_tax_exempt_pkg },
2504 splice( @{ $_->_cust_tax_exempt_pkg } );
2508 #some taxes are taxed
2511 warn "finding taxed taxes...\n" if $DEBUG > 2;
2512 foreach my $tax ( keys %taxlisthash ) {
2513 my $tax_object = shift @{ $taxlisthash{$tax} };
2514 warn "found possible taxed tax ". $tax_object->taxname. " we call $tax\n"
2516 next unless $tax_object->can('tax_on_tax');
2518 foreach my $tot ( $tax_object->tax_on_tax( $self ) ) {
2519 my $totname = ref( $tot ). ' '. $tot->taxnum;
2521 warn "checking $totname which we call ". $tot->taxname. " as applicable\n"
2523 next unless exists( $taxlisthash{ $totname } ); # only increase
2525 warn "adding $totname to taxed taxes\n" if $DEBUG > 2;
2526 if ( exists( $totlisthash{ $totname } ) ) {
2527 push @{ $totlisthash{ $totname } }, $tax{ $tax };
2529 $totlisthash{ $totname } = [ $tot, $tax{ $tax } ];
2534 warn "having a look at taxed taxes...\n" if $DEBUG > 2;
2535 foreach my $tax ( keys %totlisthash ) {
2536 my $tax_object = shift @{ $totlisthash{$tax} };
2537 warn "found previously found taxed tax ". $tax_object->taxname. "\n"
2539 my $hashref_or_error =
2540 $tax_object->taxline( $totlisthash{$tax},
2541 'custnum' => $self->custnum,
2542 'invoice_time' => $invoice_time
2544 unless (ref($hashref_or_error)) {
2545 $dbh->rollback if $oldAutoCommit;
2546 return $hashref_or_error;
2549 warn "adding taxed tax amount ". $hashref_or_error->{'amount'}.
2550 " as ". $tax_object->taxname. "\n"
2552 $tax{ $tax } += $hashref_or_error->{'amount'};
2555 #consolidate and create tax line items
2556 warn "consolidating and generating...\n" if $DEBUG > 2;
2557 foreach my $taxname ( keys %taxname ) {
2560 my @cust_bill_pkg_tax_location = ();
2561 warn "adding $taxname\n" if $DEBUG > 1;
2562 foreach my $taxitem ( @{ $taxname{$taxname} } ) {
2563 next if $seen{$taxitem}++;
2564 warn "adding $tax{$taxitem}\n" if $DEBUG > 1;
2565 $tax += $tax{$taxitem};
2566 push @cust_bill_pkg_tax_location,
2567 map { new FS::cust_bill_pkg_tax_location $_ }
2568 @{ $tax_location{ $taxitem } };
2572 $tax = sprintf('%.2f', $tax );
2573 $total_setup = sprintf('%.2f', $total_setup+$tax );
2575 push @cust_bill_pkg, new FS::cust_bill_pkg {
2581 'itemdesc' => $taxname,
2582 'cust_bill_pkg_tax_location' => \@cust_bill_pkg_tax_location,
2587 my $charged = sprintf('%.2f', $total_setup + $total_recur );
2589 #create the new invoice
2590 my $cust_bill = new FS::cust_bill ( {
2591 'custnum' => $self->custnum,
2592 '_date' => ( $invoice_time ),
2593 'charged' => $charged,
2595 my $error = $cust_bill->insert;
2597 $dbh->rollback if $oldAutoCommit;
2598 return "can't create invoice for customer #". $self->custnum. ": $error";
2601 foreach my $cust_bill_pkg ( @cust_bill_pkg ) {
2602 $cust_bill_pkg->invnum($cust_bill->invnum);
2603 my $error = $cust_bill_pkg->insert;
2605 $dbh->rollback if $oldAutoCommit;
2606 return "can't create invoice line item: $error";
2611 foreach my $hook ( @precommit_hooks ) {
2613 &{$hook}; #($self) ?
2616 $dbh->rollback if $oldAutoCommit;
2617 return "$@ running precommit hook $hook\n";
2621 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2627 my ($self, %params) = @_;
2629 my $part_pkg = $params{part_pkg} or die "no part_pkg specified";
2630 my $cust_pkg = $params{cust_pkg} or die "no cust_pkg specified";
2631 my $precommit_hooks = $params{precommit_hooks} or die "no package specified";
2632 my $cust_bill_pkgs = $params{line_items} or die "no line buffer specified";
2633 my $total_setup = $params{setup} or die "no setup accumulator specified";
2634 my $total_recur = $params{recur} or die "no recur accumulator specified";
2635 my $taxlisthash = $params{tax_matrix} or die "no tax accumulator specified";
2636 my $time = $params{'time'} or die "no time specified";
2637 my (%options) = %{$params{options}}; #hmmm only for 'resetup'
2640 my $real_pkgpart = $cust_pkg->pkgpart;
2641 my %hash = $cust_pkg->hash;
2642 my $old_cust_pkg = new FS::cust_pkg \%hash;
2648 $cust_pkg->pkgpart($part_pkg->pkgpart);
2656 if ( ! $cust_pkg->setup &&
2658 ( $conf->exists('disable_setup_suspended_pkgs') &&
2659 ! $cust_pkg->getfield('susp')
2660 ) || ! $conf->exists('disable_setup_suspended_pkgs')
2662 || $options{'resetup'}
2665 warn " bill setup\n" if $DEBUG > 1;
2668 $setup = eval { $cust_pkg->calc_setup( $time, \@details ) };
2669 return "$@ running calc_setup for $cust_pkg\n"
2672 $unitsetup = $cust_pkg->part_pkg->unit_setup || $setup; #XXX uuh
2674 $cust_pkg->setfield('setup', $time)
2675 unless $cust_pkg->setup;
2676 #do need it, but it won't get written to the db
2677 #|| $cust_pkg->pkgpart != $real_pkgpart;
2682 # bill recurring fee
2685 #XXX unit stuff here too
2689 if ( ! $cust_pkg->getfield('susp') and
2690 ( $part_pkg->getfield('freq') ne '0' &&
2691 ( $cust_pkg->getfield('bill') || 0 ) <= $time
2693 || ( $part_pkg->plan eq 'voip_cdr'
2694 && $part_pkg->option('bill_every_call')
2698 # XXX should this be a package event? probably. events are called
2699 # at collection time at the moment, though...
2700 $part_pkg->reset_usage($cust_pkg, 'debug'=>$DEBUG)
2701 if $part_pkg->can('reset_usage');
2702 #don't want to reset usage just cause we want a line item??
2703 #&& $part_pkg->pkgpart == $real_pkgpart;
2705 warn " bill recur\n" if $DEBUG > 1;
2708 # XXX shared with $recur_prog
2709 $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
2711 #over two params! lets at least switch to a hashref for the rest...
2712 my $increment_next_bill = ( $part_pkg->freq ne '0'
2713 && ( $cust_pkg->getfield('bill') || 0 ) <= $time
2715 my %param = ( 'precommit_hooks' => $precommit_hooks,
2716 'increment_next_bill' => $increment_next_bill,
2719 $recur = eval { $cust_pkg->calc_recur( \$sdate, \@details, \%param ) };
2720 return "$@ running calc_recur for $cust_pkg\n"
2723 if ( $increment_next_bill ) {
2725 my $next_bill = $part_pkg->add_freq($sdate);
2726 return "unparsable frequency: ". $part_pkg->freq
2727 if $next_bill == -1;
2729 #pro-rating magic - if $recur_prog fiddled $sdate, want to use that
2730 # only for figuring next bill date, nothing else, so, reset $sdate again
2732 $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
2733 #no need, its in $hash{last_bill}# my $last_bill = $cust_pkg->last_bill;
2734 $cust_pkg->last_bill($sdate);
2736 $cust_pkg->setfield('bill', $next_bill );
2742 warn "\$setup is undefined" unless defined($setup);
2743 warn "\$recur is undefined" unless defined($recur);
2744 warn "\$cust_pkg->bill is undefined" unless defined($cust_pkg->bill);
2747 # If there's line items, create em cust_bill_pkg records
2748 # If $cust_pkg has been modified, update it (if we're a real pkgpart)
2753 if ( $cust_pkg->modified && $cust_pkg->pkgpart == $real_pkgpart ) {
2754 # hmm.. and if just the options are modified in some weird price plan?
2756 warn " package ". $cust_pkg->pkgnum. " modified; updating\n"
2759 my $error = $cust_pkg->replace( $old_cust_pkg,
2760 'options' => { $cust_pkg->options },
2762 return "Error modifying pkgnum ". $cust_pkg->pkgnum. ": $error"
2763 if $error; #just in case
2766 $setup = sprintf( "%.2f", $setup );
2767 $recur = sprintf( "%.2f", $recur );
2768 if ( $setup < 0 && ! $conf->exists('allow_negative_charges') ) {
2769 return "negative setup $setup for pkgnum ". $cust_pkg->pkgnum;
2771 if ( $recur < 0 && ! $conf->exists('allow_negative_charges') ) {
2772 return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum;
2775 if ( $setup != 0 || $recur != 0 ) {
2777 warn " charges (setup=$setup, recur=$recur); adding line items\n"
2780 my @cust_pkg_detail = map { $_->detail } $cust_pkg->cust_pkg_detail('I');
2782 warn " adding customer package invoice detail: $_\n"
2783 foreach @cust_pkg_detail;
2785 push @details, @cust_pkg_detail;
2787 my $cust_bill_pkg = new FS::cust_bill_pkg {
2788 'pkgnum' => $cust_pkg->pkgnum,
2790 'unitsetup' => $unitsetup,
2792 'unitrecur' => $unitrecur,
2793 'quantity' => $cust_pkg->quantity,
2794 'details' => \@details,
2797 if ( $part_pkg->option('recur_temporality', 1) eq 'preceding' ) {
2798 $cust_bill_pkg->sdate( $hash{last_bill} );
2799 $cust_bill_pkg->edate( $sdate - 86399 ); #60s*60m*24h-1
2800 } else { #if ( $part_pkg->option('recur_temporality', 1) eq 'upcoming' ) {
2801 $cust_bill_pkg->sdate( $sdate );
2802 $cust_bill_pkg->edate( $cust_pkg->bill );
2805 $cust_bill_pkg->pkgpart_override($part_pkg->pkgpart)
2806 unless $part_pkg->pkgpart == $real_pkgpart;
2808 $$total_setup += $setup;
2809 $$total_recur += $recur;
2816 $self->_handle_taxes($part_pkg, $taxlisthash, $cust_bill_pkg, $cust_pkg);
2817 return $error if $error;
2819 push @$cust_bill_pkgs, $cust_bill_pkg;
2821 } #if $setup != 0 || $recur != 0
2831 my $part_pkg = shift;
2832 my $taxlisthash = shift;
2833 my $cust_bill_pkg = shift;
2834 my $cust_pkg = shift;
2836 my %cust_bill_pkg = ();
2840 #push @classes, $cust_bill_pkg->usage_classes if $cust_bill_pkg->type eq 'U';
2841 push @classes, $cust_bill_pkg->usage_classes if $cust_bill_pkg->usage;
2842 push @classes, 'setup' if $cust_bill_pkg->setup;
2843 push @classes, 'recur' if $cust_bill_pkg->recur;
2845 if ( $self->tax !~ /Y/i && $self->payby ne 'COMP' ) {
2847 if ( $conf->exists('enable_taxproducts')
2848 && ( scalar($part_pkg->part_pkg_taxoverride)
2849 || $part_pkg->has_taxproduct
2854 if ( $conf->exists('tax-pkg_address') && $cust_pkg->locationnum ) {
2855 return "fatal: Can't (yet) use tax-pkg_address with taxproducts";
2858 foreach my $class (@classes) {
2859 my $err_or_ref = $self->_gather_taxes( $part_pkg, $class );
2860 return $err_or_ref unless ref($err_or_ref);
2861 $taxes{$class} = $err_or_ref;
2864 unless (exists $taxes{''}) {
2865 my $err_or_ref = $self->_gather_taxes( $part_pkg, '' );
2866 return $err_or_ref unless ref($err_or_ref);
2867 $taxes{''} = $err_or_ref;
2872 my @loc_keys = qw( state county country );
2874 if ( $conf->exists('tax-pkg_address') && $cust_pkg->locationnum ) {
2875 my $cust_location = $cust_pkg->cust_location;
2876 %taxhash = map { $_ => $cust_location->$_() } @loc_keys;
2879 ( $conf->exists('tax-ship_address') && length($self->ship_last) )
2882 %taxhash = map { $_ => $self->get("$prefix$_") } @loc_keys;
2885 $taxhash{'taxclass'} = $part_pkg->taxclass;
2887 my @taxes = qsearch( 'cust_main_county', \%taxhash );
2889 my %taxhash_elim = %taxhash;
2891 my @elim = qw( taxclass county state );
2892 while ( !scalar(@taxes) && scalar(@elim) ) {
2893 $taxhash_elim{ shift(@elim) } = '';
2894 @taxes = qsearch( 'cust_main_county', \%taxhash_elim );
2897 if ( $conf->exists('tax-pkg_address') && $cust_pkg->locationnum ) {
2899 $_->set('pkgnum', $cust_pkg->pkgnum );
2900 $_->set('locationnum', $cust_pkg->locationnum );
2904 $taxes{''} = [ @taxes ];
2905 $taxes{'setup'} = [ @taxes ];
2906 $taxes{'recur'} = [ @taxes ];
2907 $taxes{$_} = [ @taxes ] foreach (@classes);
2909 # maybe eliminate this entirely, along with all the 0% records
2912 "fatal: can't find tax rate for state/county/country/taxclass ".
2913 join('/', map $taxhash{$_}, qw(state county country taxclass) );
2916 } #if $conf->exists('enable_taxproducts') ...
2921 if ( $conf->exists('separate_usage') ) {
2922 my $section = $cust_pkg->part_pkg->option('usage_section', 'Hush!');
2923 my $summary = $cust_pkg->part_pkg->option('summarize_usage', 'Hush!');
2924 push @display, new FS::cust_bill_pkg_display { type => 'S' };
2925 push @display, new FS::cust_bill_pkg_display { type => 'R' };
2926 push @display, new FS::cust_bill_pkg_display { type => 'U',
2929 if ($section && $summary) {
2930 $display[2]->post_total('Y');
2931 push @display, new FS::cust_bill_pkg_display { type => 'U',
2936 $cust_bill_pkg->set('display', \@display);
2938 my %tax_cust_bill_pkg = $cust_bill_pkg->disintegrate;
2939 foreach my $key (keys %tax_cust_bill_pkg) {
2940 my @taxes = @{ $taxes{$key} || [] };
2941 my $tax_cust_bill_pkg = $tax_cust_bill_pkg{$key};
2943 foreach my $tax ( @taxes ) {
2945 my $taxname = ref( $tax ). ' '. $tax->taxnum;
2946 # $taxname .= ' pkgnum'. $cust_pkg->pkgnum.
2947 # ' locationnum'. $cust_pkg->locationnum
2948 # if $conf->exists('tax-pkg_address') && $cust_pkg->locationnum;
2950 if ( exists( $taxlisthash->{ $taxname } ) ) {
2951 push @{ $taxlisthash->{ $taxname } }, $tax_cust_bill_pkg;
2953 $taxlisthash->{ $taxname } = [ $tax, $tax_cust_bill_pkg ];
2963 my $part_pkg = shift;
2967 my $geocode = $self->geocode('cch');
2969 my @taxclassnums = map { $_->taxclassnum }
2970 $part_pkg->part_pkg_taxoverride($class);
2972 unless (@taxclassnums) {
2973 @taxclassnums = map { $_->taxclassnum }
2974 $part_pkg->part_pkg_taxrate('cch', $geocode, $class);
2976 warn "Found taxclassnum values of ". join(',', @taxclassnums)
2981 join(' OR ', map { "taxclassnum = $_" } @taxclassnums ). ")";
2983 @taxes = qsearch({ 'table' => 'tax_rate',
2984 'hashref' => { 'geocode' => $geocode, },
2985 'extra_sql' => $extra_sql,
2987 if scalar(@taxclassnums);
2989 warn "Found taxes ".
2990 join(',', map{ ref($_). " ". $_->get($_->primary_key) } @taxes). "\n"
2997 =item collect OPTIONS
2999 (Attempt to) collect money for this customer's outstanding invoices (see
3000 L<FS::cust_bill>). Usually used after the bill method.
3002 Actions are now triggered by billing events; see L<FS::part_event> and the
3003 billing events web interface. Old-style invoice events (see
3004 L<FS::part_bill_event>) have been deprecated.
3006 If there is an error, returns the error, otherwise returns false.
3008 Options are passed as name-value pairs.
3010 Currently available options are:
3016 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.
3020 Retry card/echeck/LEC transactions even when not scheduled by invoice events.
3024 set true to surpress email card/ACH decline notices.
3028 "1d" for the traditional, daily events (the default), or "1m" for the new monthly events (part_event.check_freq)
3032 allows for one time override of normal customer billing method
3036 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)
3044 my( $self, %options ) = @_;
3045 my $invoice_time = $options{'invoice_time'} || time;
3048 local $SIG{HUP} = 'IGNORE';
3049 local $SIG{INT} = 'IGNORE';
3050 local $SIG{QUIT} = 'IGNORE';
3051 local $SIG{TERM} = 'IGNORE';
3052 local $SIG{TSTP} = 'IGNORE';
3053 local $SIG{PIPE} = 'IGNORE';
3055 my $oldAutoCommit = $FS::UID::AutoCommit;
3056 local $FS::UID::AutoCommit = 0;
3059 $self->select_for_update; #mutex
3062 my $balance = $self->balance;
3063 warn "$me collect customer ". $self->custnum. ": balance $balance\n"
3066 if ( exists($options{'retry_card'}) ) {
3067 carp 'retry_card option passed to collect is deprecated; use retry';
3068 $options{'retry'} ||= $options{'retry_card'};
3070 if ( exists($options{'retry'}) && $options{'retry'} ) {
3071 my $error = $self->retry_realtime;
3073 $dbh->rollback if $oldAutoCommit;
3078 # false laziness w/pay_batch::import_results
3080 my $due_cust_event = $self->due_cust_event(
3081 'debug' => ( $options{'debug'} || 0 ),
3082 'time' => $invoice_time,
3083 'check_freq' => $options{'check_freq'},
3085 unless( ref($due_cust_event) ) {
3086 $dbh->rollback if $oldAutoCommit;
3087 return $due_cust_event;
3090 foreach my $cust_event ( @$due_cust_event ) {
3094 #re-eval event conditions (a previous event could have changed things)
3095 unless ( $cust_event->test_conditions( 'time' => $invoice_time ) ) {
3096 #don't leave stray "new/locked" records around
3097 my $error = $cust_event->delete;
3099 #gah, even with transactions
3100 $dbh->commit if $oldAutoCommit; #well.
3107 local $realtime_bop_decline_quiet = 1 if $options{'quiet'};
3108 warn " running cust_event ". $cust_event->eventnum. "\n"
3112 #if ( my $error = $cust_event->do_event(%options) ) { #XXX %options?
3113 if ( my $error = $cust_event->do_event() ) {
3114 #XXX wtf is this? figure out a proper dealio with return value
3116 # gah, even with transactions.
3117 $dbh->commit if $oldAutoCommit; #well.
3124 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3129 =item due_cust_event [ HASHREF | OPTION => VALUE ... ]
3131 Inserts database records for and returns an ordered listref of new events due
3132 for this customer, as FS::cust_event objects (see L<FS::cust_event>). If no
3133 events are due, an empty listref is returned. If there is an error, returns a
3134 scalar error message.
3136 To actually run the events, call each event's test_condition method, and if
3137 still true, call the event's do_event method.
3139 Options are passed as a hashref or as a list of name-value pairs. Available
3146 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.
3150 "Current time" for the events.
3154 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)
3158 Only return events for the specified eventtable (by default, events of all eventtables are returned)
3162 Explicitly pass the objects to be tested (typically used with eventtable).
3166 Set to true to return the objects, but not actually insert them into the
3173 sub due_cust_event {
3175 my %opt = ref($_[0]) ? %{ $_[0] } : @_;
3178 #my $DEBUG = $opt{'debug'}
3179 local($DEBUG) = $opt{'debug'}
3180 if defined($opt{'debug'}) && $opt{'debug'} > $DEBUG;
3182 warn "$me due_cust_event called with options ".
3183 join(', ', map { "$_: $opt{$_}" } keys %opt). "\n"
3186 $opt{'time'} ||= time;
3188 local $SIG{HUP} = 'IGNORE';
3189 local $SIG{INT} = 'IGNORE';
3190 local $SIG{QUIT} = 'IGNORE';
3191 local $SIG{TERM} = 'IGNORE';
3192 local $SIG{TSTP} = 'IGNORE';
3193 local $SIG{PIPE} = 'IGNORE';
3195 my $oldAutoCommit = $FS::UID::AutoCommit;
3196 local $FS::UID::AutoCommit = 0;
3199 $self->select_for_update #mutex
3200 unless $opt{testonly};
3203 # 1: find possible events (initial search)
3206 my @cust_event = ();
3208 my @eventtable = $opt{'eventtable'}
3209 ? ( $opt{'eventtable'} )
3210 : FS::part_event->eventtables_runorder;
3212 foreach my $eventtable ( @eventtable ) {
3215 if ( $opt{'objects'} ) {
3217 @objects = @{ $opt{'objects'} };
3221 #my @objects = $self->eventtable(); # sub cust_main { @{ [ $self ] }; }
3222 @objects = ( $eventtable eq 'cust_main' )
3224 : ( $self->$eventtable() );
3228 my @e_cust_event = ();
3230 my $cross = "CROSS JOIN $eventtable";
3231 $cross .= ' LEFT JOIN cust_main USING ( custnum )'
3232 unless $eventtable eq 'cust_main';
3234 foreach my $object ( @objects ) {
3236 #this first search uses the condition_sql magic for optimization.
3237 #the more possible events we can eliminate in this step the better
3239 my $cross_where = '';
3240 my $pkey = $object->primary_key;
3241 $cross_where = "$eventtable.$pkey = ". $object->$pkey();
3243 my $join = FS::part_event_condition->join_conditions_sql( $eventtable );
3245 FS::part_event_condition->where_conditions_sql( $eventtable,
3246 'time'=>$opt{'time'}
3248 my $order = FS::part_event_condition->order_conditions_sql( $eventtable );
3250 $extra_sql = "AND $extra_sql" if $extra_sql;
3252 #here is the agent virtualization
3253 $extra_sql .= " AND ( part_event.agentnum IS NULL
3254 OR part_event.agentnum = ". $self->agentnum. ' )';
3256 $extra_sql .= " $order";
3258 warn "searching for events for $eventtable ". $object->$pkey. "\n"
3259 if $opt{'debug'} > 2;
3260 my @part_event = qsearch( {
3261 'debug' => ( $opt{'debug'} > 3 ? 1 : 0 ),
3262 'select' => 'part_event.*',
3263 'table' => 'part_event',
3264 'addl_from' => "$cross $join",
3265 'hashref' => { 'check_freq' => ( $opt{'check_freq'} || '1d' ),
3266 'eventtable' => $eventtable,
3269 'extra_sql' => "AND $cross_where $extra_sql",
3273 my $pkey = $object->primary_key;
3274 warn " ". scalar(@part_event).
3275 " possible events found for $eventtable ". $object->$pkey(). "\n";
3278 push @e_cust_event, map { $_->new_cust_event($object) } @part_event;
3282 warn " ". scalar(@e_cust_event).
3283 " subtotal possible cust events found for $eventtable\n"
3286 push @cust_event, @e_cust_event;
3290 warn " ". scalar(@cust_event).
3291 " total possible cust events found in initial search\n"
3295 # 2: test conditions
3300 @cust_event = grep $_->test_conditions( 'time' => $opt{'time'},
3301 'stats_hashref' => \%unsat ),
3304 warn " ". scalar(@cust_event). " cust events left satisfying conditions\n"
3307 warn " invalid conditions not eliminated with condition_sql:\n".
3308 join('', map " $_: ".$unsat{$_}."\n", keys %unsat )
3315 unless( $opt{testonly} ) {
3316 foreach my $cust_event ( @cust_event ) {
3318 my $error = $cust_event->insert();
3320 $dbh->rollback if $oldAutoCommit;
3327 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3333 warn " returning events: ". Dumper(@cust_event). "\n"
3340 =item retry_realtime
3342 Schedules realtime / batch credit card / electronic check / LEC billing
3343 events for for retry. Useful if card information has changed or manual
3344 retry is desired. The 'collect' method must be called to actually retry
3347 Implementation details: For either this customer, or for each of this
3348 customer's open invoices, changes the status of the first "done" (with
3349 statustext error) realtime processing event to "failed".
3353 sub retry_realtime {
3356 local $SIG{HUP} = 'IGNORE';
3357 local $SIG{INT} = 'IGNORE';
3358 local $SIG{QUIT} = 'IGNORE';
3359 local $SIG{TERM} = 'IGNORE';
3360 local $SIG{TSTP} = 'IGNORE';
3361 local $SIG{PIPE} = 'IGNORE';
3363 my $oldAutoCommit = $FS::UID::AutoCommit;
3364 local $FS::UID::AutoCommit = 0;
3367 #a little false laziness w/due_cust_event (not too bad, really)
3369 my $join = FS::part_event_condition->join_conditions_sql;
3370 my $order = FS::part_event_condition->order_conditions_sql;
3373 . join ( ' OR ' , map {
3374 "( part_event.eventtable = " . dbh->quote($_)
3375 . " AND tablenum IN( SELECT " . dbdef->table($_)->primary_key . " from $_ where custnum = " . dbh->quote( $self->custnum ) . "))" ;
3376 } FS::part_event->eventtables)
3379 #here is the agent virtualization
3380 my $agent_virt = " ( part_event.agentnum IS NULL
3381 OR part_event.agentnum = ". $self->agentnum. ' )';
3383 #XXX this shouldn't be hardcoded, actions should declare it...
3384 my @realtime_events = qw(
3385 cust_bill_realtime_card
3386 cust_bill_realtime_check
3387 cust_bill_realtime_lec
3391 my $is_realtime_event = ' ( '. join(' OR ', map "part_event.action = '$_'",
3396 my @cust_event = qsearchs({
3397 'table' => 'cust_event',
3398 'select' => 'cust_event.*',
3399 'addl_from' => "LEFT JOIN part_event USING ( eventpart ) $join",
3400 'hashref' => { 'status' => 'done' },
3401 'extra_sql' => " AND statustext IS NOT NULL AND statustext != '' ".
3402 " AND $mine AND $is_realtime_event AND $agent_virt $order" # LIMIT 1"
3405 my %seen_invnum = ();
3406 foreach my $cust_event (@cust_event) {
3408 #max one for the customer, one for each open invoice
3409 my $cust_X = $cust_event->cust_X;
3410 next if $seen_invnum{ $cust_event->part_event->eventtable eq 'cust_bill'
3414 or $cust_event->part_event->eventtable eq 'cust_bill'
3417 my $error = $cust_event->retry;
3419 $dbh->rollback if $oldAutoCommit;
3420 return "error scheduling event for retry: $error";
3425 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3430 # some horrid false laziness here to avoid refactor fallout
3431 # eventually realtime realtime_bop and realtime_refund_bop should go
3432 # away and be replaced by _new_realtime_bop and _new_realtime_refund_bop
3434 =item realtime_bop METHOD AMOUNT [ OPTION => VALUE ... ]
3436 Runs a realtime credit card, ACH (electronic check) or phone bill transaction
3437 via a Business::OnlinePayment realtime gateway. See
3438 L<http://420.am/business-onlinepayment> for supported gateways.
3440 Available methods are: I<CC>, I<ECHECK> and I<LEC>
3442 Available options are: I<description>, I<invnum>, I<quiet>, I<paynum_ref>, I<payunique>
3444 The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
3445 I<zip>, I<payinfo> and I<paydate> are also available. Any of these options,
3446 if set, will override the value from the customer record.
3448 I<description> is a free-text field passed to the gateway. It defaults to
3449 "Internet services".
3451 If an I<invnum> is specified, this payment (if successful) is applied to the
3452 specified invoice. If you don't specify an I<invnum> you might want to
3453 call the B<apply_payments> method.
3455 I<quiet> can be set true to surpress email decline notices.
3457 I<paynum_ref> can be set to a scalar reference. It will be filled in with the
3458 resulting paynum, if any.
3460 I<payunique> is a unique identifier for this payment.
3462 (moved from cust_bill) (probably should get realtime_{card,ach,lec} here too)
3469 return $self->_new_realtime_bop(@_)
3470 if $self->_new_bop_required();
3472 my( $method, $amount, %options ) = @_;
3474 warn "$me realtime_bop: $method $amount\n";
3475 warn " $_ => $options{$_}\n" foreach keys %options;
3478 $options{'description'} ||= 'Internet services';
3480 return $self->fake_bop($method, $amount, %options) if $options{'fake'};
3482 eval "use Business::OnlinePayment";
3485 my $payinfo = exists($options{'payinfo'})
3486 ? $options{'payinfo'}
3489 my %method2payby = (
3496 # check for banned credit card/ACH
3499 my $ban = qsearchs('banned_pay', {
3500 'payby' => $method2payby{$method},
3501 'payinfo' => md5_base64($payinfo),
3503 return "Banned credit card" if $ban;
3506 # set taxclass and trans_is_recur based on invnum if there is one
3510 my $trans_is_recur = 0;
3511 if ( $options{'invnum'} ) {
3513 my $cust_bill = qsearchs('cust_bill', { 'invnum' => $options{'invnum'} } );
3514 die "invnum ". $options{'invnum'}. " not found" unless $cust_bill;
3517 map { $_->part_pkg }
3519 map { $_->cust_pkg }
3520 $cust_bill->cust_bill_pkg;
3522 my @taxclasses = map $_->taxclass, @part_pkg;
3523 $taxclass = $taxclasses[0]
3524 unless grep { $taxclasses[0] ne $_ } @taxclasses; #unless there are
3525 #different taxclasses
3527 if grep { $_->freq ne '0' } @part_pkg;
3535 #look for an agent gateway override first
3537 if ( $method eq 'CC' ) {
3538 $cardtype = cardtype($payinfo);
3539 } elsif ( $method eq 'ECHECK' ) {
3542 $cardtype = $method;
3546 qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
3547 cardtype => $cardtype,
3548 taxclass => $taxclass, } )
3549 || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
3551 taxclass => $taxclass, } )
3552 || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
3553 cardtype => $cardtype,
3555 || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
3557 taxclass => '', } );
3559 my $payment_gateway = '';
3560 my( $processor, $login, $password, $action, @bop_options );
3561 if ( $override ) { #use a payment gateway override
3563 $payment_gateway = $override->payment_gateway;
3565 $processor = $payment_gateway->gateway_module;
3566 $login = $payment_gateway->gateway_username;
3567 $password = $payment_gateway->gateway_password;
3568 $action = $payment_gateway->gateway_action;
3569 @bop_options = $payment_gateway->options;
3571 } else { #use the standard settings from the config
3573 ( $processor, $login, $password, $action, @bop_options ) =
3574 $self->default_payment_gateway($method);
3582 my $address = exists($options{'address1'})
3583 ? $options{'address1'}
3585 my $address2 = exists($options{'address2'})
3586 ? $options{'address2'}
3588 $address .= ", ". $address2 if length($address2);
3590 my $o_payname = exists($options{'payname'})
3591 ? $options{'payname'}
3593 my($payname, $payfirst, $paylast);
3594 if ( $o_payname && $method ne 'ECHECK' ) {
3595 ($payname = $o_payname) =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
3596 or return "Illegal payname $payname";
3597 ($payfirst, $paylast) = ($1, $2);
3599 $payfirst = $self->getfield('first');
3600 $paylast = $self->getfield('last');
3601 $payname = "$payfirst $paylast";
3604 my @invoicing_list = $self->invoicing_list_emailonly;
3605 if ( $conf->exists('emailinvoiceautoalways')
3606 || $conf->exists('emailinvoiceauto') && ! @invoicing_list
3607 || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
3608 push @invoicing_list, $self->all_emails;
3611 my $email = ($conf->exists('business-onlinepayment-email-override'))
3612 ? $conf->config('business-onlinepayment-email-override')
3613 : $invoicing_list[0];
3617 my $payip = exists($options{'payip'})
3620 $content{customer_ip} = $payip
3623 $content{invoice_number} = $options{'invnum'}
3624 if exists($options{'invnum'}) && length($options{'invnum'});
3626 $content{email_customer} =
3627 ( $conf->exists('business-onlinepayment-email_customer')
3628 || $conf->exists('business-onlinepayment-email-override') );
3631 if ( $method eq 'CC' ) {
3633 $content{card_number} = $payinfo;
3634 $paydate = exists($options{'paydate'})
3635 ? $options{'paydate'}
3637 $paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
3638 $content{expiration} = "$2/$1";
3640 my $paycvv = exists($options{'paycvv'})
3641 ? $options{'paycvv'}
3643 $content{cvv2} = $paycvv
3646 my $paystart_month = exists($options{'paystart_month'})
3647 ? $options{'paystart_month'}
3648 : $self->paystart_month;
3650 my $paystart_year = exists($options{'paystart_year'})
3651 ? $options{'paystart_year'}
3652 : $self->paystart_year;
3654 $content{card_start} = "$paystart_month/$paystart_year"
3655 if $paystart_month && $paystart_year;
3657 my $payissue = exists($options{'payissue'})
3658 ? $options{'payissue'}
3660 $content{issue_number} = $payissue if $payissue;
3662 if ( $self->_bop_recurring_billing( 'payinfo' => $payinfo,
3663 'trans_is_recur' => $trans_is_recur,
3667 $content{recurring_billing} = 'YES';
3668 $content{acct_code} = 'rebill'
3669 if $conf->exists('credit_card-recurring_billing_acct_code');
3672 } elsif ( $method eq 'ECHECK' ) {
3673 ( $content{account_number}, $content{routing_code} ) =
3674 split('@', $payinfo);
3675 $content{bank_name} = $o_payname;
3676 $content{bank_state} = exists($options{'paystate'})
3677 ? $options{'paystate'}
3678 : $self->getfield('paystate');
3679 $content{account_type} = exists($options{'paytype'})
3680 ? uc($options{'paytype'}) || 'CHECKING'
3681 : uc($self->getfield('paytype')) || 'CHECKING';
3682 $content{account_name} = $payname;
3683 $content{customer_org} = $self->company ? 'B' : 'I';
3684 $content{state_id} = exists($options{'stateid'})
3685 ? $options{'stateid'}
3686 : $self->getfield('stateid');
3687 $content{state_id_state} = exists($options{'stateid_state'})
3688 ? $options{'stateid_state'}
3689 : $self->getfield('stateid_state');
3690 $content{customer_ssn} = exists($options{'ss'})
3693 } elsif ( $method eq 'LEC' ) {
3694 $content{phone} = $payinfo;
3698 # run transaction(s)
3701 my $balance = exists( $options{'balance'} )
3702 ? $options{'balance'}
3705 $self->select_for_update; #mutex ... just until we get our pending record in
3707 #the checks here are intended to catch concurrent payments
3708 #double-form-submission prevention is taken care of in cust_pay_pending::check
3711 return "The customer's balance has changed; $method transaction aborted."
3712 if $self->balance < $balance;
3713 #&& $self->balance < $amount; #might as well anyway?
3715 #also check and make sure there aren't *other* pending payments for this cust
3717 my @pending = qsearch('cust_pay_pending', {
3718 'custnum' => $self->custnum,
3719 'status' => { op=>'!=', value=>'done' }
3721 return "A payment is already being processed for this customer (".
3722 join(', ', map 'paypendingnum '. $_->paypendingnum, @pending ).
3723 "); $method transaction aborted."
3724 if scalar(@pending);
3726 #okay, good to go, if we're a duplicate, cust_pay_pending will kick us out
3728 my $cust_pay_pending = new FS::cust_pay_pending {
3729 'custnum' => $self->custnum,
3730 #'invnum' => $options{'invnum'},
3733 'payby' => $method2payby{$method},
3734 'payinfo' => $payinfo,
3735 'paydate' => $paydate,
3736 'recurring_billing' => $content{recurring_billing},
3738 'gatewaynum' => ( $payment_gateway ? $payment_gateway->gatewaynum : '' ),
3740 $cust_pay_pending->payunique( $options{payunique} )
3741 if defined($options{payunique}) && length($options{payunique});
3742 my $cpp_new_err = $cust_pay_pending->insert; #mutex lost when this is inserted
3743 return $cpp_new_err if $cpp_new_err;
3745 my( $action1, $action2 ) = split(/\s*\,\s*/, $action );
3747 my $transaction = new Business::OnlinePayment( $processor, @bop_options );
3748 $transaction->content(
3751 'password' => $password,
3752 'action' => $action1,
3753 'description' => $options{'description'},
3754 'amount' => $amount,
3755 #'invoice_number' => $options{'invnum'},
3756 'customer_id' => $self->custnum,
3757 'last_name' => $paylast,
3758 'first_name' => $payfirst,
3760 'address' => $address,
3761 'city' => ( exists($options{'city'})
3764 'state' => ( exists($options{'state'})
3767 'zip' => ( exists($options{'zip'})
3770 'country' => ( exists($options{'country'})
3771 ? $options{'country'}
3773 'referer' => 'http://cleanwhisker.420.am/', #XXX fix referer :/
3775 'phone' => $self->daytime || $self->night,
3779 $cust_pay_pending->status('pending');
3780 my $cpp_pending_err = $cust_pay_pending->replace;
3781 return $cpp_pending_err if $cpp_pending_err;
3784 my $BOP_TESTING = 0;
3785 my $BOP_TESTING_SUCCESS = 1;
3787 unless ( $BOP_TESTING ) {
3788 $transaction->submit();
3790 if ( $BOP_TESTING_SUCCESS ) {
3791 $transaction->is_success(1);
3792 $transaction->authorization('fake auth');
3794 $transaction->is_success(0);
3795 $transaction->error_message('fake failure');
3799 if ( $transaction->is_success() && $action2 ) {
3801 $cust_pay_pending->status('authorized');
3802 my $cpp_authorized_err = $cust_pay_pending->replace;
3803 return $cpp_authorized_err if $cpp_authorized_err;
3805 my $auth = $transaction->authorization;
3806 my $ordernum = $transaction->can('order_number')
3807 ? $transaction->order_number
3811 new Business::OnlinePayment( $processor, @bop_options );
3818 password => $password,
3819 order_number => $ordernum,
3821 authorization => $auth,
3822 description => $options{'description'},
3825 foreach my $field (qw( authorization_source_code returned_ACI
3826 transaction_identifier validation_code
3827 transaction_sequence_num local_transaction_date
3828 local_transaction_time AVS_result_code )) {
3829 $capture{$field} = $transaction->$field() if $transaction->can($field);
3832 $capture->content( %capture );
3836 unless ( $capture->is_success ) {
3837 my $e = "Authorization successful but capture failed, custnum #".
3838 $self->custnum. ': '. $capture->result_code.
3839 ": ". $capture->error_message;
3846 $cust_pay_pending->status($transaction->is_success() ? 'captured' : 'declined');
3847 my $cpp_captured_err = $cust_pay_pending->replace;
3848 return $cpp_captured_err if $cpp_captured_err;
3851 # remove paycvv after initial transaction
3854 #false laziness w/misc/process/payment.cgi - check both to make sure working
3856 if ( defined $self->dbdef_table->column('paycvv')
3857 && length($self->paycvv)
3858 && ! grep { $_ eq cardtype($payinfo) } $conf->config('cvv-save')
3860 my $error = $self->remove_cvv;
3862 warn "WARNING: error removing cvv: $error\n";
3870 if ( $transaction->is_success() ) {
3873 if ( $payment_gateway ) { # agent override
3874 $paybatch = $payment_gateway->gatewaynum. '-';
3877 $paybatch .= "$processor:". $transaction->authorization;
3879 $paybatch .= ':'. $transaction->order_number
3880 if $transaction->can('order_number')
3881 && length($transaction->order_number);
3883 my $cust_pay = new FS::cust_pay ( {
3884 'custnum' => $self->custnum,
3885 'invnum' => $options{'invnum'},
3888 'payby' => $method2payby{$method},
3889 'payinfo' => $payinfo,
3890 'paybatch' => $paybatch,
3891 'paydate' => $paydate,
3893 #doesn't hurt to know, even though the dup check is in cust_pay_pending now
3894 $cust_pay->payunique( $options{payunique} )
3895 if defined($options{payunique}) && length($options{payunique});
3897 my $oldAutoCommit = $FS::UID::AutoCommit;
3898 local $FS::UID::AutoCommit = 0;
3901 #start a transaction, insert the cust_pay and set cust_pay_pending.status to done in a single transction
3903 my $error = $cust_pay->insert($options{'manual'} ? ( 'manual' => 1 ) : () );
3906 $cust_pay->invnum(''); #try again with no specific invnum
3907 my $error2 = $cust_pay->insert( $options{'manual'} ?
3908 ( 'manual' => 1 ) : ()
3911 # gah. but at least we have a record of the state we had to abort in
3912 # from cust_pay_pending now.
3913 my $e = "WARNING: $method captured but payment not recorded - ".
3914 "error inserting payment ($processor): $error2".
3915 " (previously tried insert with invnum #$options{'invnum'}" .
3916 ": $error ) - pending payment saved as paypendingnum ".
3917 $cust_pay_pending->paypendingnum. "\n";
3923 if ( $options{'paynum_ref'} ) {
3924 ${ $options{'paynum_ref'} } = $cust_pay->paynum;
3927 $cust_pay_pending->status('done');
3928 $cust_pay_pending->statustext('captured');
3929 $cust_pay_pending->paynum($cust_pay->paynum);
3930 my $cpp_done_err = $cust_pay_pending->replace;
3932 if ( $cpp_done_err ) {
3934 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
3935 my $e = "WARNING: $method captured but payment not recorded - ".
3936 "error updating status for paypendingnum ".
3937 $cust_pay_pending->paypendingnum. ": $cpp_done_err \n";
3943 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3944 return ''; #no error
3950 my $perror = "$processor error: ". $transaction->error_message;
3952 unless ( $transaction->error_message ) {
3955 if ( $transaction->can('response_page') ) {
3957 'page' => ( $transaction->can('response_page')
3958 ? $transaction->response_page
3961 'code' => ( $transaction->can('response_code')
3962 ? $transaction->response_code
3965 'headers' => ( $transaction->can('response_headers')
3966 ? $transaction->response_headers
3972 "No additional debugging information available for $processor";
3975 $perror .= "No error_message returned from $processor -- ".
3976 ( ref($t_response) ? Dumper($t_response) : $t_response );
3980 if ( !$options{'quiet'} && !$realtime_bop_decline_quiet
3981 && $conf->exists('emaildecline')
3982 && grep { $_ ne 'POST' } $self->invoicing_list
3983 && ! grep { $transaction->error_message =~ /$_/ }
3984 $conf->config('emaildecline-exclude')
3986 my @templ = $conf->config('declinetemplate');
3987 my $template = new Text::Template (
3989 SOURCE => [ map "$_\n", @templ ],
3990 ) or return "($perror) can't create template: $Text::Template::ERROR";
3991 $template->compile()
3992 or return "($perror) can't compile template: $Text::Template::ERROR";
3994 my $templ_hash = { error => $transaction->error_message };
3996 my $error = send_email(
3997 'from' => $conf->config('invoice_from', $self->agentnum ),
3998 'to' => [ grep { $_ ne 'POST' } $self->invoicing_list ],
3999 'subject' => 'Your payment could not be processed',
4000 'body' => [ $template->fill_in(HASH => $templ_hash) ],
4003 $perror .= " (also received error sending decline notification: $error)"
4008 $cust_pay_pending->status('done');
4009 $cust_pay_pending->statustext("declined: $perror");
4010 my $cpp_done_err = $cust_pay_pending->replace;
4011 if ( $cpp_done_err ) {
4012 my $e = "WARNING: $method declined but pending payment not resolved - ".
4013 "error updating status for paypendingnum ".
4014 $cust_pay_pending->paypendingnum. ": $cpp_done_err \n";
4016 $perror = "$e ($perror)";
4024 sub _bop_recurring_billing {
4025 my( $self, %opt ) = @_;
4027 my $method = $conf->config('credit_card-recurring_billing_flag');
4029 if ( $method eq 'transaction_is_recur' ) {
4031 return 1 if $opt{'trans_is_recur'};
4035 my %hash = ( 'custnum' => $self->custnum,
4040 if qsearch('cust_pay', { %hash, 'payinfo' => $opt{'payinfo'} } )
4041 || qsearch('cust_pay', { %hash, 'paymask' => $self->mask_payinfo('CARD',
4052 =item realtime_refund_bop METHOD [ OPTION => VALUE ... ]
4054 Refunds a realtime credit card, ACH (electronic check) or phone bill transaction
4055 via a Business::OnlinePayment realtime gateway. See
4056 L<http://420.am/business-onlinepayment> for supported gateways.
4058 Available methods are: I<CC>, I<ECHECK> and I<LEC>
4060 Available options are: I<amount>, I<reason>, I<paynum>, I<paydate>
4062 Most gateways require a reference to an original payment transaction to refund,
4063 so you probably need to specify a I<paynum>.
4065 I<amount> defaults to the original amount of the payment if not specified.
4067 I<reason> specifies a reason for the refund.
4069 I<paydate> specifies the expiration date for a credit card overriding the
4070 value from the customer record or the payment record. Specified as yyyy-mm-dd
4072 Implementation note: If I<amount> is unspecified or equal to the amount of the
4073 orignal payment, first an attempt is made to "void" the transaction via
4074 the gateway (to cancel a not-yet settled transaction) and then if that fails,
4075 the normal attempt is made to "refund" ("credit") the transaction via the
4076 gateway is attempted.
4078 #The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
4079 #I<zip>, I<payinfo> and I<paydate> are also available. Any of these options,
4080 #if set, will override the value from the customer record.
4082 #If an I<invnum> is specified, this payment (if successful) is applied to the
4083 #specified invoice. If you don't specify an I<invnum> you might want to
4084 #call the B<apply_payments> method.
4088 #some false laziness w/realtime_bop, not enough to make it worth merging
4089 #but some useful small subs should be pulled out
4090 sub realtime_refund_bop {
4093 return $self->_new_realtime_refund_bop(@_)
4094 if $self->_new_bop_required();
4096 my( $method, %options ) = @_;
4098 warn "$me realtime_refund_bop: $method refund\n";
4099 warn " $_ => $options{$_}\n" foreach keys %options;
4102 eval "use Business::OnlinePayment";
4106 # look up the original payment and optionally a gateway for that payment
4110 my $amount = $options{'amount'};
4112 my( $processor, $login, $password, @bop_options ) ;
4113 my( $auth, $order_number ) = ( '', '', '' );
4115 if ( $options{'paynum'} ) {
4117 warn " paynum: $options{paynum}\n" if $DEBUG > 1;
4118 $cust_pay = qsearchs('cust_pay', { paynum=>$options{'paynum'} } )
4119 or return "Unknown paynum $options{'paynum'}";
4120 $amount ||= $cust_pay->paid;
4122 $cust_pay->paybatch =~ /^((\d+)\-)?(\w+):\s*([\w\-\/ ]*)(:([\w\-]+))?$/
4123 or return "Can't parse paybatch for paynum $options{'paynum'}: ".
4124 $cust_pay->paybatch;
4125 my $gatewaynum = '';
4126 ( $gatewaynum, $processor, $auth, $order_number ) = ( $2, $3, $4, $6 );
4128 if ( $gatewaynum ) { #gateway for the payment to be refunded
4130 my $payment_gateway =
4131 qsearchs('payment_gateway', { 'gatewaynum' => $gatewaynum } );
4132 die "payment gateway $gatewaynum not found"
4133 unless $payment_gateway;
4135 $processor = $payment_gateway->gateway_module;
4136 $login = $payment_gateway->gateway_username;
4137 $password = $payment_gateway->gateway_password;
4138 @bop_options = $payment_gateway->options;
4140 } else { #try the default gateway
4142 my( $conf_processor, $unused_action );
4143 ( $conf_processor, $login, $password, $unused_action, @bop_options ) =
4144 $self->default_payment_gateway($method);
4146 return "processor of payment $options{'paynum'} $processor does not".
4147 " match default processor $conf_processor"
4148 unless $processor eq $conf_processor;
4153 } else { # didn't specify a paynum, so look for agent gateway overrides
4154 # like a normal transaction
4157 if ( $method eq 'CC' ) {
4158 $cardtype = cardtype($self->payinfo);
4159 } elsif ( $method eq 'ECHECK' ) {
4162 $cardtype = $method;
4165 qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
4166 cardtype => $cardtype,
4168 || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
4170 taxclass => '', } );
4172 if ( $override ) { #use a payment gateway override
4174 my $payment_gateway = $override->payment_gateway;
4176 $processor = $payment_gateway->gateway_module;
4177 $login = $payment_gateway->gateway_username;
4178 $password = $payment_gateway->gateway_password;
4179 #$action = $payment_gateway->gateway_action;
4180 @bop_options = $payment_gateway->options;
4182 } else { #use the standard settings from the config
4185 ( $processor, $login, $password, $unused_action, @bop_options ) =
4186 $self->default_payment_gateway($method);
4191 return "neither amount nor paynum specified" unless $amount;
4196 'password' => $password,
4197 'order_number' => $order_number,
4198 'amount' => $amount,
4199 'referer' => 'http://cleanwhisker.420.am/', #XXX fix referer :/
4201 $content{authorization} = $auth
4202 if length($auth); #echeck/ACH transactions have an order # but no auth
4203 #(at least with authorize.net)
4205 my $disable_void_after;
4206 if ($conf->exists('disable_void_after')
4207 && $conf->config('disable_void_after') =~ /^(\d+)$/) {
4208 $disable_void_after = $1;
4211 #first try void if applicable
4212 if ( $cust_pay && $cust_pay->paid == $amount
4214 ( not defined($disable_void_after) )
4215 || ( time < ($cust_pay->_date + $disable_void_after ) )
4218 warn " attempting void\n" if $DEBUG > 1;
4219 my $void = new Business::OnlinePayment( $processor, @bop_options );
4220 $void->content( 'action' => 'void', %content );
4222 if ( $void->is_success ) {
4223 my $error = $cust_pay->void($options{'reason'});
4225 # gah, even with transactions.
4226 my $e = 'WARNING: Card/ACH voided but database not updated - '.
4227 "error voiding payment: $error";
4231 warn " void successful\n" if $DEBUG > 1;
4236 warn " void unsuccessful, trying refund\n"
4240 my $address = $self->address1;
4241 $address .= ", ". $self->address2 if $self->address2;
4243 my($payname, $payfirst, $paylast);
4244 if ( $self->payname && $method ne 'ECHECK' ) {
4245 $payname = $self->payname;
4246 $payname =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
4247 or return "Illegal payname $payname";
4248 ($payfirst, $paylast) = ($1, $2);
4250 $payfirst = $self->getfield('first');
4251 $paylast = $self->getfield('last');
4252 $payname = "$payfirst $paylast";
4255 my @invoicing_list = $self->invoicing_list_emailonly;
4256 if ( $conf->exists('emailinvoiceautoalways')
4257 || $conf->exists('emailinvoiceauto') && ! @invoicing_list
4258 || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
4259 push @invoicing_list, $self->all_emails;
4262 my $email = ($conf->exists('business-onlinepayment-email-override'))
4263 ? $conf->config('business-onlinepayment-email-override')
4264 : $invoicing_list[0];
4266 my $payip = exists($options{'payip'})
4269 $content{customer_ip} = $payip
4273 if ( $method eq 'CC' ) {
4276 $content{card_number} = $payinfo = $cust_pay->payinfo;
4277 (exists($options{'paydate'}) ? $options{'paydate'} : $cust_pay->paydate)
4278 =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/ &&
4279 ($content{expiration} = "$2/$1"); # where available
4281 $content{card_number} = $payinfo = $self->payinfo;
4282 (exists($options{'paydate'}) ? $options{'paydate'} : $self->paydate)
4283 =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
4284 $content{expiration} = "$2/$1";
4287 } elsif ( $method eq 'ECHECK' ) {
4290 $payinfo = $cust_pay->payinfo;
4292 $payinfo = $self->payinfo;
4294 ( $content{account_number}, $content{routing_code} )= split('@', $payinfo );
4295 $content{bank_name} = $self->payname;
4296 $content{account_type} = 'CHECKING';
4297 $content{account_name} = $payname;
4298 $content{customer_org} = $self->company ? 'B' : 'I';
4299 $content{customer_ssn} = $self->ss;
4300 } elsif ( $method eq 'LEC' ) {
4301 $content{phone} = $payinfo = $self->payinfo;
4305 my $refund = new Business::OnlinePayment( $processor, @bop_options );
4306 my %sub_content = $refund->content(
4307 'action' => 'credit',
4308 'customer_id' => $self->custnum,
4309 'last_name' => $paylast,
4310 'first_name' => $payfirst,
4312 'address' => $address,
4313 'city' => $self->city,
4314 'state' => $self->state,
4315 'zip' => $self->zip,
4316 'country' => $self->country,
4318 'phone' => $self->daytime || $self->night,
4321 warn join('', map { " $_ => $sub_content{$_}\n" } keys %sub_content )
4325 return "$processor error: ". $refund->error_message
4326 unless $refund->is_success();
4328 my %method2payby = (
4334 my $paybatch = "$processor:". $refund->authorization;
4335 $paybatch .= ':'. $refund->order_number
4336 if $refund->can('order_number') && $refund->order_number;
4338 while ( $cust_pay && $cust_pay->unapplied < $amount ) {
4339 my @cust_bill_pay = $cust_pay->cust_bill_pay;
4340 last unless @cust_bill_pay;
4341 my $cust_bill_pay = pop @cust_bill_pay;
4342 my $error = $cust_bill_pay->delete;
4346 my $cust_refund = new FS::cust_refund ( {
4347 'custnum' => $self->custnum,
4348 'paynum' => $options{'paynum'},
4349 'refund' => $amount,
4351 'payby' => $method2payby{$method},
4352 'payinfo' => $payinfo,
4353 'paybatch' => $paybatch,
4354 'reason' => $options{'reason'} || 'card or ACH refund',
4356 my $error = $cust_refund->insert;
4358 $cust_refund->paynum(''); #try again with no specific paynum
4359 my $error2 = $cust_refund->insert;
4361 # gah, even with transactions.
4362 my $e = 'WARNING: Card/ACH refunded but database not updated - '.
4363 "error inserting refund ($processor): $error2".
4364 " (previously tried insert with paynum #$options{'paynum'}" .
4375 # does the configuration indicate the new bop routines are required?
4377 sub _new_bop_required {
4380 my $botpp = 'Business::OnlineThirdPartyPayment';
4383 if ( $conf->config('business-onlinepayment-namespace') eq $botpp ||
4384 scalar( grep { $_->gateway_namespace eq $botpp }
4385 qsearch( 'payment_gateway', { 'disabled' => '' } )
4394 =item realtime_collect [ OPTION => VALUE ... ]
4396 Runs a realtime credit card, ACH (electronic check) or phone bill transaction
4397 via a Business::OnlinePayment or Business::OnlineThirdPartyPayment realtime
4398 gateway. See L<http://420.am/business-onlinepayment> and
4399 L<http://420.am/business-onlinethirdpartypayment> for supported gateways.
4401 On failure returns an error message.
4403 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.
4405 Available options are: I<method>, I<amount>, I<description>, I<invnum>, I<quiet>, I<paynum_ref>, I<payunique>, I<session_id>
4407 I<method> is one of: I<CC>, I<ECHECK> and I<LEC>. If none is specified
4408 then it is deduced from the customer record.
4410 If no I<amount> is specified, then the customer balance is used.
4412 The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
4413 I<zip>, I<payinfo> and I<paydate> are also available. Any of these options,
4414 if set, will override the value from the customer record.
4416 I<description> is a free-text field passed to the gateway. It defaults to
4417 "Internet services".
4419 If an I<invnum> is specified, this payment (if successful) is applied to the
4420 specified invoice. If you don't specify an I<invnum> you might want to
4421 call the B<apply_payments> method.
4423 I<quiet> can be set true to surpress email decline notices.
4425 I<paynum_ref> can be set to a scalar reference. It will be filled in with the
4426 resulting paynum, if any.
4428 I<payunique> is a unique identifier for this payment.
4430 I<session_id> is a session identifier associated with this payment.
4432 I<depend_jobnum> allows payment capture to unlock export jobs
4436 sub realtime_collect {
4437 my( $self, %options ) = @_;
4440 warn "$me realtime_collect:\n";
4441 warn " $_ => $options{$_}\n" foreach keys %options;
4444 $options{amount} = $self->balance unless exists( $options{amount} );
4445 $options{method} = FS::payby->payby2bop($self->payby)
4446 unless exists( $options{method} );
4448 return $self->realtime_bop({%options});
4452 =item _realtime_bop { [ ARG => VALUE ... ] }
4454 Runs a realtime credit card, ACH (electronic check) or phone bill transaction
4455 via a Business::OnlinePayment realtime gateway. See
4456 L<http://420.am/business-onlinepayment> for supported gateways.
4458 Required arguments in the hashref are I<method>, and I<amount>
4460 Available methods are: I<CC>, I<ECHECK> and I<LEC>
4462 Available optional arguments are: I<description>, I<invnum>, I<quiet>, I<paynum_ref>, I<payunique>, I<session_id>
4464 The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
4465 I<zip>, I<payinfo> and I<paydate> are also available. Any of these options,
4466 if set, will override the value from the customer record.
4468 I<description> is a free-text field passed to the gateway. It defaults to
4469 "Internet services".
4471 If an I<invnum> is specified, this payment (if successful) is applied to the
4472 specified invoice. If you don't specify an I<invnum> you might want to
4473 call the B<apply_payments> method.
4475 I<quiet> can be set true to surpress email decline notices.
4477 I<paynum_ref> can be set to a scalar reference. It will be filled in with the
4478 resulting paynum, if any.
4480 I<payunique> is a unique identifier for this payment.
4482 I<session_id> is a session identifier associated with this payment.
4484 I<depend_jobnum> allows payment capture to unlock export jobs
4486 (moved from cust_bill) (probably should get realtime_{card,ach,lec} here too)
4490 # some helper routines
4491 sub _payment_gateway {
4492 my ($self, $options) = @_;
4494 $options->{payment_gateway} = $self->agent->payment_gateway( %$options )
4495 unless exists($options->{payment_gateway});
4497 $options->{payment_gateway};
4501 my ($self, $options) = @_;
4504 'login' => $options->{payment_gateway}->gateway_username,
4505 'password' => $options->{payment_gateway}->gateway_password,
4510 my ($self, $options) = @_;
4512 $options->{payment_gateway}->gatewaynum
4513 ? $options->{payment_gateway}->options
4514 : @{ $options->{payment_gateway}->get('options') };
4518 my ($self, $options) = @_;
4520 $options->{description} ||= 'Internet services';
4521 $options->{payinfo} = $self->payinfo unless exists( $options->{payinfo} );
4522 $options->{invnum} ||= '';
4523 $options->{payname} = $self->payname unless exists( $options->{payname} );
4527 my ($self, $options) = @_;
4530 $content{address} = exists($options->{'address1'})
4531 ? $options->{'address1'}
4533 my $address2 = exists($options->{'address2'})
4534 ? $options->{'address2'}
4536 $content{address} .= ", ". $address2 if length($address2);
4538 my $payip = exists($options->{'payip'}) ? $options->{'payip'} : $self->payip;
4539 $content{customer_ip} = $payip if length($payip);
4541 $content{invoice_number} = $options->{'invnum'}
4542 if exists($options->{'invnum'}) && length($options->{'invnum'});
4544 $content{email_customer} =
4545 ( $conf->exists('business-onlinepayment-email_customer')
4546 || $conf->exists('business-onlinepayment-email-override') );
4548 $content{payfirst} = $self->getfield('first');
4549 $content{paylast} = $self->getfield('last');
4551 $content{account_name} = "$content{payfirst} $content{paylast}"
4552 if $options->{method} eq 'ECHECK';
4554 $content{name} = $options->{payname};
4555 $content{name} = $content{account_name} if exists($content{account_name});
4557 $content{city} = exists($options->{city})
4560 $content{state} = exists($options->{state})
4563 $content{zip} = exists($options->{zip})
4566 $content{country} = exists($options->{country})
4567 ? $options->{country}
4569 $content{referer} = 'http://cleanwhisker.420.am/'; #XXX fix referer :/
4570 $content{phone} = $self->daytime || $self->night;
4575 my %bop_method2payby = (
4581 sub _new_realtime_bop {
4585 if (ref($_[0]) eq 'HASH') {
4586 %options = %{$_[0]};
4588 my ( $method, $amount ) = ( shift, shift );
4590 $options{method} = $method;
4591 $options{amount} = $amount;
4595 warn "$me realtime_bop (new): $options{method} $options{amount}\n";
4596 warn " $_ => $options{$_}\n" foreach keys %options;
4599 return $self->fake_bop(%options) if $options{'fake'};
4601 $self->_bop_defaults(\%options);
4604 # set trans_is_recur based on invnum if there is one
4607 my $trans_is_recur = 0;
4608 if ( $options{'invnum'} ) {
4610 my $cust_bill = qsearchs('cust_bill', { 'invnum' => $options{'invnum'} } );
4611 die "invnum ". $options{'invnum'}. " not found" unless $cust_bill;
4614 map { $_->part_pkg }
4616 map { $_->cust_pkg }
4617 $cust_bill->cust_bill_pkg;
4620 if grep { $_->freq ne '0' } @part_pkg;
4628 my $payment_gateway = $self->_payment_gateway( \%options );
4629 my $namespace = $payment_gateway->gateway_namespace;
4631 eval "use $namespace";
4635 # check for banned credit card/ACH
4638 my $ban = qsearchs('banned_pay', {
4639 'payby' => $bop_method2payby{$options{method}},
4640 'payinfo' => md5_base64($options{payinfo}),
4642 return "Banned credit card" if $ban;
4648 my (%bop_content) = $self->_bop_content(\%options);
4650 if ( $options{method} ne 'ECHECK' ) {
4651 $options{payname} =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
4652 or return "Illegal payname $options{payname}";
4653 ($bop_content{payfirst}, $bop_content{paylast}) = ($1, $2);
4656 my @invoicing_list = $self->invoicing_list_emailonly;
4657 if ( $conf->exists('emailinvoiceautoalways')
4658 || $conf->exists('emailinvoiceauto') && ! @invoicing_list
4659 || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
4660 push @invoicing_list, $self->all_emails;
4663 my $email = ($conf->exists('business-onlinepayment-email-override'))
4664 ? $conf->config('business-onlinepayment-email-override')
4665 : $invoicing_list[0];
4669 if ( $namespace eq 'Business::OnlinePayment' && $options{method} eq 'CC' ) {
4671 $content{card_number} = $options{payinfo};
4672 $paydate = exists($options{'paydate'})
4673 ? $options{'paydate'}
4675 $paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
4676 $content{expiration} = "$2/$1";
4678 my $paycvv = exists($options{'paycvv'})
4679 ? $options{'paycvv'}
4681 $content{cvv2} = $paycvv
4684 my $paystart_month = exists($options{'paystart_month'})
4685 ? $options{'paystart_month'}
4686 : $self->paystart_month;
4688 my $paystart_year = exists($options{'paystart_year'})
4689 ? $options{'paystart_year'}
4690 : $self->paystart_year;
4692 $content{card_start} = "$paystart_month/$paystart_year"
4693 if $paystart_month && $paystart_year;
4695 my $payissue = exists($options{'payissue'})
4696 ? $options{'payissue'}
4698 $content{issue_number} = $payissue if $payissue;
4700 if ( $self->_bop_recurring_billing( 'payinfo' => $options{'payinfo'},
4701 'trans_is_recur' => $trans_is_recur,
4705 $content{recurring_billing} = 'YES';
4706 $content{acct_code} = 'rebill'
4707 if $conf->exists('credit_card-recurring_billing_acct_code');
4710 } elsif ( $namespace eq 'Business::OnlinePayment' && $options{method} eq 'ECHECK' ){
4711 ( $content{account_number}, $content{routing_code} ) =
4712 split('@', $options{payinfo});
4713 $content{bank_name} = $options{payname};
4714 $content{bank_state} = exists($options{'paystate'})
4715 ? $options{'paystate'}
4716 : $self->getfield('paystate');
4717 $content{account_type} = exists($options{'paytype'})
4718 ? uc($options{'paytype'}) || 'CHECKING'
4719 : uc($self->getfield('paytype')) || 'CHECKING';
4720 $content{customer_org} = $self->company ? 'B' : 'I';
4721 $content{state_id} = exists($options{'stateid'})
4722 ? $options{'stateid'}
4723 : $self->getfield('stateid');
4724 $content{state_id_state} = exists($options{'stateid_state'})
4725 ? $options{'stateid_state'}
4726 : $self->getfield('stateid_state');
4727 $content{customer_ssn} = exists($options{'ss'})
4730 } elsif ( $namespace eq 'Business::OnlinePayment' && $options{method} eq 'LEC' ) {
4731 $content{phone} = $options{payinfo};
4732 } elsif ( $namespace eq 'Business::OnlineThirdPartyPayment' ) {
4739 # run transaction(s)
4742 my $balance = exists( $options{'balance'} )
4743 ? $options{'balance'}
4746 $self->select_for_update; #mutex ... just until we get our pending record in
4748 #the checks here are intended to catch concurrent payments
4749 #double-form-submission prevention is taken care of in cust_pay_pending::check
4752 return "The customer's balance has changed; $options{method} transaction aborted."
4753 if $self->balance < $balance;
4754 #&& $self->balance < $options{amount}; #might as well anyway?
4756 #also check and make sure there aren't *other* pending payments for this cust
4758 my @pending = qsearch('cust_pay_pending', {
4759 'custnum' => $self->custnum,
4760 'status' => { op=>'!=', value=>'done' }
4762 return "A payment is already being processed for this customer (".
4763 join(', ', map 'paypendingnum '. $_->paypendingnum, @pending ).
4764 "); $options{method} transaction aborted."
4765 if scalar(@pending);
4767 #okay, good to go, if we're a duplicate, cust_pay_pending will kick us out
4769 my $cust_pay_pending = new FS::cust_pay_pending {
4770 'custnum' => $self->custnum,
4771 #'invnum' => $options{'invnum'},
4772 'paid' => $options{amount},
4774 'payby' => $bop_method2payby{$options{method}},
4775 'payinfo' => $options{payinfo},
4776 'paydate' => $paydate,
4777 'recurring_billing' => $content{recurring_billing},
4779 'gatewaynum' => $payment_gateway->gatewaynum || '',
4780 'session_id' => $options{session_id} || '',
4781 'jobnum' => $options{depend_jobnum} || '',
4783 $cust_pay_pending->payunique( $options{payunique} )
4784 if defined($options{payunique}) && length($options{payunique});
4785 my $cpp_new_err = $cust_pay_pending->insert; #mutex lost when this is inserted
4786 return $cpp_new_err if $cpp_new_err;
4788 my( $action1, $action2 ) =
4789 split( /\s*\,\s*/, $payment_gateway->gateway_action );
4791 my $transaction = new $namespace( $payment_gateway->gateway_module,
4792 $self->_bop_options(\%options),
4795 $transaction->content(
4796 'type' => $options{method},
4797 $self->_bop_auth(\%options),
4798 'action' => $action1,
4799 'description' => $options{'description'},
4800 'amount' => $options{amount},
4801 #'invoice_number' => $options{'invnum'},
4802 'customer_id' => $self->custnum,
4804 'reference' => $cust_pay_pending->paypendingnum, #for now
4809 $cust_pay_pending->status('pending');
4810 my $cpp_pending_err = $cust_pay_pending->replace;
4811 return $cpp_pending_err if $cpp_pending_err;
4814 my $BOP_TESTING = 0;
4815 my $BOP_TESTING_SUCCESS = 1;
4817 unless ( $BOP_TESTING ) {
4818 $transaction->submit();
4820 if ( $BOP_TESTING_SUCCESS ) {
4821 $transaction->is_success(1);
4822 $transaction->authorization('fake auth');
4824 $transaction->is_success(0);
4825 $transaction->error_message('fake failure');
4829 if ( $transaction->is_success() && $namespace eq 'Business::OnlineThirdPartyPayment' ) {
4831 return { reference => $cust_pay_pending->paypendingnum,
4832 map { $_ => $transaction->$_ } qw ( popup_url collectitems ) };
4834 } elsif ( $transaction->is_success() && $action2 ) {
4836 $cust_pay_pending->status('authorized');
4837 my $cpp_authorized_err = $cust_pay_pending->replace;
4838 return $cpp_authorized_err if $cpp_authorized_err;
4840 my $auth = $transaction->authorization;
4841 my $ordernum = $transaction->can('order_number')
4842 ? $transaction->order_number
4846 new Business::OnlinePayment( $payment_gateway->gateway_module,
4847 $self->_bop_options(\%options),
4852 type => $options{method},
4854 $self->_bop_auth(\%options),
4855 order_number => $ordernum,
4856 amount => $options{amount},
4857 authorization => $auth,
4858 description => $options{'description'},
4861 foreach my $field (qw( authorization_source_code returned_ACI
4862 transaction_identifier validation_code
4863 transaction_sequence_num local_transaction_date
4864 local_transaction_time AVS_result_code )) {
4865 $capture{$field} = $transaction->$field() if $transaction->can($field);
4868 $capture->content( %capture );
4872 unless ( $capture->is_success ) {
4873 my $e = "Authorization successful but capture failed, custnum #".
4874 $self->custnum. ': '. $capture->result_code.
4875 ": ". $capture->error_message;
4883 # remove paycvv after initial transaction
4886 #false laziness w/misc/process/payment.cgi - check both to make sure working
4888 if ( defined $self->dbdef_table->column('paycvv')
4889 && length($self->paycvv)
4890 && ! grep { $_ eq cardtype($options{payinfo}) } $conf->config('cvv-save')
4892 my $error = $self->remove_cvv;
4894 warn "WARNING: error removing cvv: $error\n";
4902 $self->_realtime_bop_result( $cust_pay_pending, $transaction, %options );
4914 if (ref($_[0]) eq 'HASH') {
4915 %options = %{$_[0]};
4917 my ( $method, $amount ) = ( shift, shift );
4919 $options{method} = $method;
4920 $options{amount} = $amount;
4923 if ( $options{'fake_failure'} ) {
4924 return "Error: No error; test failure requested with fake_failure";
4928 #if ( $payment_gateway->gatewaynum ) { # agent override
4929 # $paybatch = $payment_gateway->gatewaynum. '-';
4932 #$paybatch .= "$processor:". $transaction->authorization;
4934 #$paybatch .= ':'. $transaction->order_number
4935 # if $transaction->can('order_number')
4936 # && length($transaction->order_number);
4938 my $paybatch = 'FakeProcessor:54:32';
4940 my $cust_pay = new FS::cust_pay ( {
4941 'custnum' => $self->custnum,
4942 'invnum' => $options{'invnum'},
4943 'paid' => $options{amount},
4945 'payby' => $bop_method2payby{$options{method}},
4946 #'payinfo' => $payinfo,
4947 'payinfo' => '4111111111111111',
4948 'paybatch' => $paybatch,
4949 #'paydate' => $paydate,
4950 'paydate' => '2012-05-01',
4952 $cust_pay->payunique( $options{payunique} ) if length($options{payunique});
4954 my $error = $cust_pay->insert($options{'manual'} ? ( 'manual' => 1 ) : () );
4957 $cust_pay->invnum(''); #try again with no specific invnum
4958 my $error2 = $cust_pay->insert( $options{'manual'} ?
4959 ( 'manual' => 1 ) : ()
4962 # gah, even with transactions.
4963 my $e = 'WARNING: Card/ACH debited but database not updated - '.
4964 "error inserting (fake!) payment: $error2".
4965 " (previously tried insert with invnum #$options{'invnum'}" .
4972 if ( $options{'paynum_ref'} ) {
4973 ${ $options{'paynum_ref'} } = $cust_pay->paynum;
4976 return ''; #no error
4981 # item _realtime_bop_result CUST_PAY_PENDING, BOP_OBJECT [ OPTION => VALUE ... ]
4983 # Wraps up processing of a realtime credit card, ACH (electronic check) or
4984 # phone bill transaction.
4986 sub _realtime_bop_result {
4987 my( $self, $cust_pay_pending, $transaction, %options ) = @_;
4989 warn "$me _realtime_bop_result: pending transaction ".
4990 $cust_pay_pending->paypendingnum. "\n";
4991 warn " $_ => $options{$_}\n" foreach keys %options;
4994 my $payment_gateway = $options{payment_gateway}
4995 or return "no payment gateway in arguments to _realtime_bop_result";
4997 $cust_pay_pending->status($transaction->is_success() ? 'captured' : 'declined');
4998 my $cpp_captured_err = $cust_pay_pending->replace;
4999 return $cpp_captured_err if $cpp_captured_err;
5001 if ( $transaction->is_success() ) {
5004 if ( $payment_gateway->gatewaynum ) { # agent override
5005 $paybatch = $payment_gateway->gatewaynum. '-';
5008 $paybatch .= $payment_gateway->gateway_module. ":".
5009 $transaction->authorization;
5011 $paybatch .= ':'. $transaction->order_number
5012 if $transaction->can('order_number')
5013 && length($transaction->order_number);
5015 my $cust_pay = new FS::cust_pay ( {
5016 'custnum' => $self->custnum,
5017 'invnum' => $options{'invnum'},
5018 'paid' => $cust_pay_pending->paid,
5020 'payby' => $cust_pay_pending->payby,
5021 #'payinfo' => $payinfo,
5022 'paybatch' => $paybatch,
5023 'paydate' => $cust_pay_pending->paydate,
5025 #doesn't hurt to know, even though the dup check is in cust_pay_pending now
5026 $cust_pay->payunique( $options{payunique} )
5027 if defined($options{payunique}) && length($options{payunique});
5029 my $oldAutoCommit = $FS::UID::AutoCommit;
5030 local $FS::UID::AutoCommit = 0;
5033 #start a transaction, insert the cust_pay and set cust_pay_pending.status to done in a single transction
5035 my $error = $cust_pay->insert($options{'manual'} ? ( 'manual' => 1 ) : () );
5038 $cust_pay->invnum(''); #try again with no specific invnum
5039 my $error2 = $cust_pay->insert( $options{'manual'} ?
5040 ( 'manual' => 1 ) : ()
5043 # gah. but at least we have a record of the state we had to abort in
5044 # from cust_pay_pending now.
5045 my $e = "WARNING: $options{method} captured but payment not recorded -".
5046 " error inserting payment (". $payment_gateway->gateway_module.
5048 " (previously tried insert with invnum #$options{'invnum'}" .
5049 ": $error ) - pending payment saved as paypendingnum ".
5050 $cust_pay_pending->paypendingnum. "\n";
5056 my $jobnum = $cust_pay_pending->jobnum;
5058 my $placeholder = qsearchs( 'queue', { 'jobnum' => $jobnum } );
5060 unless ( $placeholder ) {
5061 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
5062 my $e = "WARNING: $options{method} captured but job $jobnum not ".
5063 "found for paypendingnum ". $cust_pay_pending->paypendingnum. "\n";
5068 $error = $placeholder->delete;
5071 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
5072 my $e = "WARNING: $options{method} captured but could not delete ".
5073 "job $jobnum for paypendingnum ".
5074 $cust_pay_pending->paypendingnum. ": $error\n";
5081 if ( $options{'paynum_ref'} ) {
5082 ${ $options{'paynum_ref'} } = $cust_pay->paynum;
5085 $cust_pay_pending->status('done');
5086 $cust_pay_pending->statustext('captured');
5087 $cust_pay_pending->paynum($cust_pay->paynum);
5088 my $cpp_done_err = $cust_pay_pending->replace;
5090 if ( $cpp_done_err ) {
5092 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
5093 my $e = "WARNING: $options{method} captured but payment not recorded - ".
5094 "error updating status for paypendingnum ".
5095 $cust_pay_pending->paypendingnum. ": $cpp_done_err \n";
5101 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
5102 return ''; #no error
5108 my $perror = $payment_gateway->gateway_module. " error: ".
5109 $transaction->error_message;
5111 my $jobnum = $cust_pay_pending->jobnum;
5113 my $placeholder = qsearchs( 'queue', { 'jobnum' => $jobnum } );
5115 if ( $placeholder ) {
5116 my $error = $placeholder->depended_delete;
5117 $error ||= $placeholder->delete;
5118 warn "error removing provisioning jobs after declined paypendingnum ".
5119 $cust_pay_pending->paypendingnum. "\n";
5121 my $e = "error finding job $jobnum for declined paypendingnum ".
5122 $cust_pay_pending->paypendingnum. "\n";
5128 unless ( $transaction->error_message ) {
5131 if ( $transaction->can('response_page') ) {
5133 'page' => ( $transaction->can('response_page')
5134 ? $transaction->response_page
5137 'code' => ( $transaction->can('response_code')
5138 ? $transaction->response_code
5141 'headers' => ( $transaction->can('response_headers')
5142 ? $transaction->response_headers
5148 "No additional debugging information available for ".
5149 $payment_gateway->gateway_module;
5152 $perror .= "No error_message returned from ".
5153 $payment_gateway->gateway_module. " -- ".
5154 ( ref($t_response) ? Dumper($t_response) : $t_response );
5158 if ( !$options{'quiet'} && !$realtime_bop_decline_quiet
5159 && $conf->exists('emaildecline')
5160 && grep { $_ ne 'POST' } $self->invoicing_list
5161 && ! grep { $transaction->error_message =~ /$_/ }
5162 $conf->config('emaildecline-exclude')
5164 my @templ = $conf->config('declinetemplate');
5165 my $template = new Text::Template (
5167 SOURCE => [ map "$_\n", @templ ],
5168 ) or return "($perror) can't create template: $Text::Template::ERROR";
5169 $template->compile()
5170 or return "($perror) can't compile template: $Text::Template::ERROR";
5172 my $templ_hash = { error => $transaction->error_message };
5174 my $error = send_email(
5175 'from' => $conf->config('invoice_from', $self->agentnum ),
5176 'to' => [ grep { $_ ne 'POST' } $self->invoicing_list ],
5177 'subject' => 'Your payment could not be processed',
5178 'body' => [ $template->fill_in(HASH => $templ_hash) ],
5181 $perror .= " (also received error sending decline notification: $error)"
5186 $cust_pay_pending->status('done');
5187 $cust_pay_pending->statustext("declined: $perror");
5188 my $cpp_done_err = $cust_pay_pending->replace;
5189 if ( $cpp_done_err ) {
5190 my $e = "WARNING: $options{method} declined but pending payment not ".
5191 "resolved - error updating status for paypendingnum ".
5192 $cust_pay_pending->paypendingnum. ": $cpp_done_err \n";
5194 $perror = "$e ($perror)";
5202 =item realtime_botpp_capture CUST_PAY_PENDING [ OPTION => VALUE ... ]
5204 Verifies successful third party processing of a realtime credit card,
5205 ACH (electronic check) or phone bill transaction via a
5206 Business::OnlineThirdPartyPayment realtime gateway. See
5207 L<http://420.am/business-onlinethirdpartypayment> for supported gateways.
5209 Available options are: I<description>, I<invnum>, I<quiet>, I<paynum_ref>, I<payunique>
5211 The additional options I<payname>, I<city>, I<state>,
5212 I<zip>, I<payinfo> and I<paydate> are also available. Any of these options,
5213 if set, will override the value from the customer record.
5215 I<description> is a free-text field passed to the gateway. It defaults to
5216 "Internet services".
5218 If an I<invnum> is specified, this payment (if successful) is applied to the
5219 specified invoice. If you don't specify an I<invnum> you might want to
5220 call the B<apply_payments> method.
5222 I<quiet> can be set true to surpress email decline notices.
5224 I<paynum_ref> can be set to a scalar reference. It will be filled in with the
5225 resulting paynum, if any.
5227 I<payunique> is a unique identifier for this payment.
5229 Returns a hashref containing elements bill_error (which will be undefined
5230 upon success) and session_id of any associated session.
5234 sub realtime_botpp_capture {
5235 my( $self, $cust_pay_pending, %options ) = @_;
5237 warn "$me realtime_botpp_capture: pending transaction $cust_pay_pending\n";
5238 warn " $_ => $options{$_}\n" foreach keys %options;
5241 eval "use Business::OnlineThirdPartyPayment";
5245 # select the gateway
5248 my $method = FS::payby->payby2bop($cust_pay_pending->payby);
5250 my $payment_gateway = $cust_pay_pending->gatewaynum
5251 ? qsearchs( 'payment_gateway',
5252 { gatewaynum => $cust_pay_pending->gatewaynum }
5254 : $self->agent->payment_gateway( 'method' => $method,
5255 # 'invnum' => $cust_pay_pending->invnum,
5256 # 'payinfo' => $cust_pay_pending->payinfo,
5259 $options{payment_gateway} = $payment_gateway; # for the helper subs
5265 my @invoicing_list = $self->invoicing_list_emailonly;
5266 if ( $conf->exists('emailinvoiceautoalways')
5267 || $conf->exists('emailinvoiceauto') && ! @invoicing_list
5268 || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
5269 push @invoicing_list, $self->all_emails;
5272 my $email = ($conf->exists('business-onlinepayment-email-override'))
5273 ? $conf->config('business-onlinepayment-email-override')
5274 : $invoicing_list[0];
5278 $content{email_customer} =
5279 ( $conf->exists('business-onlinepayment-email_customer')
5280 || $conf->exists('business-onlinepayment-email-override') );
5283 # run transaction(s)
5287 new Business::OnlineThirdPartyPayment( $payment_gateway->gateway_module,
5288 $self->_bop_options(\%options),
5291 $transaction->reference({ %options });
5293 $transaction->content(
5295 $self->_bop_auth(\%options),
5296 'action' => 'Post Authorization',
5297 'description' => $options{'description'},
5298 'amount' => $cust_pay_pending->paid,
5299 #'invoice_number' => $options{'invnum'},
5300 'customer_id' => $self->custnum,
5301 'referer' => 'http://cleanwhisker.420.am/',
5302 'reference' => $cust_pay_pending->paypendingnum,
5304 'phone' => $self->daytime || $self->night,
5306 # plus whatever is required for bogus capture avoidance
5309 $transaction->submit();
5312 $self->_realtime_bop_result( $cust_pay_pending, $transaction, %options );
5315 bill_error => $error,
5316 session_id => $cust_pay_pending->session_id,
5321 =item default_payment_gateway DEPRECATED -- use agent->payment_gateway
5325 sub default_payment_gateway {
5326 my( $self, $method ) = @_;
5328 die "Real-time processing not enabled\n"
5329 unless $conf->exists('business-onlinepayment');
5331 #warn "default_payment_gateway deprecated -- use agent->payment_gateway\n";
5334 my $bop_config = 'business-onlinepayment';
5335 $bop_config .= '-ach'
5336 if $method =~ /^(ECHECK|CHEK)$/ && $conf->exists($bop_config. '-ach');
5337 my ( $processor, $login, $password, $action, @bop_options ) =
5338 $conf->config($bop_config);
5339 $action ||= 'normal authorization';
5340 pop @bop_options if scalar(@bop_options) % 2 && $bop_options[-1] =~ /^\s*$/;
5341 die "No real-time processor is enabled - ".
5342 "did you set the business-onlinepayment configuration value?\n"
5345 ( $processor, $login, $password, $action, @bop_options )
5350 Removes the I<paycvv> field from the database directly.
5352 If there is an error, returns the error, otherwise returns false.
5358 my $sth = dbh->prepare("UPDATE cust_main SET paycvv = '' WHERE custnum = ?")
5359 or return dbh->errstr;
5360 $sth->execute($self->custnum)
5361 or return $sth->errstr;
5366 =item _new_realtime_refund_bop METHOD [ OPTION => VALUE ... ]
5368 Refunds a realtime credit card, ACH (electronic check) or phone bill transaction
5369 via a Business::OnlinePayment realtime gateway. See
5370 L<http://420.am/business-onlinepayment> for supported gateways.
5372 Available methods are: I<CC>, I<ECHECK> and I<LEC>
5374 Available options are: I<amount>, I<reason>, I<paynum>, I<paydate>
5376 Most gateways require a reference to an original payment transaction to refund,
5377 so you probably need to specify a I<paynum>.
5379 I<amount> defaults to the original amount of the payment if not specified.
5381 I<reason> specifies a reason for the refund.
5383 I<paydate> specifies the expiration date for a credit card overriding the
5384 value from the customer record or the payment record. Specified as yyyy-mm-dd
5386 Implementation note: If I<amount> is unspecified or equal to the amount of the
5387 orignal payment, first an attempt is made to "void" the transaction via
5388 the gateway (to cancel a not-yet settled transaction) and then if that fails,
5389 the normal attempt is made to "refund" ("credit") the transaction via the
5390 gateway is attempted.
5392 #The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
5393 #I<zip>, I<payinfo> and I<paydate> are also available. Any of these options,
5394 #if set, will override the value from the customer record.
5396 #If an I<invnum> is specified, this payment (if successful) is applied to the
5397 #specified invoice. If you don't specify an I<invnum> you might want to
5398 #call the B<apply_payments> method.
5402 #some false laziness w/realtime_bop, not enough to make it worth merging
5403 #but some useful small subs should be pulled out
5404 sub _new_realtime_refund_bop {
5408 if (ref($_[0]) ne 'HASH') {
5409 %options = %{$_[0]};
5413 $options{method} = $method;
5417 warn "$me realtime_refund_bop (new): $options{method} refund\n";
5418 warn " $_ => $options{$_}\n" foreach keys %options;
5422 # look up the original payment and optionally a gateway for that payment
5426 my $amount = $options{'amount'};
5428 my( $processor, $login, $password, @bop_options, $namespace ) ;
5429 my( $auth, $order_number ) = ( '', '', '' );
5431 if ( $options{'paynum'} ) {
5433 warn " paynum: $options{paynum}\n" if $DEBUG > 1;
5434 $cust_pay = qsearchs('cust_pay', { paynum=>$options{'paynum'} } )
5435 or return "Unknown paynum $options{'paynum'}";
5436 $amount ||= $cust_pay->paid;
5438 $cust_pay->paybatch =~ /^((\d+)\-)?(\w+):\s*([\w\-\/ ]*)(:([\w\-]+))?$/
5439 or return "Can't parse paybatch for paynum $options{'paynum'}: ".
5440 $cust_pay->paybatch;
5441 my $gatewaynum = '';
5442 ( $gatewaynum, $processor, $auth, $order_number ) = ( $2, $3, $4, $6 );
5444 if ( $gatewaynum ) { #gateway for the payment to be refunded
5446 my $payment_gateway =
5447 qsearchs('payment_gateway', { 'gatewaynum' => $gatewaynum } );
5448 die "payment gateway $gatewaynum not found"
5449 unless $payment_gateway;
5451 $processor = $payment_gateway->gateway_module;
5452 $login = $payment_gateway->gateway_username;
5453 $password = $payment_gateway->gateway_password;
5454 $namespace = $payment_gateway->gateway_namespace;
5455 @bop_options = $payment_gateway->options;
5457 } else { #try the default gateway
5460 my $payment_gateway =
5461 $self->agent->payment_gateway('method' => $options{method});
5463 ( $conf_processor, $login, $password, $namespace ) =
5464 map { my $method = "gateway_$_"; $payment_gateway->$method }
5465 qw( module username password namespace );
5467 @bop_options = $payment_gateway->gatewaynum
5468 ? $payment_gateway->options
5469 : @{ $payment_gateway->get('options') };
5471 return "processor of payment $options{'paynum'} $processor does not".
5472 " match default processor $conf_processor"
5473 unless $processor eq $conf_processor;
5478 } else { # didn't specify a paynum, so look for agent gateway overrides
5479 # like a normal transaction
5481 my $payment_gateway =
5482 $self->agent->payment_gateway( 'method' => $options{method},
5483 #'payinfo' => $payinfo,
5485 my( $processor, $login, $password, $namespace ) =
5486 map { my $method = "gateway_$_"; $payment_gateway->$method }
5487 qw( module username password namespace );
5489 my @bop_options = $payment_gateway->gatewaynum
5490 ? $payment_gateway->options
5491 : @{ $payment_gateway->get('options') };
5494 return "neither amount nor paynum specified" unless $amount;
5496 eval "use $namespace";
5500 'type' => $options{method},
5502 'password' => $password,
5503 'order_number' => $order_number,
5504 'amount' => $amount,
5505 'referer' => 'http://cleanwhisker.420.am/', #XXX fix referer :/
5507 $content{authorization} = $auth
5508 if length($auth); #echeck/ACH transactions have an order # but no auth
5509 #(at least with authorize.net)
5511 my $disable_void_after;
5512 if ($conf->exists('disable_void_after')
5513 && $conf->config('disable_void_after') =~ /^(\d+)$/) {
5514 $disable_void_after = $1;
5517 #first try void if applicable
5518 if ( $cust_pay && $cust_pay->paid == $amount
5520 ( not defined($disable_void_after) )
5521 || ( time < ($cust_pay->_date + $disable_void_after ) )
5524 warn " attempting void\n" if $DEBUG > 1;
5525 my $void = new Business::OnlinePayment( $processor, @bop_options );
5526 $void->content( 'action' => 'void', %content );
5528 if ( $void->is_success ) {
5529 my $error = $cust_pay->void($options{'reason'});
5531 # gah, even with transactions.
5532 my $e = 'WARNING: Card/ACH voided but database not updated - '.
5533 "error voiding payment: $error";
5537 warn " void successful\n" if $DEBUG > 1;
5542 warn " void unsuccessful, trying refund\n"
5546 my $address = $self->address1;
5547 $address .= ", ". $self->address2 if $self->address2;
5549 my($payname, $payfirst, $paylast);
5550 if ( $self->payname && $options{method} ne 'ECHECK' ) {
5551 $payname = $self->payname;
5552 $payname =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
5553 or return "Illegal payname $payname";
5554 ($payfirst, $paylast) = ($1, $2);
5556 $payfirst = $self->getfield('first');
5557 $paylast = $self->getfield('last');
5558 $payname = "$payfirst $paylast";
5561 my @invoicing_list = $self->invoicing_list_emailonly;
5562 if ( $conf->exists('emailinvoiceautoalways')
5563 || $conf->exists('emailinvoiceauto') && ! @invoicing_list
5564 || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
5565 push @invoicing_list, $self->all_emails;
5568 my $email = ($conf->exists('business-onlinepayment-email-override'))
5569 ? $conf->config('business-onlinepayment-email-override')
5570 : $invoicing_list[0];
5572 my $payip = exists($options{'payip'})
5575 $content{customer_ip} = $payip
5579 if ( $options{method} eq 'CC' ) {
5582 $content{card_number} = $payinfo = $cust_pay->payinfo;
5583 (exists($options{'paydate'}) ? $options{'paydate'} : $cust_pay->paydate)
5584 =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/ &&
5585 ($content{expiration} = "$2/$1"); # where available
5587 $content{card_number} = $payinfo = $self->payinfo;
5588 (exists($options{'paydate'}) ? $options{'paydate'} : $self->paydate)
5589 =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
5590 $content{expiration} = "$2/$1";
5593 } elsif ( $options{method} eq 'ECHECK' ) {
5596 $payinfo = $cust_pay->payinfo;
5598 $payinfo = $self->payinfo;
5600 ( $content{account_number}, $content{routing_code} )= split('@', $payinfo );
5601 $content{bank_name} = $self->payname;
5602 $content{account_type} = 'CHECKING';
5603 $content{account_name} = $payname;
5604 $content{customer_org} = $self->company ? 'B' : 'I';
5605 $content{customer_ssn} = $self->ss;
5606 } elsif ( $options{method} eq 'LEC' ) {
5607 $content{phone} = $payinfo = $self->payinfo;
5611 my $refund = new Business::OnlinePayment( $processor, @bop_options );
5612 my %sub_content = $refund->content(
5613 'action' => 'credit',
5614 'customer_id' => $self->custnum,
5615 'last_name' => $paylast,
5616 'first_name' => $payfirst,
5618 'address' => $address,
5619 'city' => $self->city,
5620 'state' => $self->state,
5621 'zip' => $self->zip,
5622 'country' => $self->country,
5624 'phone' => $self->daytime || $self->night,
5627 warn join('', map { " $_ => $sub_content{$_}\n" } keys %sub_content )
5631 return "$processor error: ". $refund->error_message
5632 unless $refund->is_success();
5634 my $paybatch = "$processor:". $refund->authorization;
5635 $paybatch .= ':'. $refund->order_number
5636 if $refund->can('order_number') && $refund->order_number;
5638 while ( $cust_pay && $cust_pay->unapplied < $amount ) {
5639 my @cust_bill_pay = $cust_pay->cust_bill_pay;
5640 last unless @cust_bill_pay;
5641 my $cust_bill_pay = pop @cust_bill_pay;
5642 my $error = $cust_bill_pay->delete;
5646 my $cust_refund = new FS::cust_refund ( {
5647 'custnum' => $self->custnum,
5648 'paynum' => $options{'paynum'},
5649 'refund' => $amount,
5651 'payby' => $bop_method2payby{$options{method}},
5652 'payinfo' => $payinfo,
5653 'paybatch' => $paybatch,
5654 'reason' => $options{'reason'} || 'card or ACH refund',
5656 my $error = $cust_refund->insert;
5658 $cust_refund->paynum(''); #try again with no specific paynum
5659 my $error2 = $cust_refund->insert;
5661 # gah, even with transactions.
5662 my $e = 'WARNING: Card/ACH refunded but database not updated - '.
5663 "error inserting refund ($processor): $error2".
5664 " (previously tried insert with paynum #$options{'paynum'}" .
5675 =item batch_card OPTION => VALUE...
5677 Adds a payment for this invoice to the pending credit card batch (see
5678 L<FS::cust_pay_batch>), or, if the B<realtime> option is set to a true value,
5679 runs the payment using a realtime gateway.
5684 my ($self, %options) = @_;
5687 if (exists($options{amount})) {
5688 $amount = $options{amount};
5690 $amount = sprintf("%.2f", $self->balance - $self->in_transit_payments);
5692 return '' unless $amount > 0;
5694 my $invnum = delete $options{invnum};
5695 my $payby = $options{invnum} || $self->payby; #dubious
5697 if ($options{'realtime'}) {
5698 return $self->realtime_bop( FS::payby->payby2bop($self->payby),
5704 my $oldAutoCommit = $FS::UID::AutoCommit;
5705 local $FS::UID::AutoCommit = 0;
5708 #this needs to handle mysql as well as Pg, like svc_acct.pm
5709 #(make it into a common function if folks need to do batching with mysql)
5710 $dbh->do("LOCK TABLE pay_batch IN SHARE ROW EXCLUSIVE MODE")
5711 or return "Cannot lock pay_batch: " . $dbh->errstr;
5715 'payby' => FS::payby->payby2payment($payby),
5718 my $pay_batch = qsearchs( 'pay_batch', \%pay_batch );
5720 unless ( $pay_batch ) {
5721 $pay_batch = new FS::pay_batch \%pay_batch;
5722 my $error = $pay_batch->insert;
5724 $dbh->rollback if $oldAutoCommit;
5725 die "error creating new batch: $error\n";
5729 my $old_cust_pay_batch = qsearchs('cust_pay_batch', {
5730 'batchnum' => $pay_batch->batchnum,
5731 'custnum' => $self->custnum,
5734 foreach (qw( address1 address2 city state zip country payby payinfo paydate
5736 $options{$_} = '' unless exists($options{$_});
5739 my $cust_pay_batch = new FS::cust_pay_batch ( {
5740 'batchnum' => $pay_batch->batchnum,
5741 'invnum' => $invnum || 0, # is there a better value?
5742 # this field should be
5744 # cust_bill_pay_batch now
5745 'custnum' => $self->custnum,
5746 'last' => $self->getfield('last'),
5747 'first' => $self->getfield('first'),
5748 'address1' => $options{address1} || $self->address1,
5749 'address2' => $options{address2} || $self->address2,
5750 'city' => $options{city} || $self->city,
5751 'state' => $options{state} || $self->state,
5752 'zip' => $options{zip} || $self->zip,
5753 'country' => $options{country} || $self->country,
5754 'payby' => $options{payby} || $self->payby,
5755 'payinfo' => $options{payinfo} || $self->payinfo,
5756 'exp' => $options{paydate} || $self->paydate,
5757 'payname' => $options{payname} || $self->payname,
5758 'amount' => $amount, # consolidating
5761 $cust_pay_batch->paybatchnum($old_cust_pay_batch->paybatchnum)
5762 if $old_cust_pay_batch;
5765 if ($old_cust_pay_batch) {
5766 $error = $cust_pay_batch->replace($old_cust_pay_batch)
5768 $error = $cust_pay_batch->insert;
5772 $dbh->rollback if $oldAutoCommit;
5776 my $unapplied = $self->total_unapplied_credits
5777 + $self->total_unapplied_payments
5778 + $self->in_transit_payments;
5779 foreach my $cust_bill ($self->open_cust_bill) {
5780 #$dbh->commit or die $dbh->errstr if $oldAutoCommit;
5781 my $cust_bill_pay_batch = new FS::cust_bill_pay_batch {
5782 'invnum' => $cust_bill->invnum,
5783 'paybatchnum' => $cust_pay_batch->paybatchnum,
5784 'amount' => $cust_bill->owed,
5787 if ($unapplied >= $cust_bill_pay_batch->amount){
5788 $unapplied -= $cust_bill_pay_batch->amount;
5791 $cust_bill_pay_batch->amount(sprintf ( "%.2f",
5792 $cust_bill_pay_batch->amount - $unapplied )); $unapplied = 0;
5794 $error = $cust_bill_pay_batch->insert;
5796 $dbh->rollback if $oldAutoCommit;
5801 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
5805 =item apply_payments_and_credits
5807 Applies unapplied payments and credits.
5809 In most cases, this new method should be used in place of sequential
5810 apply_payments and apply_credits methods.
5812 If there is an error, returns the error, otherwise returns false.
5816 sub apply_payments_and_credits {
5819 local $SIG{HUP} = 'IGNORE';
5820 local $SIG{INT} = 'IGNORE';
5821 local $SIG{QUIT} = 'IGNORE';
5822 local $SIG{TERM} = 'IGNORE';
5823 local $SIG{TSTP} = 'IGNORE';
5824 local $SIG{PIPE} = 'IGNORE';
5826 my $oldAutoCommit = $FS::UID::AutoCommit;
5827 local $FS::UID::AutoCommit = 0;
5830 $self->select_for_update; #mutex
5832 foreach my $cust_bill ( $self->open_cust_bill ) {
5833 my $error = $cust_bill->apply_payments_and_credits;
5835 $dbh->rollback if $oldAutoCommit;
5836 return "Error applying: $error";
5840 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
5845 =item apply_credits OPTION => VALUE ...
5847 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
5848 to outstanding invoice balances in chronological order (or reverse
5849 chronological order if the I<order> option is set to B<newest>) and returns the
5850 value of any remaining unapplied credits available for refund (see
5851 L<FS::cust_refund>).
5853 Dies if there is an error.
5861 local $SIG{HUP} = 'IGNORE';
5862 local $SIG{INT} = 'IGNORE';
5863 local $SIG{QUIT} = 'IGNORE';
5864 local $SIG{TERM} = 'IGNORE';
5865 local $SIG{TSTP} = 'IGNORE';
5866 local $SIG{PIPE} = 'IGNORE';
5868 my $oldAutoCommit = $FS::UID::AutoCommit;
5869 local $FS::UID::AutoCommit = 0;
5872 $self->select_for_update; #mutex
5874 unless ( $self->total_unapplied_credits ) {
5875 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
5879 my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
5880 qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
5882 my @invoices = $self->open_cust_bill;
5883 @invoices = sort { $b->_date <=> $a->_date } @invoices
5884 if defined($opt{'order'}) && $opt{'order'} eq 'newest';
5887 foreach my $cust_bill ( @invoices ) {
5890 if ( !defined($credit) || $credit->credited == 0) {
5891 $credit = pop @credits or last;
5894 if ($cust_bill->owed >= $credit->credited) {
5895 $amount=$credit->credited;
5897 $amount=$cust_bill->owed;
5900 my $cust_credit_bill = new FS::cust_credit_bill ( {
5901 'crednum' => $credit->crednum,
5902 'invnum' => $cust_bill->invnum,
5903 'amount' => $amount,
5905 my $error = $cust_credit_bill->insert;
5907 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
5911 redo if ($cust_bill->owed > 0);
5915 my $total_unapplied_credits = $self->total_unapplied_credits;
5917 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
5919 return $total_unapplied_credits;
5922 =item apply_payments
5924 Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
5925 to outstanding invoice balances in chronological order.
5927 #and returns the value of any remaining unapplied payments.
5929 Dies if there is an error.
5933 sub apply_payments {
5936 local $SIG{HUP} = 'IGNORE';
5937 local $SIG{INT} = 'IGNORE';
5938 local $SIG{QUIT} = 'IGNORE';
5939 local $SIG{TERM} = 'IGNORE';
5940 local $SIG{TSTP} = 'IGNORE';
5941 local $SIG{PIPE} = 'IGNORE';
5943 my $oldAutoCommit = $FS::UID::AutoCommit;
5944 local $FS::UID::AutoCommit = 0;
5947 $self->select_for_update; #mutex
5951 my @payments = sort { $b->_date <=> $a->_date }
5952 grep { $_->unapplied > 0 }
5955 my @invoices = sort { $a->_date <=> $b->_date}
5956 grep { $_->owed > 0 }
5961 foreach my $cust_bill ( @invoices ) {
5964 if ( !defined($payment) || $payment->unapplied == 0 ) {
5965 $payment = pop @payments or last;
5968 if ( $cust_bill->owed >= $payment->unapplied ) {
5969 $amount = $payment->unapplied;
5971 $amount = $cust_bill->owed;
5974 my $cust_bill_pay = new FS::cust_bill_pay ( {
5975 'paynum' => $payment->paynum,
5976 'invnum' => $cust_bill->invnum,
5977 'amount' => $amount,
5979 my $error = $cust_bill_pay->insert;
5981 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
5985 redo if ( $cust_bill->owed > 0);
5989 my $total_unapplied_payments = $self->total_unapplied_payments;
5991 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
5993 return $total_unapplied_payments;
5998 Returns the total owed for this customer on all invoices
5999 (see L<FS::cust_bill/owed>).
6005 $self->total_owed_date(2145859200); #12/31/2037
6008 =item total_owed_date TIME
6010 Returns the total owed for this customer on all invoices with date earlier than
6011 TIME. TIME is specified as a UNIX timestamp; see L<perlfunc/"time">). Also
6012 see L<Time::Local> and L<Date::Parse> for conversion functions.
6016 sub total_owed_date {
6020 foreach my $cust_bill (
6021 grep { $_->_date <= $time }
6022 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
6024 $total_bill += $cust_bill->owed;
6026 sprintf( "%.2f", $total_bill );
6031 Returns the total amount of all payments.
6038 $total += $_->paid foreach $self->cust_pay;
6039 sprintf( "%.2f", $total );
6042 =item total_unapplied_credits
6044 Returns the total outstanding credit (see L<FS::cust_credit>) for this
6045 customer. See L<FS::cust_credit/credited>.
6047 =item total_credited
6049 Old name for total_unapplied_credits. Don't use.
6053 sub total_credited {
6054 #carp "total_credited deprecated, use total_unapplied_credits";
6055 shift->total_unapplied_credits(@_);
6058 sub total_unapplied_credits {
6060 my $total_credit = 0;
6061 $total_credit += $_->credited foreach $self->cust_credit;
6062 sprintf( "%.2f", $total_credit );
6065 =item total_unapplied_payments
6067 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
6068 See L<FS::cust_pay/unapplied>.
6072 sub total_unapplied_payments {
6074 my $total_unapplied = 0;
6075 $total_unapplied += $_->unapplied foreach $self->cust_pay;
6076 sprintf( "%.2f", $total_unapplied );
6079 =item total_unapplied_refunds
6081 Returns the total unrefunded refunds (see L<FS::cust_refund>) for this
6082 customer. See L<FS::cust_refund/unapplied>.
6086 sub total_unapplied_refunds {
6088 my $total_unapplied = 0;
6089 $total_unapplied += $_->unapplied foreach $self->cust_refund;
6090 sprintf( "%.2f", $total_unapplied );
6095 Returns the balance for this customer (total_owed plus total_unrefunded, minus
6096 total_unapplied_credits minus total_unapplied_payments).
6104 + $self->total_unapplied_refunds
6105 - $self->total_unapplied_credits
6106 - $self->total_unapplied_payments
6110 =item balance_date TIME
6112 Returns the balance for this customer, only considering invoices with date
6113 earlier than TIME (total_owed_date minus total_credited minus
6114 total_unapplied_payments). TIME is specified as a UNIX timestamp; see
6115 L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion
6124 $self->total_owed_date($time)
6125 + $self->total_unapplied_refunds
6126 - $self->total_unapplied_credits
6127 - $self->total_unapplied_payments
6131 =item in_transit_payments
6133 Returns the total of requests for payments for this customer pending in
6134 batches in transit to the bank. See L<FS::pay_batch> and L<FS::cust_pay_batch>
6138 sub in_transit_payments {
6140 my $in_transit_payments = 0;
6141 foreach my $pay_batch ( qsearch('pay_batch', {
6144 foreach my $cust_pay_batch ( qsearch('cust_pay_batch', {
6145 'batchnum' => $pay_batch->batchnum,
6146 'custnum' => $self->custnum,
6148 $in_transit_payments += $cust_pay_batch->amount;
6151 sprintf( "%.2f", $in_transit_payments );
6156 Returns a hash of useful information for making a payment.
6166 'CARD' (credit card - automatic), 'DCRD' (credit card - on-demand),
6167 'CHEK' (electronic check - automatic), 'DCHK' (electronic check - on-demand),
6168 'LECB' (Phone bill billing), 'BILL' (billing), or 'COMP' (free).
6172 For credit card transactions:
6184 For electronic check transactions:
6199 $return{balance} = $self->balance;
6201 $return{payname} = $self->payname
6202 || ( $self->first. ' '. $self->get('last') );
6204 $return{$_} = $self->get($_) for qw(address1 address2 city state zip);
6206 $return{payby} = $self->payby;
6207 $return{stateid_state} = $self->stateid_state;
6209 if ( $self->payby =~ /^(CARD|DCRD)$/ ) {
6210 $return{card_type} = cardtype($self->payinfo);
6211 $return{payinfo} = $self->paymask;
6213 @return{'month', 'year'} = $self->paydate_monthyear;
6217 if ( $self->payby =~ /^(CHEK|DCHK)$/ ) {
6218 my ($payinfo1, $payinfo2) = split '@', $self->paymask;
6219 $return{payinfo1} = $payinfo1;
6220 $return{payinfo2} = $payinfo2;
6221 $return{paytype} = $self->paytype;
6222 $return{paystate} = $self->paystate;
6226 #doubleclick protection
6228 $return{paybatch} = "webui-MyAccount-$_date-$$-". rand() * 2**32;
6234 =item paydate_monthyear
6236 Returns a two-element list consisting of the month and year of this customer's
6237 paydate (credit card expiration date for CARD customers)
6241 sub paydate_monthyear {
6243 if ( $self->paydate =~ /^(\d{4})-(\d{1,2})-\d{1,2}$/ ) { #Pg date format
6245 } elsif ( $self->paydate =~ /^(\d{1,2})-(\d{1,2}-)?(\d{4}$)/ ) {
6252 =item invoicing_list [ ARRAYREF ]
6254 If an arguement is given, sets these email addresses as invoice recipients
6255 (see L<FS::cust_main_invoice>). Errors are not fatal and are not reported
6256 (except as warnings), so use check_invoicing_list first.
6258 Returns a list of email addresses (with svcnum entries expanded).
6260 Note: You can clear the invoicing list by passing an empty ARRAYREF. You can
6261 check it without disturbing anything by passing nothing.
6263 This interface may change in the future.
6267 sub invoicing_list {
6268 my( $self, $arrayref ) = @_;
6271 my @cust_main_invoice;
6272 if ( $self->custnum ) {
6273 @cust_main_invoice =
6274 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
6276 @cust_main_invoice = ();
6278 foreach my $cust_main_invoice ( @cust_main_invoice ) {
6279 #warn $cust_main_invoice->destnum;
6280 unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
6281 #warn $cust_main_invoice->destnum;
6282 my $error = $cust_main_invoice->delete;
6283 warn $error if $error;
6286 if ( $self->custnum ) {
6287 @cust_main_invoice =
6288 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
6290 @cust_main_invoice = ();
6292 my %seen = map { $_->address => 1 } @cust_main_invoice;
6293 foreach my $address ( @{$arrayref} ) {
6294 next if exists $seen{$address} && $seen{$address};
6295 $seen{$address} = 1;
6296 my $cust_main_invoice = new FS::cust_main_invoice ( {
6297 'custnum' => $self->custnum,
6300 my $error = $cust_main_invoice->insert;
6301 warn $error if $error;
6305 if ( $self->custnum ) {
6307 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
6314 =item check_invoicing_list ARRAYREF
6316 Checks these arguements as valid input for the invoicing_list method. If there
6317 is an error, returns the error, otherwise returns false.
6321 sub check_invoicing_list {
6322 my( $self, $arrayref ) = @_;
6324 foreach my $address ( @$arrayref ) {
6326 if ($address eq 'FAX' and $self->getfield('fax') eq '') {
6327 return 'Can\'t add FAX invoice destination with a blank FAX number.';
6330 my $cust_main_invoice = new FS::cust_main_invoice ( {
6331 'custnum' => $self->custnum,
6334 my $error = $self->custnum
6335 ? $cust_main_invoice->check
6336 : $cust_main_invoice->checkdest
6338 return $error if $error;
6342 return "Email address required"
6343 if $conf->exists('cust_main-require_invoicing_list_email')
6344 && ! grep { $_ !~ /^([A-Z]+)$/ } @$arrayref;
6349 =item set_default_invoicing_list
6351 Sets the invoicing list to all accounts associated with this customer,
6352 overwriting any previous invoicing list.
6356 sub set_default_invoicing_list {
6358 $self->invoicing_list($self->all_emails);
6363 Returns the email addresses of all accounts provisioned for this customer.
6370 foreach my $cust_pkg ( $self->all_pkgs ) {
6371 my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
6373 map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
6374 grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
6376 $list{$_}=1 foreach map { $_->email } @svc_acct;
6381 =item invoicing_list_addpost
6383 Adds postal invoicing to this customer. If this customer is already configured
6384 to receive postal invoices, does nothing.
6388 sub invoicing_list_addpost {
6390 return if grep { $_ eq 'POST' } $self->invoicing_list;
6391 my @invoicing_list = $self->invoicing_list;
6392 push @invoicing_list, 'POST';
6393 $self->invoicing_list(\@invoicing_list);
6396 =item invoicing_list_emailonly
6398 Returns the list of email invoice recipients (invoicing_list without non-email
6399 destinations such as POST and FAX).
6403 sub invoicing_list_emailonly {
6405 warn "$me invoicing_list_emailonly called"
6407 grep { $_ !~ /^([A-Z]+)$/ } $self->invoicing_list;
6410 =item invoicing_list_emailonly_scalar
6412 Returns the list of email invoice recipients (invoicing_list without non-email
6413 destinations such as POST and FAX) as a comma-separated scalar.
6417 sub invoicing_list_emailonly_scalar {
6419 warn "$me invoicing_list_emailonly_scalar called"
6421 join(', ', $self->invoicing_list_emailonly);
6424 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
6426 Returns an array of customers referred by this customer (referral_custnum set
6427 to this custnum). If DEPTH is given, recurses up to the given depth, returning
6428 customers referred by customers referred by this customer and so on, inclusive.
6429 The default behavior is DEPTH 1 (no recursion).
6433 sub referral_cust_main {
6435 my $depth = @_ ? shift : 1;
6436 my $exclude = @_ ? shift : {};
6439 map { $exclude->{$_->custnum}++; $_; }
6440 grep { ! $exclude->{ $_->custnum } }
6441 qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
6445 map { $_->referral_cust_main($depth-1, $exclude) }
6452 =item referral_cust_main_ncancelled
6454 Same as referral_cust_main, except only returns customers with uncancelled
6459 sub referral_cust_main_ncancelled {
6461 grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
6464 =item referral_cust_pkg [ DEPTH ]
6466 Like referral_cust_main, except returns a flat list of all unsuspended (and
6467 uncancelled) packages for each customer. The number of items in this list may
6468 be useful for comission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
6472 sub referral_cust_pkg {
6474 my $depth = @_ ? shift : 1;
6476 map { $_->unsuspended_pkgs }
6477 grep { $_->unsuspended_pkgs }
6478 $self->referral_cust_main($depth);
6481 =item referring_cust_main
6483 Returns the single cust_main record for the customer who referred this customer
6484 (referral_custnum), or false.
6488 sub referring_cust_main {
6490 return '' unless $self->referral_custnum;
6491 qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
6494 =item credit AMOUNT, REASON [ , OPTION => VALUE ... ]
6496 Applies a credit to this customer. If there is an error, returns the error,
6497 otherwise returns false.
6499 REASON can be a text string, an FS::reason object, or a scalar reference to
6500 a reasonnum. If a text string, it will be automatically inserted as a new
6501 reason, and a 'reason_type' option must be passed to indicate the
6502 FS::reason_type for the new reason.
6504 An I<addlinfo> option may be passed to set the credit's I<addlinfo> field.
6506 Any other options are passed to FS::cust_credit::insert.
6511 my( $self, $amount, $reason, %options ) = @_;
6513 my $cust_credit = new FS::cust_credit {
6514 'custnum' => $self->custnum,
6515 'amount' => $amount,
6518 if ( ref($reason) ) {
6520 if ( ref($reason) eq 'SCALAR' ) {
6521 $cust_credit->reasonnum( $$reason );
6523 $cust_credit->reasonnum( $reason->reasonnum );
6527 $cust_credit->set('reason', $reason)
6530 $cust_credit->addlinfo( delete $options{'addlinfo'} )
6531 if exists($options{'addlinfo'});
6533 $cust_credit->insert(%options);
6537 =item charge AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
6539 Creates a one-time charge for this customer. If there is an error, returns
6540 the error, otherwise returns false.
6546 my ( $amount, $quantity, $pkg, $comment, $classnum, $additional );
6547 my ( $setuptax, $taxclass ); #internal taxes
6548 my ( $taxproduct, $override ); #vendor (CCH) taxes
6549 if ( ref( $_[0] ) ) {
6550 $amount = $_[0]->{amount};
6551 $quantity = exists($_[0]->{quantity}) ? $_[0]->{quantity} : 1;
6552 $pkg = exists($_[0]->{pkg}) ? $_[0]->{pkg} : 'One-time charge';
6553 $comment = exists($_[0]->{comment}) ? $_[0]->{comment}
6554 : '$'. sprintf("%.2f",$amount);
6555 $setuptax = exists($_[0]->{setuptax}) ? $_[0]->{setuptax} : '';
6556 $taxclass = exists($_[0]->{taxclass}) ? $_[0]->{taxclass} : '';
6557 $classnum = exists($_[0]->{classnum}) ? $_[0]->{classnum} : '';
6558 $additional = $_[0]->{additional};
6559 $taxproduct = $_[0]->{taxproductnum};
6560 $override = { '' => $_[0]->{tax_override} };
6564 $pkg = @_ ? shift : 'One-time charge';
6565 $comment = @_ ? shift : '$'. sprintf("%.2f",$amount);
6567 $taxclass = @_ ? shift : '';
6571 local $SIG{HUP} = 'IGNORE';
6572 local $SIG{INT} = 'IGNORE';
6573 local $SIG{QUIT} = 'IGNORE';
6574 local $SIG{TERM} = 'IGNORE';
6575 local $SIG{TSTP} = 'IGNORE';
6576 local $SIG{PIPE} = 'IGNORE';
6578 my $oldAutoCommit = $FS::UID::AutoCommit;
6579 local $FS::UID::AutoCommit = 0;
6582 my $part_pkg = new FS::part_pkg ( {
6584 'comment' => $comment,
6588 'classnum' => $classnum ? $classnum : '',
6589 'setuptax' => $setuptax,
6590 'taxclass' => $taxclass,
6591 'taxproductnum' => $taxproduct,
6594 my %options = ( ( map { ("additional_info$_" => $additional->[$_] ) }
6595 ( 0 .. @$additional - 1 )
6597 'additional_count' => scalar(@$additional),
6598 'setup_fee' => $amount,
6601 my $error = $part_pkg->insert( options => \%options,
6602 tax_overrides => $override,
6605 $dbh->rollback if $oldAutoCommit;
6609 my $pkgpart = $part_pkg->pkgpart;
6610 my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
6611 unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
6612 my $type_pkgs = new FS::type_pkgs \%type_pkgs;
6613 $error = $type_pkgs->insert;
6615 $dbh->rollback if $oldAutoCommit;
6620 my $cust_pkg = new FS::cust_pkg ( {
6621 'custnum' => $self->custnum,
6622 'pkgpart' => $pkgpart,
6623 'quantity' => $quantity,
6626 $error = $cust_pkg->insert;
6628 $dbh->rollback if $oldAutoCommit;
6632 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
6637 #=item charge_postal_fee
6639 #Applies a one time charge this customer. If there is an error,
6640 #returns the error, returns the cust_pkg charge object or false
6641 #if there was no charge.
6645 # This should be a customer event. For that to work requires that bill
6646 # also be a customer event.
6648 sub charge_postal_fee {
6651 my $pkgpart = $conf->config('postal_invoice-fee_pkgpart');
6652 return '' unless ($pkgpart && grep { $_ eq 'POST' } $self->invoicing_list);
6654 my $cust_pkg = new FS::cust_pkg ( {
6655 'custnum' => $self->custnum,
6656 'pkgpart' => $pkgpart,
6660 my $error = $cust_pkg->insert;
6661 $error ? $error : $cust_pkg;
6666 Returns all the invoices (see L<FS::cust_bill>) for this customer.
6672 sort { $a->_date <=> $b->_date }
6673 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
6676 =item open_cust_bill
6678 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
6683 sub open_cust_bill {
6685 grep { $_->owed > 0 } $self->cust_bill;
6690 Returns all the credits (see L<FS::cust_credit>) for this customer.
6696 sort { $a->_date <=> $b->_date }
6697 qsearch( 'cust_credit', { 'custnum' => $self->custnum } )
6702 Returns all the payments (see L<FS::cust_pay>) for this customer.
6708 sort { $a->_date <=> $b->_date }
6709 qsearch( 'cust_pay', { 'custnum' => $self->custnum } )
6714 Returns all voided payments (see L<FS::cust_pay_void>) for this customer.
6720 sort { $a->_date <=> $b->_date }
6721 qsearch( 'cust_pay_void', { 'custnum' => $self->custnum } )
6724 =item cust_pay_batch
6726 Returns all batched payments (see L<FS::cust_pay_void>) for this customer.
6730 sub cust_pay_batch {
6732 sort { $a->_date <=> $b->_date }
6733 qsearch( 'cust_pay_batch', { 'custnum' => $self->custnum } )
6736 =item cust_pay_pending
6738 Returns all pending payments (see L<FS::cust_pay_pending>) for this customer
6739 (without status "done").
6743 sub cust_pay_pending {
6745 return $self->num_cust_pay_pending unless wantarray;
6746 sort { $a->_date <=> $b->_date }
6747 qsearch( 'cust_pay_pending', {
6748 'custnum' => $self->custnum,
6749 'status' => { op=>'!=', value=>'done' },
6754 =item num_cust_pay_pending
6756 Returns the number of pending payments (see L<FS::cust_pay_pending>) for this
6757 customer (without status "done"). Also called automatically when the
6758 cust_pay_pending method is used in a scalar context.
6762 sub num_cust_pay_pending {
6764 my $sql = " SELECT COUNT(*) FROM cust_pay_pending ".
6765 " WHERE custnum = ? AND status != 'done' ";
6766 my $sth = dbh->prepare($sql) or die dbh->errstr;
6767 $sth->execute($self->custnum) or die $sth->errstr;
6768 $sth->fetchrow_arrayref->[0];
6773 Returns all the refunds (see L<FS::cust_refund>) for this customer.
6779 sort { $a->_date <=> $b->_date }
6780 qsearch( 'cust_refund', { 'custnum' => $self->custnum } )
6783 =item display_custnum
6785 Returns the displayed customer number for this customer: agent_custid if
6786 cust_main-default_agent_custid is set and it has a value, custnum otherwise.
6790 sub display_custnum {
6792 if ( $conf->exists('cust_main-default_agent_custid') && $self->agent_custid ){
6793 return $self->agent_custid;
6795 return $self->custnum;
6801 Returns a name string for this customer, either "Company (Last, First)" or
6808 my $name = $self->contact;
6809 $name = $self->company. " ($name)" if $self->company;
6815 Returns a name string for this (service/shipping) contact, either
6816 "Company (Last, First)" or "Last, First".
6822 if ( $self->get('ship_last') ) {
6823 my $name = $self->ship_contact;
6824 $name = $self->ship_company. " ($name)" if $self->ship_company;
6833 Returns a name string for this customer, either "Company" or "First Last".
6839 $self->company !~ /^\s*$/ ? $self->company : $self->contact_firstlast;
6842 =item ship_name_short
6844 Returns a name string for this (service/shipping) contact, either "Company"
6849 sub ship_name_short {
6851 if ( $self->get('ship_last') ) {
6852 $self->ship_company !~ /^\s*$/
6853 ? $self->ship_company
6854 : $self->ship_contact_firstlast;
6856 $self->name_company_or_firstlast;
6862 Returns this customer's full (billing) contact name only, "Last, First"
6868 $self->get('last'). ', '. $self->first;
6873 Returns this customer's full (shipping) contact name only, "Last, First"
6879 $self->get('ship_last')
6880 ? $self->get('ship_last'). ', '. $self->ship_first
6884 =item contact_firstlast
6886 Returns this customers full (billing) contact name only, "First Last".
6890 sub contact_firstlast {
6892 $self->first. ' '. $self->get('last');
6895 =item ship_contact_firstlast
6897 Returns this customer's full (shipping) contact name only, "First Last".
6901 sub ship_contact_firstlast {
6903 $self->get('ship_last')
6904 ? $self->first. ' '. $self->get('ship_last')
6905 : $self->contact_firstlast;
6910 Returns this customer's full country name
6916 code2country($self->country);
6919 =item geocode DATA_VENDOR
6921 Returns a value for the customer location as encoded by DATA_VENDOR.
6922 Currently this only makes sense for "CCH" as DATA_VENDOR.
6927 my ($self, $data_vendor) = (shift, shift); #always cch for now
6929 my $geocode = $self->get('geocode'); #XXX only one data_vendor for geocode
6930 return $geocode if $geocode;
6932 my $prefix = ( $conf->exists('tax-ship_address') && length($self->ship_last) )
6936 my ($zip,$plus4) = split /-/, $self->get("${prefix}zip")
6937 if $self->country eq 'US';
6939 #CCH specific location stuff
6940 my $extra_sql = "AND plus4lo <= '$plus4' AND plus4hi >= '$plus4'";
6942 my @cust_tax_location =
6944 'table' => 'cust_tax_location',
6945 'hashref' => { 'zip' => $zip, 'data_vendor' => $data_vendor },
6946 'extra_sql' => $extra_sql,
6947 'order_by' => 'ORDER BY plus4hi',#overlapping with distinct ends
6950 $geocode = $cust_tax_location[0]->geocode
6951 if scalar(@cust_tax_location);
6960 Returns a status string for this customer, currently:
6964 =item prospect - No packages have ever been ordered
6966 =item active - One or more recurring packages is active
6968 =item inactive - No active recurring packages, but otherwise unsuspended/uncancelled (the inactive status is new - previously inactive customers were mis-identified as cancelled)
6970 =item suspended - All non-cancelled recurring packages are suspended
6972 =item cancelled - All recurring packages are cancelled
6978 sub status { shift->cust_status(@_); }
6982 for my $status (qw( prospect active inactive suspended cancelled )) {
6983 my $method = $status.'_sql';
6984 my $numnum = ( my $sql = $self->$method() ) =~ s/cust_main\.custnum/?/g;
6985 my $sth = dbh->prepare("SELECT $sql") or die dbh->errstr;
6986 $sth->execute( ($self->custnum) x $numnum )
6987 or die "Error executing 'SELECT $sql': ". $sth->errstr;
6988 return $status if $sth->fetchrow_arrayref->[0];
6992 =item ucfirst_cust_status
6994 =item ucfirst_status
6996 Returns the status with the first character capitalized.
7000 sub ucfirst_status { shift->ucfirst_cust_status(@_); }
7002 sub ucfirst_cust_status {
7004 ucfirst($self->cust_status);
7009 Returns a hex triplet color string for this customer's status.
7013 use vars qw(%statuscolor);
7014 tie %statuscolor, 'Tie::IxHash',
7015 'prospect' => '7e0079', #'000000', #black? naw, purple
7016 'active' => '00CC00', #green
7017 'inactive' => '0000CC', #blue
7018 'suspended' => 'FF9900', #yellow
7019 'cancelled' => 'FF0000', #red
7022 sub statuscolor { shift->cust_statuscolor(@_); }
7024 sub cust_statuscolor {
7026 $statuscolor{$self->cust_status};
7031 Returns an array of hashes representing the customer's RT tickets.
7038 my $num = $conf->config('cust_main-max_tickets') || 10;
7041 if ( $conf->config('ticket_system') ) {
7042 unless ( $conf->config('ticket_system-custom_priority_field') ) {
7044 @tickets = @{ FS::TicketSystem->customer_tickets($self->custnum, $num) };
7048 foreach my $priority (
7049 $conf->config('ticket_system-custom_priority_field-values'), ''
7051 last if scalar(@tickets) >= $num;
7053 @{ FS::TicketSystem->customer_tickets( $self->custnum,
7054 $num - scalar(@tickets),
7064 # Return services representing svc_accts in customer support packages
7065 sub support_services {
7067 my %packages = map { $_ => 1 } $conf->config('support_packages');
7069 grep { $_->pkg_svc && $_->pkg_svc->primary_svc eq 'Y' }
7070 grep { $_->part_svc->svcdb eq 'svc_acct' }
7071 map { $_->cust_svc }
7072 grep { exists $packages{ $_->pkgpart } }
7073 $self->ncancelled_pkgs;
7079 =head1 CLASS METHODS
7085 Class method that returns the list of possible status strings for customers
7086 (see L<the status method|/status>). For example:
7088 @statuses = FS::cust_main->statuses();
7093 #my $self = shift; #could be class...
7099 Returns an SQL expression identifying prospective cust_main records (customers
7100 with no packages ever ordered)
7104 use vars qw($select_count_pkgs);
7105 $select_count_pkgs =
7106 "SELECT COUNT(*) FROM cust_pkg
7107 WHERE cust_pkg.custnum = cust_main.custnum";
7109 sub select_count_pkgs_sql {
7113 sub prospect_sql { "
7114 0 = ( $select_count_pkgs )
7119 Returns an SQL expression identifying active cust_main records (customers with
7120 active recurring packages).
7125 0 < ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. "
7131 Returns an SQL expression identifying inactive cust_main records (customers with
7132 no active recurring packages, but otherwise unsuspended/uncancelled).
7136 sub inactive_sql { "
7137 0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " )
7139 0 < ( $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " )
7145 Returns an SQL expression identifying suspended cust_main records.
7150 sub suspended_sql { susp_sql(@_); }
7152 0 < ( $select_count_pkgs AND ". FS::cust_pkg->suspended_sql. " )
7154 0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " )
7160 Returns an SQL expression identifying cancelled cust_main records.
7164 sub cancelled_sql { cancel_sql(@_); }
7167 my $recurring_sql = FS::cust_pkg->recurring_sql;
7168 my $cancelled_sql = FS::cust_pkg->cancelled_sql;
7171 0 < ( $select_count_pkgs )
7172 AND 0 < ( $select_count_pkgs AND $recurring_sql AND $cancelled_sql )
7173 AND 0 = ( $select_count_pkgs AND $recurring_sql
7174 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
7176 AND 0 = ( $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " )
7182 =item uncancelled_sql
7184 Returns an SQL expression identifying un-cancelled cust_main records.
7188 sub uncancelled_sql { uncancel_sql(@_); }
7189 sub uncancel_sql { "
7190 ( 0 < ( $select_count_pkgs
7191 AND ( cust_pkg.cancel IS NULL
7192 OR cust_pkg.cancel = 0
7195 OR 0 = ( $select_count_pkgs )
7201 Returns an SQL fragment to retreive the balance.
7206 ( SELECT COALESCE( SUM(charged), 0 ) FROM cust_bill
7207 WHERE cust_bill.custnum = cust_main.custnum )
7208 - ( SELECT COALESCE( SUM(paid), 0 ) FROM cust_pay
7209 WHERE cust_pay.custnum = cust_main.custnum )
7210 - ( SELECT COALESCE( SUM(amount), 0 ) FROM cust_credit
7211 WHERE cust_credit.custnum = cust_main.custnum )
7212 + ( SELECT COALESCE( SUM(refund), 0 ) FROM cust_refund
7213 WHERE cust_refund.custnum = cust_main.custnum )
7216 =item balance_date_sql START_TIME [ END_TIME [ OPTION => VALUE ... ] ]
7218 Returns an SQL fragment to retreive the balance for this customer, only
7219 considering invoices with date earlier than START_TIME, and optionally not
7220 later than END_TIME (total_owed_date minus total_unapplied_credits minus
7221 total_unapplied_payments).
7223 Times are specified as SQL fragments or numeric
7224 UNIX timestamps; see L<perlfunc/"time">). Also see L<Time::Local> and
7225 L<Date::Parse> for conversion functions. The empty string can be passed
7226 to disable that time constraint completely.
7228 Available options are:
7232 =item unapplied_date
7234 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)
7239 set to true to remove all customer comparison clauses, for totals
7244 WHERE clause hashref (elements "AND"ed together) (typically used with the total option)
7249 JOIN clause (typically used with the total option)
7255 sub balance_date_sql {
7256 my( $class, $start, $end, %opt ) = @_;
7258 my $owed = FS::cust_bill->owed_sql;
7259 my $unapp_refund = FS::cust_refund->unapplied_sql;
7260 my $unapp_credit = FS::cust_credit->unapplied_sql;
7261 my $unapp_pay = FS::cust_pay->unapplied_sql;
7263 my $j = $opt{'join'} || '';
7265 my $owed_wh = $class->_money_table_where( 'cust_bill', $start,$end,%opt );
7266 my $refund_wh = $class->_money_table_where( 'cust_refund', $start,$end,%opt );
7267 my $credit_wh = $class->_money_table_where( 'cust_credit', $start,$end,%opt );
7268 my $pay_wh = $class->_money_table_where( 'cust_pay', $start,$end,%opt );
7270 " ( SELECT COALESCE(SUM($owed), 0) FROM cust_bill $j $owed_wh )
7271 + ( SELECT COALESCE(SUM($unapp_refund), 0) FROM cust_refund $j $refund_wh )
7272 - ( SELECT COALESCE(SUM($unapp_credit), 0) FROM cust_credit $j $credit_wh )
7273 - ( SELECT COALESCE(SUM($unapp_pay), 0) FROM cust_pay $j $pay_wh )
7278 =item _money_table_where TABLE START_TIME [ END_TIME [ OPTION => VALUE ... ] ]
7280 Helper method for balance_date_sql; name (and usage) subject to change
7281 (suggestions welcome).
7283 Returns a WHERE clause for the specified monetary TABLE (cust_bill,
7284 cust_refund, cust_credit or cust_pay).
7286 If TABLE is "cust_bill" or the unapplied_date option is true, only
7287 considers records with date earlier than START_TIME, and optionally not
7288 later than END_TIME .
7292 sub _money_table_where {
7293 my( $class, $table, $start, $end, %opt ) = @_;
7296 push @where, "cust_main.custnum = $table.custnum" unless $opt{'total'};
7297 if ( $table eq 'cust_bill' || $opt{'unapplied_date'} ) {
7298 push @where, "$table._date <= $start" if defined($start) && length($start);
7299 push @where, "$table._date > $end" if defined($end) && length($end);
7301 push @where, @{$opt{'where'}} if $opt{'where'};
7302 my $where = scalar(@where) ? 'WHERE '. join(' AND ', @where ) : '';
7308 =item search_sql HASHREF
7312 Returns a qsearch hash expression to search for parameters specified in HREF.
7313 Valid parameters are
7321 =item cancelled_pkgs
7327 listref of start date, end date
7333 =item current_balance
7335 listref (list returned by FS::UI::Web::parse_lt_gt($cgi, 'current_balance'))
7339 =item flattened_pkgs
7348 my ($class, $params) = @_;
7359 if ( $params->{'agentnum'} =~ /^(\d+)$/ and $1 ) {
7361 "cust_main.agentnum = $1";
7368 #prospect active inactive suspended cancelled
7369 if ( grep { $params->{'status'} eq $_ } FS::cust_main->statuses() ) {
7370 my $method = $params->{'status'}. '_sql';
7371 #push @where, $class->$method();
7372 push @where, FS::cust_main->$method();
7376 # parse cancelled package checkbox
7381 $pkgwhere .= "AND (cancel = 0 or cancel is null)"
7382 unless $params->{'cancelled_pkgs'};
7388 foreach my $field (qw( signupdate )) {
7390 next unless exists($params->{$field});
7392 my($beginning, $ending) = @{$params->{$field}};
7395 "cust_main.$field IS NOT NULL",
7396 "cust_main.$field >= $beginning",
7397 "cust_main.$field <= $ending";
7399 $orderby ||= "ORDER BY cust_main.$field";
7407 my @payby = grep /^([A-Z]{4})$/, @{ $params->{'payby'} };
7409 push @where, '( '. join(' OR ', map "cust_main.payby = '$_'", @payby). ' )';
7416 #my $balance_sql = $class->balance_sql();
7417 my $balance_sql = FS::cust_main->balance_sql();
7419 push @where, map { s/current_balance/$balance_sql/; $_ }
7420 @{ $params->{'current_balance'} };
7426 if ( $params->{'custbatch'} =~ /^([\w\/\-\:\.]+)$/ and $1 ) {
7428 "cust_main.custbatch = '$1'";
7432 # setup queries, subs, etc. for the search
7435 $orderby ||= 'ORDER BY custnum';
7437 # here is the agent virtualization
7438 push @where, $FS::CurrentUser::CurrentUser->agentnums_sql;
7440 my $extra_sql = scalar(@where) ? ' WHERE '. join(' AND ', @where) : '';
7442 my $addl_from = 'LEFT JOIN cust_pkg USING ( custnum ) ';
7444 my $count_query = "SELECT COUNT(*) FROM cust_main $extra_sql";
7446 my $select = join(', ',
7447 'cust_main.custnum',
7448 FS::UI::Web::cust_sql_fields($params->{'cust_fields'}),
7451 my(@extra_headers) = ();
7452 my(@extra_fields) = ();
7454 if ($params->{'flattened_pkgs'}) {
7456 if ($dbh->{Driver}->{Name} eq 'Pg') {
7458 $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";
7460 }elsif ($dbh->{Driver}->{Name} =~ /^mysql/i) {
7461 $select .= ", GROUP_CONCAT(pkg SEPARATOR '|') as magic";
7462 $addl_from .= " LEFT JOIN part_pkg using ( pkgpart )";
7464 warn "warning: unknown database type ". $dbh->{Driver}->{Name}.
7465 "omitting packing information from report.";
7468 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";
7470 my $sth = dbh->prepare($header_query) or die dbh->errstr;
7471 $sth->execute() or die $sth->errstr;
7472 my $headerrow = $sth->fetchrow_arrayref;
7473 my $headercount = $headerrow ? $headerrow->[0] : 0;
7474 while($headercount) {
7475 unshift @extra_headers, "Package ". $headercount;
7476 unshift @extra_fields, eval q!sub {my $c = shift;
7477 my @a = split '\|', $c->magic;
7478 my $p = $a[!.--$headercount. q!];
7486 'table' => 'cust_main',
7487 'select' => $select,
7489 'extra_sql' => $extra_sql,
7490 'order_by' => $orderby,
7491 'count_query' => $count_query,
7492 'extra_headers' => \@extra_headers,
7493 'extra_fields' => \@extra_fields,
7498 =item email_search_sql HASHREF
7502 Emails a notice to the specified customers.
7504 Valid parameters are those of the L<search_sql> method, plus the following:
7526 Optional job queue job for status updates.
7530 Returns an error message, or false for success.
7532 If an error occurs during any email, stops the enture send and returns that
7533 error. Presumably if you're getting SMTP errors aborting is better than
7534 retrying everything.
7538 sub email_search_sql {
7539 my($class, $params) = @_;
7541 my $from = delete $params->{from};
7542 my $subject = delete $params->{subject};
7543 my $html_body = delete $params->{html_body};
7544 my $text_body = delete $params->{text_body};
7546 my $job = delete $params->{'job'};
7548 my $sql_query = $class->search_sql($params);
7550 my $count_query = delete($sql_query->{'count_query'});
7551 my $count_sth = dbh->prepare($count_query)
7552 or die "Error preparing $count_query: ". dbh->errstr;
7554 or die "Error executing $count_query: ". $count_sth->errstr;
7555 my $count_arrayref = $count_sth->fetchrow_arrayref;
7556 my $num_cust = $count_arrayref->[0];
7558 #my @extra_headers = @{ delete($sql_query->{'extra_headers'}) };
7559 #my @extra_fields = @{ delete($sql_query->{'extra_fields'}) };
7562 my( $num, $last, $min_sec ) = (0, time, 5); #progresbar foo
7564 #eventually order+limit magic to reduce memory use?
7565 foreach my $cust_main ( qsearch($sql_query) ) {
7567 my $to = $cust_main->invoicing_list_emailonly_scalar;
7570 my $error = send_email(
7574 'subject' => $subject,
7575 'html_body' => $html_body,
7576 'text_body' => $text_body,
7579 return $error if $error;
7581 if ( $job ) { #progressbar foo
7583 if ( time - $min_sec > $last ) {
7584 my $error = $job->update_statustext(
7585 int( 100 * $num / $num_cust )
7587 die $error if $error;
7597 use Storable qw(thaw);
7600 sub process_email_search_sql {
7602 #warn "$me process_re_X $method for job $job\n" if $DEBUG;
7604 my $param = thaw(decode_base64(shift));
7605 warn Dumper($param) if $DEBUG;
7607 $param->{'job'} = $job;
7609 my $error = FS::cust_main->email_search_sql( $param );
7610 die $error if $error;
7614 =item fuzzy_search FUZZY_HASHREF [ HASHREF, SELECT, EXTRA_SQL, CACHE_OBJ ]
7616 Performs a fuzzy (approximate) search and returns the matching FS::cust_main
7617 records. Currently, I<first>, I<last> and/or I<company> may be specified (the
7618 appropriate ship_ field is also searched).
7620 Additional options are the same as FS::Record::qsearch
7625 my( $self, $fuzzy, $hash, @opt) = @_;
7630 check_and_rebuild_fuzzyfiles();
7631 foreach my $field ( keys %$fuzzy ) {
7633 my $all = $self->all_X($field);
7634 next unless scalar(@$all);
7637 $match{$_}=1 foreach ( amatch( $fuzzy->{$field}, ['i'], @$all ) );
7640 foreach ( keys %match ) {
7641 push @fcust, qsearch('cust_main', { %$hash, $field=>$_}, @opt);
7642 push @fcust, qsearch('cust_main', { %$hash, "ship_$field"=>$_}, @opt);
7645 push @cust_main, grep { ! $fsaw{$_->custnum}++ } @fcust;
7648 # we want the components of $fuzzy ANDed, not ORed, but still don't want dupes
7650 @cust_main = grep { ++$saw{$_->custnum} == scalar(keys %$fuzzy) } @cust_main;
7658 Returns a masked version of the named field
7663 my ($self,$field) = @_;
7667 'x'x(length($self->getfield($field))-4).
7668 substr($self->getfield($field), (length($self->getfield($field))-4));
7678 =item smart_search OPTION => VALUE ...
7680 Accepts the following options: I<search>, the string to search for. The string
7681 will be searched for as a customer number, phone number, name or company name,
7682 as an exact, or, in some cases, a substring or fuzzy match (see the source code
7683 for the exact heuristics used); I<no_fuzzy_on_exact>, causes smart_search to
7684 skip fuzzy matching when an exact match is found.
7686 Any additional options are treated as an additional qualifier on the search
7689 Returns a (possibly empty) array of FS::cust_main objects.
7696 #here is the agent virtualization
7697 my $agentnums_sql = $FS::CurrentUser::CurrentUser->agentnums_sql;
7701 my $skip_fuzzy = delete $options{'no_fuzzy_on_exact'};
7702 my $search = delete $options{'search'};
7703 ( my $alphanum_search = $search ) =~ s/\W//g;
7705 if ( $alphanum_search =~ /^1?(\d{3})(\d{3})(\d{4})(\d*)$/ ) { #phone# search
7707 #false laziness w/Record::ut_phone
7708 my $phonen = "$1-$2-$3";
7709 $phonen .= " x$4" if $4;
7711 push @cust_main, qsearch( {
7712 'table' => 'cust_main',
7713 'hashref' => { %options },
7714 'extra_sql' => ( scalar(keys %options) ? ' AND ' : ' WHERE ' ).
7716 join(' OR ', map "$_ = '$phonen'",
7717 qw( daytime night fax
7718 ship_daytime ship_night ship_fax )
7721 " AND $agentnums_sql", #agent virtualization
7724 unless ( @cust_main || $phonen =~ /x\d+$/ ) { #no exact match
7725 #try looking for matches with extensions unless one was specified
7727 push @cust_main, qsearch( {
7728 'table' => 'cust_main',
7729 'hashref' => { %options },
7730 'extra_sql' => ( scalar(keys %options) ? ' AND ' : ' WHERE ' ).
7732 join(' OR ', map "$_ LIKE '$phonen\%'",
7734 ship_daytime ship_night )
7737 " AND $agentnums_sql", #agent virtualization
7742 # custnum search (also try agent_custid), with some tweaking options if your
7743 # legacy cust "numbers" have letters
7746 if ( $search =~ /^\s*(\d+)\s*$/
7747 || ( $conf->config('cust_main-agent_custid-format') eq 'ww?d+'
7748 && $search =~ /^\s*(\w\w?\d+)\s*$/
7755 if ( $num <= 2147483647 ) { #need a bigint custnum? wow.
7756 push @cust_main, qsearch( {
7757 'table' => 'cust_main',
7758 'hashref' => { 'custnum' => $num, %options },
7759 'extra_sql' => " AND $agentnums_sql", #agent virtualization
7763 push @cust_main, qsearch( {
7764 'table' => 'cust_main',
7765 'hashref' => { 'agent_custid' => $num, %options },
7766 'extra_sql' => " AND $agentnums_sql", #agent virtualization
7769 } elsif ( $search =~ /^\s*(\S.*\S)\s+\((.+), ([^,]+)\)\s*$/ ) {
7771 my($company, $last, $first) = ( $1, $2, $3 );
7773 # "Company (Last, First)"
7774 #this is probably something a browser remembered,
7775 #so just do an exact search
7777 foreach my $prefix ( '', 'ship_' ) {
7778 push @cust_main, qsearch( {
7779 'table' => 'cust_main',
7780 'hashref' => { $prefix.'first' => $first,
7781 $prefix.'last' => $last,
7782 $prefix.'company' => $company,
7785 'extra_sql' => " AND $agentnums_sql",
7789 } elsif ( $search =~ /^\s*(\S.*\S)\s*$/ ) { # value search
7790 # try (ship_){last,company}
7794 # # remove "(Last, First)" in "Company (Last, First)", otherwise the
7795 # # full strings the browser remembers won't work
7796 # $value =~ s/\([\w \,\.\-\']*\)$//; #false laziness w/Record::ut_name
7798 use Lingua::EN::NameParse;
7799 my $NameParse = new Lingua::EN::NameParse(
7801 allow_reversed => 1,
7804 my($last, $first) = ( '', '' );
7805 #maybe disable this too and just rely on NameParse?
7806 if ( $value =~ /^(.+),\s*([^,]+)$/ ) { # Last, First
7808 ($last, $first) = ( $1, $2 );
7810 #} elsif ( $value =~ /^(.+)\s+(.+)$/ ) {
7811 } elsif ( ! $NameParse->parse($value) ) {
7813 my %name = $NameParse->components;
7814 $first = $name{'given_name_1'};
7815 $last = $name{'surname_1'};
7819 if ( $first && $last ) {
7821 my($q_last, $q_first) = ( dbh->quote($last), dbh->quote($first) );
7824 my $sql = scalar(keys %options) ? ' AND ' : ' WHERE ';
7826 ( ( LOWER(last) = $q_last AND LOWER(first) = $q_first )
7827 OR ( LOWER(ship_last) = $q_last AND LOWER(ship_first) = $q_first )
7830 push @cust_main, qsearch( {
7831 'table' => 'cust_main',
7832 'hashref' => \%options,
7833 'extra_sql' => "$sql AND $agentnums_sql", #agent virtualization
7836 # or it just be something that was typed in... (try that in a sec)
7840 my $q_value = dbh->quote($value);
7843 my $sql = scalar(keys %options) ? ' AND ' : ' WHERE ';
7844 $sql .= " ( LOWER(last) = $q_value
7845 OR LOWER(company) = $q_value
7846 OR LOWER(ship_last) = $q_value
7847 OR LOWER(ship_company) = $q_value
7850 push @cust_main, qsearch( {
7851 'table' => 'cust_main',
7852 'hashref' => \%options,
7853 'extra_sql' => "$sql AND $agentnums_sql", #agent virtualization
7856 #no exact match, trying substring/fuzzy
7857 #always do substring & fuzzy (unless they're explicity config'ed off)
7858 #getting complaints searches are not returning enough
7859 unless ( @cust_main && $skip_fuzzy || $conf->exists('disable-fuzzy') ) {
7861 #still some false laziness w/search_sql (was search/cust_main.cgi)
7866 { 'company' => { op=>'ILIKE', value=>"%$value%" }, },
7867 { 'ship_company' => { op=>'ILIKE', value=>"%$value%" }, },
7870 if ( $first && $last ) {
7873 { 'first' => { op=>'ILIKE', value=>"%$first%" },
7874 'last' => { op=>'ILIKE', value=>"%$last%" },
7876 { 'ship_first' => { op=>'ILIKE', value=>"%$first%" },
7877 'ship_last' => { op=>'ILIKE', value=>"%$last%" },
7884 { 'last' => { op=>'ILIKE', value=>"%$value%" }, },
7885 { 'ship_last' => { op=>'ILIKE', value=>"%$value%" }, },
7889 foreach my $hashref ( @hashrefs ) {
7891 push @cust_main, qsearch( {
7892 'table' => 'cust_main',
7893 'hashref' => { %$hashref,
7896 'extra_sql' => " AND $agentnums_sql", #agent virtualizaiton
7905 " AND $agentnums_sql", #extra_sql #agent virtualization
7908 if ( $first && $last ) {
7909 push @cust_main, FS::cust_main->fuzzy_search(
7910 { 'last' => $last, #fuzzy hashref
7911 'first' => $first }, #
7915 foreach my $field ( 'last', 'company' ) {
7917 FS::cust_main->fuzzy_search( { $field => $value }, @fuzopts );
7922 #eliminate duplicates
7924 @cust_main = grep { !$saw{$_->custnum}++ } @cust_main;
7934 Accepts the following options: I<email>, the email address to search for. The
7935 email address will be searched for as an email invoice destination and as an
7938 #Any additional options are treated as an additional qualifier on the search
7939 #(i.e. I<agentnum>).
7941 Returns a (possibly empty) array of FS::cust_main objects (but usually just
7951 my $email = delete $options{'email'};
7953 #we're only being used by RT at the moment... no agent virtualization yet
7954 #my $agentnums_sql = $FS::CurrentUser::CurrentUser->agentnums_sql;
7958 if ( $email =~ /([^@]+)\@([^@]+)/ ) {
7960 my ( $user, $domain ) = ( $1, $2 );
7962 warn "$me smart_search: searching for $user in domain $domain"
7968 'table' => 'cust_main_invoice',
7969 'hashref' => { 'dest' => $email },
7976 map $_->cust_svc->cust_pkg,
7978 'table' => 'svc_acct',
7979 'hashref' => { 'username' => $user, },
7981 'AND ( SELECT domain FROM svc_domain
7982 WHERE svc_acct.domsvc = svc_domain.svcnum
7983 ) = '. dbh->quote($domain),
7989 @cust_main = grep { !$saw{$_->custnum}++ } @cust_main;
7991 warn "$me smart_search: found ". scalar(@cust_main). " unique customers"
7998 =item check_and_rebuild_fuzzyfiles
8002 use vars qw(@fuzzyfields);
8003 @fuzzyfields = ( 'last', 'first', 'company' );
8005 sub check_and_rebuild_fuzzyfiles {
8006 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
8007 rebuild_fuzzyfiles() if grep { ! -e "$dir/cust_main.$_" } @fuzzyfields
8010 =item rebuild_fuzzyfiles
8014 sub rebuild_fuzzyfiles {
8016 use Fcntl qw(:flock);
8018 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
8019 mkdir $dir, 0700 unless -d $dir;
8021 foreach my $fuzzy ( @fuzzyfields ) {
8023 open(LOCK,">>$dir/cust_main.$fuzzy")
8024 or die "can't open $dir/cust_main.$fuzzy: $!";
8026 or die "can't lock $dir/cust_main.$fuzzy: $!";
8028 open (CACHE,">$dir/cust_main.$fuzzy.tmp")
8029 or die "can't open $dir/cust_main.$fuzzy.tmp: $!";
8031 foreach my $field ( $fuzzy, "ship_$fuzzy" ) {
8032 my $sth = dbh->prepare("SELECT $field FROM cust_main".
8033 " WHERE $field != '' AND $field IS NOT NULL");
8034 $sth->execute or die $sth->errstr;
8036 while ( my $row = $sth->fetchrow_arrayref ) {
8037 print CACHE $row->[0]. "\n";
8042 close CACHE or die "can't close $dir/cust_main.$fuzzy.tmp: $!";
8044 rename "$dir/cust_main.$fuzzy.tmp", "$dir/cust_main.$fuzzy";
8055 my( $self, $field ) = @_;
8056 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
8057 open(CACHE,"<$dir/cust_main.$field")
8058 or die "can't open $dir/cust_main.$field: $!";
8059 my @array = map { chomp; $_; } <CACHE>;
8064 =item append_fuzzyfiles LASTNAME COMPANY
8068 sub append_fuzzyfiles {
8069 #my( $first, $last, $company ) = @_;
8071 &check_and_rebuild_fuzzyfiles;
8073 use Fcntl qw(:flock);
8075 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
8077 foreach my $field (qw( first last company )) {
8082 open(CACHE,">>$dir/cust_main.$field")
8083 or die "can't open $dir/cust_main.$field: $!";
8084 flock(CACHE,LOCK_EX)
8085 or die "can't lock $dir/cust_main.$field: $!";
8087 print CACHE "$value\n";
8089 flock(CACHE,LOCK_UN)
8090 or die "can't unlock $dir/cust_main.$field: $!";
8105 #warn join('-',keys %$param);
8106 my $fh = $param->{filehandle};
8107 my @fields = @{$param->{fields}};
8109 eval "use Text::CSV_XS;";
8112 my $csv = new Text::CSV_XS;
8119 local $SIG{HUP} = 'IGNORE';
8120 local $SIG{INT} = 'IGNORE';
8121 local $SIG{QUIT} = 'IGNORE';
8122 local $SIG{TERM} = 'IGNORE';
8123 local $SIG{TSTP} = 'IGNORE';
8124 local $SIG{PIPE} = 'IGNORE';
8126 my $oldAutoCommit = $FS::UID::AutoCommit;
8127 local $FS::UID::AutoCommit = 0;
8130 #while ( $columns = $csv->getline($fh) ) {
8132 while ( defined($line=<$fh>) ) {
8134 $csv->parse($line) or do {
8135 $dbh->rollback if $oldAutoCommit;
8136 return "can't parse: ". $csv->error_input();
8139 my @columns = $csv->fields();
8140 #warn join('-',@columns);
8143 foreach my $field ( @fields ) {
8144 $row{$field} = shift @columns;
8147 my $cust_main = qsearchs('cust_main', { 'custnum' => $row{'custnum'} } );
8148 unless ( $cust_main ) {
8149 $dbh->rollback if $oldAutoCommit;
8150 return "unknown custnum $row{'custnum'}";
8153 if ( $row{'amount'} > 0 ) {
8154 my $error = $cust_main->charge($row{'amount'}, $row{'pkg'});
8156 $dbh->rollback if $oldAutoCommit;
8160 } elsif ( $row{'amount'} < 0 ) {
8161 my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ),
8164 $dbh->rollback if $oldAutoCommit;
8174 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
8176 return "Empty file!" unless $imported;
8182 =item notify CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
8184 Sends a templated email notification to the customer (see L<Text::Template>).
8186 OPTIONS is a hash and may include
8188 I<from> - the email sender (default is invoice_from)
8190 I<to> - comma-separated scalar or arrayref of recipients
8191 (default is invoicing_list)
8193 I<subject> - The subject line of the sent email notification
8194 (default is "Notice from company_name")
8196 I<extra_fields> - a hashref of name/value pairs which will be substituted
8199 The following variables are vavailable in the template.
8201 I<$first> - the customer first name
8202 I<$last> - the customer last name
8203 I<$company> - the customer company
8204 I<$payby> - a description of the method of payment for the customer
8205 # would be nice to use FS::payby::shortname
8206 I<$payinfo> - the account information used to collect for this customer
8207 I<$expdate> - the expiration of the customer payment in seconds from epoch
8212 my ($self, $template, %options) = @_;
8214 return unless $conf->exists($template);
8216 my $from = $conf->config('invoice_from', $self->agentnum)
8217 if $conf->exists('invoice_from', $self->agentnum);
8218 $from = $options{from} if exists($options{from});
8220 my $to = join(',', $self->invoicing_list_emailonly);
8221 $to = $options{to} if exists($options{to});
8223 my $subject = "Notice from " . $conf->config('company_name', $self->agentnum)
8224 if $conf->exists('company_name', $self->agentnum);
8225 $subject = $options{subject} if exists($options{subject});
8227 my $notify_template = new Text::Template (TYPE => 'ARRAY',
8228 SOURCE => [ map "$_\n",
8229 $conf->config($template)]
8231 or die "can't create new Text::Template object: Text::Template::ERROR";
8232 $notify_template->compile()
8233 or die "can't compile template: Text::Template::ERROR";
8235 $FS::notify_template::_template::company_name =
8236 $conf->config('company_name', $self->agentnum);
8237 $FS::notify_template::_template::company_address =
8238 join("\n", $conf->config('company_address', $self->agentnum) ). "\n";
8240 my $paydate = $self->paydate || '2037-12-31';
8241 $FS::notify_template::_template::first = $self->first;
8242 $FS::notify_template::_template::last = $self->last;
8243 $FS::notify_template::_template::company = $self->company;
8244 $FS::notify_template::_template::payinfo = $self->mask_payinfo;
8245 my $payby = $self->payby;
8246 my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
8247 my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
8249 #credit cards expire at the end of the month/year of their exp date
8250 if ($payby eq 'CARD' || $payby eq 'DCRD') {
8251 $FS::notify_template::_template::payby = 'credit card';
8252 ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
8253 $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
8255 }elsif ($payby eq 'COMP') {
8256 $FS::notify_template::_template::payby = 'complimentary account';
8258 $FS::notify_template::_template::payby = 'current method';
8260 $FS::notify_template::_template::expdate = $expire_time;
8262 for (keys %{$options{extra_fields}}){
8264 ${"FS::notify_template::_template::$_"} = $options{extra_fields}->{$_};
8267 send_email(from => $from,
8269 subject => $subject,
8270 body => $notify_template->fill_in( PACKAGE =>
8271 'FS::notify_template::_template' ),
8276 =item generate_letter CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
8278 Generates a templated notification to the customer (see L<Text::Template>).
8280 OPTIONS is a hash and may include
8282 I<extra_fields> - a hashref of name/value pairs which will be substituted
8283 into the template. These values may override values mentioned below
8284 and those from the customer record.
8286 The following variables are available in the template instead of or in addition
8287 to the fields of the customer record.
8289 I<$payby> - a description of the method of payment for the customer
8290 # would be nice to use FS::payby::shortname
8291 I<$payinfo> - the masked account information used to collect for this customer
8292 I<$expdate> - the expiration of the customer payment method in seconds from epoch
8293 I<$returnaddress> - the return address defaults to invoice_latexreturnaddress or company_address
8297 sub generate_letter {
8298 my ($self, $template, %options) = @_;
8300 return unless $conf->exists($template);
8302 my $letter_template = new Text::Template
8304 SOURCE => [ map "$_\n", $conf->config($template)],
8305 DELIMITERS => [ '[@--', '--@]' ],
8307 or die "can't create new Text::Template object: Text::Template::ERROR";
8309 $letter_template->compile()
8310 or die "can't compile template: Text::Template::ERROR";
8312 my %letter_data = map { $_ => $self->$_ } $self->fields;
8313 $letter_data{payinfo} = $self->mask_payinfo;
8315 #my $paydate = $self->paydate || '2037-12-31';
8316 my $paydate = $self->paydate =~ /^\S+$/ ? $self->paydate : '2037-12-31';
8318 my $payby = $self->payby;
8319 my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
8320 my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
8322 #credit cards expire at the end of the month/year of their exp date
8323 if ($payby eq 'CARD' || $payby eq 'DCRD') {
8324 $letter_data{payby} = 'credit card';
8325 ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
8326 $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
8328 }elsif ($payby eq 'COMP') {
8329 $letter_data{payby} = 'complimentary account';
8331 $letter_data{payby} = 'current method';
8333 $letter_data{expdate} = $expire_time;
8335 for (keys %{$options{extra_fields}}){
8336 $letter_data{$_} = $options{extra_fields}->{$_};
8339 unless(exists($letter_data{returnaddress})){
8340 my $retadd = join("\n", $conf->config_orbase( 'invoice_latexreturnaddress',
8341 $self->agent_template)
8343 if ( length($retadd) ) {
8344 $letter_data{returnaddress} = $retadd;
8345 } elsif ( grep /\S/, $conf->config('company_address', $self->agentnum) ) {
8346 $letter_data{returnaddress} =
8347 join( '\\*'."\n", map s/( {2,})/'~' x length($1)/eg,
8348 $conf->config('company_address', $self->agentnum)
8351 $letter_data{returnaddress} = '~';
8355 $letter_data{conf_dir} = "$FS::UID::conf_dir/conf.$FS::UID::datasrc";
8357 $letter_data{company_name} = $conf->config('company_name', $self->agentnum);
8359 my $dir = $FS::UID::conf_dir."/cache.". $FS::UID::datasrc;
8360 my $fh = new File::Temp( TEMPLATE => 'letter.'. $self->custnum. '.XXXXXXXX',
8364 ) or die "can't open temp file: $!\n";
8366 $letter_template->fill_in( OUTPUT => $fh, HASH => \%letter_data );
8368 $fh->filename =~ /^(.*).tex$/ or die "unparsable filename: ". $fh->filename;
8372 =item print_ps TEMPLATE
8374 Returns an postscript letter filled in from TEMPLATE, as a scalar.
8380 my $file = $self->generate_letter(@_);
8381 FS::Misc::generate_ps($file);
8384 =item print TEMPLATE
8386 Prints the filled in template.
8388 TEMPLATE is the name of a L<Text::Template> to fill in and print.
8392 sub queueable_print {
8395 my $self = qsearchs('cust_main', { 'custnum' => $opt{custnum} } )
8396 or die "invalid customer number: " . $opt{custvnum};
8398 my $error = $self->print( $opt{template} );
8399 die $error if $error;
8403 my ($self, $template) = (shift, shift);
8404 do_print [ $self->print_ps($template) ];
8407 #these three subs should just go away once agent stuff is all config overrides
8409 sub agent_template {
8411 $self->_agent_plandata('agent_templatename');
8414 sub agent_invoice_from {
8416 $self->_agent_plandata('agent_invoice_from');
8419 sub _agent_plandata {
8420 my( $self, $option ) = @_;
8422 #yuck. this whole thing needs to be reconciled better with 1.9's idea of
8423 #agent-specific Conf
8425 use FS::part_event::Condition;
8427 my $agentnum = $self->agentnum;
8430 if ( driver_name =~ /^Pg/i ) {
8432 } elsif ( driver_name =~ /^mysql/i ) {
8435 die "don't know how to use regular expressions in ". driver_name. " databases";
8438 my $part_event_option =
8440 'select' => 'part_event_option.*',
8441 'table' => 'part_event_option',
8443 LEFT JOIN part_event USING ( eventpart )
8444 LEFT JOIN part_event_option AS peo_agentnum
8445 ON ( part_event.eventpart = peo_agentnum.eventpart
8446 AND peo_agentnum.optionname = 'agentnum'
8447 AND peo_agentnum.optionvalue }. $regexp. q{ '(^|,)}. $agentnum. q{(,|$)'
8449 LEFT JOIN part_event_condition
8450 ON ( part_event.eventpart = part_event_condition.eventpart
8451 AND part_event_condition.conditionname = 'cust_bill_age'
8453 LEFT JOIN part_event_condition_option
8454 ON ( part_event_condition.eventconditionnum = part_event_condition_option.eventconditionnum
8455 AND part_event_condition_option.optionname = 'age'
8458 #'hashref' => { 'optionname' => $option },
8459 #'hashref' => { 'part_event_option.optionname' => $option },
8461 " WHERE part_event_option.optionname = ". dbh->quote($option).
8462 " AND action = 'cust_bill_send_agent' ".
8463 " AND ( disabled IS NULL OR disabled != 'Y' ) ".
8464 " AND peo_agentnum.optionname = 'agentnum' ".
8465 " AND ( agentnum IS NULL OR agentnum = $agentnum ) ".
8467 CASE WHEN part_event_condition_option.optionname IS NULL
8469 ELSE ". FS::part_event::Condition->age2seconds_sql('part_event_condition_option.optionvalue').
8471 , part_event.weight".
8475 unless ( $part_event_option ) {
8476 return $self->agent->invoice_template || ''
8477 if $option eq 'agent_templatename';
8481 $part_event_option->optionvalue;
8486 ## actual sub, not a method, designed to be called from the queue.
8487 ## sets up the customer, and calls the bill_and_collect
8488 my (%args) = @_; #, ($time, $invoice_time, $check_freq, $resetup) = @_;
8489 my $cust_main = qsearchs( 'cust_main', { custnum => $args{'custnum'} } );
8490 $cust_main->bill_and_collect(
8495 sub _upgrade_data { #class method
8496 my ($class, %opts) = @_;
8498 my $sql = 'UPDATE h_cust_main SET paycvv = NULL WHERE paycvv IS NOT NULL';
8499 my $sth = dbh->prepare($sql) or die dbh->errstr;
8500 $sth->execute or die $sth->errstr;
8510 The delete method should possibly take an FS::cust_main object reference
8511 instead of a scalar customer number.
8513 Bill and collect options should probably be passed as references instead of a
8516 There should probably be a configuration file with a list of allowed credit
8519 No multiple currency support (probably a larger project than just this module).
8521 payinfo_masked false laziness with cust_pay.pm and cust_refund.pm
8523 Birthdates rely on negative epoch values.
8525 The payby for card/check batches is broken. With mixed batching, bad
8528 B<collect> I<invoice_time> should be renamed I<time>, like B<bill>.
8532 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
8533 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
8534 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.