5 use vars qw( @ISA @EXPORT_OK $DEBUG $me $conf @encrypted_fields
6 $import $skip_fuzzyfiles $ignore_expired_card @paytypes);
7 use vars qw( $realtime_bop_decline_quiet ); #ugh
11 use Scalar::Util qw( blessed );
12 use Time::Local qw(timelocal);
15 use Digest::MD5 qw(md5_base64);
18 use File::Temp qw( tempfile );
19 use String::Approx qw(amatch);
20 use Business::CreditCard 0.28;
22 use FS::UID qw( getotaker dbh driver_name );
23 use FS::Record qw( qsearchs qsearch dbdef );
24 use FS::Misc qw( generate_email send_email generate_ps do_print );
25 use FS::Msgcat qw(gettext);
30 use FS::cust_bill_pkg;
31 use FS::cust_bill_pkg_display;
32 use FS::cust_bill_pkg_tax_location;
33 use FS::cust_bill_pkg_tax_rate_location;
35 use FS::cust_pay_pending;
36 use FS::cust_pay_void;
37 use FS::cust_pay_batch;
40 use FS::part_referral;
41 use FS::cust_main_county;
42 use FS::cust_location;
44 use FS::tax_rate_location;
45 use FS::cust_tax_location;
46 use FS::part_pkg_taxrate;
48 use FS::cust_main_invoice;
49 use FS::cust_credit_bill;
50 use FS::cust_bill_pay;
51 use FS::prepay_credit;
55 use FS::part_event_condition;
58 use FS::payment_gateway;
59 use FS::agent_payment_gateway;
61 use FS::payinfo_Mixin;
64 @ISA = qw( FS::payinfo_Mixin FS::Record );
66 @EXPORT_OK = qw( smart_search );
68 $realtime_bop_decline_quiet = 0;
70 # 1 is mostly method/subroutine entry and options
71 # 2 traces progress of some operations
72 # 3 is even more information including possibly sensitive data
74 $me = '[FS::cust_main]';
78 $ignore_expired_card = 0;
80 @encrypted_fields = ('payinfo', 'paycvv');
81 sub nohistory_fields { ('paycvv'); }
83 @paytypes = ('', 'Personal checking', 'Personal savings', 'Business checking', 'Business savings');
85 #ask FS::UID to run this stuff for us later
86 #$FS::UID::callback{'FS::cust_main'} = sub {
87 install_callback FS::UID sub {
89 #yes, need it for stuff below (prolly should be cached)
94 my ( $hashref, $cache ) = @_;
95 if ( exists $hashref->{'pkgnum'} ) {
96 #@{ $self->{'_pkgnum'} } = ();
97 my $subcache = $cache->subcache( 'pkgnum', 'cust_pkg', $hashref->{custnum});
98 $self->{'_pkgnum'} = $subcache;
99 #push @{ $self->{'_pkgnum'} },
100 FS::cust_pkg->new_or_cached($hashref, $subcache) if $hashref->{pkgnum};
106 FS::cust_main - Object methods for cust_main records
112 $record = new FS::cust_main \%hash;
113 $record = new FS::cust_main { 'column' => 'value' };
115 $error = $record->insert;
117 $error = $new_record->replace($old_record);
119 $error = $record->delete;
121 $error = $record->check;
123 @cust_pkg = $record->all_pkgs;
125 @cust_pkg = $record->ncancelled_pkgs;
127 @cust_pkg = $record->suspended_pkgs;
129 $error = $record->bill;
130 $error = $record->bill %options;
131 $error = $record->bill 'time' => $time;
133 $error = $record->collect;
134 $error = $record->collect %options;
135 $error = $record->collect 'invoice_time' => $time,
140 An FS::cust_main object represents a customer. FS::cust_main inherits from
141 FS::Record. The following fields are currently supported:
147 Primary key (assigned automatically for new customers)
151 Agent (see L<FS::agent>)
155 Advertising source (see L<FS::part_referral>)
167 Cocial security number (optional)
183 (optional, see L<FS::cust_main_county>)
187 (see L<FS::cust_main_county>)
193 (see L<FS::cust_main_county>)
229 (optional, see L<FS::cust_main_county>)
233 (see L<FS::cust_main_county>)
239 (see L<FS::cust_main_county>)
255 Payment Type (See L<FS::payinfo_Mixin> for valid payby values)
259 Payment Information (See L<FS::payinfo_Mixin> for data format)
263 Masked payinfo (See L<FS::payinfo_Mixin> for how this works)
267 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
271 Expiration date, mm/yyyy, m/yyyy, mm/yy or m/yy
275 Start date month (maestro/solo cards only)
279 Start date year (maestro/solo cards only)
283 Issue number (maestro/solo cards only)
287 Name on card or billing name
291 IP address from which payment information was received
295 Tax exempt, empty or `Y'
299 Order taker (assigned automatically, see L<FS::UID>)
305 =item referral_custnum
307 Referring customer number
311 Enable individual CDR spooling, empty or `Y'
315 A suggestion to events (see L<FS::part_bill_event">) to delay until this unix timestamp
319 Discourage individual CDR printing, empty or `Y'
329 Creates a new customer. To add the customer to the database, see L<"insert">.
331 Note that this stores the hash reference, not a distinct copy of the hash it
332 points to. You can ask the object for a copy with the I<hash> method.
336 sub table { 'cust_main'; }
338 =item insert [ CUST_PKG_HASHREF [ , INVOICING_LIST_ARYREF ] [ , OPTION => VALUE ... ] ]
340 Adds this customer to the database. If there is an error, returns the error,
341 otherwise returns false.
343 CUST_PKG_HASHREF: If you pass a Tie::RefHash data structure to the insert
344 method containing FS::cust_pkg and FS::svc_I<tablename> objects, all records
345 are inserted atomicly, or the transaction is rolled back. Passing an empty
346 hash reference is equivalent to not supplying this parameter. There should be
347 a better explanation of this, but until then, here's an example:
350 tie %hash, 'Tie::RefHash'; #this part is important
352 $cust_pkg => [ $svc_acct ],
355 $cust_main->insert( \%hash );
357 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
358 be set as the invoicing list (see L<"invoicing_list">). Errors return as
359 expected and rollback the entire transaction; it is not necessary to call
360 check_invoicing_list first. The invoicing_list is set after the records in the
361 CUST_PKG_HASHREF above are inserted, so it is now possible to set an
362 invoicing_list destination to the newly-created svc_acct. Here's an example:
364 $cust_main->insert( {}, [ $email, 'POST' ] );
366 Currently available options are: I<depend_jobnum> and I<noexport>.
368 If I<depend_jobnum> is set, all provisioning jobs will have a dependancy
369 on the supplied jobnum (they will not run until the specific job completes).
370 This can be used to defer provisioning until some action completes (such
371 as running the customer's credit card successfully).
373 The I<noexport> option is deprecated. If I<noexport> is set true, no
374 provisioning jobs (exports) are scheduled. (You can schedule them later with
375 the B<reexport> method.)
381 my $cust_pkgs = @_ ? shift : {};
382 my $invoicing_list = @_ ? shift : '';
384 warn "$me insert called with options ".
385 join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
388 local $SIG{HUP} = 'IGNORE';
389 local $SIG{INT} = 'IGNORE';
390 local $SIG{QUIT} = 'IGNORE';
391 local $SIG{TERM} = 'IGNORE';
392 local $SIG{TSTP} = 'IGNORE';
393 local $SIG{PIPE} = 'IGNORE';
395 my $oldAutoCommit = $FS::UID::AutoCommit;
396 local $FS::UID::AutoCommit = 0;
399 my $prepay_identifier = '';
400 my( $amount, $seconds, $upbytes, $downbytes, $totalbytes ) = (0, 0, 0, 0, 0);
402 if ( $self->payby eq 'PREPAY' ) {
404 $self->payby('BILL');
405 $prepay_identifier = $self->payinfo;
408 warn " looking up prepaid card $prepay_identifier\n"
411 my $error = $self->get_prepay( $prepay_identifier,
412 'amount_ref' => \$amount,
413 'seconds_ref' => \$seconds,
414 'upbytes_ref' => \$upbytes,
415 'downbytes_ref' => \$downbytes,
416 'totalbytes_ref' => \$totalbytes,
419 $dbh->rollback if $oldAutoCommit;
420 #return "error applying prepaid card (transaction rolled back): $error";
424 $payby = 'PREP' if $amount;
426 } elsif ( $self->payby =~ /^(CASH|WEST|MCRD)$/ ) {
429 $self->payby('BILL');
430 $amount = $self->paid;
434 warn " inserting $self\n"
437 $self->signupdate(time) unless $self->signupdate;
439 $self->auto_agent_custid()
440 if $conf->config('cust_main-auto_agent_custid') && ! $self->agent_custid;
442 my $error = $self->SUPER::insert;
444 $dbh->rollback if $oldAutoCommit;
445 #return "inserting cust_main record (transaction rolled back): $error";
449 warn " setting invoicing list\n"
452 if ( $invoicing_list ) {
453 $error = $self->check_invoicing_list( $invoicing_list );
455 $dbh->rollback if $oldAutoCommit;
456 #return "checking invoicing_list (transaction rolled back): $error";
459 $self->invoicing_list( $invoicing_list );
462 if ( $conf->config('cust_main-skeleton_tables')
463 && $conf->config('cust_main-skeleton_custnum') ) {
465 warn " inserting skeleton records\n"
468 my $error = $self->start_copy_skel;
470 $dbh->rollback if $oldAutoCommit;
476 warn " ordering packages\n"
479 $error = $self->order_pkgs( $cust_pkgs,
481 'seconds_ref' => \$seconds,
482 'upbytes_ref' => \$upbytes,
483 'downbytes_ref' => \$downbytes,
484 'totalbytes_ref' => \$totalbytes,
487 $dbh->rollback if $oldAutoCommit;
492 $dbh->rollback if $oldAutoCommit;
493 return "No svc_acct record to apply pre-paid time";
495 if ( $upbytes || $downbytes || $totalbytes ) {
496 $dbh->rollback if $oldAutoCommit;
497 return "No svc_acct record to apply pre-paid data";
501 warn " inserting initial $payby payment of $amount\n"
503 $error = $self->insert_cust_pay($payby, $amount, $prepay_identifier);
505 $dbh->rollback if $oldAutoCommit;
506 return "inserting payment (transaction rolled back): $error";
510 unless ( $import || $skip_fuzzyfiles ) {
511 warn " queueing fuzzyfiles update\n"
513 $error = $self->queue_fuzzyfiles_update;
515 $dbh->rollback if $oldAutoCommit;
516 return "updating fuzzy search cache: $error";
520 warn " insert complete; committing transaction\n"
523 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
528 use File::CounterFile;
529 sub auto_agent_custid {
532 my $format = $conf->config('cust_main-auto_agent_custid');
534 if ( $format eq '1YMMXXXXXXXX' ) {
536 my $counter = new File::CounterFile 'cust_main.agent_custid';
539 my $ym = 100000000000 + time2str('%y%m00000000', time);
540 if ( $ym > $counter->value ) {
541 $counter->{'value'} = $agent_custid = $ym;
542 $counter->{'updated'} = 1;
544 $agent_custid = $counter->inc;
550 die "Unknown cust_main-auto_agent_custid format: $format";
553 $self->agent_custid($agent_custid);
557 sub start_copy_skel {
560 #'mg_user_preference' => {},
561 #'mg_user_indicator_profile.user_indicator_profile_id' => { 'mg_profile_indicator.profile_indicator_id' => { 'mg_profile_details.profile_detail_id' }, },
562 #'mg_watchlist_header.watchlist_header_id' => { 'mg_watchlist_details.watchlist_details_id' },
563 #'mg_user_grid_header.grid_header_id' => { 'mg_user_grid_details.user_grid_details_id' },
564 #'mg_portfolio_header.portfolio_header_id' => { 'mg_portfolio_trades.portfolio_trades_id' => { 'mg_portfolio_trades_positions.portfolio_trades_positions_id' } },
565 my @tables = eval(join('\n',$conf->config('cust_main-skeleton_tables')));
568 _copy_skel( 'cust_main', #tablename
569 $conf->config('cust_main-skeleton_custnum'), #sourceid
570 $self->custnum, #destid
571 @tables, #child tables
575 #recursive subroutine, not a method
577 my( $table, $sourceid, $destid, %child_tables ) = @_;
580 if ( $table =~ /^(\w+)\.(\w+)$/ ) {
581 ( $table, $primary_key ) = ( $1, $2 );
583 my $dbdef_table = dbdef->table($table);
584 $primary_key = $dbdef_table->primary_key
585 or return "$table has no primary key".
586 " (or do you need to run dbdef-create?)";
589 warn " _copy_skel: $table.$primary_key $sourceid to $destid for ".
590 join (', ', keys %child_tables). "\n"
593 foreach my $child_table_def ( keys %child_tables ) {
597 if ( $child_table_def =~ /^(\w+)\.(\w+)$/ ) {
598 ( $child_table, $child_pkey ) = ( $1, $2 );
600 $child_table = $child_table_def;
602 $child_pkey = dbdef->table($child_table)->primary_key;
603 # or return "$table has no primary key".
604 # " (or do you need to run dbdef-create?)\n";
608 if ( keys %{ $child_tables{$child_table_def} } ) {
610 return "$child_table has no primary key".
611 " (run dbdef-create or try specifying it?)\n"
614 #false laziness w/Record::insert and only works on Pg
615 #refactor the proper last-inserted-id stuff out of Record::insert if this
616 # ever gets use for anything besides a quick kludge for one customer
617 my $default = dbdef->table($child_table)->column($child_pkey)->default;
618 $default =~ /^nextval\(\(?'"?([\w\.]+)"?'/i
619 or return "can't parse $child_table.$child_pkey default value ".
620 " for sequence name: $default";
625 my @sel_columns = grep { $_ ne $primary_key }
626 dbdef->table($child_table)->columns;
627 my $sel_columns = join(', ', @sel_columns );
629 my @ins_columns = grep { $_ ne $child_pkey } @sel_columns;
630 my $ins_columns = ' ( '. join(', ', $primary_key, @ins_columns ). ' ) ';
631 my $placeholders = ' ( ?, '. join(', ', map '?', @ins_columns ). ' ) ';
633 my $sel_st = "SELECT $sel_columns FROM $child_table".
634 " WHERE $primary_key = $sourceid";
637 my $sel_sth = dbh->prepare( $sel_st )
638 or return dbh->errstr;
640 $sel_sth->execute or return $sel_sth->errstr;
642 while ( my $row = $sel_sth->fetchrow_hashref ) {
644 warn " selected row: ".
645 join(', ', map { "$_=".$row->{$_} } keys %$row ). "\n"
649 "INSERT INTO $child_table $ins_columns VALUES $placeholders";
650 my $ins_sth =dbh->prepare($statement)
651 or return dbh->errstr;
652 my @param = ( $destid, map $row->{$_}, @ins_columns );
653 warn " $statement: [ ". join(', ', @param). " ]\n"
655 $ins_sth->execute( @param )
656 or return $ins_sth->errstr;
658 #next unless keys %{ $child_tables{$child_table} };
659 next unless $sequence;
661 #another section of that laziness
662 my $seq_sql = "SELECT currval('$sequence')";
663 my $seq_sth = dbh->prepare($seq_sql) or return dbh->errstr;
664 $seq_sth->execute or return $seq_sth->errstr;
665 my $insertid = $seq_sth->fetchrow_arrayref->[0];
667 # don't drink soap! recurse! recurse! okay!
669 _copy_skel( $child_table_def,
670 $row->{$child_pkey}, #sourceid
672 %{ $child_tables{$child_table_def} },
674 return $error if $error;
684 =item order_pkg HASHREF | OPTION => VALUE ...
686 Orders a single package.
688 Options may be passed as a list of key/value pairs or as a hash reference.
699 Optional FS::cust_location object
703 Optional arryaref of FS::svc_* service objects.
707 If this option is set to a job queue jobnum (see L<FS::queue>), all provisioning
708 jobs will have a dependancy on the supplied job (they will not run until the
709 specific job completes). This can be used to defer provisioning until some
710 action completes (such as running the customer's credit card successfully).
714 Optional subject for a ticket created and attached to this customer
718 Optional queue name for ticket additions
726 my $opt = ref($_[0]) ? shift : { @_ };
728 warn "$me order_pkg called with options ".
729 join(', ', map { "$_: $opt->{$_}" } keys %$opt ). "\n"
732 my $cust_pkg = $opt->{'cust_pkg'};
733 my $svcs = $opt->{'svcs'} || [];
735 my %svc_options = ();
736 $svc_options{'depend_jobnum'} = $opt->{'depend_jobnum'}
737 if exists($opt->{'depend_jobnum'}) && $opt->{'depend_jobnum'};
739 my %insert_params = map { $opt->{$_} ? ( $_ => $opt->{$_} ) : () }
740 qw( ticket_subject ticket_queue );
742 local $SIG{HUP} = 'IGNORE';
743 local $SIG{INT} = 'IGNORE';
744 local $SIG{QUIT} = 'IGNORE';
745 local $SIG{TERM} = 'IGNORE';
746 local $SIG{TSTP} = 'IGNORE';
747 local $SIG{PIPE} = 'IGNORE';
749 my $oldAutoCommit = $FS::UID::AutoCommit;
750 local $FS::UID::AutoCommit = 0;
753 if ( $opt->{'cust_location'} &&
754 ( ! $cust_pkg->locationnum || $cust_pkg->locationnum == -1 ) ) {
755 my $error = $opt->{'cust_location'}->insert;
757 $dbh->rollback if $oldAutoCommit;
758 return "inserting cust_location (transaction rolled back): $error";
760 $cust_pkg->locationnum($opt->{'cust_location'}->locationnum);
763 $cust_pkg->custnum( $self->custnum );
765 my $error = $cust_pkg->insert( %insert_params );
767 $dbh->rollback if $oldAutoCommit;
768 return "inserting cust_pkg (transaction rolled back): $error";
771 foreach my $svc_something ( @{ $opt->{'svcs'} } ) {
772 if ( $svc_something->svcnum ) {
773 my $old_cust_svc = $svc_something->cust_svc;
774 my $new_cust_svc = new FS::cust_svc { $old_cust_svc->hash };
775 $new_cust_svc->pkgnum( $cust_pkg->pkgnum);
776 $error = $new_cust_svc->replace($old_cust_svc);
778 $svc_something->pkgnum( $cust_pkg->pkgnum );
779 if ( $svc_something->isa('FS::svc_acct') ) {
780 foreach ( grep { $opt->{$_.'_ref'} && ${ $opt->{$_.'_ref'} } }
781 qw( seconds upbytes downbytes totalbytes ) ) {
782 $svc_something->$_( $svc_something->$_() + ${ $opt->{$_.'_ref'} } );
783 ${ $opt->{$_.'_ref'} } = 0;
786 $error = $svc_something->insert(%svc_options);
789 $dbh->rollback if $oldAutoCommit;
790 return "inserting svc_ (transaction rolled back): $error";
794 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
799 #deprecated #=item order_pkgs HASHREF [ , SECONDSREF ] [ , OPTION => VALUE ... ]
800 =item order_pkgs HASHREF [ , OPTION => VALUE ... ]
802 Like the insert method on an existing record, this method orders multiple
803 packages and included services atomicaly. Pass a Tie::RefHash data structure
804 to this method containing FS::cust_pkg and FS::svc_I<tablename> objects.
805 There should be a better explanation of this, but until then, here's an
809 tie %hash, 'Tie::RefHash'; #this part is important
811 $cust_pkg => [ $svc_acct ],
814 $cust_main->order_pkgs( \%hash, 'noexport'=>1 );
816 Services can be new, in which case they are inserted, or existing unaudited
817 services, in which case they are linked to the newly-created package.
819 Currently available options are: I<depend_jobnum>, I<noexport>, I<seconds_ref>,
820 I<upbytes_ref>, I<downbytes_ref>, and I<totalbytes_ref>.
822 If I<depend_jobnum> is set, all provisioning jobs will have a dependancy
823 on the supplied jobnum (they will not run until the specific job completes).
824 This can be used to defer provisioning until some action completes (such
825 as running the customer's credit card successfully).
827 The I<noexport> option is deprecated. If I<noexport> is set true, no
828 provisioning jobs (exports) are scheduled. (You can schedule them later with
829 the B<reexport> method for each cust_pkg object. Using the B<reexport> method
830 on the cust_main object is not recommended, as existing services will also be
833 If I<seconds_ref>, I<upbytes_ref>, I<downbytes_ref>, or I<totalbytes_ref> is
834 provided, the scalars (provided by references) will be incremented by the
835 values of the prepaid card.`
841 my $cust_pkgs = shift;
842 my $seconds_ref = ref($_[0]) ? shift : ''; #deprecated
844 $seconds_ref ||= $options{'seconds_ref'};
846 warn "$me order_pkgs called with options ".
847 join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
850 local $SIG{HUP} = 'IGNORE';
851 local $SIG{INT} = 'IGNORE';
852 local $SIG{QUIT} = 'IGNORE';
853 local $SIG{TERM} = 'IGNORE';
854 local $SIG{TSTP} = 'IGNORE';
855 local $SIG{PIPE} = 'IGNORE';
857 my $oldAutoCommit = $FS::UID::AutoCommit;
858 local $FS::UID::AutoCommit = 0;
861 local $FS::svc_Common::noexport_hack = 1 if $options{'noexport'};
863 foreach my $cust_pkg ( keys %$cust_pkgs ) {
865 my $error = $self->order_pkg(
866 'cust_pkg' => $cust_pkg,
867 'svcs' => $cust_pkgs->{$cust_pkg},
868 'seconds_ref' => $seconds_ref,
869 map { $_ => $options{$_} } qw( upbytes_ref downbytes_ref totalbytes_ref
874 $dbh->rollback if $oldAutoCommit;
880 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
884 =item recharge_prepay IDENTIFIER | PREPAY_CREDIT_OBJ [ , AMOUNTREF, SECONDSREF, UPBYTEREF, DOWNBYTEREF ]
886 Recharges this (existing) customer with the specified prepaid card (see
887 L<FS::prepay_credit>), specified either by I<identifier> or as an
888 FS::prepay_credit object. If there is an error, returns the error, otherwise
891 Optionally, five scalar references can be passed as well. They will have their
892 values filled in with the amount, number of seconds, and number of upload,
893 download, and total bytes applied by this prepaid card.
897 #the ref bullshit here should be refactored like get_prepay. MyAccount.pm is
898 #the only place that uses these args
899 sub recharge_prepay {
900 my( $self, $prepay_credit, $amountref, $secondsref,
901 $upbytesref, $downbytesref, $totalbytesref ) = @_;
903 local $SIG{HUP} = 'IGNORE';
904 local $SIG{INT} = 'IGNORE';
905 local $SIG{QUIT} = 'IGNORE';
906 local $SIG{TERM} = 'IGNORE';
907 local $SIG{TSTP} = 'IGNORE';
908 local $SIG{PIPE} = 'IGNORE';
910 my $oldAutoCommit = $FS::UID::AutoCommit;
911 local $FS::UID::AutoCommit = 0;
914 my( $amount, $seconds, $upbytes, $downbytes, $totalbytes) = ( 0, 0, 0, 0, 0 );
916 my $error = $self->get_prepay( $prepay_credit,
917 'amount_ref' => \$amount,
918 'seconds_ref' => \$seconds,
919 'upbytes_ref' => \$upbytes,
920 'downbytes_ref' => \$downbytes,
921 'totalbytes_ref' => \$totalbytes,
923 || $self->increment_seconds($seconds)
924 || $self->increment_upbytes($upbytes)
925 || $self->increment_downbytes($downbytes)
926 || $self->increment_totalbytes($totalbytes)
927 || $self->insert_cust_pay_prepay( $amount,
929 ? $prepay_credit->identifier
934 $dbh->rollback if $oldAutoCommit;
938 if ( defined($amountref) ) { $$amountref = $amount; }
939 if ( defined($secondsref) ) { $$secondsref = $seconds; }
940 if ( defined($upbytesref) ) { $$upbytesref = $upbytes; }
941 if ( defined($downbytesref) ) { $$downbytesref = $downbytes; }
942 if ( defined($totalbytesref) ) { $$totalbytesref = $totalbytes; }
944 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
949 =item get_prepay IDENTIFIER | PREPAY_CREDIT_OBJ [ , OPTION => VALUE ... ]
951 Looks up and deletes a prepaid card (see L<FS::prepay_credit>),
952 specified either by I<identifier> or as an FS::prepay_credit object.
954 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
955 incremented by the values of the prepaid card.
957 If the prepaid card specifies an I<agentnum> (see L<FS::agent>), it is used to
958 check or set this customer's I<agentnum>.
960 If there is an error, returns the error, otherwise returns false.
966 my( $self, $prepay_credit, %opt ) = @_;
968 local $SIG{HUP} = 'IGNORE';
969 local $SIG{INT} = 'IGNORE';
970 local $SIG{QUIT} = 'IGNORE';
971 local $SIG{TERM} = 'IGNORE';
972 local $SIG{TSTP} = 'IGNORE';
973 local $SIG{PIPE} = 'IGNORE';
975 my $oldAutoCommit = $FS::UID::AutoCommit;
976 local $FS::UID::AutoCommit = 0;
979 unless ( ref($prepay_credit) ) {
981 my $identifier = $prepay_credit;
983 $prepay_credit = qsearchs(
985 { 'identifier' => $prepay_credit },
990 unless ( $prepay_credit ) {
991 $dbh->rollback if $oldAutoCommit;
992 return "Invalid prepaid card: ". $identifier;
997 if ( $prepay_credit->agentnum ) {
998 if ( $self->agentnum && $self->agentnum != $prepay_credit->agentnum ) {
999 $dbh->rollback if $oldAutoCommit;
1000 return "prepaid card not valid for agent ". $self->agentnum;
1002 $self->agentnum($prepay_credit->agentnum);
1005 my $error = $prepay_credit->delete;
1007 $dbh->rollback if $oldAutoCommit;
1008 return "removing prepay_credit (transaction rolled back): $error";
1011 ${ $opt{$_.'_ref'} } += $prepay_credit->$_()
1012 for grep $opt{$_.'_ref'}, qw( amount seconds upbytes downbytes totalbytes );
1014 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1019 =item increment_upbytes SECONDS
1021 Updates this customer's single or primary account (see L<FS::svc_acct>) by
1022 the specified number of upbytes. If there is an error, returns the error,
1023 otherwise returns false.
1027 sub increment_upbytes {
1028 _increment_column( shift, 'upbytes', @_);
1031 =item increment_downbytes SECONDS
1033 Updates this customer's single or primary account (see L<FS::svc_acct>) by
1034 the specified number of downbytes. If there is an error, returns the error,
1035 otherwise returns false.
1039 sub increment_downbytes {
1040 _increment_column( shift, 'downbytes', @_);
1043 =item increment_totalbytes SECONDS
1045 Updates this customer's single or primary account (see L<FS::svc_acct>) by
1046 the specified number of totalbytes. If there is an error, returns the error,
1047 otherwise returns false.
1051 sub increment_totalbytes {
1052 _increment_column( shift, 'totalbytes', @_);
1055 =item increment_seconds SECONDS
1057 Updates this customer's single or primary account (see L<FS::svc_acct>) by
1058 the specified number of seconds. If there is an error, returns the error,
1059 otherwise returns false.
1063 sub increment_seconds {
1064 _increment_column( shift, 'seconds', @_);
1067 =item _increment_column AMOUNT
1069 Updates this customer's single or primary account (see L<FS::svc_acct>) by
1070 the specified number of seconds or bytes. If there is an error, returns
1071 the error, otherwise returns false.
1075 sub _increment_column {
1076 my( $self, $column, $amount ) = @_;
1077 warn "$me increment_column called: $column, $amount\n"
1080 return '' unless $amount;
1082 my @cust_pkg = grep { $_->part_pkg->svcpart('svc_acct') }
1083 $self->ncancelled_pkgs;
1085 if ( ! @cust_pkg ) {
1086 return 'No packages with primary or single services found'.
1087 ' to apply pre-paid time';
1088 } elsif ( scalar(@cust_pkg) > 1 ) {
1089 #maybe have a way to specify the package/account?
1090 return 'Multiple packages found to apply pre-paid time';
1093 my $cust_pkg = $cust_pkg[0];
1094 warn " found package pkgnum ". $cust_pkg->pkgnum. "\n"
1098 $cust_pkg->cust_svc( $cust_pkg->part_pkg->svcpart('svc_acct') );
1100 if ( ! @cust_svc ) {
1101 return 'No account found to apply pre-paid time';
1102 } elsif ( scalar(@cust_svc) > 1 ) {
1103 return 'Multiple accounts found to apply pre-paid time';
1106 my $svc_acct = $cust_svc[0]->svc_x;
1107 warn " found service svcnum ". $svc_acct->pkgnum.
1108 ' ('. $svc_acct->email. ")\n"
1111 $column = "increment_$column";
1112 $svc_acct->$column($amount);
1116 =item insert_cust_pay_prepay AMOUNT [ PAYINFO ]
1118 Inserts a prepayment in the specified amount for this customer. An optional
1119 second argument can specify the prepayment identifier for tracking purposes.
1120 If there is an error, returns the error, otherwise returns false.
1124 sub insert_cust_pay_prepay {
1125 shift->insert_cust_pay('PREP', @_);
1128 =item insert_cust_pay_cash AMOUNT [ PAYINFO ]
1130 Inserts a cash payment in the specified amount for this customer. An optional
1131 second argument can specify the payment identifier for tracking purposes.
1132 If there is an error, returns the error, otherwise returns false.
1136 sub insert_cust_pay_cash {
1137 shift->insert_cust_pay('CASH', @_);
1140 =item insert_cust_pay_west AMOUNT [ PAYINFO ]
1142 Inserts a Western Union payment in the specified amount for this customer. An
1143 optional second argument can specify the prepayment identifier for tracking
1144 purposes. If there is an error, returns the error, otherwise returns false.
1148 sub insert_cust_pay_west {
1149 shift->insert_cust_pay('WEST', @_);
1152 sub insert_cust_pay {
1153 my( $self, $payby, $amount ) = splice(@_, 0, 3);
1154 my $payinfo = scalar(@_) ? shift : '';
1156 my $cust_pay = new FS::cust_pay {
1157 'custnum' => $self->custnum,
1158 'paid' => sprintf('%.2f', $amount),
1159 #'_date' => #date the prepaid card was purchased???
1161 'payinfo' => $payinfo,
1169 This method is deprecated. See the I<depend_jobnum> option to the insert and
1170 order_pkgs methods for a better way to defer provisioning.
1172 Re-schedules all exports by calling the B<reexport> method of all associated
1173 packages (see L<FS::cust_pkg>). If there is an error, returns the error;
1174 otherwise returns false.
1181 carp "WARNING: FS::cust_main::reexport is deprectated; ".
1182 "use the depend_jobnum option to insert or order_pkgs to delay export";
1184 local $SIG{HUP} = 'IGNORE';
1185 local $SIG{INT} = 'IGNORE';
1186 local $SIG{QUIT} = 'IGNORE';
1187 local $SIG{TERM} = 'IGNORE';
1188 local $SIG{TSTP} = 'IGNORE';
1189 local $SIG{PIPE} = 'IGNORE';
1191 my $oldAutoCommit = $FS::UID::AutoCommit;
1192 local $FS::UID::AutoCommit = 0;
1195 foreach my $cust_pkg ( $self->ncancelled_pkgs ) {
1196 my $error = $cust_pkg->reexport;
1198 $dbh->rollback if $oldAutoCommit;
1203 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1208 =item delete NEW_CUSTNUM
1210 This deletes the customer. If there is an error, returns the error, otherwise
1213 This will completely remove all traces of the customer record. This is not
1214 what you want when a customer cancels service; for that, cancel all of the
1215 customer's packages (see L</cancel>).
1217 If the customer has any uncancelled packages, you need to pass a new (valid)
1218 customer number for those packages to be transferred to. Cancelled packages
1219 will be deleted. Did I mention that this is NOT what you want when a customer
1220 cancels service and that you really should be looking see L<FS::cust_pkg/cancel>?
1222 You can't delete a customer with invoices (see L<FS::cust_bill>),
1223 or credits (see L<FS::cust_credit>), payments (see L<FS::cust_pay>) or
1224 refunds (see L<FS::cust_refund>).
1231 local $SIG{HUP} = 'IGNORE';
1232 local $SIG{INT} = 'IGNORE';
1233 local $SIG{QUIT} = 'IGNORE';
1234 local $SIG{TERM} = 'IGNORE';
1235 local $SIG{TSTP} = 'IGNORE';
1236 local $SIG{PIPE} = 'IGNORE';
1238 my $oldAutoCommit = $FS::UID::AutoCommit;
1239 local $FS::UID::AutoCommit = 0;
1242 if ( $self->cust_bill ) {
1243 $dbh->rollback if $oldAutoCommit;
1244 return "Can't delete a customer with invoices";
1246 if ( $self->cust_credit ) {
1247 $dbh->rollback if $oldAutoCommit;
1248 return "Can't delete a customer with credits";
1250 if ( $self->cust_pay ) {
1251 $dbh->rollback if $oldAutoCommit;
1252 return "Can't delete a customer with payments";
1254 if ( $self->cust_refund ) {
1255 $dbh->rollback if $oldAutoCommit;
1256 return "Can't delete a customer with refunds";
1259 my @cust_pkg = $self->ncancelled_pkgs;
1261 my $new_custnum = shift;
1262 unless ( qsearchs( 'cust_main', { 'custnum' => $new_custnum } ) ) {
1263 $dbh->rollback if $oldAutoCommit;
1264 return "Invalid new customer number: $new_custnum";
1266 foreach my $cust_pkg ( @cust_pkg ) {
1267 my %hash = $cust_pkg->hash;
1268 $hash{'custnum'} = $new_custnum;
1269 my $new_cust_pkg = new FS::cust_pkg ( \%hash );
1270 my $error = $new_cust_pkg->replace($cust_pkg,
1271 options => { $cust_pkg->options },
1274 $dbh->rollback if $oldAutoCommit;
1279 my @cancelled_cust_pkg = $self->all_pkgs;
1280 foreach my $cust_pkg ( @cancelled_cust_pkg ) {
1281 my $error = $cust_pkg->delete;
1283 $dbh->rollback if $oldAutoCommit;
1288 foreach my $cust_main_invoice ( #(email invoice destinations, not invoices)
1289 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } )
1291 my $error = $cust_main_invoice->delete;
1293 $dbh->rollback if $oldAutoCommit;
1298 my $error = $self->SUPER::delete;
1300 $dbh->rollback if $oldAutoCommit;
1304 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1309 =item replace [ OLD_RECORD ] [ INVOICING_LIST_ARYREF ]
1311 Replaces the OLD_RECORD with this one in the database. If there is an error,
1312 returns the error, otherwise returns false.
1314 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
1315 be set as the invoicing list (see L<"invoicing_list">). Errors return as
1316 expected and rollback the entire transaction; it is not necessary to call
1317 check_invoicing_list first. Here's an example:
1319 $new_cust_main->replace( $old_cust_main, [ $email, 'POST' ] );
1326 my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
1328 : $self->replace_old;
1332 warn "$me replace called\n"
1335 my $curuser = $FS::CurrentUser::CurrentUser;
1336 if ( $self->payby eq 'COMP'
1337 && $self->payby ne $old->payby
1338 && ! $curuser->access_right('Complimentary customer')
1341 return "You are not permitted to create complimentary accounts.";
1344 local($ignore_expired_card) = 1
1345 if $old->payby =~ /^(CARD|DCRD)$/
1346 && $self->payby =~ /^(CARD|DCRD)$/
1347 && ( $old->payinfo eq $self->payinfo || $old->paymask eq $self->paymask );
1349 local $SIG{HUP} = 'IGNORE';
1350 local $SIG{INT} = 'IGNORE';
1351 local $SIG{QUIT} = 'IGNORE';
1352 local $SIG{TERM} = 'IGNORE';
1353 local $SIG{TSTP} = 'IGNORE';
1354 local $SIG{PIPE} = 'IGNORE';
1356 my $oldAutoCommit = $FS::UID::AutoCommit;
1357 local $FS::UID::AutoCommit = 0;
1360 my $error = $self->SUPER::replace($old);
1363 $dbh->rollback if $oldAutoCommit;
1367 if ( @param ) { # INVOICING_LIST_ARYREF
1368 my $invoicing_list = shift @param;
1369 $error = $self->check_invoicing_list( $invoicing_list );
1371 $dbh->rollback if $oldAutoCommit;
1374 $self->invoicing_list( $invoicing_list );
1377 if ( $self->payby =~ /^(CARD|CHEK|LECB)$/ &&
1378 grep { $self->get($_) ne $old->get($_) } qw(payinfo paydate payname) ) {
1379 # card/check/lec info has changed, want to retry realtime_ invoice events
1380 my $error = $self->retry_realtime;
1382 $dbh->rollback if $oldAutoCommit;
1387 unless ( $import || $skip_fuzzyfiles ) {
1388 $error = $self->queue_fuzzyfiles_update;
1390 $dbh->rollback if $oldAutoCommit;
1391 return "updating fuzzy search cache: $error";
1395 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1400 =item queue_fuzzyfiles_update
1402 Used by insert & replace to update the fuzzy search cache
1406 sub queue_fuzzyfiles_update {
1409 local $SIG{HUP} = 'IGNORE';
1410 local $SIG{INT} = 'IGNORE';
1411 local $SIG{QUIT} = 'IGNORE';
1412 local $SIG{TERM} = 'IGNORE';
1413 local $SIG{TSTP} = 'IGNORE';
1414 local $SIG{PIPE} = 'IGNORE';
1416 my $oldAutoCommit = $FS::UID::AutoCommit;
1417 local $FS::UID::AutoCommit = 0;
1420 my $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
1421 my $error = $queue->insert( map $self->getfield($_),
1422 qw(first last company)
1425 $dbh->rollback if $oldAutoCommit;
1426 return "queueing job (transaction rolled back): $error";
1429 if ( $self->ship_last ) {
1430 $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
1431 $error = $queue->insert( map $self->getfield("ship_$_"),
1432 qw(first last company)
1435 $dbh->rollback if $oldAutoCommit;
1436 return "queueing job (transaction rolled back): $error";
1440 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1447 Checks all fields to make sure this is a valid customer record. If there is
1448 an error, returns the error, otherwise returns false. Called by the insert
1449 and replace methods.
1456 warn "$me check BEFORE: \n". $self->_dump
1460 $self->ut_numbern('custnum')
1461 || $self->ut_number('agentnum')
1462 || $self->ut_textn('agent_custid')
1463 || $self->ut_number('refnum')
1464 || $self->ut_textn('custbatch')
1465 || $self->ut_name('last')
1466 || $self->ut_name('first')
1467 || $self->ut_snumbern('birthdate')
1468 || $self->ut_snumbern('signupdate')
1469 || $self->ut_textn('company')
1470 || $self->ut_text('address1')
1471 || $self->ut_textn('address2')
1472 || $self->ut_text('city')
1473 || $self->ut_textn('county')
1474 || $self->ut_textn('state')
1475 || $self->ut_country('country')
1476 || $self->ut_anything('comments')
1477 || $self->ut_numbern('referral_custnum')
1478 || $self->ut_textn('stateid')
1479 || $self->ut_textn('stateid_state')
1480 || $self->ut_textn('invoice_terms')
1481 || $self->ut_alphan('geocode')
1484 #barf. need message catalogs. i18n. etc.
1485 $error .= "Please select an advertising source."
1486 if $error =~ /^Illegal or empty \(numeric\) refnum: /;
1487 return $error if $error;
1489 return "Unknown agent"
1490 unless qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
1492 return "Unknown refnum"
1493 unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } );
1495 return "Unknown referring custnum: ". $self->referral_custnum
1496 unless ! $self->referral_custnum
1497 || qsearchs( 'cust_main', { 'custnum' => $self->referral_custnum } );
1499 if ( $self->ss eq '' ) {
1504 $ss =~ /^(\d{3})(\d{2})(\d{4})$/
1505 or return "Illegal social security number: ". $self->ss;
1506 $self->ss("$1-$2-$3");
1510 # bad idea to disable, causes billing to fail because of no tax rates later
1511 # unless ( $import ) {
1512 unless ( qsearch('cust_main_county', {
1513 'country' => $self->country,
1516 return "Unknown state/county/country: ".
1517 $self->state. "/". $self->county. "/". $self->country
1518 unless qsearch('cust_main_county',{
1519 'state' => $self->state,
1520 'county' => $self->county,
1521 'country' => $self->country,
1527 $self->ut_phonen('daytime', $self->country)
1528 || $self->ut_phonen('night', $self->country)
1529 || $self->ut_phonen('fax', $self->country)
1530 || $self->ut_zip('zip', $self->country)
1532 return $error if $error;
1534 if ( $conf->exists('cust_main-require_phone')
1535 && ! length($self->daytime) && ! length($self->night)
1538 my $daytime_label = FS::Msgcat::_gettext('daytime') =~ /^(daytime)?$/
1540 : FS::Msgcat::_gettext('daytime');
1541 my $night_label = FS::Msgcat::_gettext('night') =~ /^(night)?$/
1543 : FS::Msgcat::_gettext('night');
1545 return "$daytime_label or $night_label is required"
1549 if ( $self->has_ship_address
1550 && scalar ( grep { $self->getfield($_) ne $self->getfield("ship_$_") }
1551 $self->addr_fields )
1555 $self->ut_name('ship_last')
1556 || $self->ut_name('ship_first')
1557 || $self->ut_textn('ship_company')
1558 || $self->ut_text('ship_address1')
1559 || $self->ut_textn('ship_address2')
1560 || $self->ut_text('ship_city')
1561 || $self->ut_textn('ship_county')
1562 || $self->ut_textn('ship_state')
1563 || $self->ut_country('ship_country')
1565 return $error if $error;
1567 #false laziness with above
1568 unless ( qsearchs('cust_main_county', {
1569 'country' => $self->ship_country,
1572 return "Unknown ship_state/ship_county/ship_country: ".
1573 $self->ship_state. "/". $self->ship_county. "/". $self->ship_country
1574 unless qsearch('cust_main_county',{
1575 'state' => $self->ship_state,
1576 'county' => $self->ship_county,
1577 'country' => $self->ship_country,
1583 $self->ut_phonen('ship_daytime', $self->ship_country)
1584 || $self->ut_phonen('ship_night', $self->ship_country)
1585 || $self->ut_phonen('ship_fax', $self->ship_country)
1586 || $self->ut_zip('ship_zip', $self->ship_country)
1588 return $error if $error;
1590 return "Unit # is required."
1591 if $self->ship_address2 =~ /^\s*$/
1592 && $conf->exists('cust_main-require_address2');
1594 } else { # ship_ info eq billing info, so don't store dup info in database
1596 $self->setfield("ship_$_", '')
1597 foreach $self->addr_fields;
1599 return "Unit # is required."
1600 if $self->address2 =~ /^\s*$/
1601 && $conf->exists('cust_main-require_address2');
1605 #$self->payby =~ /^(CARD|DCRD|CHEK|DCHK|LECB|BILL|COMP|PREPAY|CASH|WEST|MCRD)$/
1606 # or return "Illegal payby: ". $self->payby;
1608 FS::payby->can_payby($self->table, $self->payby)
1609 or return "Illegal payby: ". $self->payby;
1611 $error = $self->ut_numbern('paystart_month')
1612 || $self->ut_numbern('paystart_year')
1613 || $self->ut_numbern('payissue')
1614 || $self->ut_textn('paytype')
1616 return $error if $error;
1618 if ( $self->payip eq '' ) {
1621 $error = $self->ut_ip('payip');
1622 return $error if $error;
1625 # If it is encrypted and the private key is not availaible then we can't
1626 # check the credit card.
1628 my $check_payinfo = 1;
1630 if ($self->is_encrypted($self->payinfo)) {
1634 if ( $check_payinfo && $self->payby =~ /^(CARD|DCRD)$/ ) {
1636 my $payinfo = $self->payinfo;
1637 $payinfo =~ s/\D//g;
1638 $payinfo =~ /^(\d{13,16})$/
1639 or return gettext('invalid_card'); # . ": ". $self->payinfo;
1641 $self->payinfo($payinfo);
1643 or return gettext('invalid_card'); # . ": ". $self->payinfo;
1645 return gettext('unknown_card_type')
1646 if cardtype($self->payinfo) eq "Unknown";
1648 my $ban = qsearchs('banned_pay', $self->_banned_pay_hashref);
1650 return 'Banned credit card: banned on '.
1651 time2str('%a %h %o at %r', $ban->_date).
1652 ' by '. $ban->otaker.
1653 ' (ban# '. $ban->bannum. ')';
1656 if (length($self->paycvv) && !$self->is_encrypted($self->paycvv)) {
1657 if ( cardtype($self->payinfo) eq 'American Express card' ) {
1658 $self->paycvv =~ /^(\d{4})$/
1659 or return "CVV2 (CID) for American Express cards is four digits.";
1662 $self->paycvv =~ /^(\d{3})$/
1663 or return "CVV2 (CVC2/CID) is three digits.";
1670 my $cardtype = cardtype($payinfo);
1671 if ( $cardtype =~ /^(Switch|Solo)$/i ) {
1673 return "Start date or issue number is required for $cardtype cards"
1674 unless $self->paystart_month && $self->paystart_year or $self->payissue;
1676 return "Start month must be between 1 and 12"
1677 if $self->paystart_month
1678 and $self->paystart_month < 1 || $self->paystart_month > 12;
1680 return "Start year must be 1990 or later"
1681 if $self->paystart_year
1682 and $self->paystart_year < 1990;
1684 return "Issue number must be beween 1 and 99"
1686 and $self->payissue < 1 || $self->payissue > 99;
1689 $self->paystart_month('');
1690 $self->paystart_year('');
1691 $self->payissue('');
1694 } elsif ( $check_payinfo && $self->payby =~ /^(CHEK|DCHK)$/ ) {
1696 my $payinfo = $self->payinfo;
1697 $payinfo =~ s/[^\d\@]//g;
1698 if ( $conf->exists('echeck-nonus') ) {
1699 $payinfo =~ /^(\d+)\@(\d+)$/ or return 'invalid echeck account@aba';
1700 $payinfo = "$1\@$2";
1702 $payinfo =~ /^(\d+)\@(\d{9})$/ or return 'invalid echeck account@aba';
1703 $payinfo = "$1\@$2";
1705 $self->payinfo($payinfo);
1708 my $ban = qsearchs('banned_pay', $self->_banned_pay_hashref);
1710 return 'Banned ACH account: banned on '.
1711 time2str('%a %h %o at %r', $ban->_date).
1712 ' by '. $ban->otaker.
1713 ' (ban# '. $ban->bannum. ')';
1716 } elsif ( $self->payby eq 'LECB' ) {
1718 my $payinfo = $self->payinfo;
1719 $payinfo =~ s/\D//g;
1720 $payinfo =~ /^1?(\d{10})$/ or return 'invalid btn billing telephone number';
1722 $self->payinfo($payinfo);
1725 } elsif ( $self->payby eq 'BILL' ) {
1727 $error = $self->ut_textn('payinfo');
1728 return "Illegal P.O. number: ". $self->payinfo if $error;
1731 } elsif ( $self->payby eq 'COMP' ) {
1733 my $curuser = $FS::CurrentUser::CurrentUser;
1734 if ( ! $self->custnum
1735 && ! $curuser->access_right('Complimentary customer')
1738 return "You are not permitted to create complimentary accounts."
1741 $error = $self->ut_textn('payinfo');
1742 return "Illegal comp account issuer: ". $self->payinfo if $error;
1745 } elsif ( $self->payby eq 'PREPAY' ) {
1747 my $payinfo = $self->payinfo;
1748 $payinfo =~ s/\W//g; #anything else would just confuse things
1749 $self->payinfo($payinfo);
1750 $error = $self->ut_alpha('payinfo');
1751 return "Illegal prepayment identifier: ". $self->payinfo if $error;
1752 return "Unknown prepayment identifier"
1753 unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } );
1758 if ( $self->paydate eq '' || $self->paydate eq '-' ) {
1759 return "Expiration date required"
1760 unless $self->payby =~ /^(BILL|PREPAY|CHEK|DCHK|LECB|CASH|WEST|MCRD)$/;
1764 if ( $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/ ) {
1765 ( $m, $y ) = ( $1, length($2) == 4 ? $2 : "20$2" );
1766 } elsif ( $self->paydate =~ /^(20)?(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) {
1767 ( $m, $y ) = ( $3, "20$2" );
1769 return "Illegal expiration date: ". $self->paydate;
1771 $self->paydate("$y-$m-01");
1772 my($nowm,$nowy)=(localtime(time))[4,5]; $nowm++; $nowy+=1900;
1773 return gettext('expired_card')
1775 && !$ignore_expired_card
1776 && ( $y<$nowy || ( $y==$nowy && $1<$nowm ) );
1779 if ( $self->payname eq '' && $self->payby !~ /^(CHEK|DCHK)$/ &&
1780 ( ! $conf->exists('require_cardname')
1781 || $self->payby !~ /^(CARD|DCRD)$/ )
1783 $self->payname( $self->first. " ". $self->getfield('last') );
1785 $self->payname =~ /^([\w \,\.\-\'\&]+)$/
1786 or return gettext('illegal_name'). " payname: ". $self->payname;
1790 foreach my $flag (qw( tax spool_cdr squelch_cdr archived )) {
1791 $self->$flag() =~ /^(Y?)$/ or return "Illegal $flag: ". $self->$flag();
1795 $self->otaker(getotaker) unless $self->otaker;
1797 warn "$me check AFTER: \n". $self->_dump
1800 $self->SUPER::check;
1805 Returns a list of fields which have ship_ duplicates.
1810 qw( last first company
1811 address1 address2 city county state zip country
1816 =item has_ship_address
1818 Returns true if this customer record has a separate shipping address.
1822 sub has_ship_address {
1824 scalar( grep { $self->getfield("ship_$_") ne '' } $self->addr_fields );
1827 =item all_pkgs [ EXTRA_QSEARCH_PARAMS_HASHREF ]
1829 Returns all packages (see L<FS::cust_pkg>) for this customer.
1835 my $extra_qsearch = ref($_[0]) ? shift : {};
1837 return $self->num_pkgs unless wantarray || keys(%$extra_qsearch);
1840 if ( $self->{'_pkgnum'} ) {
1841 @cust_pkg = values %{ $self->{'_pkgnum'}->cache };
1843 @cust_pkg = $self->_cust_pkg($extra_qsearch);
1846 sort sort_packages @cust_pkg;
1851 Synonym for B<all_pkgs>.
1856 shift->all_pkgs(@_);
1861 Returns all locations (see L<FS::cust_location>) for this customer.
1867 qsearch('cust_location', { 'custnum' => $self->custnum } );
1870 =item ncancelled_pkgs [ EXTRA_QSEARCH_PARAMS_HASHREF ]
1872 Returns all non-cancelled packages (see L<FS::cust_pkg>) for this customer.
1876 sub ncancelled_pkgs {
1878 my $extra_qsearch = ref($_[0]) ? shift : {};
1880 return $self->num_ncancelled_pkgs unless wantarray;
1883 if ( $self->{'_pkgnum'} ) {
1885 warn "$me ncancelled_pkgs: returning cached objects"
1888 @cust_pkg = grep { ! $_->getfield('cancel') }
1889 values %{ $self->{'_pkgnum'}->cache };
1893 warn "$me ncancelled_pkgs: searching for packages with custnum ".
1894 $self->custnum. "\n"
1897 $extra_qsearch->{'extra_sql'} .= ' AND ( cancel IS NULL OR cancel = 0 ) ';
1899 @cust_pkg = $self->_cust_pkg($extra_qsearch);
1903 sort sort_packages @cust_pkg;
1909 my $extra_qsearch = ref($_[0]) ? shift : {};
1911 $extra_qsearch->{'select'} ||= '*';
1912 $extra_qsearch->{'select'} .=
1913 ',( SELECT COUNT(*) FROM cust_svc WHERE cust_pkg.pkgnum = cust_svc.pkgnum )
1917 $_->{'_num_cust_svc'} = $_->get('_num_cust_svc');
1922 'table' => 'cust_pkg',
1923 'hashref' => { 'custnum' => $self->custnum },
1928 # This should be generalized to use config options to determine order.
1931 if ( $a->get('cancel') xor $b->get('cancel') ) {
1932 return -1 if $b->get('cancel');
1933 return 1 if $a->get('cancel');
1934 #shouldn't get here...
1937 my $a_num_cust_svc = $a->num_cust_svc;
1938 my $b_num_cust_svc = $b->num_cust_svc;
1939 return 0 if !$a_num_cust_svc && !$b_num_cust_svc;
1940 return -1 if $a_num_cust_svc && !$b_num_cust_svc;
1941 return 1 if !$a_num_cust_svc && $b_num_cust_svc;
1942 my @a_cust_svc = $a->cust_svc;
1943 my @b_cust_svc = $b->cust_svc;
1944 $a_cust_svc[0]->svc_x->label cmp $b_cust_svc[0]->svc_x->label;
1949 =item suspended_pkgs
1951 Returns all suspended packages (see L<FS::cust_pkg>) for this customer.
1955 sub suspended_pkgs {
1957 grep { $_->susp } $self->ncancelled_pkgs;
1960 =item unflagged_suspended_pkgs
1962 Returns all unflagged suspended packages (see L<FS::cust_pkg>) for this
1963 customer (thouse packages without the `manual_flag' set).
1967 sub unflagged_suspended_pkgs {
1969 return $self->suspended_pkgs
1970 unless dbdef->table('cust_pkg')->column('manual_flag');
1971 grep { ! $_->manual_flag } $self->suspended_pkgs;
1974 =item unsuspended_pkgs
1976 Returns all unsuspended (and uncancelled) packages (see L<FS::cust_pkg>) for
1981 sub unsuspended_pkgs {
1983 grep { ! $_->susp } $self->ncancelled_pkgs;
1986 =item num_cancelled_pkgs
1988 Returns the number of cancelled packages (see L<FS::cust_pkg>) for this
1993 sub num_cancelled_pkgs {
1994 shift->num_pkgs("cust_pkg.cancel IS NOT NULL AND cust_pkg.cancel != 0");
1997 sub num_ncancelled_pkgs {
1998 shift->num_pkgs("( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )");
2002 my( $self ) = shift;
2003 my $sql = scalar(@_) ? shift : '';
2004 $sql = "AND $sql" if $sql && $sql !~ /^\s*$/ && $sql !~ /^\s*AND/i;
2005 my $sth = dbh->prepare(
2006 "SELECT COUNT(*) FROM cust_pkg WHERE custnum = ? $sql"
2007 ) or die dbh->errstr;
2008 $sth->execute($self->custnum) or die $sth->errstr;
2009 $sth->fetchrow_arrayref->[0];
2014 Unsuspends all unflagged suspended packages (see L</unflagged_suspended_pkgs>
2015 and L<FS::cust_pkg>) for this customer. Always returns a list: an empty list
2016 on success or a list of errors.
2022 grep { $_->unsuspend } $self->suspended_pkgs;
2027 Suspends all unsuspended packages (see L<FS::cust_pkg>) for this customer.
2029 Returns a list: an empty list on success or a list of errors.
2035 grep { $_->suspend(@_) } $self->unsuspended_pkgs;
2038 =item suspend_if_pkgpart HASHREF | PKGPART [ , PKGPART ... ]
2040 Suspends all unsuspended packages (see L<FS::cust_pkg>) matching the listed
2041 PKGPARTs (see L<FS::part_pkg>). Preferred usage is to pass a hashref instead
2042 of a list of pkgparts; the hashref has the following keys:
2046 =item pkgparts - listref of pkgparts
2048 =item (other options are passed to the suspend method)
2053 Returns a list: an empty list on success or a list of errors.
2057 sub suspend_if_pkgpart {
2059 my (@pkgparts, %opt);
2060 if (ref($_[0]) eq 'HASH'){
2061 @pkgparts = @{$_[0]{pkgparts}};
2066 grep { $_->suspend(%opt) }
2067 grep { my $pkgpart = $_->pkgpart; grep { $pkgpart eq $_ } @pkgparts }
2068 $self->unsuspended_pkgs;
2071 =item suspend_unless_pkgpart HASHREF | PKGPART [ , PKGPART ... ]
2073 Suspends all unsuspended packages (see L<FS::cust_pkg>) unless they match the
2074 given PKGPARTs (see L<FS::part_pkg>). Preferred usage is to pass a hashref
2075 instead of a list of pkgparts; the hashref has the following keys:
2079 =item pkgparts - listref of pkgparts
2081 =item (other options are passed to the suspend method)
2085 Returns a list: an empty list on success or a list of errors.
2089 sub suspend_unless_pkgpart {
2091 my (@pkgparts, %opt);
2092 if (ref($_[0]) eq 'HASH'){
2093 @pkgparts = @{$_[0]{pkgparts}};
2098 grep { $_->suspend(%opt) }
2099 grep { my $pkgpart = $_->pkgpart; ! grep { $pkgpart eq $_ } @pkgparts }
2100 $self->unsuspended_pkgs;
2103 =item cancel [ OPTION => VALUE ... ]
2105 Cancels all uncancelled packages (see L<FS::cust_pkg>) for this customer.
2107 Available options are:
2111 =item quiet - can be set true to supress email cancellation notices.
2113 =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.
2115 =item ban - can be set true to ban this customer's credit card or ACH information, if present.
2119 Always returns a list: an empty list on success or a list of errors.
2124 my( $self, %opt ) = @_;
2126 warn "$me cancel called on customer ". $self->custnum. " with options ".
2127 join(', ', map { "$_: $opt{$_}" } keys %opt ). "\n"
2130 return ( 'access denied' )
2131 unless $FS::CurrentUser::CurrentUser->access_right('Cancel customer');
2133 if ( $opt{'ban'} && $self->payby =~ /^(CARD|DCRD|CHEK|DCHK)$/ ) {
2135 #should try decryption (we might have the private key)
2136 # and if not maybe queue a job for the server that does?
2137 return ( "Can't (yet) ban encrypted credit cards" )
2138 if $self->is_encrypted($self->payinfo);
2140 my $ban = new FS::banned_pay $self->_banned_pay_hashref;
2141 my $error = $ban->insert;
2142 return ( $error ) if $error;
2146 my @pkgs = $self->ncancelled_pkgs;
2148 warn "$me cancelling ". scalar($self->ncancelled_pkgs). "/".
2149 scalar(@pkgs). " packages for customer ". $self->custnum. "\n"
2152 grep { $_ } map { $_->cancel(%opt) } $self->ncancelled_pkgs;
2155 sub _banned_pay_hashref {
2166 'payby' => $payby2ban{$self->payby},
2167 'payinfo' => md5_base64($self->payinfo),
2168 #don't ever *search* on reason! #'reason' =>
2174 Returns all notes (see L<FS::cust_main_note>) for this customer.
2181 qsearch( 'cust_main_note',
2182 { 'custnum' => $self->custnum },
2184 'ORDER BY _DATE DESC'
2190 Returns the agent (see L<FS::agent>) for this customer.
2196 qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
2199 =item bill_and_collect
2201 Cancels and suspends any packages due, generates bills, applies payments and
2204 Warns on errors (Does not currently: If there is an error, returns the error, otherwise returns false.)
2206 Options are passed as name-value pairs. Currently available options are:
2212 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:
2216 $cust_main->bill( 'time' => str2time('April 20th, 2001') );
2220 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.
2224 "1d" for the traditional, daily events (the default), or "1m" for the new monthly events (part_event.check_freq)
2228 If set true, re-charges setup fees.
2232 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)
2238 sub bill_and_collect {
2239 my( $self, %options ) = @_;
2241 #$options{actual_time} not $options{time} because freeside-daily -d is for
2242 #pre-printing invoices
2243 $self->cancel_expired_pkgs( $options{actual_time} );
2244 $self->suspend_adjourned_pkgs( $options{actual_time} );
2246 my $error = $self->bill( %options );
2247 warn "Error billing, custnum ". $self->custnum. ": $error" if $error;
2249 $self->apply_payments_and_credits;
2251 unless ( $conf->exists('cancelled_cust-noevents')
2252 && ! $self->num_ncancelled_pkgs
2255 $error = $self->collect( %options );
2256 warn "Error collecting, custnum". $self->custnum. ": $error" if $error;
2262 sub cancel_expired_pkgs {
2263 my ( $self, $time ) = @_;
2265 my @cancel_pkgs = grep { $_->expire && $_->expire <= $time }
2266 $self->ncancelled_pkgs;
2268 foreach my $cust_pkg ( @cancel_pkgs ) {
2269 my $cpr = $cust_pkg->last_cust_pkg_reason('expire');
2270 my $error = $cust_pkg->cancel($cpr ? ( 'reason' => $cpr->reasonnum,
2271 'reason_otaker' => $cpr->otaker
2275 warn "Error cancelling expired pkg ". $cust_pkg->pkgnum.
2276 " for custnum ". $self->custnum. ": $error"
2282 sub suspend_adjourned_pkgs {
2283 my ( $self, $time ) = @_;
2287 && ( ( $_->part_pkg->is_prepaid
2292 && $_->adjourn <= $time
2296 $self->ncancelled_pkgs;
2298 foreach my $cust_pkg ( @susp_pkgs ) {
2299 my $cpr = $cust_pkg->last_cust_pkg_reason('adjourn')
2300 if ($cust_pkg->adjourn && $cust_pkg->adjourn < $^T);
2301 my $error = $cust_pkg->suspend($cpr ? ( 'reason' => $cpr->reasonnum,
2302 'reason_otaker' => $cpr->otaker
2307 warn "Error suspending package ". $cust_pkg->pkgnum.
2308 " for custnum ". $self->custnum. ": $error"
2316 Generates invoices (see L<FS::cust_bill>) for this customer. Usually used in
2317 conjunction with the collect method by calling B<bill_and_collect>.
2319 If there is an error, returns the error, otherwise returns false.
2321 Options are passed as name-value pairs. Currently available options are:
2327 If set true, re-charges setup fees.
2331 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:
2335 $cust_main->bill( 'time' => str2time('April 20th, 2001') );
2339 An array ref of specific packages (objects) to attempt billing, instead trying all of them.
2341 $cust_main->bill( pkg_list => [$pkg1, $pkg2] );
2345 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.
2352 my( $self, %options ) = @_;
2353 return '' if $self->payby eq 'COMP';
2354 warn "$me bill customer ". $self->custnum. "\n"
2357 my $time = $options{'time'} || time;
2358 my $invoice_time = $options{'invoice_time'} || $time;
2361 local $SIG{HUP} = 'IGNORE';
2362 local $SIG{INT} = 'IGNORE';
2363 local $SIG{QUIT} = 'IGNORE';
2364 local $SIG{TERM} = 'IGNORE';
2365 local $SIG{TSTP} = 'IGNORE';
2366 local $SIG{PIPE} = 'IGNORE';
2368 my $oldAutoCommit = $FS::UID::AutoCommit;
2369 local $FS::UID::AutoCommit = 0;
2372 $self->select_for_update; #mutex
2374 my @cust_bill_pkg = ();
2377 # find the packages which are due for billing, find out how much they are
2378 # & generate invoice database.
2381 my( $total_setup, $total_recur, $postal_charge ) = ( 0, 0, 0 );
2383 my @precommit_hooks = ();
2385 my @cust_pkgs = qsearch('cust_pkg', { 'custnum' => $self->custnum } );
2386 foreach my $cust_pkg (@cust_pkgs) {
2388 #NO!! next if $cust_pkg->cancel;
2389 next if $cust_pkg->getfield('cancel');
2391 warn " bill package ". $cust_pkg->pkgnum. "\n" if $DEBUG > 1;
2393 #? to avoid use of uninitialized value errors... ?
2394 $cust_pkg->setfield('bill', '')
2395 unless defined($cust_pkg->bill);
2397 #my $part_pkg = $cust_pkg->part_pkg;
2399 my $real_pkgpart = $cust_pkg->pkgpart;
2400 my %hash = $cust_pkg->hash;
2402 foreach my $part_pkg ( $cust_pkg->part_pkg->self_and_bill_linked ) {
2404 $cust_pkg->set($_, $hash{$_}) foreach qw ( setup last_bill bill );
2407 $self->_make_lines( 'part_pkg' => $part_pkg,
2408 'cust_pkg' => $cust_pkg,
2409 'precommit_hooks' => \@precommit_hooks,
2410 'line_items' => \@cust_bill_pkg,
2411 'setup' => \$total_setup,
2412 'recur' => \$total_recur,
2413 'tax_matrix' => \%taxlisthash,
2415 'options' => \%options,
2418 $dbh->rollback if $oldAutoCommit;
2422 } #foreach my $part_pkg
2424 } #foreach my $cust_pkg
2426 unless ( @cust_bill_pkg ) { #don't create an invoice w/o line items
2427 #but do commit any package date cycling that happened
2428 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2432 if ( scalar( grep { $_->recur && $_->recur > 0 } @cust_bill_pkg) ||
2433 !$conf->exists('postal_invoice-recurring_only')
2437 my $postal_pkg = $self->charge_postal_fee();
2438 if ( $postal_pkg && !ref( $postal_pkg ) ) {
2440 $dbh->rollback if $oldAutoCommit;
2441 return "can't charge postal invoice fee for customer ".
2442 $self->custnum. ": $postal_pkg";
2444 } elsif ( $postal_pkg ) {
2446 foreach my $part_pkg ( $postal_pkg->part_pkg->self_and_bill_linked ) {
2448 $self->_make_lines( 'part_pkg' => $part_pkg,
2449 'cust_pkg' => $postal_pkg,
2450 'precommit_hooks' => \@precommit_hooks,
2451 'line_items' => \@cust_bill_pkg,
2452 'setup' => \$total_setup,
2453 'recur' => \$total_recur,
2454 'tax_matrix' => \%taxlisthash,
2456 'options' => \%options,
2459 $dbh->rollback if $oldAutoCommit;
2468 warn "having a look at the taxes we found...\n" if $DEBUG > 2;
2470 # keys are tax names (as printed on invoices / itemdesc )
2471 # values are listrefs of taxlisthash keys (internal identifiers)
2474 # keys are taxlisthash keys (internal identifiers)
2475 # values are (cumulative) amounts
2478 # keys are taxlisthash keys (internal identifiers)
2479 # values are listrefs of cust_bill_pkg_tax_location hashrefs
2480 my %tax_location = ();
2482 # keys are taxlisthash keys (internal identifiers)
2483 # values are listrefs of cust_bill_pkg_tax_rate_location hashrefs
2484 my %tax_rate_location = ();
2486 foreach my $tax ( keys %taxlisthash ) {
2487 my $tax_object = shift @{ $taxlisthash{$tax} };
2488 warn "found ". $tax_object->taxname. " as $tax\n" if $DEBUG > 2;
2489 warn " ". join('/', @{ $taxlisthash{$tax} } ). "\n" if $DEBUG > 2;
2490 my $hashref_or_error =
2491 $tax_object->taxline( $taxlisthash{$tax},
2492 'custnum' => $self->custnum,
2493 'invoice_time' => $invoice_time
2495 unless ( ref($hashref_or_error) ) {
2496 $dbh->rollback if $oldAutoCommit;
2497 return $hashref_or_error;
2499 unshift @{ $taxlisthash{$tax} }, $tax_object;
2501 my $name = $hashref_or_error->{'name'};
2502 my $amount = $hashref_or_error->{'amount'};
2504 #warn "adding $amount as $name\n";
2505 $taxname{ $name } ||= [];
2506 push @{ $taxname{ $name } }, $tax;
2508 $tax{ $tax } += $amount;
2510 $tax_location{ $tax } ||= [];
2511 if ( $tax_object->get('pkgnum') || $tax_object->get('locationnum') ) {
2512 push @{ $tax_location{ $tax } },
2514 'taxnum' => $tax_object->taxnum,
2515 'taxtype' => ref($tax_object),
2516 'pkgnum' => $tax_object->get('pkgnum'),
2517 'locationnum' => $tax_object->get('locationnum'),
2518 'amount' => sprintf('%.2f', $amount ),
2522 $tax_rate_location{ $tax } ||= [];
2523 if ( ref($tax_object) eq 'FS::tax_rate' ) {
2524 my $taxratelocationnum =
2525 $tax_object->tax_rate_location->taxratelocationnum;
2526 push @{ $tax_rate_location{ $tax } },
2528 'taxnum' => $tax_object->taxnum,
2529 'taxtype' => ref($tax_object),
2530 'amount' => sprintf('%.2f', $amount ),
2531 'locationtaxid' => $tax_object->location,
2532 'taxratelocationnum' => $taxratelocationnum,
2538 #move the cust_tax_exempt_pkg records to the cust_bill_pkgs we will commit
2539 my %packagemap = map { $_->pkgnum => $_ } @cust_bill_pkg;
2540 foreach my $tax ( keys %taxlisthash ) {
2541 foreach ( @{ $taxlisthash{$tax} }[1 ... scalar(@{ $taxlisthash{$tax} })] ) {
2542 next unless ref($_) eq 'FS::cust_bill_pkg';
2544 push @{ $packagemap{$_->pkgnum}->_cust_tax_exempt_pkg },
2545 splice( @{ $_->_cust_tax_exempt_pkg } );
2549 #consolidate and create tax line items
2550 warn "consolidating and generating...\n" if $DEBUG > 2;
2551 foreach my $taxname ( keys %taxname ) {
2554 my @cust_bill_pkg_tax_location = ();
2555 my @cust_bill_pkg_tax_rate_location = ();
2556 warn "adding $taxname\n" if $DEBUG > 1;
2557 foreach my $taxitem ( @{ $taxname{$taxname} } ) {
2558 next if $seen{$taxitem}++;
2559 warn "adding $tax{$taxitem}\n" if $DEBUG > 1;
2560 $tax += $tax{$taxitem};
2561 push @cust_bill_pkg_tax_location,
2562 map { new FS::cust_bill_pkg_tax_location $_ }
2563 @{ $tax_location{ $taxitem } };
2564 push @cust_bill_pkg_tax_rate_location,
2565 map { new FS::cust_bill_pkg_tax_rate_location $_ }
2566 @{ $tax_rate_location{ $taxitem } };
2570 $tax = sprintf('%.2f', $tax );
2571 $total_setup = sprintf('%.2f', $total_setup+$tax );
2573 push @cust_bill_pkg, new FS::cust_bill_pkg {
2579 'itemdesc' => $taxname,
2580 'cust_bill_pkg_tax_location' => \@cust_bill_pkg_tax_location,
2581 'cust_bill_pkg_tax_rate_location' => \@cust_bill_pkg_tax_rate_location,
2586 my $charged = sprintf('%.2f', $total_setup + $total_recur );
2588 #create the new invoice
2589 my $cust_bill = new FS::cust_bill ( {
2590 'custnum' => $self->custnum,
2591 '_date' => ( $invoice_time ),
2592 'charged' => $charged,
2594 my $error = $cust_bill->insert;
2596 $dbh->rollback if $oldAutoCommit;
2597 return "can't create invoice for customer #". $self->custnum. ": $error";
2600 foreach my $cust_bill_pkg ( @cust_bill_pkg ) {
2601 $cust_bill_pkg->invnum($cust_bill->invnum);
2602 my $error = $cust_bill_pkg->insert;
2604 $dbh->rollback if $oldAutoCommit;
2605 return "can't create invoice line item: $error";
2610 foreach my $hook ( @precommit_hooks ) {
2612 &{$hook}; #($self) ?
2615 $dbh->rollback if $oldAutoCommit;
2616 return "$@ running precommit hook $hook\n";
2620 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2626 my ($self, %params) = @_;
2628 my $part_pkg = $params{part_pkg} or die "no part_pkg specified";
2629 my $cust_pkg = $params{cust_pkg} or die "no cust_pkg specified";
2630 my $precommit_hooks = $params{precommit_hooks} or die "no package specified";
2631 my $cust_bill_pkgs = $params{line_items} or die "no line buffer specified";
2632 my $total_setup = $params{setup} or die "no setup accumulator specified";
2633 my $total_recur = $params{recur} or die "no recur accumulator specified";
2634 my $taxlisthash = $params{tax_matrix} or die "no tax accumulator specified";
2635 my $time = $params{'time'} or die "no time specified";
2636 my (%options) = %{$params{options}};
2639 my $real_pkgpart = $cust_pkg->pkgpart;
2640 my %hash = $cust_pkg->hash;
2641 my $old_cust_pkg = new FS::cust_pkg \%hash;
2647 $cust_pkg->pkgpart($part_pkg->pkgpart);
2655 if ( ! $cust_pkg->setup &&
2657 ( $conf->exists('disable_setup_suspended_pkgs') &&
2658 ! $cust_pkg->getfield('susp')
2659 ) || ! $conf->exists('disable_setup_suspended_pkgs')
2661 || $options{'resetup'}
2664 warn " bill setup\n" if $DEBUG > 1;
2667 $setup = eval { $cust_pkg->calc_setup( $time, \@details ) };
2668 return "$@ running calc_setup for $cust_pkg\n"
2671 $unitsetup = $cust_pkg->part_pkg->unit_setup || $setup; #XXX uuh
2673 $cust_pkg->setfield('setup', $time)
2674 unless $cust_pkg->setup;
2675 #do need it, but it won't get written to the db
2676 #|| $cust_pkg->pkgpart != $real_pkgpart;
2681 # bill recurring fee
2684 #XXX unit stuff here too
2688 if ( ! $cust_pkg->getfield('susp') and
2689 ( $part_pkg->getfield('freq') ne '0' &&
2690 ( $cust_pkg->getfield('bill') || 0 ) <= $time
2692 || ( $part_pkg->plan eq 'voip_cdr'
2693 && $part_pkg->option('bill_every_call')
2697 # XXX should this be a package event? probably. events are called
2698 # at collection time at the moment, though...
2699 $part_pkg->reset_usage($cust_pkg, 'debug'=>$DEBUG)
2700 if $part_pkg->can('reset_usage');
2701 #don't want to reset usage just cause we want a line item??
2702 #&& $part_pkg->pkgpart == $real_pkgpart;
2704 warn " bill recur\n" if $DEBUG > 1;
2707 # XXX shared with $recur_prog
2708 $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
2710 #over two params! lets at least switch to a hashref for the rest...
2711 my $increment_next_bill = ( $part_pkg->freq ne '0'
2712 && ( $cust_pkg->getfield('bill') || 0 ) <= $time
2714 my %param = ( 'precommit_hooks' => $precommit_hooks,
2715 'increment_next_bill' => $increment_next_bill,
2718 $recur = eval { $cust_pkg->calc_recur( \$sdate, \@details, \%param ) };
2719 return "$@ running calc_recur for $cust_pkg\n"
2722 if ( $increment_next_bill ) {
2724 my $next_bill = $part_pkg->add_freq($sdate);
2725 return "unparsable frequency: ". $part_pkg->freq
2726 if $next_bill == -1;
2728 #pro-rating magic - if $recur_prog fiddled $sdate, want to use that
2729 # only for figuring next bill date, nothing else, so, reset $sdate again
2731 $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
2732 #no need, its in $hash{last_bill}# my $last_bill = $cust_pkg->last_bill;
2733 $cust_pkg->last_bill($sdate);
2735 $cust_pkg->setfield('bill', $next_bill );
2741 warn "\$setup is undefined" unless defined($setup);
2742 warn "\$recur is undefined" unless defined($recur);
2743 warn "\$cust_pkg->bill is undefined" unless defined($cust_pkg->bill);
2746 # If there's line items, create em cust_bill_pkg records
2747 # If $cust_pkg has been modified, update it (if we're a real pkgpart)
2752 if ( $cust_pkg->modified && $cust_pkg->pkgpart == $real_pkgpart ) {
2753 # hmm.. and if just the options are modified in some weird price plan?
2755 warn " package ". $cust_pkg->pkgnum. " modified; updating\n"
2758 my $error = $cust_pkg->replace( $old_cust_pkg,
2759 'options' => { $cust_pkg->options },
2761 return "Error modifying pkgnum ". $cust_pkg->pkgnum. ": $error"
2762 if $error; #just in case
2765 $setup = sprintf( "%.2f", $setup );
2766 $recur = sprintf( "%.2f", $recur );
2767 if ( $setup < 0 && ! $conf->exists('allow_negative_charges') ) {
2768 return "negative setup $setup for pkgnum ". $cust_pkg->pkgnum;
2770 if ( $recur < 0 && ! $conf->exists('allow_negative_charges') ) {
2771 return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum;
2774 if ( $setup != 0 || $recur != 0 ) {
2776 warn " charges (setup=$setup, recur=$recur); adding line items\n"
2779 my @cust_pkg_detail = map { $_->detail } $cust_pkg->cust_pkg_detail('I');
2781 warn " adding customer package invoice detail: $_\n"
2782 foreach @cust_pkg_detail;
2784 push @details, @cust_pkg_detail;
2786 my $cust_bill_pkg = new FS::cust_bill_pkg {
2787 'pkgnum' => $cust_pkg->pkgnum,
2789 'unitsetup' => $unitsetup,
2791 'unitrecur' => $unitrecur,
2792 'quantity' => $cust_pkg->quantity,
2793 'details' => \@details,
2796 if ( $part_pkg->option('recur_temporality', 1) eq 'preceding' ) {
2797 $cust_bill_pkg->sdate( $hash{last_bill} );
2798 $cust_bill_pkg->edate( $sdate - 86399 ); #60s*60m*24h-1
2799 } else { #if ( $part_pkg->option('recur_temporality', 1) eq 'upcoming' ) {
2800 $cust_bill_pkg->sdate( $sdate );
2801 $cust_bill_pkg->edate( $cust_pkg->bill );
2804 $cust_bill_pkg->pkgpart_override($part_pkg->pkgpart)
2805 unless $part_pkg->pkgpart == $real_pkgpart;
2807 $$total_setup += $setup;
2808 $$total_recur += $recur;
2815 $self->_handle_taxes($part_pkg, $taxlisthash, $cust_bill_pkg, $cust_pkg, $options{invoice_time});
2816 return $error if $error;
2818 push @$cust_bill_pkgs, $cust_bill_pkg;
2820 } #if $setup != 0 || $recur != 0
2830 my $part_pkg = shift;
2831 my $taxlisthash = shift;
2832 my $cust_bill_pkg = shift;
2833 my $cust_pkg = shift;
2834 my $invoice_time = 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 my %localtaxlisthash = ();
2944 foreach my $tax ( @taxes ) {
2946 my $taxname = ref( $tax ). ' '. $tax->taxnum;
2947 # $taxname .= ' pkgnum'. $cust_pkg->pkgnum.
2948 # ' locationnum'. $cust_pkg->locationnum
2949 # if $conf->exists('tax-pkg_address') && $cust_pkg->locationnum;
2951 $taxlisthash->{ $taxname } ||= [ $tax ];
2952 push @{ $taxlisthash->{ $taxname } }, $tax_cust_bill_pkg;
2954 $localtaxlisthash{ $taxname } ||= [ $tax ];
2955 push @{ $localtaxlisthash{ $taxname } }, $tax_cust_bill_pkg;
2959 warn "finding taxed taxes...\n" if $DEBUG > 2;
2960 foreach my $tax ( keys %localtaxlisthash ) {
2961 my $tax_object = shift @{ $localtaxlisthash{$tax} };
2962 warn "found possible taxed tax ". $tax_object->taxname. " we call $tax\n"
2964 next unless $tax_object->can('tax_on_tax');
2966 foreach my $tot ( $tax_object->tax_on_tax( $self ) ) {
2967 my $totname = ref( $tot ). ' '. $tot->taxnum;
2969 warn "checking $totname which we call ". $tot->taxname. " as applicable\n"
2971 next unless exists( $localtaxlisthash{ $totname } ); # only increase
2973 warn "adding $totname to taxed taxes\n" if $DEBUG > 2;
2974 my $hashref_or_error =
2975 $tax_object->taxline( $localtaxlisthash{$tax},
2976 'custnum' => $self->custnum,
2977 'invoice_time' => $invoice_time,
2979 return $hashref_or_error
2980 unless ref($hashref_or_error);
2982 $taxlisthash->{ $totname } ||= [ $tot ];
2983 push @{ $taxlisthash->{ $totname } }, $hashref_or_error->{amount};
2995 my $part_pkg = shift;
2999 my $geocode = $self->geocode('cch');
3001 my @taxclassnums = map { $_->taxclassnum }
3002 $part_pkg->part_pkg_taxoverride($class);
3004 unless (@taxclassnums) {
3005 @taxclassnums = map { $_->taxclassnum }
3006 $part_pkg->part_pkg_taxrate('cch', $geocode, $class);
3008 warn "Found taxclassnum values of ". join(',', @taxclassnums)
3013 join(' OR ', map { "taxclassnum = $_" } @taxclassnums ). ")";
3015 @taxes = qsearch({ 'table' => 'tax_rate',
3016 'hashref' => { 'geocode' => $geocode, },
3017 'extra_sql' => $extra_sql,
3019 if scalar(@taxclassnums);
3021 warn "Found taxes ".
3022 join(',', map{ ref($_). " ". $_->get($_->primary_key) } @taxes). "\n"
3029 =item collect OPTIONS
3031 (Attempt to) collect money for this customer's outstanding invoices (see
3032 L<FS::cust_bill>). Usually used after the bill method.
3034 Actions are now triggered by billing events; see L<FS::part_event> and the
3035 billing events web interface. Old-style invoice events (see
3036 L<FS::part_bill_event>) have been deprecated.
3038 If there is an error, returns the error, otherwise returns false.
3040 Options are passed as name-value pairs.
3042 Currently available options are:
3048 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.
3052 Retry card/echeck/LEC transactions even when not scheduled by invoice events.
3056 set true to surpress email card/ACH decline notices.
3060 "1d" for the traditional, daily events (the default), or "1m" for the new monthly events (part_event.check_freq)
3064 allows for one time override of normal customer billing method
3068 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)
3076 my( $self, %options ) = @_;
3077 my $invoice_time = $options{'invoice_time'} || time;
3080 local $SIG{HUP} = 'IGNORE';
3081 local $SIG{INT} = 'IGNORE';
3082 local $SIG{QUIT} = 'IGNORE';
3083 local $SIG{TERM} = 'IGNORE';
3084 local $SIG{TSTP} = 'IGNORE';
3085 local $SIG{PIPE} = 'IGNORE';
3087 my $oldAutoCommit = $FS::UID::AutoCommit;
3088 local $FS::UID::AutoCommit = 0;
3091 $self->select_for_update; #mutex
3094 my $balance = $self->balance;
3095 warn "$me collect customer ". $self->custnum. ": balance $balance\n"
3098 if ( exists($options{'retry_card'}) ) {
3099 carp 'retry_card option passed to collect is deprecated; use retry';
3100 $options{'retry'} ||= $options{'retry_card'};
3102 if ( exists($options{'retry'}) && $options{'retry'} ) {
3103 my $error = $self->retry_realtime;
3105 $dbh->rollback if $oldAutoCommit;
3110 # false laziness w/pay_batch::import_results
3112 my $due_cust_event = $self->due_cust_event(
3113 'debug' => ( $options{'debug'} || 0 ),
3114 'time' => $invoice_time,
3115 'check_freq' => $options{'check_freq'},
3117 unless( ref($due_cust_event) ) {
3118 $dbh->rollback if $oldAutoCommit;
3119 return $due_cust_event;
3122 foreach my $cust_event ( @$due_cust_event ) {
3126 #re-eval event conditions (a previous event could have changed things)
3127 unless ( $cust_event->test_conditions( 'time' => $invoice_time ) ) {
3128 #don't leave stray "new/locked" records around
3129 my $error = $cust_event->delete;
3131 #gah, even with transactions
3132 $dbh->commit if $oldAutoCommit; #well.
3139 local $realtime_bop_decline_quiet = 1 if $options{'quiet'};
3140 warn " running cust_event ". $cust_event->eventnum. "\n"
3144 #if ( my $error = $cust_event->do_event(%options) ) { #XXX %options?
3145 if ( my $error = $cust_event->do_event() ) {
3146 #XXX wtf is this? figure out a proper dealio with return value
3148 # gah, even with transactions.
3149 $dbh->commit if $oldAutoCommit; #well.
3156 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3161 =item due_cust_event [ HASHREF | OPTION => VALUE ... ]
3163 Inserts database records for and returns an ordered listref of new events due
3164 for this customer, as FS::cust_event objects (see L<FS::cust_event>). If no
3165 events are due, an empty listref is returned. If there is an error, returns a
3166 scalar error message.
3168 To actually run the events, call each event's test_condition method, and if
3169 still true, call the event's do_event method.
3171 Options are passed as a hashref or as a list of name-value pairs. Available
3178 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.
3182 "Current time" for the events.
3186 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)
3190 Only return events for the specified eventtable (by default, events of all eventtables are returned)
3194 Explicitly pass the objects to be tested (typically used with eventtable).
3198 Set to true to return the objects, but not actually insert them into the
3205 sub due_cust_event {
3207 my %opt = ref($_[0]) ? %{ $_[0] } : @_;
3210 #my $DEBUG = $opt{'debug'}
3211 local($DEBUG) = $opt{'debug'}
3212 if defined($opt{'debug'}) && $opt{'debug'} > $DEBUG;
3214 warn "$me due_cust_event called with options ".
3215 join(', ', map { "$_: $opt{$_}" } keys %opt). "\n"
3218 $opt{'time'} ||= time;
3220 local $SIG{HUP} = 'IGNORE';
3221 local $SIG{INT} = 'IGNORE';
3222 local $SIG{QUIT} = 'IGNORE';
3223 local $SIG{TERM} = 'IGNORE';
3224 local $SIG{TSTP} = 'IGNORE';
3225 local $SIG{PIPE} = 'IGNORE';
3227 my $oldAutoCommit = $FS::UID::AutoCommit;
3228 local $FS::UID::AutoCommit = 0;
3231 $self->select_for_update #mutex
3232 unless $opt{testonly};
3235 # 1: find possible events (initial search)
3238 my @cust_event = ();
3240 my @eventtable = $opt{'eventtable'}
3241 ? ( $opt{'eventtable'} )
3242 : FS::part_event->eventtables_runorder;
3244 foreach my $eventtable ( @eventtable ) {
3247 if ( $opt{'objects'} ) {
3249 @objects = @{ $opt{'objects'} };
3253 #my @objects = $self->eventtable(); # sub cust_main { @{ [ $self ] }; }
3254 @objects = ( $eventtable eq 'cust_main' )
3256 : ( $self->$eventtable() );
3260 my @e_cust_event = ();
3262 my $cross = "CROSS JOIN $eventtable";
3263 $cross .= ' LEFT JOIN cust_main USING ( custnum )'
3264 unless $eventtable eq 'cust_main';
3266 foreach my $object ( @objects ) {
3268 #this first search uses the condition_sql magic for optimization.
3269 #the more possible events we can eliminate in this step the better
3271 my $cross_where = '';
3272 my $pkey = $object->primary_key;
3273 $cross_where = "$eventtable.$pkey = ". $object->$pkey();
3275 my $join = FS::part_event_condition->join_conditions_sql( $eventtable );
3277 FS::part_event_condition->where_conditions_sql( $eventtable,
3278 'time'=>$opt{'time'}
3280 my $order = FS::part_event_condition->order_conditions_sql( $eventtable );
3282 $extra_sql = "AND $extra_sql" if $extra_sql;
3284 #here is the agent virtualization
3285 $extra_sql .= " AND ( part_event.agentnum IS NULL
3286 OR part_event.agentnum = ". $self->agentnum. ' )';
3288 $extra_sql .= " $order";
3290 warn "searching for events for $eventtable ". $object->$pkey. "\n"
3291 if $opt{'debug'} > 2;
3292 my @part_event = qsearch( {
3293 'debug' => ( $opt{'debug'} > 3 ? 1 : 0 ),
3294 'select' => 'part_event.*',
3295 'table' => 'part_event',
3296 'addl_from' => "$cross $join",
3297 'hashref' => { 'check_freq' => ( $opt{'check_freq'} || '1d' ),
3298 'eventtable' => $eventtable,
3301 'extra_sql' => "AND $cross_where $extra_sql",
3305 my $pkey = $object->primary_key;
3306 warn " ". scalar(@part_event).
3307 " possible events found for $eventtable ". $object->$pkey(). "\n";
3310 push @e_cust_event, map { $_->new_cust_event($object) } @part_event;
3314 warn " ". scalar(@e_cust_event).
3315 " subtotal possible cust events found for $eventtable\n"
3318 push @cust_event, @e_cust_event;
3322 warn " ". scalar(@cust_event).
3323 " total possible cust events found in initial search\n"
3327 # 2: test conditions
3332 @cust_event = grep $_->test_conditions( 'time' => $opt{'time'},
3333 'stats_hashref' => \%unsat ),
3336 warn " ". scalar(@cust_event). " cust events left satisfying conditions\n"
3339 warn " invalid conditions not eliminated with condition_sql:\n".
3340 join('', map " $_: ".$unsat{$_}."\n", keys %unsat )
3347 unless( $opt{testonly} ) {
3348 foreach my $cust_event ( @cust_event ) {
3350 my $error = $cust_event->insert();
3352 $dbh->rollback if $oldAutoCommit;
3359 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3365 warn " returning events: ". Dumper(@cust_event). "\n"
3372 =item retry_realtime
3374 Schedules realtime / batch credit card / electronic check / LEC billing
3375 events for for retry. Useful if card information has changed or manual
3376 retry is desired. The 'collect' method must be called to actually retry
3379 Implementation details: For either this customer, or for each of this
3380 customer's open invoices, changes the status of the first "done" (with
3381 statustext error) realtime processing event to "failed".
3385 sub retry_realtime {
3388 local $SIG{HUP} = 'IGNORE';
3389 local $SIG{INT} = 'IGNORE';
3390 local $SIG{QUIT} = 'IGNORE';
3391 local $SIG{TERM} = 'IGNORE';
3392 local $SIG{TSTP} = 'IGNORE';
3393 local $SIG{PIPE} = 'IGNORE';
3395 my $oldAutoCommit = $FS::UID::AutoCommit;
3396 local $FS::UID::AutoCommit = 0;
3399 #a little false laziness w/due_cust_event (not too bad, really)
3401 my $join = FS::part_event_condition->join_conditions_sql;
3402 my $order = FS::part_event_condition->order_conditions_sql;
3405 . join ( ' OR ' , map {
3406 "( part_event.eventtable = " . dbh->quote($_)
3407 . " AND tablenum IN( SELECT " . dbdef->table($_)->primary_key . " from $_ where custnum = " . dbh->quote( $self->custnum ) . "))" ;
3408 } FS::part_event->eventtables)
3411 #here is the agent virtualization
3412 my $agent_virt = " ( part_event.agentnum IS NULL
3413 OR part_event.agentnum = ". $self->agentnum. ' )';
3415 #XXX this shouldn't be hardcoded, actions should declare it...
3416 my @realtime_events = qw(
3417 cust_bill_realtime_card
3418 cust_bill_realtime_check
3419 cust_bill_realtime_lec
3423 my $is_realtime_event = ' ( '. join(' OR ', map "part_event.action = '$_'",
3428 my @cust_event = qsearchs({
3429 'table' => 'cust_event',
3430 'select' => 'cust_event.*',
3431 'addl_from' => "LEFT JOIN part_event USING ( eventpart ) $join",
3432 'hashref' => { 'status' => 'done' },
3433 'extra_sql' => " AND statustext IS NOT NULL AND statustext != '' ".
3434 " AND $mine AND $is_realtime_event AND $agent_virt $order" # LIMIT 1"
3437 my %seen_invnum = ();
3438 foreach my $cust_event (@cust_event) {
3440 #max one for the customer, one for each open invoice
3441 my $cust_X = $cust_event->cust_X;
3442 next if $seen_invnum{ $cust_event->part_event->eventtable eq 'cust_bill'
3446 or $cust_event->part_event->eventtable eq 'cust_bill'
3449 my $error = $cust_event->retry;
3451 $dbh->rollback if $oldAutoCommit;
3452 return "error scheduling event for retry: $error";
3457 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3462 # some horrid false laziness here to avoid refactor fallout
3463 # eventually realtime realtime_bop and realtime_refund_bop should go
3464 # away and be replaced by _new_realtime_bop and _new_realtime_refund_bop
3466 =item realtime_bop METHOD AMOUNT [ OPTION => VALUE ... ]
3468 Runs a realtime credit card, ACH (electronic check) or phone bill transaction
3469 via a Business::OnlinePayment realtime gateway. See
3470 L<http://420.am/business-onlinepayment> for supported gateways.
3472 Available methods are: I<CC>, I<ECHECK> and I<LEC>
3474 Available options are: I<description>, I<invnum>, I<quiet>, I<paynum_ref>, I<payunique>
3476 The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
3477 I<zip>, I<payinfo> and I<paydate> are also available. Any of these options,
3478 if set, will override the value from the customer record.
3480 I<description> is a free-text field passed to the gateway. It defaults to
3481 "Internet services".
3483 If an I<invnum> is specified, this payment (if successful) is applied to the
3484 specified invoice. If you don't specify an I<invnum> you might want to
3485 call the B<apply_payments> method.
3487 I<quiet> can be set true to surpress email decline notices.
3489 I<paynum_ref> can be set to a scalar reference. It will be filled in with the
3490 resulting paynum, if any.
3492 I<payunique> is a unique identifier for this payment.
3494 (moved from cust_bill) (probably should get realtime_{card,ach,lec} here too)
3501 return $self->_new_realtime_bop(@_)
3502 if $self->_new_bop_required();
3504 my( $method, $amount, %options ) = @_;
3506 warn "$me realtime_bop: $method $amount\n";
3507 warn " $_ => $options{$_}\n" foreach keys %options;
3510 $options{'description'} ||= 'Internet services';
3512 return $self->fake_bop($method, $amount, %options) if $options{'fake'};
3514 eval "use Business::OnlinePayment";
3517 my $payinfo = exists($options{'payinfo'})
3518 ? $options{'payinfo'}
3521 my %method2payby = (
3528 # check for banned credit card/ACH
3531 my $ban = qsearchs('banned_pay', {
3532 'payby' => $method2payby{$method},
3533 'payinfo' => md5_base64($payinfo),
3535 return "Banned credit card" if $ban;
3538 # set taxclass and trans_is_recur based on invnum if there is one
3542 my $trans_is_recur = 0;
3543 if ( $options{'invnum'} ) {
3545 my $cust_bill = qsearchs('cust_bill', { 'invnum' => $options{'invnum'} } );
3546 die "invnum ". $options{'invnum'}. " not found" unless $cust_bill;
3549 map { $_->part_pkg }
3551 map { $_->cust_pkg }
3552 $cust_bill->cust_bill_pkg;
3554 my @taxclasses = map $_->taxclass, @part_pkg;
3555 $taxclass = $taxclasses[0]
3556 unless grep { $taxclasses[0] ne $_ } @taxclasses; #unless there are
3557 #different taxclasses
3559 if grep { $_->freq ne '0' } @part_pkg;
3567 #look for an agent gateway override first
3569 if ( $method eq 'CC' ) {
3570 $cardtype = cardtype($payinfo);
3571 } elsif ( $method eq 'ECHECK' ) {
3574 $cardtype = $method;
3578 qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
3579 cardtype => $cardtype,
3580 taxclass => $taxclass, } )
3581 || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
3583 taxclass => $taxclass, } )
3584 || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
3585 cardtype => $cardtype,
3587 || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
3589 taxclass => '', } );
3591 my $payment_gateway = '';
3592 my( $processor, $login, $password, $action, @bop_options );
3593 if ( $override ) { #use a payment gateway override
3595 $payment_gateway = $override->payment_gateway;
3597 $processor = $payment_gateway->gateway_module;
3598 $login = $payment_gateway->gateway_username;
3599 $password = $payment_gateway->gateway_password;
3600 $action = $payment_gateway->gateway_action;
3601 @bop_options = $payment_gateway->options;
3603 } else { #use the standard settings from the config
3605 ( $processor, $login, $password, $action, @bop_options ) =
3606 $self->default_payment_gateway($method);
3614 my $address = exists($options{'address1'})
3615 ? $options{'address1'}
3617 my $address2 = exists($options{'address2'})
3618 ? $options{'address2'}
3620 $address .= ", ". $address2 if length($address2);
3622 my $o_payname = exists($options{'payname'})
3623 ? $options{'payname'}
3625 my($payname, $payfirst, $paylast);
3626 if ( $o_payname && $method ne 'ECHECK' ) {
3627 ($payname = $o_payname) =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
3628 or return "Illegal payname $payname";
3629 ($payfirst, $paylast) = ($1, $2);
3631 $payfirst = $self->getfield('first');
3632 $paylast = $self->getfield('last');
3633 $payname = "$payfirst $paylast";
3636 my @invoicing_list = $self->invoicing_list_emailonly;
3637 if ( $conf->exists('emailinvoiceautoalways')
3638 || $conf->exists('emailinvoiceauto') && ! @invoicing_list
3639 || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
3640 push @invoicing_list, $self->all_emails;
3643 my $email = ($conf->exists('business-onlinepayment-email-override'))
3644 ? $conf->config('business-onlinepayment-email-override')
3645 : $invoicing_list[0];
3649 my $payip = exists($options{'payip'})
3652 $content{customer_ip} = $payip
3655 $content{invoice_number} = $options{'invnum'}
3656 if exists($options{'invnum'}) && length($options{'invnum'});
3658 $content{email_customer} =
3659 ( $conf->exists('business-onlinepayment-email_customer')
3660 || $conf->exists('business-onlinepayment-email-override') );
3663 if ( $method eq 'CC' ) {
3665 $content{card_number} = $payinfo;
3666 $paydate = exists($options{'paydate'})
3667 ? $options{'paydate'}
3669 $paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
3670 $content{expiration} = "$2/$1";
3672 my $paycvv = exists($options{'paycvv'})
3673 ? $options{'paycvv'}
3675 $content{cvv2} = $paycvv
3678 my $paystart_month = exists($options{'paystart_month'})
3679 ? $options{'paystart_month'}
3680 : $self->paystart_month;
3682 my $paystart_year = exists($options{'paystart_year'})
3683 ? $options{'paystart_year'}
3684 : $self->paystart_year;
3686 $content{card_start} = "$paystart_month/$paystart_year"
3687 if $paystart_month && $paystart_year;
3689 my $payissue = exists($options{'payissue'})
3690 ? $options{'payissue'}
3692 $content{issue_number} = $payissue if $payissue;
3694 if ( $self->_bop_recurring_billing( 'payinfo' => $payinfo,
3695 'trans_is_recur' => $trans_is_recur,
3699 $content{recurring_billing} = 'YES';
3700 $content{acct_code} = 'rebill'
3701 if $conf->exists('credit_card-recurring_billing_acct_code');
3704 } elsif ( $method eq 'ECHECK' ) {
3705 ( $content{account_number}, $content{routing_code} ) =
3706 split('@', $payinfo);
3707 $content{bank_name} = $o_payname;
3708 $content{bank_state} = exists($options{'paystate'})
3709 ? $options{'paystate'}
3710 : $self->getfield('paystate');
3711 $content{account_type} = exists($options{'paytype'})
3712 ? uc($options{'paytype'}) || 'CHECKING'
3713 : uc($self->getfield('paytype')) || 'CHECKING';
3714 $content{account_name} = $payname;
3715 $content{customer_org} = $self->company ? 'B' : 'I';
3716 $content{state_id} = exists($options{'stateid'})
3717 ? $options{'stateid'}
3718 : $self->getfield('stateid');
3719 $content{state_id_state} = exists($options{'stateid_state'})
3720 ? $options{'stateid_state'}
3721 : $self->getfield('stateid_state');
3722 $content{customer_ssn} = exists($options{'ss'})
3725 } elsif ( $method eq 'LEC' ) {
3726 $content{phone} = $payinfo;
3730 # run transaction(s)
3733 my $balance = exists( $options{'balance'} )
3734 ? $options{'balance'}
3737 $self->select_for_update; #mutex ... just until we get our pending record in
3739 #the checks here are intended to catch concurrent payments
3740 #double-form-submission prevention is taken care of in cust_pay_pending::check
3743 return "The customer's balance has changed; $method transaction aborted."
3744 if $self->balance < $balance;
3745 #&& $self->balance < $amount; #might as well anyway?
3747 #also check and make sure there aren't *other* pending payments for this cust
3749 my @pending = qsearch('cust_pay_pending', {
3750 'custnum' => $self->custnum,
3751 'status' => { op=>'!=', value=>'done' }
3753 return "A payment is already being processed for this customer (".
3754 join(', ', map 'paypendingnum '. $_->paypendingnum, @pending ).
3755 "); $method transaction aborted."
3756 if scalar(@pending);
3758 #okay, good to go, if we're a duplicate, cust_pay_pending will kick us out
3760 my $cust_pay_pending = new FS::cust_pay_pending {
3761 'custnum' => $self->custnum,
3762 #'invnum' => $options{'invnum'},
3765 'payby' => $method2payby{$method},
3766 'payinfo' => $payinfo,
3767 'paydate' => $paydate,
3768 'recurring_billing' => $content{recurring_billing},
3770 'gatewaynum' => ( $payment_gateway ? $payment_gateway->gatewaynum : '' ),
3772 $cust_pay_pending->payunique( $options{payunique} )
3773 if defined($options{payunique}) && length($options{payunique});
3774 my $cpp_new_err = $cust_pay_pending->insert; #mutex lost when this is inserted
3775 return $cpp_new_err if $cpp_new_err;
3777 my( $action1, $action2 ) = split(/\s*\,\s*/, $action );
3779 my $transaction = new Business::OnlinePayment( $processor, @bop_options );
3780 $transaction->content(
3783 'password' => $password,
3784 'action' => $action1,
3785 'description' => $options{'description'},
3786 'amount' => $amount,
3787 #'invoice_number' => $options{'invnum'},
3788 'customer_id' => $self->custnum,
3789 'last_name' => $paylast,
3790 'first_name' => $payfirst,
3792 'address' => $address,
3793 'city' => ( exists($options{'city'})
3796 'state' => ( exists($options{'state'})
3799 'zip' => ( exists($options{'zip'})
3802 'country' => ( exists($options{'country'})
3803 ? $options{'country'}
3805 'referer' => 'http://cleanwhisker.420.am/', #XXX fix referer :/
3807 'phone' => $self->daytime || $self->night,
3811 $cust_pay_pending->status('pending');
3812 my $cpp_pending_err = $cust_pay_pending->replace;
3813 return $cpp_pending_err if $cpp_pending_err;
3816 my $BOP_TESTING = 0;
3817 my $BOP_TESTING_SUCCESS = 1;
3819 unless ( $BOP_TESTING ) {
3820 $transaction->submit();
3822 if ( $BOP_TESTING_SUCCESS ) {
3823 $transaction->is_success(1);
3824 $transaction->authorization('fake auth');
3826 $transaction->is_success(0);
3827 $transaction->error_message('fake failure');
3831 if ( $transaction->is_success() && $action2 ) {
3833 $cust_pay_pending->status('authorized');
3834 my $cpp_authorized_err = $cust_pay_pending->replace;
3835 return $cpp_authorized_err if $cpp_authorized_err;
3837 my $auth = $transaction->authorization;
3838 my $ordernum = $transaction->can('order_number')
3839 ? $transaction->order_number
3843 new Business::OnlinePayment( $processor, @bop_options );
3850 password => $password,
3851 order_number => $ordernum,
3853 authorization => $auth,
3854 description => $options{'description'},
3857 foreach my $field (qw( authorization_source_code returned_ACI
3858 transaction_identifier validation_code
3859 transaction_sequence_num local_transaction_date
3860 local_transaction_time AVS_result_code )) {
3861 $capture{$field} = $transaction->$field() if $transaction->can($field);
3864 $capture->content( %capture );
3868 unless ( $capture->is_success ) {
3869 my $e = "Authorization successful but capture failed, custnum #".
3870 $self->custnum. ': '. $capture->result_code.
3871 ": ". $capture->error_message;
3878 $cust_pay_pending->status($transaction->is_success() ? 'captured' : 'declined');
3879 my $cpp_captured_err = $cust_pay_pending->replace;
3880 return $cpp_captured_err if $cpp_captured_err;
3883 # remove paycvv after initial transaction
3886 #false laziness w/misc/process/payment.cgi - check both to make sure working
3888 if ( defined $self->dbdef_table->column('paycvv')
3889 && length($self->paycvv)
3890 && ! grep { $_ eq cardtype($payinfo) } $conf->config('cvv-save')
3892 my $error = $self->remove_cvv;
3894 warn "WARNING: error removing cvv: $error\n";
3902 if ( $transaction->is_success() ) {
3905 if ( $payment_gateway ) { # agent override
3906 $paybatch = $payment_gateway->gatewaynum. '-';
3909 $paybatch .= "$processor:". $transaction->authorization;
3911 $paybatch .= ':'. $transaction->order_number
3912 if $transaction->can('order_number')
3913 && length($transaction->order_number);
3915 my $cust_pay = new FS::cust_pay ( {
3916 'custnum' => $self->custnum,
3917 'invnum' => $options{'invnum'},
3920 'payby' => $method2payby{$method},
3921 'payinfo' => $payinfo,
3922 'paybatch' => $paybatch,
3923 'paydate' => $paydate,
3925 #doesn't hurt to know, even though the dup check is in cust_pay_pending now
3926 $cust_pay->payunique( $options{payunique} )
3927 if defined($options{payunique}) && length($options{payunique});
3929 my $oldAutoCommit = $FS::UID::AutoCommit;
3930 local $FS::UID::AutoCommit = 0;
3933 #start a transaction, insert the cust_pay and set cust_pay_pending.status to done in a single transction
3935 my $error = $cust_pay->insert($options{'manual'} ? ( 'manual' => 1 ) : () );
3938 $cust_pay->invnum(''); #try again with no specific invnum
3939 my $error2 = $cust_pay->insert( $options{'manual'} ?
3940 ( 'manual' => 1 ) : ()
3943 # gah. but at least we have a record of the state we had to abort in
3944 # from cust_pay_pending now.
3945 my $e = "WARNING: $method captured but payment not recorded - ".
3946 "error inserting payment ($processor): $error2".
3947 " (previously tried insert with invnum #$options{'invnum'}" .
3948 ": $error ) - pending payment saved as paypendingnum ".
3949 $cust_pay_pending->paypendingnum. "\n";
3955 if ( $options{'paynum_ref'} ) {
3956 ${ $options{'paynum_ref'} } = $cust_pay->paynum;
3959 $cust_pay_pending->status('done');
3960 $cust_pay_pending->statustext('captured');
3961 $cust_pay_pending->paynum($cust_pay->paynum);
3962 my $cpp_done_err = $cust_pay_pending->replace;
3964 if ( $cpp_done_err ) {
3966 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
3967 my $e = "WARNING: $method captured but payment not recorded - ".
3968 "error updating status for paypendingnum ".
3969 $cust_pay_pending->paypendingnum. ": $cpp_done_err \n";
3975 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3976 return ''; #no error
3982 my $perror = "$processor error: ". $transaction->error_message;
3984 unless ( $transaction->error_message ) {
3987 if ( $transaction->can('response_page') ) {
3989 'page' => ( $transaction->can('response_page')
3990 ? $transaction->response_page
3993 'code' => ( $transaction->can('response_code')
3994 ? $transaction->response_code
3997 'headers' => ( $transaction->can('response_headers')
3998 ? $transaction->response_headers
4004 "No additional debugging information available for $processor";
4007 $perror .= "No error_message returned from $processor -- ".
4008 ( ref($t_response) ? Dumper($t_response) : $t_response );
4012 if ( !$options{'quiet'} && !$realtime_bop_decline_quiet
4013 && $conf->exists('emaildecline')
4014 && grep { $_ ne 'POST' } $self->invoicing_list
4015 && ! grep { $transaction->error_message =~ /$_/ }
4016 $conf->config('emaildecline-exclude')
4018 my @templ = $conf->config('declinetemplate');
4019 my $template = new Text::Template (
4021 SOURCE => [ map "$_\n", @templ ],
4022 ) or return "($perror) can't create template: $Text::Template::ERROR";
4023 $template->compile()
4024 or return "($perror) can't compile template: $Text::Template::ERROR";
4026 my $templ_hash = { error => $transaction->error_message };
4028 my $error = send_email(
4029 'from' => $conf->config('invoice_from', $self->agentnum ),
4030 'to' => [ grep { $_ ne 'POST' } $self->invoicing_list ],
4031 'subject' => 'Your payment could not be processed',
4032 'body' => [ $template->fill_in(HASH => $templ_hash) ],
4035 $perror .= " (also received error sending decline notification: $error)"
4040 $cust_pay_pending->status('done');
4041 $cust_pay_pending->statustext("declined: $perror");
4042 my $cpp_done_err = $cust_pay_pending->replace;
4043 if ( $cpp_done_err ) {
4044 my $e = "WARNING: $method declined but pending payment not resolved - ".
4045 "error updating status for paypendingnum ".
4046 $cust_pay_pending->paypendingnum. ": $cpp_done_err \n";
4048 $perror = "$e ($perror)";
4056 sub _bop_recurring_billing {
4057 my( $self, %opt ) = @_;
4059 my $method = $conf->config('credit_card-recurring_billing_flag');
4061 if ( $method eq 'transaction_is_recur' ) {
4063 return 1 if $opt{'trans_is_recur'};
4067 my %hash = ( 'custnum' => $self->custnum,
4072 if qsearch('cust_pay', { %hash, 'payinfo' => $opt{'payinfo'} } )
4073 || qsearch('cust_pay', { %hash, 'paymask' => $self->mask_payinfo('CARD',
4084 =item realtime_refund_bop METHOD [ OPTION => VALUE ... ]
4086 Refunds a realtime credit card, ACH (electronic check) or phone bill transaction
4087 via a Business::OnlinePayment realtime gateway. See
4088 L<http://420.am/business-onlinepayment> for supported gateways.
4090 Available methods are: I<CC>, I<ECHECK> and I<LEC>
4092 Available options are: I<amount>, I<reason>, I<paynum>, I<paydate>
4094 Most gateways require a reference to an original payment transaction to refund,
4095 so you probably need to specify a I<paynum>.
4097 I<amount> defaults to the original amount of the payment if not specified.
4099 I<reason> specifies a reason for the refund.
4101 I<paydate> specifies the expiration date for a credit card overriding the
4102 value from the customer record or the payment record. Specified as yyyy-mm-dd
4104 Implementation note: If I<amount> is unspecified or equal to the amount of the
4105 orignal payment, first an attempt is made to "void" the transaction via
4106 the gateway (to cancel a not-yet settled transaction) and then if that fails,
4107 the normal attempt is made to "refund" ("credit") the transaction via the
4108 gateway is attempted.
4110 #The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
4111 #I<zip>, I<payinfo> and I<paydate> are also available. Any of these options,
4112 #if set, will override the value from the customer record.
4114 #If an I<invnum> is specified, this payment (if successful) is applied to the
4115 #specified invoice. If you don't specify an I<invnum> you might want to
4116 #call the B<apply_payments> method.
4120 #some false laziness w/realtime_bop, not enough to make it worth merging
4121 #but some useful small subs should be pulled out
4122 sub realtime_refund_bop {
4125 return $self->_new_realtime_refund_bop(@_)
4126 if $self->_new_bop_required();
4128 my( $method, %options ) = @_;
4130 warn "$me realtime_refund_bop: $method refund\n";
4131 warn " $_ => $options{$_}\n" foreach keys %options;
4134 eval "use Business::OnlinePayment";
4138 # look up the original payment and optionally a gateway for that payment
4142 my $amount = $options{'amount'};
4144 my( $processor, $login, $password, @bop_options ) ;
4145 my( $auth, $order_number ) = ( '', '', '' );
4147 if ( $options{'paynum'} ) {
4149 warn " paynum: $options{paynum}\n" if $DEBUG > 1;
4150 $cust_pay = qsearchs('cust_pay', { paynum=>$options{'paynum'} } )
4151 or return "Unknown paynum $options{'paynum'}";
4152 $amount ||= $cust_pay->paid;
4154 $cust_pay->paybatch =~ /^((\d+)\-)?(\w+):\s*([\w\-\/ ]*)(:([\w\-]+))?$/
4155 or return "Can't parse paybatch for paynum $options{'paynum'}: ".
4156 $cust_pay->paybatch;
4157 my $gatewaynum = '';
4158 ( $gatewaynum, $processor, $auth, $order_number ) = ( $2, $3, $4, $6 );
4160 if ( $gatewaynum ) { #gateway for the payment to be refunded
4162 my $payment_gateway =
4163 qsearchs('payment_gateway', { 'gatewaynum' => $gatewaynum } );
4164 die "payment gateway $gatewaynum not found"
4165 unless $payment_gateway;
4167 $processor = $payment_gateway->gateway_module;
4168 $login = $payment_gateway->gateway_username;
4169 $password = $payment_gateway->gateway_password;
4170 @bop_options = $payment_gateway->options;
4172 } else { #try the default gateway
4174 my( $conf_processor, $unused_action );
4175 ( $conf_processor, $login, $password, $unused_action, @bop_options ) =
4176 $self->default_payment_gateway($method);
4178 return "processor of payment $options{'paynum'} $processor does not".
4179 " match default processor $conf_processor"
4180 unless $processor eq $conf_processor;
4185 } else { # didn't specify a paynum, so look for agent gateway overrides
4186 # like a normal transaction
4189 if ( $method eq 'CC' ) {
4190 $cardtype = cardtype($self->payinfo);
4191 } elsif ( $method eq 'ECHECK' ) {
4194 $cardtype = $method;
4197 qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
4198 cardtype => $cardtype,
4200 || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
4202 taxclass => '', } );
4204 if ( $override ) { #use a payment gateway override
4206 my $payment_gateway = $override->payment_gateway;
4208 $processor = $payment_gateway->gateway_module;
4209 $login = $payment_gateway->gateway_username;
4210 $password = $payment_gateway->gateway_password;
4211 #$action = $payment_gateway->gateway_action;
4212 @bop_options = $payment_gateway->options;
4214 } else { #use the standard settings from the config
4217 ( $processor, $login, $password, $unused_action, @bop_options ) =
4218 $self->default_payment_gateway($method);
4223 return "neither amount nor paynum specified" unless $amount;
4228 'password' => $password,
4229 'order_number' => $order_number,
4230 'amount' => $amount,
4231 'referer' => 'http://cleanwhisker.420.am/', #XXX fix referer :/
4233 $content{authorization} = $auth
4234 if length($auth); #echeck/ACH transactions have an order # but no auth
4235 #(at least with authorize.net)
4237 my $disable_void_after;
4238 if ($conf->exists('disable_void_after')
4239 && $conf->config('disable_void_after') =~ /^(\d+)$/) {
4240 $disable_void_after = $1;
4243 #first try void if applicable
4244 if ( $cust_pay && $cust_pay->paid == $amount
4246 ( not defined($disable_void_after) )
4247 || ( time < ($cust_pay->_date + $disable_void_after ) )
4250 warn " attempting void\n" if $DEBUG > 1;
4251 my $void = new Business::OnlinePayment( $processor, @bop_options );
4252 $void->content( 'action' => 'void', %content );
4254 if ( $void->is_success ) {
4255 my $error = $cust_pay->void($options{'reason'});
4257 # gah, even with transactions.
4258 my $e = 'WARNING: Card/ACH voided but database not updated - '.
4259 "error voiding payment: $error";
4263 warn " void successful\n" if $DEBUG > 1;
4268 warn " void unsuccessful, trying refund\n"
4272 my $address = $self->address1;
4273 $address .= ", ". $self->address2 if $self->address2;
4275 my($payname, $payfirst, $paylast);
4276 if ( $self->payname && $method ne 'ECHECK' ) {
4277 $payname = $self->payname;
4278 $payname =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
4279 or return "Illegal payname $payname";
4280 ($payfirst, $paylast) = ($1, $2);
4282 $payfirst = $self->getfield('first');
4283 $paylast = $self->getfield('last');
4284 $payname = "$payfirst $paylast";
4287 my @invoicing_list = $self->invoicing_list_emailonly;
4288 if ( $conf->exists('emailinvoiceautoalways')
4289 || $conf->exists('emailinvoiceauto') && ! @invoicing_list
4290 || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
4291 push @invoicing_list, $self->all_emails;
4294 my $email = ($conf->exists('business-onlinepayment-email-override'))
4295 ? $conf->config('business-onlinepayment-email-override')
4296 : $invoicing_list[0];
4298 my $payip = exists($options{'payip'})
4301 $content{customer_ip} = $payip
4305 if ( $method eq 'CC' ) {
4308 $content{card_number} = $payinfo = $cust_pay->payinfo;
4309 (exists($options{'paydate'}) ? $options{'paydate'} : $cust_pay->paydate)
4310 =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/ &&
4311 ($content{expiration} = "$2/$1"); # where available
4313 $content{card_number} = $payinfo = $self->payinfo;
4314 (exists($options{'paydate'}) ? $options{'paydate'} : $self->paydate)
4315 =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
4316 $content{expiration} = "$2/$1";
4319 } elsif ( $method eq 'ECHECK' ) {
4322 $payinfo = $cust_pay->payinfo;
4324 $payinfo = $self->payinfo;
4326 ( $content{account_number}, $content{routing_code} )= split('@', $payinfo );
4327 $content{bank_name} = $self->payname;
4328 $content{account_type} = 'CHECKING';
4329 $content{account_name} = $payname;
4330 $content{customer_org} = $self->company ? 'B' : 'I';
4331 $content{customer_ssn} = $self->ss;
4332 } elsif ( $method eq 'LEC' ) {
4333 $content{phone} = $payinfo = $self->payinfo;
4337 my $refund = new Business::OnlinePayment( $processor, @bop_options );
4338 my %sub_content = $refund->content(
4339 'action' => 'credit',
4340 'customer_id' => $self->custnum,
4341 'last_name' => $paylast,
4342 'first_name' => $payfirst,
4344 'address' => $address,
4345 'city' => $self->city,
4346 'state' => $self->state,
4347 'zip' => $self->zip,
4348 'country' => $self->country,
4350 'phone' => $self->daytime || $self->night,
4353 warn join('', map { " $_ => $sub_content{$_}\n" } keys %sub_content )
4357 return "$processor error: ". $refund->error_message
4358 unless $refund->is_success();
4360 my %method2payby = (
4366 my $paybatch = "$processor:". $refund->authorization;
4367 $paybatch .= ':'. $refund->order_number
4368 if $refund->can('order_number') && $refund->order_number;
4370 while ( $cust_pay && $cust_pay->unapplied < $amount ) {
4371 my @cust_bill_pay = $cust_pay->cust_bill_pay;
4372 last unless @cust_bill_pay;
4373 my $cust_bill_pay = pop @cust_bill_pay;
4374 my $error = $cust_bill_pay->delete;
4378 my $cust_refund = new FS::cust_refund ( {
4379 'custnum' => $self->custnum,
4380 'paynum' => $options{'paynum'},
4381 'refund' => $amount,
4383 'payby' => $method2payby{$method},
4384 'payinfo' => $payinfo,
4385 'paybatch' => $paybatch,
4386 'reason' => $options{'reason'} || 'card or ACH refund',
4388 my $error = $cust_refund->insert;
4390 $cust_refund->paynum(''); #try again with no specific paynum
4391 my $error2 = $cust_refund->insert;
4393 # gah, even with transactions.
4394 my $e = 'WARNING: Card/ACH refunded but database not updated - '.
4395 "error inserting refund ($processor): $error2".
4396 " (previously tried insert with paynum #$options{'paynum'}" .
4407 # does the configuration indicate the new bop routines are required?
4409 sub _new_bop_required {
4412 my $botpp = 'Business::OnlineThirdPartyPayment';
4415 if ( $conf->config('business-onlinepayment-namespace') eq $botpp ||
4416 scalar( grep { $_->gateway_namespace eq $botpp }
4417 qsearch( 'payment_gateway', { 'disabled' => '' } )
4426 =item realtime_collect [ OPTION => VALUE ... ]
4428 Runs a realtime credit card, ACH (electronic check) or phone bill transaction
4429 via a Business::OnlinePayment or Business::OnlineThirdPartyPayment realtime
4430 gateway. See L<http://420.am/business-onlinepayment> and
4431 L<http://420.am/business-onlinethirdpartypayment> for supported gateways.
4433 On failure returns an error message.
4435 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.
4437 Available options are: I<method>, I<amount>, I<description>, I<invnum>, I<quiet>, I<paynum_ref>, I<payunique>, I<session_id>
4439 I<method> is one of: I<CC>, I<ECHECK> and I<LEC>. If none is specified
4440 then it is deduced from the customer record.
4442 If no I<amount> is specified, then the customer balance is used.
4444 The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
4445 I<zip>, I<payinfo> and I<paydate> are also available. Any of these options,
4446 if set, will override the value from the customer record.
4448 I<description> is a free-text field passed to the gateway. It defaults to
4449 "Internet services".
4451 If an I<invnum> is specified, this payment (if successful) is applied to the
4452 specified invoice. If you don't specify an I<invnum> you might want to
4453 call the B<apply_payments> method.
4455 I<quiet> can be set true to surpress email decline notices.
4457 I<paynum_ref> can be set to a scalar reference. It will be filled in with the
4458 resulting paynum, if any.
4460 I<payunique> is a unique identifier for this payment.
4462 I<session_id> is a session identifier associated with this payment.
4464 I<depend_jobnum> allows payment capture to unlock export jobs
4468 sub realtime_collect {
4469 my( $self, %options ) = @_;
4472 warn "$me realtime_collect:\n";
4473 warn " $_ => $options{$_}\n" foreach keys %options;
4476 $options{amount} = $self->balance unless exists( $options{amount} );
4477 $options{method} = FS::payby->payby2bop($self->payby)
4478 unless exists( $options{method} );
4480 return $self->realtime_bop({%options});
4484 =item _realtime_bop { [ ARG => VALUE ... ] }
4486 Runs a realtime credit card, ACH (electronic check) or phone bill transaction
4487 via a Business::OnlinePayment realtime gateway. See
4488 L<http://420.am/business-onlinepayment> for supported gateways.
4490 Required arguments in the hashref are I<method>, and I<amount>
4492 Available methods are: I<CC>, I<ECHECK> and I<LEC>
4494 Available optional arguments are: I<description>, I<invnum>, I<quiet>, I<paynum_ref>, I<payunique>, I<session_id>
4496 The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
4497 I<zip>, I<payinfo> and I<paydate> are also available. Any of these options,
4498 if set, will override the value from the customer record.
4500 I<description> is a free-text field passed to the gateway. It defaults to
4501 "Internet services".
4503 If an I<invnum> is specified, this payment (if successful) is applied to the
4504 specified invoice. If you don't specify an I<invnum> you might want to
4505 call the B<apply_payments> method.
4507 I<quiet> can be set true to surpress email decline notices.
4509 I<paynum_ref> can be set to a scalar reference. It will be filled in with the
4510 resulting paynum, if any.
4512 I<payunique> is a unique identifier for this payment.
4514 I<session_id> is a session identifier associated with this payment.
4516 I<depend_jobnum> allows payment capture to unlock export jobs
4518 (moved from cust_bill) (probably should get realtime_{card,ach,lec} here too)
4522 # some helper routines
4523 sub _payment_gateway {
4524 my ($self, $options) = @_;
4526 $options->{payment_gateway} = $self->agent->payment_gateway( %$options )
4527 unless exists($options->{payment_gateway});
4529 $options->{payment_gateway};
4533 my ($self, $options) = @_;
4536 'login' => $options->{payment_gateway}->gateway_username,
4537 'password' => $options->{payment_gateway}->gateway_password,
4542 my ($self, $options) = @_;
4544 $options->{payment_gateway}->gatewaynum
4545 ? $options->{payment_gateway}->options
4546 : @{ $options->{payment_gateway}->get('options') };
4550 my ($self, $options) = @_;
4552 $options->{description} ||= 'Internet services';
4553 $options->{payinfo} = $self->payinfo unless exists( $options->{payinfo} );
4554 $options->{invnum} ||= '';
4555 $options->{payname} = $self->payname unless exists( $options->{payname} );
4559 my ($self, $options) = @_;
4562 $content{address} = exists($options->{'address1'})
4563 ? $options->{'address1'}
4565 my $address2 = exists($options->{'address2'})
4566 ? $options->{'address2'}
4568 $content{address} .= ", ". $address2 if length($address2);
4570 my $payip = exists($options->{'payip'}) ? $options->{'payip'} : $self->payip;
4571 $content{customer_ip} = $payip if length($payip);
4573 $content{invoice_number} = $options->{'invnum'}
4574 if exists($options->{'invnum'}) && length($options->{'invnum'});
4576 $content{email_customer} =
4577 ( $conf->exists('business-onlinepayment-email_customer')
4578 || $conf->exists('business-onlinepayment-email-override') );
4580 $content{payfirst} = $self->getfield('first');
4581 $content{paylast} = $self->getfield('last');
4583 $content{account_name} = "$content{payfirst} $content{paylast}"
4584 if $options->{method} eq 'ECHECK';
4586 $content{name} = $options->{payname};
4587 $content{name} = $content{account_name} if exists($content{account_name});
4589 $content{city} = exists($options->{city})
4592 $content{state} = exists($options->{state})
4595 $content{zip} = exists($options->{zip})
4598 $content{country} = exists($options->{country})
4599 ? $options->{country}
4601 $content{referer} = 'http://cleanwhisker.420.am/'; #XXX fix referer :/
4602 $content{phone} = $self->daytime || $self->night;
4607 my %bop_method2payby = (
4613 sub _new_realtime_bop {
4617 if (ref($_[0]) eq 'HASH') {
4618 %options = %{$_[0]};
4620 my ( $method, $amount ) = ( shift, shift );
4622 $options{method} = $method;
4623 $options{amount} = $amount;
4627 warn "$me realtime_bop (new): $options{method} $options{amount}\n";
4628 warn " $_ => $options{$_}\n" foreach keys %options;
4631 return $self->fake_bop(%options) if $options{'fake'};
4633 $self->_bop_defaults(\%options);
4636 # set trans_is_recur based on invnum if there is one
4639 my $trans_is_recur = 0;
4640 if ( $options{'invnum'} ) {
4642 my $cust_bill = qsearchs('cust_bill', { 'invnum' => $options{'invnum'} } );
4643 die "invnum ". $options{'invnum'}. " not found" unless $cust_bill;
4646 map { $_->part_pkg }
4648 map { $_->cust_pkg }
4649 $cust_bill->cust_bill_pkg;
4652 if grep { $_->freq ne '0' } @part_pkg;
4660 my $payment_gateway = $self->_payment_gateway( \%options );
4661 my $namespace = $payment_gateway->gateway_namespace;
4663 eval "use $namespace";
4667 # check for banned credit card/ACH
4670 my $ban = qsearchs('banned_pay', {
4671 'payby' => $bop_method2payby{$options{method}},
4672 'payinfo' => md5_base64($options{payinfo}),
4674 return "Banned credit card" if $ban;
4680 my (%bop_content) = $self->_bop_content(\%options);
4682 if ( $options{method} ne 'ECHECK' ) {
4683 $options{payname} =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
4684 or return "Illegal payname $options{payname}";
4685 ($bop_content{payfirst}, $bop_content{paylast}) = ($1, $2);
4688 my @invoicing_list = $self->invoicing_list_emailonly;
4689 if ( $conf->exists('emailinvoiceautoalways')
4690 || $conf->exists('emailinvoiceauto') && ! @invoicing_list
4691 || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
4692 push @invoicing_list, $self->all_emails;
4695 my $email = ($conf->exists('business-onlinepayment-email-override'))
4696 ? $conf->config('business-onlinepayment-email-override')
4697 : $invoicing_list[0];
4701 if ( $namespace eq 'Business::OnlinePayment' && $options{method} eq 'CC' ) {
4703 $content{card_number} = $options{payinfo};
4704 $paydate = exists($options{'paydate'})
4705 ? $options{'paydate'}
4707 $paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
4708 $content{expiration} = "$2/$1";
4710 my $paycvv = exists($options{'paycvv'})
4711 ? $options{'paycvv'}
4713 $content{cvv2} = $paycvv
4716 my $paystart_month = exists($options{'paystart_month'})
4717 ? $options{'paystart_month'}
4718 : $self->paystart_month;
4720 my $paystart_year = exists($options{'paystart_year'})
4721 ? $options{'paystart_year'}
4722 : $self->paystart_year;
4724 $content{card_start} = "$paystart_month/$paystart_year"
4725 if $paystart_month && $paystart_year;
4727 my $payissue = exists($options{'payissue'})
4728 ? $options{'payissue'}
4730 $content{issue_number} = $payissue if $payissue;
4732 if ( $self->_bop_recurring_billing( 'payinfo' => $options{'payinfo'},
4733 'trans_is_recur' => $trans_is_recur,
4737 $content{recurring_billing} = 'YES';
4738 $content{acct_code} = 'rebill'
4739 if $conf->exists('credit_card-recurring_billing_acct_code');
4742 } elsif ( $namespace eq 'Business::OnlinePayment' && $options{method} eq 'ECHECK' ){
4743 ( $content{account_number}, $content{routing_code} ) =
4744 split('@', $options{payinfo});
4745 $content{bank_name} = $options{payname};
4746 $content{bank_state} = exists($options{'paystate'})
4747 ? $options{'paystate'}
4748 : $self->getfield('paystate');
4749 $content{account_type} = exists($options{'paytype'})
4750 ? uc($options{'paytype'}) || 'CHECKING'
4751 : uc($self->getfield('paytype')) || 'CHECKING';
4752 $content{customer_org} = $self->company ? 'B' : 'I';
4753 $content{state_id} = exists($options{'stateid'})
4754 ? $options{'stateid'}
4755 : $self->getfield('stateid');
4756 $content{state_id_state} = exists($options{'stateid_state'})
4757 ? $options{'stateid_state'}
4758 : $self->getfield('stateid_state');
4759 $content{customer_ssn} = exists($options{'ss'})
4762 } elsif ( $namespace eq 'Business::OnlinePayment' && $options{method} eq 'LEC' ) {
4763 $content{phone} = $options{payinfo};
4764 } elsif ( $namespace eq 'Business::OnlineThirdPartyPayment' ) {
4771 # run transaction(s)
4774 my $balance = exists( $options{'balance'} )
4775 ? $options{'balance'}
4778 $self->select_for_update; #mutex ... just until we get our pending record in
4780 #the checks here are intended to catch concurrent payments
4781 #double-form-submission prevention is taken care of in cust_pay_pending::check
4784 return "The customer's balance has changed; $options{method} transaction aborted."
4785 if $self->balance < $balance;
4786 #&& $self->balance < $options{amount}; #might as well anyway?
4788 #also check and make sure there aren't *other* pending payments for this cust
4790 my @pending = qsearch('cust_pay_pending', {
4791 'custnum' => $self->custnum,
4792 'status' => { op=>'!=', value=>'done' }
4794 return "A payment is already being processed for this customer (".
4795 join(', ', map 'paypendingnum '. $_->paypendingnum, @pending ).
4796 "); $options{method} transaction aborted."
4797 if scalar(@pending);
4799 #okay, good to go, if we're a duplicate, cust_pay_pending will kick us out
4801 my $cust_pay_pending = new FS::cust_pay_pending {
4802 'custnum' => $self->custnum,
4803 #'invnum' => $options{'invnum'},
4804 'paid' => $options{amount},
4806 'payby' => $bop_method2payby{$options{method}},
4807 'payinfo' => $options{payinfo},
4808 'paydate' => $paydate,
4809 'recurring_billing' => $content{recurring_billing},
4811 'gatewaynum' => $payment_gateway->gatewaynum || '',
4812 'session_id' => $options{session_id} || '',
4813 'jobnum' => $options{depend_jobnum} || '',
4815 $cust_pay_pending->payunique( $options{payunique} )
4816 if defined($options{payunique}) && length($options{payunique});
4817 my $cpp_new_err = $cust_pay_pending->insert; #mutex lost when this is inserted
4818 return $cpp_new_err if $cpp_new_err;
4820 my( $action1, $action2 ) =
4821 split( /\s*\,\s*/, $payment_gateway->gateway_action );
4823 my $transaction = new $namespace( $payment_gateway->gateway_module,
4824 $self->_bop_options(\%options),
4827 $transaction->content(
4828 'type' => $options{method},
4829 $self->_bop_auth(\%options),
4830 'action' => $action1,
4831 'description' => $options{'description'},
4832 'amount' => $options{amount},
4833 #'invoice_number' => $options{'invnum'},
4834 'customer_id' => $self->custnum,
4836 'reference' => $cust_pay_pending->paypendingnum, #for now
4841 $cust_pay_pending->status('pending');
4842 my $cpp_pending_err = $cust_pay_pending->replace;
4843 return $cpp_pending_err if $cpp_pending_err;
4846 my $BOP_TESTING = 0;
4847 my $BOP_TESTING_SUCCESS = 1;
4849 unless ( $BOP_TESTING ) {
4850 $transaction->submit();
4852 if ( $BOP_TESTING_SUCCESS ) {
4853 $transaction->is_success(1);
4854 $transaction->authorization('fake auth');
4856 $transaction->is_success(0);
4857 $transaction->error_message('fake failure');
4861 if ( $transaction->is_success() && $namespace eq 'Business::OnlineThirdPartyPayment' ) {
4863 return { reference => $cust_pay_pending->paypendingnum,
4864 map { $_ => $transaction->$_ } qw ( popup_url collectitems ) };
4866 } elsif ( $transaction->is_success() && $action2 ) {
4868 $cust_pay_pending->status('authorized');
4869 my $cpp_authorized_err = $cust_pay_pending->replace;
4870 return $cpp_authorized_err if $cpp_authorized_err;
4872 my $auth = $transaction->authorization;
4873 my $ordernum = $transaction->can('order_number')
4874 ? $transaction->order_number
4878 new Business::OnlinePayment( $payment_gateway->gateway_module,
4879 $self->_bop_options(\%options),
4884 type => $options{method},
4886 $self->_bop_auth(\%options),
4887 order_number => $ordernum,
4888 amount => $options{amount},
4889 authorization => $auth,
4890 description => $options{'description'},
4893 foreach my $field (qw( authorization_source_code returned_ACI
4894 transaction_identifier validation_code
4895 transaction_sequence_num local_transaction_date
4896 local_transaction_time AVS_result_code )) {
4897 $capture{$field} = $transaction->$field() if $transaction->can($field);
4900 $capture->content( %capture );
4904 unless ( $capture->is_success ) {
4905 my $e = "Authorization successful but capture failed, custnum #".
4906 $self->custnum. ': '. $capture->result_code.
4907 ": ". $capture->error_message;
4915 # remove paycvv after initial transaction
4918 #false laziness w/misc/process/payment.cgi - check both to make sure working
4920 if ( defined $self->dbdef_table->column('paycvv')
4921 && length($self->paycvv)
4922 && ! grep { $_ eq cardtype($options{payinfo}) } $conf->config('cvv-save')
4924 my $error = $self->remove_cvv;
4926 warn "WARNING: error removing cvv: $error\n";
4934 $self->_realtime_bop_result( $cust_pay_pending, $transaction, %options );
4946 if (ref($_[0]) eq 'HASH') {
4947 %options = %{$_[0]};
4949 my ( $method, $amount ) = ( shift, shift );
4951 $options{method} = $method;
4952 $options{amount} = $amount;
4955 if ( $options{'fake_failure'} ) {
4956 return "Error: No error; test failure requested with fake_failure";
4960 #if ( $payment_gateway->gatewaynum ) { # agent override
4961 # $paybatch = $payment_gateway->gatewaynum. '-';
4964 #$paybatch .= "$processor:". $transaction->authorization;
4966 #$paybatch .= ':'. $transaction->order_number
4967 # if $transaction->can('order_number')
4968 # && length($transaction->order_number);
4970 my $paybatch = 'FakeProcessor:54:32';
4972 my $cust_pay = new FS::cust_pay ( {
4973 'custnum' => $self->custnum,
4974 'invnum' => $options{'invnum'},
4975 'paid' => $options{amount},
4977 'payby' => $bop_method2payby{$options{method}},
4978 #'payinfo' => $payinfo,
4979 'payinfo' => '4111111111111111',
4980 'paybatch' => $paybatch,
4981 #'paydate' => $paydate,
4982 'paydate' => '2012-05-01',
4984 $cust_pay->payunique( $options{payunique} ) if length($options{payunique});
4986 my $error = $cust_pay->insert($options{'manual'} ? ( 'manual' => 1 ) : () );
4989 $cust_pay->invnum(''); #try again with no specific invnum
4990 my $error2 = $cust_pay->insert( $options{'manual'} ?
4991 ( 'manual' => 1 ) : ()
4994 # gah, even with transactions.
4995 my $e = 'WARNING: Card/ACH debited but database not updated - '.
4996 "error inserting (fake!) payment: $error2".
4997 " (previously tried insert with invnum #$options{'invnum'}" .
5004 if ( $options{'paynum_ref'} ) {
5005 ${ $options{'paynum_ref'} } = $cust_pay->paynum;
5008 return ''; #no error
5013 # item _realtime_bop_result CUST_PAY_PENDING, BOP_OBJECT [ OPTION => VALUE ... ]
5015 # Wraps up processing of a realtime credit card, ACH (electronic check) or
5016 # phone bill transaction.
5018 sub _realtime_bop_result {
5019 my( $self, $cust_pay_pending, $transaction, %options ) = @_;
5021 warn "$me _realtime_bop_result: pending transaction ".
5022 $cust_pay_pending->paypendingnum. "\n";
5023 warn " $_ => $options{$_}\n" foreach keys %options;
5026 my $payment_gateway = $options{payment_gateway}
5027 or return "no payment gateway in arguments to _realtime_bop_result";
5029 $cust_pay_pending->status($transaction->is_success() ? 'captured' : 'declined');
5030 my $cpp_captured_err = $cust_pay_pending->replace;
5031 return $cpp_captured_err if $cpp_captured_err;
5033 if ( $transaction->is_success() ) {
5036 if ( $payment_gateway->gatewaynum ) { # agent override
5037 $paybatch = $payment_gateway->gatewaynum. '-';
5040 $paybatch .= $payment_gateway->gateway_module. ":".
5041 $transaction->authorization;
5043 $paybatch .= ':'. $transaction->order_number
5044 if $transaction->can('order_number')
5045 && length($transaction->order_number);
5047 my $cust_pay = new FS::cust_pay ( {
5048 'custnum' => $self->custnum,
5049 'invnum' => $options{'invnum'},
5050 'paid' => $cust_pay_pending->paid,
5052 'payby' => $cust_pay_pending->payby,
5053 #'payinfo' => $payinfo,
5054 'paybatch' => $paybatch,
5055 'paydate' => $cust_pay_pending->paydate,
5057 #doesn't hurt to know, even though the dup check is in cust_pay_pending now
5058 $cust_pay->payunique( $options{payunique} )
5059 if defined($options{payunique}) && length($options{payunique});
5061 my $oldAutoCommit = $FS::UID::AutoCommit;
5062 local $FS::UID::AutoCommit = 0;
5065 #start a transaction, insert the cust_pay and set cust_pay_pending.status to done in a single transction
5067 my $error = $cust_pay->insert($options{'manual'} ? ( 'manual' => 1 ) : () );
5070 $cust_pay->invnum(''); #try again with no specific invnum
5071 my $error2 = $cust_pay->insert( $options{'manual'} ?
5072 ( 'manual' => 1 ) : ()
5075 # gah. but at least we have a record of the state we had to abort in
5076 # from cust_pay_pending now.
5077 my $e = "WARNING: $options{method} captured but payment not recorded -".
5078 " error inserting payment (". $payment_gateway->gateway_module.
5080 " (previously tried insert with invnum #$options{'invnum'}" .
5081 ": $error ) - pending payment saved as paypendingnum ".
5082 $cust_pay_pending->paypendingnum. "\n";
5088 my $jobnum = $cust_pay_pending->jobnum;
5090 my $placeholder = qsearchs( 'queue', { 'jobnum' => $jobnum } );
5092 unless ( $placeholder ) {
5093 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
5094 my $e = "WARNING: $options{method} captured but job $jobnum not ".
5095 "found for paypendingnum ". $cust_pay_pending->paypendingnum. "\n";
5100 $error = $placeholder->delete;
5103 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
5104 my $e = "WARNING: $options{method} captured but could not delete ".
5105 "job $jobnum for paypendingnum ".
5106 $cust_pay_pending->paypendingnum. ": $error\n";
5113 if ( $options{'paynum_ref'} ) {
5114 ${ $options{'paynum_ref'} } = $cust_pay->paynum;
5117 $cust_pay_pending->status('done');
5118 $cust_pay_pending->statustext('captured');
5119 $cust_pay_pending->paynum($cust_pay->paynum);
5120 my $cpp_done_err = $cust_pay_pending->replace;
5122 if ( $cpp_done_err ) {
5124 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
5125 my $e = "WARNING: $options{method} captured but payment not recorded - ".
5126 "error updating status for paypendingnum ".
5127 $cust_pay_pending->paypendingnum. ": $cpp_done_err \n";
5133 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
5134 return ''; #no error
5140 my $perror = $payment_gateway->gateway_module. " error: ".
5141 $transaction->error_message;
5143 my $jobnum = $cust_pay_pending->jobnum;
5145 my $placeholder = qsearchs( 'queue', { 'jobnum' => $jobnum } );
5147 if ( $placeholder ) {
5148 my $error = $placeholder->depended_delete;
5149 $error ||= $placeholder->delete;
5150 warn "error removing provisioning jobs after declined paypendingnum ".
5151 $cust_pay_pending->paypendingnum. "\n";
5153 my $e = "error finding job $jobnum for declined paypendingnum ".
5154 $cust_pay_pending->paypendingnum. "\n";
5160 unless ( $transaction->error_message ) {
5163 if ( $transaction->can('response_page') ) {
5165 'page' => ( $transaction->can('response_page')
5166 ? $transaction->response_page
5169 'code' => ( $transaction->can('response_code')
5170 ? $transaction->response_code
5173 'headers' => ( $transaction->can('response_headers')
5174 ? $transaction->response_headers
5180 "No additional debugging information available for ".
5181 $payment_gateway->gateway_module;
5184 $perror .= "No error_message returned from ".
5185 $payment_gateway->gateway_module. " -- ".
5186 ( ref($t_response) ? Dumper($t_response) : $t_response );
5190 if ( !$options{'quiet'} && !$realtime_bop_decline_quiet
5191 && $conf->exists('emaildecline')
5192 && grep { $_ ne 'POST' } $self->invoicing_list
5193 && ! grep { $transaction->error_message =~ /$_/ }
5194 $conf->config('emaildecline-exclude')
5196 my @templ = $conf->config('declinetemplate');
5197 my $template = new Text::Template (
5199 SOURCE => [ map "$_\n", @templ ],
5200 ) or return "($perror) can't create template: $Text::Template::ERROR";
5201 $template->compile()
5202 or return "($perror) can't compile template: $Text::Template::ERROR";
5204 my $templ_hash = { error => $transaction->error_message };
5206 my $error = send_email(
5207 'from' => $conf->config('invoice_from', $self->agentnum ),
5208 'to' => [ grep { $_ ne 'POST' } $self->invoicing_list ],
5209 'subject' => 'Your payment could not be processed',
5210 'body' => [ $template->fill_in(HASH => $templ_hash) ],
5213 $perror .= " (also received error sending decline notification: $error)"
5218 $cust_pay_pending->status('done');
5219 $cust_pay_pending->statustext("declined: $perror");
5220 my $cpp_done_err = $cust_pay_pending->replace;
5221 if ( $cpp_done_err ) {
5222 my $e = "WARNING: $options{method} declined but pending payment not ".
5223 "resolved - error updating status for paypendingnum ".
5224 $cust_pay_pending->paypendingnum. ": $cpp_done_err \n";
5226 $perror = "$e ($perror)";
5234 =item realtime_botpp_capture CUST_PAY_PENDING [ OPTION => VALUE ... ]
5236 Verifies successful third party processing of a realtime credit card,
5237 ACH (electronic check) or phone bill transaction via a
5238 Business::OnlineThirdPartyPayment realtime gateway. See
5239 L<http://420.am/business-onlinethirdpartypayment> for supported gateways.
5241 Available options are: I<description>, I<invnum>, I<quiet>, I<paynum_ref>, I<payunique>
5243 The additional options I<payname>, I<city>, I<state>,
5244 I<zip>, I<payinfo> and I<paydate> are also available. Any of these options,
5245 if set, will override the value from the customer record.
5247 I<description> is a free-text field passed to the gateway. It defaults to
5248 "Internet services".
5250 If an I<invnum> is specified, this payment (if successful) is applied to the
5251 specified invoice. If you don't specify an I<invnum> you might want to
5252 call the B<apply_payments> method.
5254 I<quiet> can be set true to surpress email decline notices.
5256 I<paynum_ref> can be set to a scalar reference. It will be filled in with the
5257 resulting paynum, if any.
5259 I<payunique> is a unique identifier for this payment.
5261 Returns a hashref containing elements bill_error (which will be undefined
5262 upon success) and session_id of any associated session.
5266 sub realtime_botpp_capture {
5267 my( $self, $cust_pay_pending, %options ) = @_;
5269 warn "$me realtime_botpp_capture: pending transaction $cust_pay_pending\n";
5270 warn " $_ => $options{$_}\n" foreach keys %options;
5273 eval "use Business::OnlineThirdPartyPayment";
5277 # select the gateway
5280 my $method = FS::payby->payby2bop($cust_pay_pending->payby);
5282 my $payment_gateway = $cust_pay_pending->gatewaynum
5283 ? qsearchs( 'payment_gateway',
5284 { gatewaynum => $cust_pay_pending->gatewaynum }
5286 : $self->agent->payment_gateway( 'method' => $method,
5287 # 'invnum' => $cust_pay_pending->invnum,
5288 # 'payinfo' => $cust_pay_pending->payinfo,
5291 $options{payment_gateway} = $payment_gateway; # for the helper subs
5297 my @invoicing_list = $self->invoicing_list_emailonly;
5298 if ( $conf->exists('emailinvoiceautoalways')
5299 || $conf->exists('emailinvoiceauto') && ! @invoicing_list
5300 || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
5301 push @invoicing_list, $self->all_emails;
5304 my $email = ($conf->exists('business-onlinepayment-email-override'))
5305 ? $conf->config('business-onlinepayment-email-override')
5306 : $invoicing_list[0];
5310 $content{email_customer} =
5311 ( $conf->exists('business-onlinepayment-email_customer')
5312 || $conf->exists('business-onlinepayment-email-override') );
5315 # run transaction(s)
5319 new Business::OnlineThirdPartyPayment( $payment_gateway->gateway_module,
5320 $self->_bop_options(\%options),
5323 $transaction->reference({ %options });
5325 $transaction->content(
5327 $self->_bop_auth(\%options),
5328 'action' => 'Post Authorization',
5329 'description' => $options{'description'},
5330 'amount' => $cust_pay_pending->paid,
5331 #'invoice_number' => $options{'invnum'},
5332 'customer_id' => $self->custnum,
5333 'referer' => 'http://cleanwhisker.420.am/',
5334 'reference' => $cust_pay_pending->paypendingnum,
5336 'phone' => $self->daytime || $self->night,
5338 # plus whatever is required for bogus capture avoidance
5341 $transaction->submit();
5344 $self->_realtime_bop_result( $cust_pay_pending, $transaction, %options );
5347 bill_error => $error,
5348 session_id => $cust_pay_pending->session_id,
5353 =item default_payment_gateway DEPRECATED -- use agent->payment_gateway
5357 sub default_payment_gateway {
5358 my( $self, $method ) = @_;
5360 die "Real-time processing not enabled\n"
5361 unless $conf->exists('business-onlinepayment');
5363 #warn "default_payment_gateway deprecated -- use agent->payment_gateway\n";
5366 my $bop_config = 'business-onlinepayment';
5367 $bop_config .= '-ach'
5368 if $method =~ /^(ECHECK|CHEK)$/ && $conf->exists($bop_config. '-ach');
5369 my ( $processor, $login, $password, $action, @bop_options ) =
5370 $conf->config($bop_config);
5371 $action ||= 'normal authorization';
5372 pop @bop_options if scalar(@bop_options) % 2 && $bop_options[-1] =~ /^\s*$/;
5373 die "No real-time processor is enabled - ".
5374 "did you set the business-onlinepayment configuration value?\n"
5377 ( $processor, $login, $password, $action, @bop_options )
5382 Removes the I<paycvv> field from the database directly.
5384 If there is an error, returns the error, otherwise returns false.
5390 my $sth = dbh->prepare("UPDATE cust_main SET paycvv = '' WHERE custnum = ?")
5391 or return dbh->errstr;
5392 $sth->execute($self->custnum)
5393 or return $sth->errstr;
5398 =item _new_realtime_refund_bop METHOD [ OPTION => VALUE ... ]
5400 Refunds a realtime credit card, ACH (electronic check) or phone bill transaction
5401 via a Business::OnlinePayment realtime gateway. See
5402 L<http://420.am/business-onlinepayment> for supported gateways.
5404 Available methods are: I<CC>, I<ECHECK> and I<LEC>
5406 Available options are: I<amount>, I<reason>, I<paynum>, I<paydate>
5408 Most gateways require a reference to an original payment transaction to refund,
5409 so you probably need to specify a I<paynum>.
5411 I<amount> defaults to the original amount of the payment if not specified.
5413 I<reason> specifies a reason for the refund.
5415 I<paydate> specifies the expiration date for a credit card overriding the
5416 value from the customer record or the payment record. Specified as yyyy-mm-dd
5418 Implementation note: If I<amount> is unspecified or equal to the amount of the
5419 orignal payment, first an attempt is made to "void" the transaction via
5420 the gateway (to cancel a not-yet settled transaction) and then if that fails,
5421 the normal attempt is made to "refund" ("credit") the transaction via the
5422 gateway is attempted.
5424 #The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
5425 #I<zip>, I<payinfo> and I<paydate> are also available. Any of these options,
5426 #if set, will override the value from the customer record.
5428 #If an I<invnum> is specified, this payment (if successful) is applied to the
5429 #specified invoice. If you don't specify an I<invnum> you might want to
5430 #call the B<apply_payments> method.
5434 #some false laziness w/realtime_bop, not enough to make it worth merging
5435 #but some useful small subs should be pulled out
5436 sub _new_realtime_refund_bop {
5440 if (ref($_[0]) ne 'HASH') {
5441 %options = %{$_[0]};
5445 $options{method} = $method;
5449 warn "$me realtime_refund_bop (new): $options{method} refund\n";
5450 warn " $_ => $options{$_}\n" foreach keys %options;
5454 # look up the original payment and optionally a gateway for that payment
5458 my $amount = $options{'amount'};
5460 my( $processor, $login, $password, @bop_options, $namespace ) ;
5461 my( $auth, $order_number ) = ( '', '', '' );
5463 if ( $options{'paynum'} ) {
5465 warn " paynum: $options{paynum}\n" if $DEBUG > 1;
5466 $cust_pay = qsearchs('cust_pay', { paynum=>$options{'paynum'} } )
5467 or return "Unknown paynum $options{'paynum'}";
5468 $amount ||= $cust_pay->paid;
5470 $cust_pay->paybatch =~ /^((\d+)\-)?(\w+):\s*([\w\-\/ ]*)(:([\w\-]+))?$/
5471 or return "Can't parse paybatch for paynum $options{'paynum'}: ".
5472 $cust_pay->paybatch;
5473 my $gatewaynum = '';
5474 ( $gatewaynum, $processor, $auth, $order_number ) = ( $2, $3, $4, $6 );
5476 if ( $gatewaynum ) { #gateway for the payment to be refunded
5478 my $payment_gateway =
5479 qsearchs('payment_gateway', { 'gatewaynum' => $gatewaynum } );
5480 die "payment gateway $gatewaynum not found"
5481 unless $payment_gateway;
5483 $processor = $payment_gateway->gateway_module;
5484 $login = $payment_gateway->gateway_username;
5485 $password = $payment_gateway->gateway_password;
5486 $namespace = $payment_gateway->gateway_namespace;
5487 @bop_options = $payment_gateway->options;
5489 } else { #try the default gateway
5492 my $payment_gateway =
5493 $self->agent->payment_gateway('method' => $options{method});
5495 ( $conf_processor, $login, $password, $namespace ) =
5496 map { my $method = "gateway_$_"; $payment_gateway->$method }
5497 qw( module username password namespace );
5499 @bop_options = $payment_gateway->gatewaynum
5500 ? $payment_gateway->options
5501 : @{ $payment_gateway->get('options') };
5503 return "processor of payment $options{'paynum'} $processor does not".
5504 " match default processor $conf_processor"
5505 unless $processor eq $conf_processor;
5510 } else { # didn't specify a paynum, so look for agent gateway overrides
5511 # like a normal transaction
5513 my $payment_gateway =
5514 $self->agent->payment_gateway( 'method' => $options{method},
5515 #'payinfo' => $payinfo,
5517 my( $processor, $login, $password, $namespace ) =
5518 map { my $method = "gateway_$_"; $payment_gateway->$method }
5519 qw( module username password namespace );
5521 my @bop_options = $payment_gateway->gatewaynum
5522 ? $payment_gateway->options
5523 : @{ $payment_gateway->get('options') };
5526 return "neither amount nor paynum specified" unless $amount;
5528 eval "use $namespace";
5532 'type' => $options{method},
5534 'password' => $password,
5535 'order_number' => $order_number,
5536 'amount' => $amount,
5537 'referer' => 'http://cleanwhisker.420.am/', #XXX fix referer :/
5539 $content{authorization} = $auth
5540 if length($auth); #echeck/ACH transactions have an order # but no auth
5541 #(at least with authorize.net)
5543 my $disable_void_after;
5544 if ($conf->exists('disable_void_after')
5545 && $conf->config('disable_void_after') =~ /^(\d+)$/) {
5546 $disable_void_after = $1;
5549 #first try void if applicable
5550 if ( $cust_pay && $cust_pay->paid == $amount
5552 ( not defined($disable_void_after) )
5553 || ( time < ($cust_pay->_date + $disable_void_after ) )
5556 warn " attempting void\n" if $DEBUG > 1;
5557 my $void = new Business::OnlinePayment( $processor, @bop_options );
5558 $void->content( 'action' => 'void', %content );
5560 if ( $void->is_success ) {
5561 my $error = $cust_pay->void($options{'reason'});
5563 # gah, even with transactions.
5564 my $e = 'WARNING: Card/ACH voided but database not updated - '.
5565 "error voiding payment: $error";
5569 warn " void successful\n" if $DEBUG > 1;
5574 warn " void unsuccessful, trying refund\n"
5578 my $address = $self->address1;
5579 $address .= ", ". $self->address2 if $self->address2;
5581 my($payname, $payfirst, $paylast);
5582 if ( $self->payname && $options{method} ne 'ECHECK' ) {
5583 $payname = $self->payname;
5584 $payname =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
5585 or return "Illegal payname $payname";
5586 ($payfirst, $paylast) = ($1, $2);
5588 $payfirst = $self->getfield('first');
5589 $paylast = $self->getfield('last');
5590 $payname = "$payfirst $paylast";
5593 my @invoicing_list = $self->invoicing_list_emailonly;
5594 if ( $conf->exists('emailinvoiceautoalways')
5595 || $conf->exists('emailinvoiceauto') && ! @invoicing_list
5596 || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
5597 push @invoicing_list, $self->all_emails;
5600 my $email = ($conf->exists('business-onlinepayment-email-override'))
5601 ? $conf->config('business-onlinepayment-email-override')
5602 : $invoicing_list[0];
5604 my $payip = exists($options{'payip'})
5607 $content{customer_ip} = $payip
5611 if ( $options{method} eq 'CC' ) {
5614 $content{card_number} = $payinfo = $cust_pay->payinfo;
5615 (exists($options{'paydate'}) ? $options{'paydate'} : $cust_pay->paydate)
5616 =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/ &&
5617 ($content{expiration} = "$2/$1"); # where available
5619 $content{card_number} = $payinfo = $self->payinfo;
5620 (exists($options{'paydate'}) ? $options{'paydate'} : $self->paydate)
5621 =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
5622 $content{expiration} = "$2/$1";
5625 } elsif ( $options{method} eq 'ECHECK' ) {
5628 $payinfo = $cust_pay->payinfo;
5630 $payinfo = $self->payinfo;
5632 ( $content{account_number}, $content{routing_code} )= split('@', $payinfo );
5633 $content{bank_name} = $self->payname;
5634 $content{account_type} = 'CHECKING';
5635 $content{account_name} = $payname;
5636 $content{customer_org} = $self->company ? 'B' : 'I';
5637 $content{customer_ssn} = $self->ss;
5638 } elsif ( $options{method} eq 'LEC' ) {
5639 $content{phone} = $payinfo = $self->payinfo;
5643 my $refund = new Business::OnlinePayment( $processor, @bop_options );
5644 my %sub_content = $refund->content(
5645 'action' => 'credit',
5646 'customer_id' => $self->custnum,
5647 'last_name' => $paylast,
5648 'first_name' => $payfirst,
5650 'address' => $address,
5651 'city' => $self->city,
5652 'state' => $self->state,
5653 'zip' => $self->zip,
5654 'country' => $self->country,
5656 'phone' => $self->daytime || $self->night,
5659 warn join('', map { " $_ => $sub_content{$_}\n" } keys %sub_content )
5663 return "$processor error: ". $refund->error_message
5664 unless $refund->is_success();
5666 my $paybatch = "$processor:". $refund->authorization;
5667 $paybatch .= ':'. $refund->order_number
5668 if $refund->can('order_number') && $refund->order_number;
5670 while ( $cust_pay && $cust_pay->unapplied < $amount ) {
5671 my @cust_bill_pay = $cust_pay->cust_bill_pay;
5672 last unless @cust_bill_pay;
5673 my $cust_bill_pay = pop @cust_bill_pay;
5674 my $error = $cust_bill_pay->delete;
5678 my $cust_refund = new FS::cust_refund ( {
5679 'custnum' => $self->custnum,
5680 'paynum' => $options{'paynum'},
5681 'refund' => $amount,
5683 'payby' => $bop_method2payby{$options{method}},
5684 'payinfo' => $payinfo,
5685 'paybatch' => $paybatch,
5686 'reason' => $options{'reason'} || 'card or ACH refund',
5688 my $error = $cust_refund->insert;
5690 $cust_refund->paynum(''); #try again with no specific paynum
5691 my $error2 = $cust_refund->insert;
5693 # gah, even with transactions.
5694 my $e = 'WARNING: Card/ACH refunded but database not updated - '.
5695 "error inserting refund ($processor): $error2".
5696 " (previously tried insert with paynum #$options{'paynum'}" .
5707 =item batch_card OPTION => VALUE...
5709 Adds a payment for this invoice to the pending credit card batch (see
5710 L<FS::cust_pay_batch>), or, if the B<realtime> option is set to a true value,
5711 runs the payment using a realtime gateway.
5716 my ($self, %options) = @_;
5719 if (exists($options{amount})) {
5720 $amount = $options{amount};
5722 $amount = sprintf("%.2f", $self->balance - $self->in_transit_payments);
5724 return '' unless $amount > 0;
5726 my $invnum = delete $options{invnum};
5727 my $payby = $options{invnum} || $self->payby; #dubious
5729 if ($options{'realtime'}) {
5730 return $self->realtime_bop( FS::payby->payby2bop($self->payby),
5736 my $oldAutoCommit = $FS::UID::AutoCommit;
5737 local $FS::UID::AutoCommit = 0;
5740 #this needs to handle mysql as well as Pg, like svc_acct.pm
5741 #(make it into a common function if folks need to do batching with mysql)
5742 $dbh->do("LOCK TABLE pay_batch IN SHARE ROW EXCLUSIVE MODE")
5743 or return "Cannot lock pay_batch: " . $dbh->errstr;
5747 'payby' => FS::payby->payby2payment($payby),
5750 my $pay_batch = qsearchs( 'pay_batch', \%pay_batch );
5752 unless ( $pay_batch ) {
5753 $pay_batch = new FS::pay_batch \%pay_batch;
5754 my $error = $pay_batch->insert;
5756 $dbh->rollback if $oldAutoCommit;
5757 die "error creating new batch: $error\n";
5761 my $old_cust_pay_batch = qsearchs('cust_pay_batch', {
5762 'batchnum' => $pay_batch->batchnum,
5763 'custnum' => $self->custnum,
5766 foreach (qw( address1 address2 city state zip country payby payinfo paydate
5768 $options{$_} = '' unless exists($options{$_});
5771 my $cust_pay_batch = new FS::cust_pay_batch ( {
5772 'batchnum' => $pay_batch->batchnum,
5773 'invnum' => $invnum || 0, # is there a better value?
5774 # this field should be
5776 # cust_bill_pay_batch now
5777 'custnum' => $self->custnum,
5778 'last' => $self->getfield('last'),
5779 'first' => $self->getfield('first'),
5780 'address1' => $options{address1} || $self->address1,
5781 'address2' => $options{address2} || $self->address2,
5782 'city' => $options{city} || $self->city,
5783 'state' => $options{state} || $self->state,
5784 'zip' => $options{zip} || $self->zip,
5785 'country' => $options{country} || $self->country,
5786 'payby' => $options{payby} || $self->payby,
5787 'payinfo' => $options{payinfo} || $self->payinfo,
5788 'exp' => $options{paydate} || $self->paydate,
5789 'payname' => $options{payname} || $self->payname,
5790 'amount' => $amount, # consolidating
5793 $cust_pay_batch->paybatchnum($old_cust_pay_batch->paybatchnum)
5794 if $old_cust_pay_batch;
5797 if ($old_cust_pay_batch) {
5798 $error = $cust_pay_batch->replace($old_cust_pay_batch)
5800 $error = $cust_pay_batch->insert;
5804 $dbh->rollback if $oldAutoCommit;
5808 my $unapplied = $self->total_unapplied_credits
5809 + $self->total_unapplied_payments
5810 + $self->in_transit_payments;
5811 foreach my $cust_bill ($self->open_cust_bill) {
5812 #$dbh->commit or die $dbh->errstr if $oldAutoCommit;
5813 my $cust_bill_pay_batch = new FS::cust_bill_pay_batch {
5814 'invnum' => $cust_bill->invnum,
5815 'paybatchnum' => $cust_pay_batch->paybatchnum,
5816 'amount' => $cust_bill->owed,
5819 if ($unapplied >= $cust_bill_pay_batch->amount){
5820 $unapplied -= $cust_bill_pay_batch->amount;
5823 $cust_bill_pay_batch->amount(sprintf ( "%.2f",
5824 $cust_bill_pay_batch->amount - $unapplied )); $unapplied = 0;
5826 $error = $cust_bill_pay_batch->insert;
5828 $dbh->rollback if $oldAutoCommit;
5833 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
5837 =item apply_payments_and_credits
5839 Applies unapplied payments and credits.
5841 In most cases, this new method should be used in place of sequential
5842 apply_payments and apply_credits methods.
5844 If there is an error, returns the error, otherwise returns false.
5848 sub apply_payments_and_credits {
5851 local $SIG{HUP} = 'IGNORE';
5852 local $SIG{INT} = 'IGNORE';
5853 local $SIG{QUIT} = 'IGNORE';
5854 local $SIG{TERM} = 'IGNORE';
5855 local $SIG{TSTP} = 'IGNORE';
5856 local $SIG{PIPE} = 'IGNORE';
5858 my $oldAutoCommit = $FS::UID::AutoCommit;
5859 local $FS::UID::AutoCommit = 0;
5862 $self->select_for_update; #mutex
5864 foreach my $cust_bill ( $self->open_cust_bill ) {
5865 my $error = $cust_bill->apply_payments_and_credits;
5867 $dbh->rollback if $oldAutoCommit;
5868 return "Error applying: $error";
5872 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
5877 =item apply_credits OPTION => VALUE ...
5879 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
5880 to outstanding invoice balances in chronological order (or reverse
5881 chronological order if the I<order> option is set to B<newest>) and returns the
5882 value of any remaining unapplied credits available for refund (see
5883 L<FS::cust_refund>).
5885 Dies if there is an error.
5893 local $SIG{HUP} = 'IGNORE';
5894 local $SIG{INT} = 'IGNORE';
5895 local $SIG{QUIT} = 'IGNORE';
5896 local $SIG{TERM} = 'IGNORE';
5897 local $SIG{TSTP} = 'IGNORE';
5898 local $SIG{PIPE} = 'IGNORE';
5900 my $oldAutoCommit = $FS::UID::AutoCommit;
5901 local $FS::UID::AutoCommit = 0;
5904 $self->select_for_update; #mutex
5906 unless ( $self->total_unapplied_credits ) {
5907 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
5911 my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
5912 qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
5914 my @invoices = $self->open_cust_bill;
5915 @invoices = sort { $b->_date <=> $a->_date } @invoices
5916 if defined($opt{'order'}) && $opt{'order'} eq 'newest';
5919 foreach my $cust_bill ( @invoices ) {
5922 if ( !defined($credit) || $credit->credited == 0) {
5923 $credit = pop @credits or last;
5926 if ($cust_bill->owed >= $credit->credited) {
5927 $amount=$credit->credited;
5929 $amount=$cust_bill->owed;
5932 my $cust_credit_bill = new FS::cust_credit_bill ( {
5933 'crednum' => $credit->crednum,
5934 'invnum' => $cust_bill->invnum,
5935 'amount' => $amount,
5937 my $error = $cust_credit_bill->insert;
5939 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
5943 redo if ($cust_bill->owed > 0);
5947 my $total_unapplied_credits = $self->total_unapplied_credits;
5949 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
5951 return $total_unapplied_credits;
5954 =item apply_payments
5956 Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
5957 to outstanding invoice balances in chronological order.
5959 #and returns the value of any remaining unapplied payments.
5961 Dies if there is an error.
5965 sub apply_payments {
5968 local $SIG{HUP} = 'IGNORE';
5969 local $SIG{INT} = 'IGNORE';
5970 local $SIG{QUIT} = 'IGNORE';
5971 local $SIG{TERM} = 'IGNORE';
5972 local $SIG{TSTP} = 'IGNORE';
5973 local $SIG{PIPE} = 'IGNORE';
5975 my $oldAutoCommit = $FS::UID::AutoCommit;
5976 local $FS::UID::AutoCommit = 0;
5979 $self->select_for_update; #mutex
5983 my @payments = sort { $b->_date <=> $a->_date }
5984 grep { $_->unapplied > 0 }
5987 my @invoices = sort { $a->_date <=> $b->_date}
5988 grep { $_->owed > 0 }
5993 foreach my $cust_bill ( @invoices ) {
5996 if ( !defined($payment) || $payment->unapplied == 0 ) {
5997 $payment = pop @payments or last;
6000 if ( $cust_bill->owed >= $payment->unapplied ) {
6001 $amount = $payment->unapplied;
6003 $amount = $cust_bill->owed;
6006 my $cust_bill_pay = new FS::cust_bill_pay ( {
6007 'paynum' => $payment->paynum,
6008 'invnum' => $cust_bill->invnum,
6009 'amount' => $amount,
6011 my $error = $cust_bill_pay->insert;
6013 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
6017 redo if ( $cust_bill->owed > 0);
6021 my $total_unapplied_payments = $self->total_unapplied_payments;
6023 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
6025 return $total_unapplied_payments;
6030 Returns the total owed for this customer on all invoices
6031 (see L<FS::cust_bill/owed>).
6037 $self->total_owed_date(2145859200); #12/31/2037
6040 =item total_owed_date TIME
6042 Returns the total owed for this customer on all invoices with date earlier than
6043 TIME. TIME is specified as a UNIX timestamp; see L<perlfunc/"time">). Also
6044 see L<Time::Local> and L<Date::Parse> for conversion functions.
6048 sub total_owed_date {
6052 foreach my $cust_bill (
6053 grep { $_->_date <= $time }
6054 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
6056 $total_bill += $cust_bill->owed;
6058 sprintf( "%.2f", $total_bill );
6063 Returns the total amount of all payments.
6070 $total += $_->paid foreach $self->cust_pay;
6071 sprintf( "%.2f", $total );
6074 =item total_unapplied_credits
6076 Returns the total outstanding credit (see L<FS::cust_credit>) for this
6077 customer. See L<FS::cust_credit/credited>.
6079 =item total_credited
6081 Old name for total_unapplied_credits. Don't use.
6085 sub total_credited {
6086 #carp "total_credited deprecated, use total_unapplied_credits";
6087 shift->total_unapplied_credits(@_);
6090 sub total_unapplied_credits {
6092 my $total_credit = 0;
6093 $total_credit += $_->credited foreach $self->cust_credit;
6094 sprintf( "%.2f", $total_credit );
6097 =item total_unapplied_payments
6099 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
6100 See L<FS::cust_pay/unapplied>.
6104 sub total_unapplied_payments {
6106 my $total_unapplied = 0;
6107 $total_unapplied += $_->unapplied foreach $self->cust_pay;
6108 sprintf( "%.2f", $total_unapplied );
6111 =item total_unapplied_refunds
6113 Returns the total unrefunded refunds (see L<FS::cust_refund>) for this
6114 customer. See L<FS::cust_refund/unapplied>.
6118 sub total_unapplied_refunds {
6120 my $total_unapplied = 0;
6121 $total_unapplied += $_->unapplied foreach $self->cust_refund;
6122 sprintf( "%.2f", $total_unapplied );
6127 Returns the balance for this customer (total_owed plus total_unrefunded, minus
6128 total_unapplied_credits minus total_unapplied_payments).
6136 + $self->total_unapplied_refunds
6137 - $self->total_unapplied_credits
6138 - $self->total_unapplied_payments
6142 =item balance_date TIME
6144 Returns the balance for this customer, only considering invoices with date
6145 earlier than TIME (total_owed_date minus total_credited minus
6146 total_unapplied_payments). TIME is specified as a UNIX timestamp; see
6147 L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion
6156 $self->total_owed_date($time)
6157 + $self->total_unapplied_refunds
6158 - $self->total_unapplied_credits
6159 - $self->total_unapplied_payments
6163 =item in_transit_payments
6165 Returns the total of requests for payments for this customer pending in
6166 batches in transit to the bank. See L<FS::pay_batch> and L<FS::cust_pay_batch>
6170 sub in_transit_payments {
6172 my $in_transit_payments = 0;
6173 foreach my $pay_batch ( qsearch('pay_batch', {
6176 foreach my $cust_pay_batch ( qsearch('cust_pay_batch', {
6177 'batchnum' => $pay_batch->batchnum,
6178 'custnum' => $self->custnum,
6180 $in_transit_payments += $cust_pay_batch->amount;
6183 sprintf( "%.2f", $in_transit_payments );
6188 Returns a hash of useful information for making a payment.
6198 'CARD' (credit card - automatic), 'DCRD' (credit card - on-demand),
6199 'CHEK' (electronic check - automatic), 'DCHK' (electronic check - on-demand),
6200 'LECB' (Phone bill billing), 'BILL' (billing), or 'COMP' (free).
6204 For credit card transactions:
6216 For electronic check transactions:
6231 $return{balance} = $self->balance;
6233 $return{payname} = $self->payname
6234 || ( $self->first. ' '. $self->get('last') );
6236 $return{$_} = $self->get($_) for qw(address1 address2 city state zip);
6238 $return{payby} = $self->payby;
6239 $return{stateid_state} = $self->stateid_state;
6241 if ( $self->payby =~ /^(CARD|DCRD)$/ ) {
6242 $return{card_type} = cardtype($self->payinfo);
6243 $return{payinfo} = $self->paymask;
6245 @return{'month', 'year'} = $self->paydate_monthyear;
6249 if ( $self->payby =~ /^(CHEK|DCHK)$/ ) {
6250 my ($payinfo1, $payinfo2) = split '@', $self->paymask;
6251 $return{payinfo1} = $payinfo1;
6252 $return{payinfo2} = $payinfo2;
6253 $return{paytype} = $self->paytype;
6254 $return{paystate} = $self->paystate;
6258 #doubleclick protection
6260 $return{paybatch} = "webui-MyAccount-$_date-$$-". rand() * 2**32;
6266 =item paydate_monthyear
6268 Returns a two-element list consisting of the month and year of this customer's
6269 paydate (credit card expiration date for CARD customers)
6273 sub paydate_monthyear {
6275 if ( $self->paydate =~ /^(\d{4})-(\d{1,2})-\d{1,2}$/ ) { #Pg date format
6277 } elsif ( $self->paydate =~ /^(\d{1,2})-(\d{1,2}-)?(\d{4}$)/ ) {
6284 =item invoicing_list [ ARRAYREF ]
6286 If an arguement is given, sets these email addresses as invoice recipients
6287 (see L<FS::cust_main_invoice>). Errors are not fatal and are not reported
6288 (except as warnings), so use check_invoicing_list first.
6290 Returns a list of email addresses (with svcnum entries expanded).
6292 Note: You can clear the invoicing list by passing an empty ARRAYREF. You can
6293 check it without disturbing anything by passing nothing.
6295 This interface may change in the future.
6299 sub invoicing_list {
6300 my( $self, $arrayref ) = @_;
6303 my @cust_main_invoice;
6304 if ( $self->custnum ) {
6305 @cust_main_invoice =
6306 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
6308 @cust_main_invoice = ();
6310 foreach my $cust_main_invoice ( @cust_main_invoice ) {
6311 #warn $cust_main_invoice->destnum;
6312 unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
6313 #warn $cust_main_invoice->destnum;
6314 my $error = $cust_main_invoice->delete;
6315 warn $error if $error;
6318 if ( $self->custnum ) {
6319 @cust_main_invoice =
6320 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
6322 @cust_main_invoice = ();
6324 my %seen = map { $_->address => 1 } @cust_main_invoice;
6325 foreach my $address ( @{$arrayref} ) {
6326 next if exists $seen{$address} && $seen{$address};
6327 $seen{$address} = 1;
6328 my $cust_main_invoice = new FS::cust_main_invoice ( {
6329 'custnum' => $self->custnum,
6332 my $error = $cust_main_invoice->insert;
6333 warn $error if $error;
6337 if ( $self->custnum ) {
6339 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
6346 =item check_invoicing_list ARRAYREF
6348 Checks these arguements as valid input for the invoicing_list method. If there
6349 is an error, returns the error, otherwise returns false.
6353 sub check_invoicing_list {
6354 my( $self, $arrayref ) = @_;
6356 foreach my $address ( @$arrayref ) {
6358 if ($address eq 'FAX' and $self->getfield('fax') eq '') {
6359 return 'Can\'t add FAX invoice destination with a blank FAX number.';
6362 my $cust_main_invoice = new FS::cust_main_invoice ( {
6363 'custnum' => $self->custnum,
6366 my $error = $self->custnum
6367 ? $cust_main_invoice->check
6368 : $cust_main_invoice->checkdest
6370 return $error if $error;
6374 return "Email address required"
6375 if $conf->exists('cust_main-require_invoicing_list_email')
6376 && ! grep { $_ !~ /^([A-Z]+)$/ } @$arrayref;
6381 =item set_default_invoicing_list
6383 Sets the invoicing list to all accounts associated with this customer,
6384 overwriting any previous invoicing list.
6388 sub set_default_invoicing_list {
6390 $self->invoicing_list($self->all_emails);
6395 Returns the email addresses of all accounts provisioned for this customer.
6402 foreach my $cust_pkg ( $self->all_pkgs ) {
6403 my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
6405 map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
6406 grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
6408 $list{$_}=1 foreach map { $_->email } @svc_acct;
6413 =item invoicing_list_addpost
6415 Adds postal invoicing to this customer. If this customer is already configured
6416 to receive postal invoices, does nothing.
6420 sub invoicing_list_addpost {
6422 return if grep { $_ eq 'POST' } $self->invoicing_list;
6423 my @invoicing_list = $self->invoicing_list;
6424 push @invoicing_list, 'POST';
6425 $self->invoicing_list(\@invoicing_list);
6428 =item invoicing_list_emailonly
6430 Returns the list of email invoice recipients (invoicing_list without non-email
6431 destinations such as POST and FAX).
6435 sub invoicing_list_emailonly {
6437 warn "$me invoicing_list_emailonly called"
6439 grep { $_ !~ /^([A-Z]+)$/ } $self->invoicing_list;
6442 =item invoicing_list_emailonly_scalar
6444 Returns the list of email invoice recipients (invoicing_list without non-email
6445 destinations such as POST and FAX) as a comma-separated scalar.
6449 sub invoicing_list_emailonly_scalar {
6451 warn "$me invoicing_list_emailonly_scalar called"
6453 join(', ', $self->invoicing_list_emailonly);
6456 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
6458 Returns an array of customers referred by this customer (referral_custnum set
6459 to this custnum). If DEPTH is given, recurses up to the given depth, returning
6460 customers referred by customers referred by this customer and so on, inclusive.
6461 The default behavior is DEPTH 1 (no recursion).
6465 sub referral_cust_main {
6467 my $depth = @_ ? shift : 1;
6468 my $exclude = @_ ? shift : {};
6471 map { $exclude->{$_->custnum}++; $_; }
6472 grep { ! $exclude->{ $_->custnum } }
6473 qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
6477 map { $_->referral_cust_main($depth-1, $exclude) }
6484 =item referral_cust_main_ncancelled
6486 Same as referral_cust_main, except only returns customers with uncancelled
6491 sub referral_cust_main_ncancelled {
6493 grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
6496 =item referral_cust_pkg [ DEPTH ]
6498 Like referral_cust_main, except returns a flat list of all unsuspended (and
6499 uncancelled) packages for each customer. The number of items in this list may
6500 be useful for comission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
6504 sub referral_cust_pkg {
6506 my $depth = @_ ? shift : 1;
6508 map { $_->unsuspended_pkgs }
6509 grep { $_->unsuspended_pkgs }
6510 $self->referral_cust_main($depth);
6513 =item referring_cust_main
6515 Returns the single cust_main record for the customer who referred this customer
6516 (referral_custnum), or false.
6520 sub referring_cust_main {
6522 return '' unless $self->referral_custnum;
6523 qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
6526 =item credit AMOUNT, REASON [ , OPTION => VALUE ... ]
6528 Applies a credit to this customer. If there is an error, returns the error,
6529 otherwise returns false.
6531 REASON can be a text string, an FS::reason object, or a scalar reference to
6532 a reasonnum. If a text string, it will be automatically inserted as a new
6533 reason, and a 'reason_type' option must be passed to indicate the
6534 FS::reason_type for the new reason.
6536 An I<addlinfo> option may be passed to set the credit's I<addlinfo> field.
6538 Any other options are passed to FS::cust_credit::insert.
6543 my( $self, $amount, $reason, %options ) = @_;
6545 my $cust_credit = new FS::cust_credit {
6546 'custnum' => $self->custnum,
6547 'amount' => $amount,
6550 if ( ref($reason) ) {
6552 if ( ref($reason) eq 'SCALAR' ) {
6553 $cust_credit->reasonnum( $$reason );
6555 $cust_credit->reasonnum( $reason->reasonnum );
6559 $cust_credit->set('reason', $reason)
6562 $cust_credit->addlinfo( delete $options{'addlinfo'} )
6563 if exists($options{'addlinfo'});
6565 $cust_credit->insert(%options);
6569 =item charge AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
6571 Creates a one-time charge for this customer. If there is an error, returns
6572 the error, otherwise returns false.
6578 my ( $amount, $quantity, $pkg, $comment, $classnum, $additional );
6579 my ( $setuptax, $taxclass ); #internal taxes
6580 my ( $taxproduct, $override ); #vendor (CCH) taxes
6581 if ( ref( $_[0] ) ) {
6582 $amount = $_[0]->{amount};
6583 $quantity = exists($_[0]->{quantity}) ? $_[0]->{quantity} : 1;
6584 $pkg = exists($_[0]->{pkg}) ? $_[0]->{pkg} : 'One-time charge';
6585 $comment = exists($_[0]->{comment}) ? $_[0]->{comment}
6586 : '$'. sprintf("%.2f",$amount);
6587 $setuptax = exists($_[0]->{setuptax}) ? $_[0]->{setuptax} : '';
6588 $taxclass = exists($_[0]->{taxclass}) ? $_[0]->{taxclass} : '';
6589 $classnum = exists($_[0]->{classnum}) ? $_[0]->{classnum} : '';
6590 $additional = $_[0]->{additional};
6591 $taxproduct = $_[0]->{taxproductnum};
6592 $override = { '' => $_[0]->{tax_override} };
6596 $pkg = @_ ? shift : 'One-time charge';
6597 $comment = @_ ? shift : '$'. sprintf("%.2f",$amount);
6599 $taxclass = @_ ? shift : '';
6603 local $SIG{HUP} = 'IGNORE';
6604 local $SIG{INT} = 'IGNORE';
6605 local $SIG{QUIT} = 'IGNORE';
6606 local $SIG{TERM} = 'IGNORE';
6607 local $SIG{TSTP} = 'IGNORE';
6608 local $SIG{PIPE} = 'IGNORE';
6610 my $oldAutoCommit = $FS::UID::AutoCommit;
6611 local $FS::UID::AutoCommit = 0;
6614 my $part_pkg = new FS::part_pkg ( {
6616 'comment' => $comment,
6620 'classnum' => $classnum ? $classnum : '',
6621 'setuptax' => $setuptax,
6622 'taxclass' => $taxclass,
6623 'taxproductnum' => $taxproduct,
6626 my %options = ( ( map { ("additional_info$_" => $additional->[$_] ) }
6627 ( 0 .. @$additional - 1 )
6629 'additional_count' => scalar(@$additional),
6630 'setup_fee' => $amount,
6633 my $error = $part_pkg->insert( options => \%options,
6634 tax_overrides => $override,
6637 $dbh->rollback if $oldAutoCommit;
6641 my $pkgpart = $part_pkg->pkgpart;
6642 my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
6643 unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
6644 my $type_pkgs = new FS::type_pkgs \%type_pkgs;
6645 $error = $type_pkgs->insert;
6647 $dbh->rollback if $oldAutoCommit;
6652 my $cust_pkg = new FS::cust_pkg ( {
6653 'custnum' => $self->custnum,
6654 'pkgpart' => $pkgpart,
6655 'quantity' => $quantity,
6658 $error = $cust_pkg->insert;
6660 $dbh->rollback if $oldAutoCommit;
6664 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
6669 #=item charge_postal_fee
6671 #Applies a one time charge this customer. If there is an error,
6672 #returns the error, returns the cust_pkg charge object or false
6673 #if there was no charge.
6677 # This should be a customer event. For that to work requires that bill
6678 # also be a customer event.
6680 sub charge_postal_fee {
6683 my $pkgpart = $conf->config('postal_invoice-fee_pkgpart');
6684 return '' unless ($pkgpart && grep { $_ eq 'POST' } $self->invoicing_list);
6686 my $cust_pkg = new FS::cust_pkg ( {
6687 'custnum' => $self->custnum,
6688 'pkgpart' => $pkgpart,
6692 my $error = $cust_pkg->insert;
6693 $error ? $error : $cust_pkg;
6698 Returns all the invoices (see L<FS::cust_bill>) for this customer.
6704 sort { $a->_date <=> $b->_date }
6705 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
6708 =item open_cust_bill
6710 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
6715 sub open_cust_bill {
6717 grep { $_->owed > 0 } $self->cust_bill;
6722 Returns all the credits (see L<FS::cust_credit>) for this customer.
6728 sort { $a->_date <=> $b->_date }
6729 qsearch( 'cust_credit', { 'custnum' => $self->custnum } )
6734 Returns all the payments (see L<FS::cust_pay>) for this customer.
6740 sort { $a->_date <=> $b->_date }
6741 qsearch( 'cust_pay', { 'custnum' => $self->custnum } )
6746 Returns all voided payments (see L<FS::cust_pay_void>) for this customer.
6752 sort { $a->_date <=> $b->_date }
6753 qsearch( 'cust_pay_void', { 'custnum' => $self->custnum } )
6756 =item cust_pay_batch
6758 Returns all batched payments (see L<FS::cust_pay_void>) for this customer.
6762 sub cust_pay_batch {
6764 sort { $a->paybatchnum <=> $b->paybatchnum }
6765 qsearch( 'cust_pay_batch', { 'custnum' => $self->custnum } )
6768 =item cust_pay_pending
6770 Returns all pending payments (see L<FS::cust_pay_pending>) for this customer
6771 (without status "done").
6775 sub cust_pay_pending {
6777 return $self->num_cust_pay_pending unless wantarray;
6778 sort { $a->_date <=> $b->_date }
6779 qsearch( 'cust_pay_pending', {
6780 'custnum' => $self->custnum,
6781 'status' => { op=>'!=', value=>'done' },
6786 =item num_cust_pay_pending
6788 Returns the number of pending payments (see L<FS::cust_pay_pending>) for this
6789 customer (without status "done"). Also called automatically when the
6790 cust_pay_pending method is used in a scalar context.
6794 sub num_cust_pay_pending {
6796 my $sql = " SELECT COUNT(*) FROM cust_pay_pending ".
6797 " WHERE custnum = ? AND status != 'done' ";
6798 my $sth = dbh->prepare($sql) or die dbh->errstr;
6799 $sth->execute($self->custnum) or die $sth->errstr;
6800 $sth->fetchrow_arrayref->[0];
6805 Returns all the refunds (see L<FS::cust_refund>) for this customer.
6811 sort { $a->_date <=> $b->_date }
6812 qsearch( 'cust_refund', { 'custnum' => $self->custnum } )
6815 =item display_custnum
6817 Returns the displayed customer number for this customer: agent_custid if
6818 cust_main-default_agent_custid is set and it has a value, custnum otherwise.
6822 sub display_custnum {
6824 if ( $conf->exists('cust_main-default_agent_custid') && $self->agent_custid ){
6825 return $self->agent_custid;
6827 return $self->custnum;
6833 Returns a name string for this customer, either "Company (Last, First)" or
6840 my $name = $self->contact;
6841 $name = $self->company. " ($name)" if $self->company;
6847 Returns a name string for this (service/shipping) contact, either
6848 "Company (Last, First)" or "Last, First".
6854 if ( $self->get('ship_last') ) {
6855 my $name = $self->ship_contact;
6856 $name = $self->ship_company. " ($name)" if $self->ship_company;
6865 Returns a name string for this customer, either "Company" or "First Last".
6871 $self->company !~ /^\s*$/ ? $self->company : $self->contact_firstlast;
6874 =item ship_name_short
6876 Returns a name string for this (service/shipping) contact, either "Company"
6881 sub ship_name_short {
6883 if ( $self->get('ship_last') ) {
6884 $self->ship_company !~ /^\s*$/
6885 ? $self->ship_company
6886 : $self->ship_contact_firstlast;
6888 $self->name_company_or_firstlast;
6894 Returns this customer's full (billing) contact name only, "Last, First"
6900 $self->get('last'). ', '. $self->first;
6905 Returns this customer's full (shipping) contact name only, "Last, First"
6911 $self->get('ship_last')
6912 ? $self->get('ship_last'). ', '. $self->ship_first
6916 =item contact_firstlast
6918 Returns this customers full (billing) contact name only, "First Last".
6922 sub contact_firstlast {
6924 $self->first. ' '. $self->get('last');
6927 =item ship_contact_firstlast
6929 Returns this customer's full (shipping) contact name only, "First Last".
6933 sub ship_contact_firstlast {
6935 $self->get('ship_last')
6936 ? $self->first. ' '. $self->get('ship_last')
6937 : $self->contact_firstlast;
6942 Returns this customer's full country name
6948 code2country($self->country);
6951 =item geocode DATA_VENDOR
6953 Returns a value for the customer location as encoded by DATA_VENDOR.
6954 Currently this only makes sense for "CCH" as DATA_VENDOR.
6959 my ($self, $data_vendor) = (shift, shift); #always cch for now
6961 my $geocode = $self->get('geocode'); #XXX only one data_vendor for geocode
6962 return $geocode if $geocode;
6964 my $prefix = ( $conf->exists('tax-ship_address') && length($self->ship_last) )
6968 my ($zip,$plus4) = split /-/, $self->get("${prefix}zip")
6969 if $self->country eq 'US';
6971 #CCH specific location stuff
6972 my $extra_sql = "AND plus4lo <= '$plus4' AND plus4hi >= '$plus4'";
6974 my @cust_tax_location =
6976 'table' => 'cust_tax_location',
6977 'hashref' => { 'zip' => $zip, 'data_vendor' => $data_vendor },
6978 'extra_sql' => $extra_sql,
6979 'order_by' => 'ORDER BY plus4hi',#overlapping with distinct ends
6982 $geocode = $cust_tax_location[0]->geocode
6983 if scalar(@cust_tax_location);
6992 Returns a status string for this customer, currently:
6996 =item prospect - No packages have ever been ordered
6998 =item active - One or more recurring packages is active
7000 =item inactive - No active recurring packages, but otherwise unsuspended/uncancelled (the inactive status is new - previously inactive customers were mis-identified as cancelled)
7002 =item suspended - All non-cancelled recurring packages are suspended
7004 =item cancelled - All recurring packages are cancelled
7010 sub status { shift->cust_status(@_); }
7014 for my $status (qw( prospect active inactive suspended cancelled )) {
7015 my $method = $status.'_sql';
7016 my $numnum = ( my $sql = $self->$method() ) =~ s/cust_main\.custnum/?/g;
7017 my $sth = dbh->prepare("SELECT $sql") or die dbh->errstr;
7018 $sth->execute( ($self->custnum) x $numnum )
7019 or die "Error executing 'SELECT $sql': ". $sth->errstr;
7020 return $status if $sth->fetchrow_arrayref->[0];
7024 =item ucfirst_cust_status
7026 =item ucfirst_status
7028 Returns the status with the first character capitalized.
7032 sub ucfirst_status { shift->ucfirst_cust_status(@_); }
7034 sub ucfirst_cust_status {
7036 ucfirst($self->cust_status);
7041 Returns a hex triplet color string for this customer's status.
7045 use vars qw(%statuscolor);
7046 tie %statuscolor, 'Tie::IxHash',
7047 'prospect' => '7e0079', #'000000', #black? naw, purple
7048 'active' => '00CC00', #green
7049 'inactive' => '0000CC', #blue
7050 'suspended' => 'FF9900', #yellow
7051 'cancelled' => 'FF0000', #red
7054 sub statuscolor { shift->cust_statuscolor(@_); }
7056 sub cust_statuscolor {
7058 $statuscolor{$self->cust_status};
7063 Returns an array of hashes representing the customer's RT tickets.
7070 my $num = $conf->config('cust_main-max_tickets') || 10;
7073 if ( $conf->config('ticket_system') ) {
7074 unless ( $conf->config('ticket_system-custom_priority_field') ) {
7076 @tickets = @{ FS::TicketSystem->customer_tickets($self->custnum, $num) };
7080 foreach my $priority (
7081 $conf->config('ticket_system-custom_priority_field-values'), ''
7083 last if scalar(@tickets) >= $num;
7085 @{ FS::TicketSystem->customer_tickets( $self->custnum,
7086 $num - scalar(@tickets),
7096 # Return services representing svc_accts in customer support packages
7097 sub support_services {
7099 my %packages = map { $_ => 1 } $conf->config('support_packages');
7101 grep { $_->pkg_svc && $_->pkg_svc->primary_svc eq 'Y' }
7102 grep { $_->part_svc->svcdb eq 'svc_acct' }
7103 map { $_->cust_svc }
7104 grep { exists $packages{ $_->pkgpart } }
7105 $self->ncancelled_pkgs;
7111 =head1 CLASS METHODS
7117 Class method that returns the list of possible status strings for customers
7118 (see L<the status method|/status>). For example:
7120 @statuses = FS::cust_main->statuses();
7125 #my $self = shift; #could be class...
7131 Returns an SQL expression identifying prospective cust_main records (customers
7132 with no packages ever ordered)
7136 use vars qw($select_count_pkgs);
7137 $select_count_pkgs =
7138 "SELECT COUNT(*) FROM cust_pkg
7139 WHERE cust_pkg.custnum = cust_main.custnum";
7141 sub select_count_pkgs_sql {
7145 sub prospect_sql { "
7146 0 = ( $select_count_pkgs )
7151 Returns an SQL expression identifying active cust_main records (customers with
7152 active recurring packages).
7157 0 < ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. "
7163 Returns an SQL expression identifying inactive cust_main records (customers with
7164 no active recurring packages, but otherwise unsuspended/uncancelled).
7168 sub inactive_sql { "
7169 0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " )
7171 0 < ( $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " )
7177 Returns an SQL expression identifying suspended cust_main records.
7182 sub suspended_sql { susp_sql(@_); }
7184 0 < ( $select_count_pkgs AND ". FS::cust_pkg->suspended_sql. " )
7186 0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " )
7192 Returns an SQL expression identifying cancelled cust_main records.
7196 sub cancelled_sql { cancel_sql(@_); }
7199 my $recurring_sql = FS::cust_pkg->recurring_sql;
7200 my $cancelled_sql = FS::cust_pkg->cancelled_sql;
7203 0 < ( $select_count_pkgs )
7204 AND 0 < ( $select_count_pkgs AND $recurring_sql AND $cancelled_sql )
7205 AND 0 = ( $select_count_pkgs AND $recurring_sql
7206 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
7208 AND 0 = ( $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " )
7214 =item uncancelled_sql
7216 Returns an SQL expression identifying un-cancelled cust_main records.
7220 sub uncancelled_sql { uncancel_sql(@_); }
7221 sub uncancel_sql { "
7222 ( 0 < ( $select_count_pkgs
7223 AND ( cust_pkg.cancel IS NULL
7224 OR cust_pkg.cancel = 0
7227 OR 0 = ( $select_count_pkgs )
7233 Returns an SQL fragment to retreive the balance.
7238 ( SELECT COALESCE( SUM(charged), 0 ) FROM cust_bill
7239 WHERE cust_bill.custnum = cust_main.custnum )
7240 - ( SELECT COALESCE( SUM(paid), 0 ) FROM cust_pay
7241 WHERE cust_pay.custnum = cust_main.custnum )
7242 - ( SELECT COALESCE( SUM(amount), 0 ) FROM cust_credit
7243 WHERE cust_credit.custnum = cust_main.custnum )
7244 + ( SELECT COALESCE( SUM(refund), 0 ) FROM cust_refund
7245 WHERE cust_refund.custnum = cust_main.custnum )
7248 =item balance_date_sql START_TIME [ END_TIME [ OPTION => VALUE ... ] ]
7250 Returns an SQL fragment to retreive the balance for this customer, only
7251 considering invoices with date earlier than START_TIME, and optionally not
7252 later than END_TIME (total_owed_date minus total_unapplied_credits minus
7253 total_unapplied_payments).
7255 Times are specified as SQL fragments or numeric
7256 UNIX timestamps; see L<perlfunc/"time">). Also see L<Time::Local> and
7257 L<Date::Parse> for conversion functions. The empty string can be passed
7258 to disable that time constraint completely.
7260 Available options are:
7264 =item unapplied_date
7266 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)
7271 set to true to remove all customer comparison clauses, for totals
7276 WHERE clause hashref (elements "AND"ed together) (typically used with the total option)
7281 JOIN clause (typically used with the total option)
7287 sub balance_date_sql {
7288 my( $class, $start, $end, %opt ) = @_;
7290 my $owed = FS::cust_bill->owed_sql;
7291 my $unapp_refund = FS::cust_refund->unapplied_sql;
7292 my $unapp_credit = FS::cust_credit->unapplied_sql;
7293 my $unapp_pay = FS::cust_pay->unapplied_sql;
7295 my $j = $opt{'join'} || '';
7297 my $owed_wh = $class->_money_table_where( 'cust_bill', $start,$end,%opt );
7298 my $refund_wh = $class->_money_table_where( 'cust_refund', $start,$end,%opt );
7299 my $credit_wh = $class->_money_table_where( 'cust_credit', $start,$end,%opt );
7300 my $pay_wh = $class->_money_table_where( 'cust_pay', $start,$end,%opt );
7302 " ( SELECT COALESCE(SUM($owed), 0) FROM cust_bill $j $owed_wh )
7303 + ( SELECT COALESCE(SUM($unapp_refund), 0) FROM cust_refund $j $refund_wh )
7304 - ( SELECT COALESCE(SUM($unapp_credit), 0) FROM cust_credit $j $credit_wh )
7305 - ( SELECT COALESCE(SUM($unapp_pay), 0) FROM cust_pay $j $pay_wh )
7310 =item _money_table_where TABLE START_TIME [ END_TIME [ OPTION => VALUE ... ] ]
7312 Helper method for balance_date_sql; name (and usage) subject to change
7313 (suggestions welcome).
7315 Returns a WHERE clause for the specified monetary TABLE (cust_bill,
7316 cust_refund, cust_credit or cust_pay).
7318 If TABLE is "cust_bill" or the unapplied_date option is true, only
7319 considers records with date earlier than START_TIME, and optionally not
7320 later than END_TIME .
7324 sub _money_table_where {
7325 my( $class, $table, $start, $end, %opt ) = @_;
7328 push @where, "cust_main.custnum = $table.custnum" unless $opt{'total'};
7329 if ( $table eq 'cust_bill' || $opt{'unapplied_date'} ) {
7330 push @where, "$table._date <= $start" if defined($start) && length($start);
7331 push @where, "$table._date > $end" if defined($end) && length($end);
7333 push @where, @{$opt{'where'}} if $opt{'where'};
7334 my $where = scalar(@where) ? 'WHERE '. join(' AND ', @where ) : '';
7340 =item search_sql HASHREF
7344 Returns a qsearch hash expression to search for parameters specified in HREF.
7345 Valid parameters are
7353 =item cancelled_pkgs
7359 listref of start date, end date
7365 =item current_balance
7367 listref (list returned by FS::UI::Web::parse_lt_gt($cgi, 'current_balance'))
7371 =item flattened_pkgs
7380 my ($class, $params) = @_;
7391 if ( $params->{'agentnum'} =~ /^(\d+)$/ and $1 ) {
7393 "cust_main.agentnum = $1";
7400 #prospect active inactive suspended cancelled
7401 if ( grep { $params->{'status'} eq $_ } FS::cust_main->statuses() ) {
7402 my $method = $params->{'status'}. '_sql';
7403 #push @where, $class->$method();
7404 push @where, FS::cust_main->$method();
7408 # parse cancelled package checkbox
7413 $pkgwhere .= "AND (cancel = 0 or cancel is null)"
7414 unless $params->{'cancelled_pkgs'};
7420 foreach my $field (qw( signupdate )) {
7422 next unless exists($params->{$field});
7424 my($beginning, $ending) = @{$params->{$field}};
7427 "cust_main.$field IS NOT NULL",
7428 "cust_main.$field >= $beginning",
7429 "cust_main.$field <= $ending";
7431 $orderby ||= "ORDER BY cust_main.$field";
7439 my @payby = grep /^([A-Z]{4})$/, @{ $params->{'payby'} };
7441 push @where, '( '. join(' OR ', map "cust_main.payby = '$_'", @payby). ' )';
7448 #my $balance_sql = $class->balance_sql();
7449 my $balance_sql = FS::cust_main->balance_sql();
7451 push @where, map { s/current_balance/$balance_sql/; $_ }
7452 @{ $params->{'current_balance'} };
7458 if ( $params->{'custbatch'} =~ /^([\w\/\-\:\.]+)$/ and $1 ) {
7460 "cust_main.custbatch = '$1'";
7464 # setup queries, subs, etc. for the search
7467 $orderby ||= 'ORDER BY custnum';
7469 # here is the agent virtualization
7470 push @where, $FS::CurrentUser::CurrentUser->agentnums_sql;
7472 my $extra_sql = scalar(@where) ? ' WHERE '. join(' AND ', @where) : '';
7474 my $addl_from = 'LEFT JOIN cust_pkg USING ( custnum ) ';
7476 my $count_query = "SELECT COUNT(*) FROM cust_main $extra_sql";
7478 my $select = join(', ',
7479 'cust_main.custnum',
7480 FS::UI::Web::cust_sql_fields($params->{'cust_fields'}),
7483 my(@extra_headers) = ();
7484 my(@extra_fields) = ();
7486 if ($params->{'flattened_pkgs'}) {
7488 if ($dbh->{Driver}->{Name} eq 'Pg') {
7490 $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";
7492 }elsif ($dbh->{Driver}->{Name} =~ /^mysql/i) {
7493 $select .= ", GROUP_CONCAT(pkg SEPARATOR '|') as magic";
7494 $addl_from .= " LEFT JOIN part_pkg using ( pkgpart )";
7496 warn "warning: unknown database type ". $dbh->{Driver}->{Name}.
7497 "omitting packing information from report.";
7500 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";
7502 my $sth = dbh->prepare($header_query) or die dbh->errstr;
7503 $sth->execute() or die $sth->errstr;
7504 my $headerrow = $sth->fetchrow_arrayref;
7505 my $headercount = $headerrow ? $headerrow->[0] : 0;
7506 while($headercount) {
7507 unshift @extra_headers, "Package ". $headercount;
7508 unshift @extra_fields, eval q!sub {my $c = shift;
7509 my @a = split '\|', $c->magic;
7510 my $p = $a[!.--$headercount. q!];
7518 'table' => 'cust_main',
7519 'select' => $select,
7521 'extra_sql' => $extra_sql,
7522 'order_by' => $orderby,
7523 'count_query' => $count_query,
7524 'extra_headers' => \@extra_headers,
7525 'extra_fields' => \@extra_fields,
7530 =item email_search_sql HASHREF
7534 Emails a notice to the specified customers.
7536 Valid parameters are those of the L<search_sql> method, plus the following:
7558 Optional job queue job for status updates.
7562 Returns an error message, or false for success.
7564 If an error occurs during any email, stops the enture send and returns that
7565 error. Presumably if you're getting SMTP errors aborting is better than
7566 retrying everything.
7570 sub email_search_sql {
7571 my($class, $params) = @_;
7573 my $from = delete $params->{from};
7574 my $subject = delete $params->{subject};
7575 my $html_body = delete $params->{html_body};
7576 my $text_body = delete $params->{text_body};
7578 my $job = delete $params->{'job'};
7580 my $sql_query = $class->search_sql($params);
7582 my $count_query = delete($sql_query->{'count_query'});
7583 my $count_sth = dbh->prepare($count_query)
7584 or die "Error preparing $count_query: ". dbh->errstr;
7586 or die "Error executing $count_query: ". $count_sth->errstr;
7587 my $count_arrayref = $count_sth->fetchrow_arrayref;
7588 my $num_cust = $count_arrayref->[0];
7590 #my @extra_headers = @{ delete($sql_query->{'extra_headers'}) };
7591 #my @extra_fields = @{ delete($sql_query->{'extra_fields'}) };
7594 my( $num, $last, $min_sec ) = (0, time, 5); #progresbar foo
7596 #eventually order+limit magic to reduce memory use?
7597 foreach my $cust_main ( qsearch($sql_query) ) {
7599 my $to = $cust_main->invoicing_list_emailonly_scalar;
7602 my $error = send_email(
7606 'subject' => $subject,
7607 'html_body' => $html_body,
7608 'text_body' => $text_body,
7611 return $error if $error;
7613 if ( $job ) { #progressbar foo
7615 if ( time - $min_sec > $last ) {
7616 my $error = $job->update_statustext(
7617 int( 100 * $num / $num_cust )
7619 die $error if $error;
7629 use Storable qw(thaw);
7632 sub process_email_search_sql {
7634 #warn "$me process_re_X $method for job $job\n" if $DEBUG;
7636 my $param = thaw(decode_base64(shift));
7637 warn Dumper($param) if $DEBUG;
7639 $param->{'job'} = $job;
7641 my $error = FS::cust_main->email_search_sql( $param );
7642 die $error if $error;
7646 =item fuzzy_search FUZZY_HASHREF [ HASHREF, SELECT, EXTRA_SQL, CACHE_OBJ ]
7648 Performs a fuzzy (approximate) search and returns the matching FS::cust_main
7649 records. Currently, I<first>, I<last> and/or I<company> may be specified (the
7650 appropriate ship_ field is also searched).
7652 Additional options are the same as FS::Record::qsearch
7657 my( $self, $fuzzy, $hash, @opt) = @_;
7662 check_and_rebuild_fuzzyfiles();
7663 foreach my $field ( keys %$fuzzy ) {
7665 my $all = $self->all_X($field);
7666 next unless scalar(@$all);
7669 $match{$_}=1 foreach ( amatch( $fuzzy->{$field}, ['i'], @$all ) );
7672 foreach ( keys %match ) {
7673 push @fcust, qsearch('cust_main', { %$hash, $field=>$_}, @opt);
7674 push @fcust, qsearch('cust_main', { %$hash, "ship_$field"=>$_}, @opt);
7677 push @cust_main, grep { ! $fsaw{$_->custnum}++ } @fcust;
7680 # we want the components of $fuzzy ANDed, not ORed, but still don't want dupes
7682 @cust_main = grep { ++$saw{$_->custnum} == scalar(keys %$fuzzy) } @cust_main;
7690 Returns a masked version of the named field
7695 my ($self,$field) = @_;
7699 'x'x(length($self->getfield($field))-4).
7700 substr($self->getfield($field), (length($self->getfield($field))-4));
7710 =item smart_search OPTION => VALUE ...
7712 Accepts the following options: I<search>, the string to search for. The string
7713 will be searched for as a customer number, phone number, name or company name,
7714 as an exact, or, in some cases, a substring or fuzzy match (see the source code
7715 for the exact heuristics used); I<no_fuzzy_on_exact>, causes smart_search to
7716 skip fuzzy matching when an exact match is found.
7718 Any additional options are treated as an additional qualifier on the search
7721 Returns a (possibly empty) array of FS::cust_main objects.
7728 #here is the agent virtualization
7729 my $agentnums_sql = $FS::CurrentUser::CurrentUser->agentnums_sql;
7733 my $skip_fuzzy = delete $options{'no_fuzzy_on_exact'};
7734 my $search = delete $options{'search'};
7735 ( my $alphanum_search = $search ) =~ s/\W//g;
7737 if ( $alphanum_search =~ /^1?(\d{3})(\d{3})(\d{4})(\d*)$/ ) { #phone# search
7739 #false laziness w/Record::ut_phone
7740 my $phonen = "$1-$2-$3";
7741 $phonen .= " x$4" if $4;
7743 push @cust_main, qsearch( {
7744 'table' => 'cust_main',
7745 'hashref' => { %options },
7746 'extra_sql' => ( scalar(keys %options) ? ' AND ' : ' WHERE ' ).
7748 join(' OR ', map "$_ = '$phonen'",
7749 qw( daytime night fax
7750 ship_daytime ship_night ship_fax )
7753 " AND $agentnums_sql", #agent virtualization
7756 unless ( @cust_main || $phonen =~ /x\d+$/ ) { #no exact match
7757 #try looking for matches with extensions unless one was specified
7759 push @cust_main, qsearch( {
7760 'table' => 'cust_main',
7761 'hashref' => { %options },
7762 'extra_sql' => ( scalar(keys %options) ? ' AND ' : ' WHERE ' ).
7764 join(' OR ', map "$_ LIKE '$phonen\%'",
7766 ship_daytime ship_night )
7769 " AND $agentnums_sql", #agent virtualization
7774 # custnum search (also try agent_custid), with some tweaking options if your
7775 # legacy cust "numbers" have letters
7778 if ( $search =~ /^\s*(\d+)\s*$/
7779 || ( $conf->config('cust_main-agent_custid-format') eq 'ww?d+'
7780 && $search =~ /^\s*(\w\w?\d+)\s*$/
7787 if ( $num <= 2147483647 ) { #need a bigint custnum? wow.
7788 push @cust_main, qsearch( {
7789 'table' => 'cust_main',
7790 'hashref' => { 'custnum' => $num, %options },
7791 'extra_sql' => " AND $agentnums_sql", #agent virtualization
7795 push @cust_main, qsearch( {
7796 'table' => 'cust_main',
7797 'hashref' => { 'agent_custid' => $num, %options },
7798 'extra_sql' => " AND $agentnums_sql", #agent virtualization
7801 } elsif ( $search =~ /^\s*(\S.*\S)\s+\((.+), ([^,]+)\)\s*$/ ) {
7803 my($company, $last, $first) = ( $1, $2, $3 );
7805 # "Company (Last, First)"
7806 #this is probably something a browser remembered,
7807 #so just do an exact search
7809 foreach my $prefix ( '', 'ship_' ) {
7810 push @cust_main, qsearch( {
7811 'table' => 'cust_main',
7812 'hashref' => { $prefix.'first' => $first,
7813 $prefix.'last' => $last,
7814 $prefix.'company' => $company,
7817 'extra_sql' => " AND $agentnums_sql",
7821 } elsif ( $search =~ /^\s*(\S.*\S)\s*$/ ) { # value search
7822 # try (ship_){last,company}
7826 # # remove "(Last, First)" in "Company (Last, First)", otherwise the
7827 # # full strings the browser remembers won't work
7828 # $value =~ s/\([\w \,\.\-\']*\)$//; #false laziness w/Record::ut_name
7830 use Lingua::EN::NameParse;
7831 my $NameParse = new Lingua::EN::NameParse(
7833 allow_reversed => 1,
7836 my($last, $first) = ( '', '' );
7837 #maybe disable this too and just rely on NameParse?
7838 if ( $value =~ /^(.+),\s*([^,]+)$/ ) { # Last, First
7840 ($last, $first) = ( $1, $2 );
7842 #} elsif ( $value =~ /^(.+)\s+(.+)$/ ) {
7843 } elsif ( ! $NameParse->parse($value) ) {
7845 my %name = $NameParse->components;
7846 $first = $name{'given_name_1'};
7847 $last = $name{'surname_1'};
7851 if ( $first && $last ) {
7853 my($q_last, $q_first) = ( dbh->quote($last), dbh->quote($first) );
7856 my $sql = scalar(keys %options) ? ' AND ' : ' WHERE ';
7858 ( ( LOWER(last) = $q_last AND LOWER(first) = $q_first )
7859 OR ( LOWER(ship_last) = $q_last AND LOWER(ship_first) = $q_first )
7862 push @cust_main, qsearch( {
7863 'table' => 'cust_main',
7864 'hashref' => \%options,
7865 'extra_sql' => "$sql AND $agentnums_sql", #agent virtualization
7868 # or it just be something that was typed in... (try that in a sec)
7872 my $q_value = dbh->quote($value);
7875 my $sql = scalar(keys %options) ? ' AND ' : ' WHERE ';
7876 $sql .= " ( LOWER(last) = $q_value
7877 OR LOWER(company) = $q_value
7878 OR LOWER(ship_last) = $q_value
7879 OR LOWER(ship_company) = $q_value
7882 push @cust_main, qsearch( {
7883 'table' => 'cust_main',
7884 'hashref' => \%options,
7885 'extra_sql' => "$sql AND $agentnums_sql", #agent virtualization
7888 #no exact match, trying substring/fuzzy
7889 #always do substring & fuzzy (unless they're explicity config'ed off)
7890 #getting complaints searches are not returning enough
7891 unless ( @cust_main && $skip_fuzzy || $conf->exists('disable-fuzzy') ) {
7893 #still some false laziness w/search_sql (was search/cust_main.cgi)
7898 { 'company' => { op=>'ILIKE', value=>"%$value%" }, },
7899 { 'ship_company' => { op=>'ILIKE', value=>"%$value%" }, },
7902 if ( $first && $last ) {
7905 { 'first' => { op=>'ILIKE', value=>"%$first%" },
7906 'last' => { op=>'ILIKE', value=>"%$last%" },
7908 { 'ship_first' => { op=>'ILIKE', value=>"%$first%" },
7909 'ship_last' => { op=>'ILIKE', value=>"%$last%" },
7916 { 'last' => { op=>'ILIKE', value=>"%$value%" }, },
7917 { 'ship_last' => { op=>'ILIKE', value=>"%$value%" }, },
7921 foreach my $hashref ( @hashrefs ) {
7923 push @cust_main, qsearch( {
7924 'table' => 'cust_main',
7925 'hashref' => { %$hashref,
7928 'extra_sql' => " AND $agentnums_sql", #agent virtualizaiton
7937 " AND $agentnums_sql", #extra_sql #agent virtualization
7940 if ( $first && $last ) {
7941 push @cust_main, FS::cust_main->fuzzy_search(
7942 { 'last' => $last, #fuzzy hashref
7943 'first' => $first }, #
7947 foreach my $field ( 'last', 'company' ) {
7949 FS::cust_main->fuzzy_search( { $field => $value }, @fuzopts );
7954 #eliminate duplicates
7956 @cust_main = grep { !$saw{$_->custnum}++ } @cust_main;
7966 Accepts the following options: I<email>, the email address to search for. The
7967 email address will be searched for as an email invoice destination and as an
7970 #Any additional options are treated as an additional qualifier on the search
7971 #(i.e. I<agentnum>).
7973 Returns a (possibly empty) array of FS::cust_main objects (but usually just
7983 my $email = delete $options{'email'};
7985 #we're only being used by RT at the moment... no agent virtualization yet
7986 #my $agentnums_sql = $FS::CurrentUser::CurrentUser->agentnums_sql;
7990 if ( $email =~ /([^@]+)\@([^@]+)/ ) {
7992 my ( $user, $domain ) = ( $1, $2 );
7994 warn "$me smart_search: searching for $user in domain $domain"
8000 'table' => 'cust_main_invoice',
8001 'hashref' => { 'dest' => $email },
8008 map $_->cust_svc->cust_pkg,
8010 'table' => 'svc_acct',
8011 'hashref' => { 'username' => $user, },
8013 'AND ( SELECT domain FROM svc_domain
8014 WHERE svc_acct.domsvc = svc_domain.svcnum
8015 ) = '. dbh->quote($domain),
8021 @cust_main = grep { !$saw{$_->custnum}++ } @cust_main;
8023 warn "$me smart_search: found ". scalar(@cust_main). " unique customers"
8030 =item check_and_rebuild_fuzzyfiles
8034 use vars qw(@fuzzyfields);
8035 @fuzzyfields = ( 'last', 'first', 'company' );
8037 sub check_and_rebuild_fuzzyfiles {
8038 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
8039 rebuild_fuzzyfiles() if grep { ! -e "$dir/cust_main.$_" } @fuzzyfields
8042 =item rebuild_fuzzyfiles
8046 sub rebuild_fuzzyfiles {
8048 use Fcntl qw(:flock);
8050 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
8051 mkdir $dir, 0700 unless -d $dir;
8053 foreach my $fuzzy ( @fuzzyfields ) {
8055 open(LOCK,">>$dir/cust_main.$fuzzy")
8056 or die "can't open $dir/cust_main.$fuzzy: $!";
8058 or die "can't lock $dir/cust_main.$fuzzy: $!";
8060 open (CACHE,">$dir/cust_main.$fuzzy.tmp")
8061 or die "can't open $dir/cust_main.$fuzzy.tmp: $!";
8063 foreach my $field ( $fuzzy, "ship_$fuzzy" ) {
8064 my $sth = dbh->prepare("SELECT $field FROM cust_main".
8065 " WHERE $field != '' AND $field IS NOT NULL");
8066 $sth->execute or die $sth->errstr;
8068 while ( my $row = $sth->fetchrow_arrayref ) {
8069 print CACHE $row->[0]. "\n";
8074 close CACHE or die "can't close $dir/cust_main.$fuzzy.tmp: $!";
8076 rename "$dir/cust_main.$fuzzy.tmp", "$dir/cust_main.$fuzzy";
8087 my( $self, $field ) = @_;
8088 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
8089 open(CACHE,"<$dir/cust_main.$field")
8090 or die "can't open $dir/cust_main.$field: $!";
8091 my @array = map { chomp; $_; } <CACHE>;
8096 =item append_fuzzyfiles LASTNAME COMPANY
8100 sub append_fuzzyfiles {
8101 #my( $first, $last, $company ) = @_;
8103 &check_and_rebuild_fuzzyfiles;
8105 use Fcntl qw(:flock);
8107 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
8109 foreach my $field (qw( first last company )) {
8114 open(CACHE,">>$dir/cust_main.$field")
8115 or die "can't open $dir/cust_main.$field: $!";
8116 flock(CACHE,LOCK_EX)
8117 or die "can't lock $dir/cust_main.$field: $!";
8119 print CACHE "$value\n";
8121 flock(CACHE,LOCK_UN)
8122 or die "can't unlock $dir/cust_main.$field: $!";
8137 #warn join('-',keys %$param);
8138 my $fh = $param->{filehandle};
8139 my @fields = @{$param->{fields}};
8141 eval "use Text::CSV_XS;";
8144 my $csv = new Text::CSV_XS;
8151 local $SIG{HUP} = 'IGNORE';
8152 local $SIG{INT} = 'IGNORE';
8153 local $SIG{QUIT} = 'IGNORE';
8154 local $SIG{TERM} = 'IGNORE';
8155 local $SIG{TSTP} = 'IGNORE';
8156 local $SIG{PIPE} = 'IGNORE';
8158 my $oldAutoCommit = $FS::UID::AutoCommit;
8159 local $FS::UID::AutoCommit = 0;
8162 #while ( $columns = $csv->getline($fh) ) {
8164 while ( defined($line=<$fh>) ) {
8166 $csv->parse($line) or do {
8167 $dbh->rollback if $oldAutoCommit;
8168 return "can't parse: ". $csv->error_input();
8171 my @columns = $csv->fields();
8172 #warn join('-',@columns);
8175 foreach my $field ( @fields ) {
8176 $row{$field} = shift @columns;
8179 my $cust_main = qsearchs('cust_main', { 'custnum' => $row{'custnum'} } );
8180 unless ( $cust_main ) {
8181 $dbh->rollback if $oldAutoCommit;
8182 return "unknown custnum $row{'custnum'}";
8185 if ( $row{'amount'} > 0 ) {
8186 my $error = $cust_main->charge($row{'amount'}, $row{'pkg'});
8188 $dbh->rollback if $oldAutoCommit;
8192 } elsif ( $row{'amount'} < 0 ) {
8193 my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ),
8196 $dbh->rollback if $oldAutoCommit;
8206 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
8208 return "Empty file!" unless $imported;
8214 =item notify CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
8216 Sends a templated email notification to the customer (see L<Text::Template>).
8218 OPTIONS is a hash and may include
8220 I<from> - the email sender (default is invoice_from)
8222 I<to> - comma-separated scalar or arrayref of recipients
8223 (default is invoicing_list)
8225 I<subject> - The subject line of the sent email notification
8226 (default is "Notice from company_name")
8228 I<extra_fields> - a hashref of name/value pairs which will be substituted
8231 The following variables are vavailable in the template.
8233 I<$first> - the customer first name
8234 I<$last> - the customer last name
8235 I<$company> - the customer company
8236 I<$payby> - a description of the method of payment for the customer
8237 # would be nice to use FS::payby::shortname
8238 I<$payinfo> - the account information used to collect for this customer
8239 I<$expdate> - the expiration of the customer payment in seconds from epoch
8244 my ($self, $template, %options) = @_;
8246 return unless $conf->exists($template);
8248 my $from = $conf->config('invoice_from', $self->agentnum)
8249 if $conf->exists('invoice_from', $self->agentnum);
8250 $from = $options{from} if exists($options{from});
8252 my $to = join(',', $self->invoicing_list_emailonly);
8253 $to = $options{to} if exists($options{to});
8255 my $subject = "Notice from " . $conf->config('company_name', $self->agentnum)
8256 if $conf->exists('company_name', $self->agentnum);
8257 $subject = $options{subject} if exists($options{subject});
8259 my $notify_template = new Text::Template (TYPE => 'ARRAY',
8260 SOURCE => [ map "$_\n",
8261 $conf->config($template)]
8263 or die "can't create new Text::Template object: Text::Template::ERROR";
8264 $notify_template->compile()
8265 or die "can't compile template: Text::Template::ERROR";
8267 $FS::notify_template::_template::company_name =
8268 $conf->config('company_name', $self->agentnum);
8269 $FS::notify_template::_template::company_address =
8270 join("\n", $conf->config('company_address', $self->agentnum) ). "\n";
8272 my $paydate = $self->paydate || '2037-12-31';
8273 $FS::notify_template::_template::first = $self->first;
8274 $FS::notify_template::_template::last = $self->last;
8275 $FS::notify_template::_template::company = $self->company;
8276 $FS::notify_template::_template::payinfo = $self->mask_payinfo;
8277 my $payby = $self->payby;
8278 my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
8279 my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
8281 #credit cards expire at the end of the month/year of their exp date
8282 if ($payby eq 'CARD' || $payby eq 'DCRD') {
8283 $FS::notify_template::_template::payby = 'credit card';
8284 ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
8285 $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
8287 }elsif ($payby eq 'COMP') {
8288 $FS::notify_template::_template::payby = 'complimentary account';
8290 $FS::notify_template::_template::payby = 'current method';
8292 $FS::notify_template::_template::expdate = $expire_time;
8294 for (keys %{$options{extra_fields}}){
8296 ${"FS::notify_template::_template::$_"} = $options{extra_fields}->{$_};
8299 send_email(from => $from,
8301 subject => $subject,
8302 body => $notify_template->fill_in( PACKAGE =>
8303 'FS::notify_template::_template' ),
8308 =item generate_letter CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
8310 Generates a templated notification to the customer (see L<Text::Template>).
8312 OPTIONS is a hash and may include
8314 I<extra_fields> - a hashref of name/value pairs which will be substituted
8315 into the template. These values may override values mentioned below
8316 and those from the customer record.
8318 The following variables are available in the template instead of or in addition
8319 to the fields of the customer record.
8321 I<$payby> - a description of the method of payment for the customer
8322 # would be nice to use FS::payby::shortname
8323 I<$payinfo> - the masked account information used to collect for this customer
8324 I<$expdate> - the expiration of the customer payment method in seconds from epoch
8325 I<$returnaddress> - the return address defaults to invoice_latexreturnaddress or company_address
8329 sub generate_letter {
8330 my ($self, $template, %options) = @_;
8332 return unless $conf->exists($template);
8334 my $letter_template = new Text::Template
8336 SOURCE => [ map "$_\n", $conf->config($template)],
8337 DELIMITERS => [ '[@--', '--@]' ],
8339 or die "can't create new Text::Template object: Text::Template::ERROR";
8341 $letter_template->compile()
8342 or die "can't compile template: Text::Template::ERROR";
8344 my %letter_data = map { $_ => $self->$_ } $self->fields;
8345 $letter_data{payinfo} = $self->mask_payinfo;
8347 #my $paydate = $self->paydate || '2037-12-31';
8348 my $paydate = $self->paydate =~ /^\S+$/ ? $self->paydate : '2037-12-31';
8350 my $payby = $self->payby;
8351 my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
8352 my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
8354 #credit cards expire at the end of the month/year of their exp date
8355 if ($payby eq 'CARD' || $payby eq 'DCRD') {
8356 $letter_data{payby} = 'credit card';
8357 ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
8358 $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
8360 }elsif ($payby eq 'COMP') {
8361 $letter_data{payby} = 'complimentary account';
8363 $letter_data{payby} = 'current method';
8365 $letter_data{expdate} = $expire_time;
8367 for (keys %{$options{extra_fields}}){
8368 $letter_data{$_} = $options{extra_fields}->{$_};
8371 unless(exists($letter_data{returnaddress})){
8372 my $retadd = join("\n", $conf->config_orbase( 'invoice_latexreturnaddress',
8373 $self->agent_template)
8375 if ( length($retadd) ) {
8376 $letter_data{returnaddress} = $retadd;
8377 } elsif ( grep /\S/, $conf->config('company_address', $self->agentnum) ) {
8378 $letter_data{returnaddress} =
8379 join( '\\*'."\n", map s/( {2,})/'~' x length($1)/eg,
8380 $conf->config('company_address', $self->agentnum)
8383 $letter_data{returnaddress} = '~';
8387 $letter_data{conf_dir} = "$FS::UID::conf_dir/conf.$FS::UID::datasrc";
8389 $letter_data{company_name} = $conf->config('company_name', $self->agentnum);
8391 my $dir = $FS::UID::conf_dir."/cache.". $FS::UID::datasrc;
8392 my $fh = new File::Temp( TEMPLATE => 'letter.'. $self->custnum. '.XXXXXXXX',
8396 ) or die "can't open temp file: $!\n";
8398 $letter_template->fill_in( OUTPUT => $fh, HASH => \%letter_data );
8400 $fh->filename =~ /^(.*).tex$/ or die "unparsable filename: ". $fh->filename;
8404 =item print_ps TEMPLATE
8406 Returns an postscript letter filled in from TEMPLATE, as a scalar.
8412 my $file = $self->generate_letter(@_);
8413 FS::Misc::generate_ps($file);
8416 =item print TEMPLATE
8418 Prints the filled in template.
8420 TEMPLATE is the name of a L<Text::Template> to fill in and print.
8424 sub queueable_print {
8427 my $self = qsearchs('cust_main', { 'custnum' => $opt{custnum} } )
8428 or die "invalid customer number: " . $opt{custvnum};
8430 my $error = $self->print( $opt{template} );
8431 die $error if $error;
8435 my ($self, $template) = (shift, shift);
8436 do_print [ $self->print_ps($template) ];
8439 #these three subs should just go away once agent stuff is all config overrides
8441 sub agent_template {
8443 $self->_agent_plandata('agent_templatename');
8446 sub agent_invoice_from {
8448 $self->_agent_plandata('agent_invoice_from');
8451 sub _agent_plandata {
8452 my( $self, $option ) = @_;
8454 #yuck. this whole thing needs to be reconciled better with 1.9's idea of
8455 #agent-specific Conf
8457 use FS::part_event::Condition;
8459 my $agentnum = $self->agentnum;
8462 if ( driver_name =~ /^Pg/i ) {
8464 } elsif ( driver_name =~ /^mysql/i ) {
8467 die "don't know how to use regular expressions in ". driver_name. " databases";
8470 my $part_event_option =
8472 'select' => 'part_event_option.*',
8473 'table' => 'part_event_option',
8475 LEFT JOIN part_event USING ( eventpart )
8476 LEFT JOIN part_event_option AS peo_agentnum
8477 ON ( part_event.eventpart = peo_agentnum.eventpart
8478 AND peo_agentnum.optionname = 'agentnum'
8479 AND peo_agentnum.optionvalue }. $regexp. q{ '(^|,)}. $agentnum. q{(,|$)'
8481 LEFT JOIN part_event_condition
8482 ON ( part_event.eventpart = part_event_condition.eventpart
8483 AND part_event_condition.conditionname = 'cust_bill_age'
8485 LEFT JOIN part_event_condition_option
8486 ON ( part_event_condition.eventconditionnum = part_event_condition_option.eventconditionnum
8487 AND part_event_condition_option.optionname = 'age'
8490 #'hashref' => { 'optionname' => $option },
8491 #'hashref' => { 'part_event_option.optionname' => $option },
8493 " WHERE part_event_option.optionname = ". dbh->quote($option).
8494 " AND action = 'cust_bill_send_agent' ".
8495 " AND ( disabled IS NULL OR disabled != 'Y' ) ".
8496 " AND peo_agentnum.optionname = 'agentnum' ".
8497 " AND ( agentnum IS NULL OR agentnum = $agentnum ) ".
8499 CASE WHEN part_event_condition_option.optionname IS NULL
8501 ELSE ". FS::part_event::Condition->age2seconds_sql('part_event_condition_option.optionvalue').
8503 , part_event.weight".
8507 unless ( $part_event_option ) {
8508 return $self->agent->invoice_template || ''
8509 if $option eq 'agent_templatename';
8513 $part_event_option->optionvalue;
8518 ## actual sub, not a method, designed to be called from the queue.
8519 ## sets up the customer, and calls the bill_and_collect
8520 my (%args) = @_; #, ($time, $invoice_time, $check_freq, $resetup) = @_;
8521 my $cust_main = qsearchs( 'cust_main', { custnum => $args{'custnum'} } );
8522 $cust_main->bill_and_collect(
8527 sub _upgrade_data { #class method
8528 my ($class, %opts) = @_;
8530 my $sql = 'UPDATE h_cust_main SET paycvv = NULL WHERE paycvv IS NOT NULL';
8531 my $sth = dbh->prepare($sql) or die dbh->errstr;
8532 $sth->execute or die $sth->errstr;
8542 The delete method should possibly take an FS::cust_main object reference
8543 instead of a scalar customer number.
8545 Bill and collect options should probably be passed as references instead of a
8548 There should probably be a configuration file with a list of allowed credit
8551 No multiple currency support (probably a larger project than just this module).
8553 payinfo_masked false laziness with cust_pay.pm and cust_refund.pm
8555 Birthdates rely on negative epoch values.
8557 The payby for card/check batches is broken. With mixed batching, bad
8560 B<collect> I<invoice_time> should be renamed I<time>, like B<bill>.
8564 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
8565 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
8566 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.