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 timelocal_nocheck);
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);
29 use FS::cust_bill_pkg;
30 use FS::cust_bill_pkg_display;
32 use FS::cust_pay_pending;
33 use FS::cust_pay_void;
34 use FS::cust_pay_batch;
37 use FS::part_referral;
38 use FS::cust_main_county;
39 use FS::cust_location;
41 use FS::cust_tax_location;
42 use FS::part_pkg_taxrate;
44 use FS::cust_main_invoice;
45 use FS::cust_credit_bill;
46 use FS::cust_bill_pay;
47 use FS::prepay_credit;
51 use FS::part_event_condition;
54 use FS::payment_gateway;
55 use FS::agent_payment_gateway;
57 use FS::payinfo_Mixin;
60 @ISA = qw( FS::payinfo_Mixin FS::Record );
62 @EXPORT_OK = qw( smart_search );
64 $realtime_bop_decline_quiet = 0;
66 # 1 is mostly method/subroutine entry and options
67 # 2 traces progress of some operations
68 # 3 is even more information including possibly sensitive data
70 $me = '[FS::cust_main]';
74 $ignore_expired_card = 0;
76 @encrypted_fields = ('payinfo', 'paycvv');
77 @paytypes = ('', 'Personal checking', 'Personal savings', 'Business checking', 'Business savings');
79 #ask FS::UID to run this stuff for us later
80 #$FS::UID::callback{'FS::cust_main'} = sub {
81 install_callback FS::UID sub {
83 #yes, need it for stuff below (prolly should be cached)
88 my ( $hashref, $cache ) = @_;
89 if ( exists $hashref->{'pkgnum'} ) {
90 #@{ $self->{'_pkgnum'} } = ();
91 my $subcache = $cache->subcache( 'pkgnum', 'cust_pkg', $hashref->{custnum});
92 $self->{'_pkgnum'} = $subcache;
93 #push @{ $self->{'_pkgnum'} },
94 FS::cust_pkg->new_or_cached($hashref, $subcache) if $hashref->{pkgnum};
100 FS::cust_main - Object methods for cust_main records
106 $record = new FS::cust_main \%hash;
107 $record = new FS::cust_main { 'column' => 'value' };
109 $error = $record->insert;
111 $error = $new_record->replace($old_record);
113 $error = $record->delete;
115 $error = $record->check;
117 @cust_pkg = $record->all_pkgs;
119 @cust_pkg = $record->ncancelled_pkgs;
121 @cust_pkg = $record->suspended_pkgs;
123 $error = $record->bill;
124 $error = $record->bill %options;
125 $error = $record->bill 'time' => $time;
127 $error = $record->collect;
128 $error = $record->collect %options;
129 $error = $record->collect 'invoice_time' => $time,
134 An FS::cust_main object represents a customer. FS::cust_main inherits from
135 FS::Record. The following fields are currently supported:
141 Primary key (assigned automatically for new customers)
145 Agent (see L<FS::agent>)
149 Advertising source (see L<FS::part_referral>)
161 Cocial security number (optional)
177 (optional, see L<FS::cust_main_county>)
181 (see L<FS::cust_main_county>)
187 (see L<FS::cust_main_county>)
223 (optional, see L<FS::cust_main_county>)
227 (see L<FS::cust_main_county>)
233 (see L<FS::cust_main_county>)
249 Payment Type (See L<FS::payinfo_Mixin> for valid payby values)
253 Payment Information (See L<FS::payinfo_Mixin> for data format)
257 Masked payinfo (See L<FS::payinfo_Mixin> for how this works)
261 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
265 Expiration date, mm/yyyy, m/yyyy, mm/yy or m/yy
269 Start date month (maestro/solo cards only)
273 Start date year (maestro/solo cards only)
277 Issue number (maestro/solo cards only)
281 Name on card or billing name
285 IP address from which payment information was received
289 Tax exempt, empty or `Y'
293 Order taker (assigned automatically, see L<FS::UID>)
299 =item referral_custnum
301 Referring customer number
305 Enable individual CDR spooling, empty or `Y'
309 A suggestion to events (see L<FS::part_bill_event">) to delay until this unix timestamp
313 Discourage individual CDR printing, empty or `Y'
323 Creates a new customer. To add the customer to the database, see L<"insert">.
325 Note that this stores the hash reference, not a distinct copy of the hash it
326 points to. You can ask the object for a copy with the I<hash> method.
330 sub table { 'cust_main'; }
332 =item insert [ CUST_PKG_HASHREF [ , INVOICING_LIST_ARYREF ] [ , OPTION => VALUE ... ] ]
334 Adds this customer to the database. If there is an error, returns the error,
335 otherwise returns false.
337 CUST_PKG_HASHREF: If you pass a Tie::RefHash data structure to the insert
338 method containing FS::cust_pkg and FS::svc_I<tablename> objects, all records
339 are inserted atomicly, or the transaction is rolled back. Passing an empty
340 hash reference is equivalent to not supplying this parameter. There should be
341 a better explanation of this, but until then, here's an example:
344 tie %hash, 'Tie::RefHash'; #this part is important
346 $cust_pkg => [ $svc_acct ],
349 $cust_main->insert( \%hash );
351 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
352 be set as the invoicing list (see L<"invoicing_list">). Errors return as
353 expected and rollback the entire transaction; it is not necessary to call
354 check_invoicing_list first. The invoicing_list is set after the records in the
355 CUST_PKG_HASHREF above are inserted, so it is now possible to set an
356 invoicing_list destination to the newly-created svc_acct. Here's an example:
358 $cust_main->insert( {}, [ $email, 'POST' ] );
360 Currently available options are: I<depend_jobnum> and I<noexport>.
362 If I<depend_jobnum> is set, all provisioning jobs will have a dependancy
363 on the supplied jobnum (they will not run until the specific job completes).
364 This can be used to defer provisioning until some action completes (such
365 as running the customer's credit card successfully).
367 The I<noexport> option is deprecated. If I<noexport> is set true, no
368 provisioning jobs (exports) are scheduled. (You can schedule them later with
369 the B<reexport> method.)
375 my $cust_pkgs = @_ ? shift : {};
376 my $invoicing_list = @_ ? shift : '';
378 warn "$me insert called with options ".
379 join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
382 local $SIG{HUP} = 'IGNORE';
383 local $SIG{INT} = 'IGNORE';
384 local $SIG{QUIT} = 'IGNORE';
385 local $SIG{TERM} = 'IGNORE';
386 local $SIG{TSTP} = 'IGNORE';
387 local $SIG{PIPE} = 'IGNORE';
389 my $oldAutoCommit = $FS::UID::AutoCommit;
390 local $FS::UID::AutoCommit = 0;
393 my $prepay_identifier = '';
394 my( $amount, $seconds ) = ( 0, 0 );
396 if ( $self->payby eq 'PREPAY' ) {
398 $self->payby('BILL');
399 $prepay_identifier = $self->payinfo;
402 warn " looking up prepaid card $prepay_identifier\n"
405 my $error = $self->get_prepay($prepay_identifier, \$amount, \$seconds);
407 $dbh->rollback if $oldAutoCommit;
408 #return "error applying prepaid card (transaction rolled back): $error";
412 $payby = 'PREP' if $amount;
414 } elsif ( $self->payby =~ /^(CASH|WEST|MCRD)$/ ) {
417 $self->payby('BILL');
418 $amount = $self->paid;
422 warn " inserting $self\n"
425 $self->signupdate(time) unless $self->signupdate;
427 $self->auto_agent_custid()
428 if $conf->config('cust_main-auto_agent_custid') && ! $self->agent_custid;
430 my $error = $self->SUPER::insert;
432 $dbh->rollback if $oldAutoCommit;
433 #return "inserting cust_main record (transaction rolled back): $error";
437 warn " setting invoicing list\n"
440 if ( $invoicing_list ) {
441 $error = $self->check_invoicing_list( $invoicing_list );
443 $dbh->rollback if $oldAutoCommit;
444 #return "checking invoicing_list (transaction rolled back): $error";
447 $self->invoicing_list( $invoicing_list );
450 if ( $conf->config('cust_main-skeleton_tables')
451 && $conf->config('cust_main-skeleton_custnum') ) {
453 warn " inserting skeleton records\n"
456 my $error = $self->start_copy_skel;
458 $dbh->rollback if $oldAutoCommit;
464 warn " ordering packages\n"
467 $error = $self->order_pkgs($cust_pkgs, \$seconds, %options);
469 $dbh->rollback if $oldAutoCommit;
474 $dbh->rollback if $oldAutoCommit;
475 return "No svc_acct record to apply pre-paid time";
479 warn " inserting initial $payby payment of $amount\n"
481 $error = $self->insert_cust_pay($payby, $amount, $prepay_identifier);
483 $dbh->rollback if $oldAutoCommit;
484 return "inserting payment (transaction rolled back): $error";
488 unless ( $import || $skip_fuzzyfiles ) {
489 warn " queueing fuzzyfiles update\n"
491 $error = $self->queue_fuzzyfiles_update;
493 $dbh->rollback if $oldAutoCommit;
494 return "updating fuzzy search cache: $error";
498 warn " insert complete; committing transaction\n"
501 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
506 use File::CounterFile;
507 sub auto_agent_custid {
510 my $format = $conf->config('cust_main-auto_agent_custid');
512 if ( $format eq '1YMMXXXXXXXX' ) {
514 my $counter = new File::CounterFile 'cust_main.agent_custid';
517 my $ym = 100000000000 + time2str('%y%m00000000', time);
518 if ( $ym > $counter->value ) {
519 $counter->{'value'} = $agent_custid = $ym;
520 $counter->{'updated'} = 1;
522 $agent_custid = $counter->inc;
528 die "Unknown cust_main-auto_agent_custid format: $format";
531 $self->agent_custid($agent_custid);
535 sub start_copy_skel {
538 #'mg_user_preference' => {},
539 #'mg_user_indicator_profile.user_indicator_profile_id' => { 'mg_profile_indicator.profile_indicator_id' => { 'mg_profile_details.profile_detail_id' }, },
540 #'mg_watchlist_header.watchlist_header_id' => { 'mg_watchlist_details.watchlist_details_id' },
541 #'mg_user_grid_header.grid_header_id' => { 'mg_user_grid_details.user_grid_details_id' },
542 #'mg_portfolio_header.portfolio_header_id' => { 'mg_portfolio_trades.portfolio_trades_id' => { 'mg_portfolio_trades_positions.portfolio_trades_positions_id' } },
543 my @tables = eval(join('\n',$conf->config('cust_main-skeleton_tables')));
546 _copy_skel( 'cust_main', #tablename
547 $conf->config('cust_main-skeleton_custnum'), #sourceid
548 $self->custnum, #destid
549 @tables, #child tables
553 #recursive subroutine, not a method
555 my( $table, $sourceid, $destid, %child_tables ) = @_;
558 if ( $table =~ /^(\w+)\.(\w+)$/ ) {
559 ( $table, $primary_key ) = ( $1, $2 );
561 my $dbdef_table = dbdef->table($table);
562 $primary_key = $dbdef_table->primary_key
563 or return "$table has no primary key".
564 " (or do you need to run dbdef-create?)";
567 warn " _copy_skel: $table.$primary_key $sourceid to $destid for ".
568 join (', ', keys %child_tables). "\n"
571 foreach my $child_table_def ( keys %child_tables ) {
575 if ( $child_table_def =~ /^(\w+)\.(\w+)$/ ) {
576 ( $child_table, $child_pkey ) = ( $1, $2 );
578 $child_table = $child_table_def;
580 $child_pkey = dbdef->table($child_table)->primary_key;
581 # or return "$table has no primary key".
582 # " (or do you need to run dbdef-create?)\n";
586 if ( keys %{ $child_tables{$child_table_def} } ) {
588 return "$child_table has no primary key".
589 " (run dbdef-create or try specifying it?)\n"
592 #false laziness w/Record::insert and only works on Pg
593 #refactor the proper last-inserted-id stuff out of Record::insert if this
594 # ever gets use for anything besides a quick kludge for one customer
595 my $default = dbdef->table($child_table)->column($child_pkey)->default;
596 $default =~ /^nextval\(\(?'"?([\w\.]+)"?'/i
597 or return "can't parse $child_table.$child_pkey default value ".
598 " for sequence name: $default";
603 my @sel_columns = grep { $_ ne $primary_key }
604 dbdef->table($child_table)->columns;
605 my $sel_columns = join(', ', @sel_columns );
607 my @ins_columns = grep { $_ ne $child_pkey } @sel_columns;
608 my $ins_columns = ' ( '. join(', ', $primary_key, @ins_columns ). ' ) ';
609 my $placeholders = ' ( ?, '. join(', ', map '?', @ins_columns ). ' ) ';
611 my $sel_st = "SELECT $sel_columns FROM $child_table".
612 " WHERE $primary_key = $sourceid";
615 my $sel_sth = dbh->prepare( $sel_st )
616 or return dbh->errstr;
618 $sel_sth->execute or return $sel_sth->errstr;
620 while ( my $row = $sel_sth->fetchrow_hashref ) {
622 warn " selected row: ".
623 join(', ', map { "$_=".$row->{$_} } keys %$row ). "\n"
627 "INSERT INTO $child_table $ins_columns VALUES $placeholders";
628 my $ins_sth =dbh->prepare($statement)
629 or return dbh->errstr;
630 my @param = ( $destid, map $row->{$_}, @ins_columns );
631 warn " $statement: [ ". join(', ', @param). " ]\n"
633 $ins_sth->execute( @param )
634 or return $ins_sth->errstr;
636 #next unless keys %{ $child_tables{$child_table} };
637 next unless $sequence;
639 #another section of that laziness
640 my $seq_sql = "SELECT currval('$sequence')";
641 my $seq_sth = dbh->prepare($seq_sql) or return dbh->errstr;
642 $seq_sth->execute or return $seq_sth->errstr;
643 my $insertid = $seq_sth->fetchrow_arrayref->[0];
645 # don't drink soap! recurse! recurse! okay!
647 _copy_skel( $child_table_def,
648 $row->{$child_pkey}, #sourceid
650 %{ $child_tables{$child_table_def} },
652 return $error if $error;
662 =item order_pkgs HASHREF, [ SECONDSREF, [ , OPTION => VALUE ... ] ]
664 Like the insert method on an existing record, this method orders a package
665 and included services atomicaly. Pass a Tie::RefHash data structure to this
666 method containing FS::cust_pkg and FS::svc_I<tablename> objects. There should
667 be a better explanation of this, but until then, here's an example:
670 tie %hash, 'Tie::RefHash'; #this part is important
672 $cust_pkg => [ $svc_acct ],
675 $cust_main->order_pkgs( \%hash, \'0', 'noexport'=>1 );
677 Services can be new, in which case they are inserted, or existing unaudited
678 services, in which case they are linked to the newly-created package.
680 Currently available options are: I<depend_jobnum> and I<noexport>.
682 If I<depend_jobnum> is set, all provisioning jobs will have a dependancy
683 on the supplied jobnum (they will not run until the specific job completes).
684 This can be used to defer provisioning until some action completes (such
685 as running the customer's credit card successfully).
687 The I<noexport> option is deprecated. If I<noexport> is set true, no
688 provisioning jobs (exports) are scheduled. (You can schedule them later with
689 the B<reexport> method for each cust_pkg object. Using the B<reexport> method
690 on the cust_main object is not recommended, as existing services will also be
697 my $cust_pkgs = shift;
701 warn "$me order_pkgs called with options ".
702 join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
705 local $SIG{HUP} = 'IGNORE';
706 local $SIG{INT} = 'IGNORE';
707 local $SIG{QUIT} = 'IGNORE';
708 local $SIG{TERM} = 'IGNORE';
709 local $SIG{TSTP} = 'IGNORE';
710 local $SIG{PIPE} = 'IGNORE';
712 my $oldAutoCommit = $FS::UID::AutoCommit;
713 local $FS::UID::AutoCommit = 0;
716 local $FS::svc_Common::noexport_hack = 1 if $options{'noexport'};
718 foreach my $cust_pkg ( keys %$cust_pkgs ) {
720 my $error = $self->order_pkg( 'cust_pkg' => $cust_pkg,
721 'svcs' => $cust_pkgs->{$cust_pkg},
722 'seconds' => $seconds,
723 'depend_jobnum' => $options{'depend_jobnum'},
726 $dbh->rollback if $oldAutoCommit;
732 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
736 =item order_pkg HASHREF | OPTION => VALUE ...
738 Orders a single package. This is the preferred and most flexible method for
739 ordering a single package, including the ability to set a (new or existing)
740 location as well as insert services.
742 Options may be passed as a list of key/value pairs or as a hash reference.
753 Optional FS::cust_location object
757 Optional arryaref of FS::svc_* service objects.
761 If this option is set to a job queue jobnum (see L<FS::queue), all provisioning
762 jobs will have a dependancy on the supplied job (they will not run until the
763 specific job completes). This can be used to defer provisioning until some
764 action completes (such as running the customer's credit card successfully).
772 my $opt = ref($_[0]) ? shift : { @_ };
774 warn "$me order_pkg called with options ".
775 join(', ', map { "$_: $opt->{$_}" } keys %$opt ). "\n"
778 my $cust_pkg = $opt->{'cust_pkg'};
779 my $seconds = $opt->{'seconds'};
780 my $svcs = $opt->{'svcs'} || [];
782 my %svc_options = ();
783 $svc_options{'depend_jobnum'} = $opt->{'depend_jobnum'}
784 if exists($opt->{'depend_jobnum'}) && $opt->{'depend_jobnum'};
786 local $SIG{HUP} = 'IGNORE';
787 local $SIG{INT} = 'IGNORE';
788 local $SIG{QUIT} = 'IGNORE';
789 local $SIG{TERM} = 'IGNORE';
790 local $SIG{TSTP} = 'IGNORE';
791 local $SIG{PIPE} = 'IGNORE';
793 my $oldAutoCommit = $FS::UID::AutoCommit;
794 local $FS::UID::AutoCommit = 0;
797 if ( $opt->{'cust_location'} &&
798 ( ! $cust_pkg->locationnum || $cust_pkg->locationnum == -1 ) ) {
799 my $error = $opt->{'cust_location'}->insert;
801 $dbh->rollback if $oldAutoCommit;
802 return "inserting cust_location (transaction rolled back): $error";
804 $cust_pkg->locationnum($opt->{'cust_location'}->locationnum);
807 $cust_pkg->custnum( $self->custnum );
809 my $error = $cust_pkg->insert;
811 $dbh->rollback if $oldAutoCommit;
812 return "inserting cust_pkg (transaction rolled back): $error";
815 foreach my $svc_something ( @{ $opt->{'svcs'} } ) {
816 if ( $svc_something->svcnum ) {
817 my $old_cust_svc = $svc_something->cust_svc;
818 my $new_cust_svc = new FS::cust_svc { $old_cust_svc->hash };
819 $new_cust_svc->pkgnum( $cust_pkg->pkgnum);
820 $error = $new_cust_svc->replace($old_cust_svc);
822 $svc_something->pkgnum( $cust_pkg->pkgnum );
823 if ( $seconds && $$seconds && $svc_something->isa('FS::svc_acct') ) {
824 $svc_something->seconds( $svc_something->seconds + $$seconds );
827 $error = $svc_something->insert(%svc_options);
830 $dbh->rollback if $oldAutoCommit;
831 return "inserting svc_ (transaction rolled back): $error";
835 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
840 =item recharge_prepay IDENTIFIER | PREPAY_CREDIT_OBJ [ , AMOUNTREF, SECONDSREF, UPBYTEREF, DOWNBYTEREF ]
842 Recharges this (existing) customer with the specified prepaid card (see
843 L<FS::prepay_credit>), specified either by I<identifier> or as an
844 FS::prepay_credit object. If there is an error, returns the error, otherwise
847 Optionally, four scalar references can be passed as well. They will have their
848 values filled in with the amount, number of seconds, and number of upload and
849 download bytes applied by this prepaid
854 sub recharge_prepay {
855 my( $self, $prepay_credit, $amountref, $secondsref,
856 $upbytesref, $downbytesref, $totalbytesref ) = @_;
858 local $SIG{HUP} = 'IGNORE';
859 local $SIG{INT} = 'IGNORE';
860 local $SIG{QUIT} = 'IGNORE';
861 local $SIG{TERM} = 'IGNORE';
862 local $SIG{TSTP} = 'IGNORE';
863 local $SIG{PIPE} = 'IGNORE';
865 my $oldAutoCommit = $FS::UID::AutoCommit;
866 local $FS::UID::AutoCommit = 0;
869 my( $amount, $seconds, $upbytes, $downbytes, $totalbytes) = ( 0, 0, 0, 0, 0 );
871 my $error = $self->get_prepay($prepay_credit, \$amount,
872 \$seconds, \$upbytes, \$downbytes, \$totalbytes)
873 || $self->increment_seconds($seconds)
874 || $self->increment_upbytes($upbytes)
875 || $self->increment_downbytes($downbytes)
876 || $self->increment_totalbytes($totalbytes)
877 || $self->insert_cust_pay_prepay( $amount,
879 ? $prepay_credit->identifier
884 $dbh->rollback if $oldAutoCommit;
888 if ( defined($amountref) ) { $$amountref = $amount; }
889 if ( defined($secondsref) ) { $$secondsref = $seconds; }
890 if ( defined($upbytesref) ) { $$upbytesref = $upbytes; }
891 if ( defined($downbytesref) ) { $$downbytesref = $downbytes; }
892 if ( defined($totalbytesref) ) { $$totalbytesref = $totalbytes; }
894 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
899 =item get_prepay IDENTIFIER | PREPAY_CREDIT_OBJ , AMOUNTREF, SECONDSREF
901 Looks up and deletes a prepaid card (see L<FS::prepay_credit>),
902 specified either by I<identifier> or as an FS::prepay_credit object.
904 References to I<amount> and I<seconds> scalars should be passed as arguments
905 and will be incremented by the values of the prepaid card.
907 If the prepaid card specifies an I<agentnum> (see L<FS::agent>), it is used to
908 check or set this customer's I<agentnum>.
910 If there is an error, returns the error, otherwise returns false.
916 my( $self, $prepay_credit, $amountref, $secondsref,
917 $upref, $downref, $totalref) = @_;
919 local $SIG{HUP} = 'IGNORE';
920 local $SIG{INT} = 'IGNORE';
921 local $SIG{QUIT} = 'IGNORE';
922 local $SIG{TERM} = 'IGNORE';
923 local $SIG{TSTP} = 'IGNORE';
924 local $SIG{PIPE} = 'IGNORE';
926 my $oldAutoCommit = $FS::UID::AutoCommit;
927 local $FS::UID::AutoCommit = 0;
930 unless ( ref($prepay_credit) ) {
932 my $identifier = $prepay_credit;
934 $prepay_credit = qsearchs(
936 { 'identifier' => $prepay_credit },
941 unless ( $prepay_credit ) {
942 $dbh->rollback if $oldAutoCommit;
943 return "Invalid prepaid card: ". $identifier;
948 if ( $prepay_credit->agentnum ) {
949 if ( $self->agentnum && $self->agentnum != $prepay_credit->agentnum ) {
950 $dbh->rollback if $oldAutoCommit;
951 return "prepaid card not valid for agent ". $self->agentnum;
953 $self->agentnum($prepay_credit->agentnum);
956 my $error = $prepay_credit->delete;
958 $dbh->rollback if $oldAutoCommit;
959 return "removing prepay_credit (transaction rolled back): $error";
962 $$amountref += $prepay_credit->amount;
963 $$secondsref += $prepay_credit->seconds;
964 $$upref += $prepay_credit->upbytes;
965 $$downref += $prepay_credit->downbytes;
966 $$totalref += $prepay_credit->totalbytes;
968 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
973 =item increment_upbytes SECONDS
975 Updates this customer's single or primary account (see L<FS::svc_acct>) by
976 the specified number of upbytes. If there is an error, returns the error,
977 otherwise returns false.
981 sub increment_upbytes {
982 _increment_column( shift, 'upbytes', @_);
985 =item increment_downbytes SECONDS
987 Updates this customer's single or primary account (see L<FS::svc_acct>) by
988 the specified number of downbytes. If there is an error, returns the error,
989 otherwise returns false.
993 sub increment_downbytes {
994 _increment_column( shift, 'downbytes', @_);
997 =item increment_totalbytes SECONDS
999 Updates this customer's single or primary account (see L<FS::svc_acct>) by
1000 the specified number of totalbytes. If there is an error, returns the error,
1001 otherwise returns false.
1005 sub increment_totalbytes {
1006 _increment_column( shift, 'totalbytes', @_);
1009 =item increment_seconds SECONDS
1011 Updates this customer's single or primary account (see L<FS::svc_acct>) by
1012 the specified number of seconds. If there is an error, returns the error,
1013 otherwise returns false.
1017 sub increment_seconds {
1018 _increment_column( shift, 'seconds', @_);
1021 =item _increment_column AMOUNT
1023 Updates this customer's single or primary account (see L<FS::svc_acct>) by
1024 the specified number of seconds or bytes. If there is an error, returns
1025 the error, otherwise returns false.
1029 sub _increment_column {
1030 my( $self, $column, $amount ) = @_;
1031 warn "$me increment_column called: $column, $amount\n"
1034 return '' unless $amount;
1036 my @cust_pkg = grep { $_->part_pkg->svcpart('svc_acct') }
1037 $self->ncancelled_pkgs;
1039 if ( ! @cust_pkg ) {
1040 return 'No packages with primary or single services found'.
1041 ' to apply pre-paid time';
1042 } elsif ( scalar(@cust_pkg) > 1 ) {
1043 #maybe have a way to specify the package/account?
1044 return 'Multiple packages found to apply pre-paid time';
1047 my $cust_pkg = $cust_pkg[0];
1048 warn " found package pkgnum ". $cust_pkg->pkgnum. "\n"
1052 $cust_pkg->cust_svc( $cust_pkg->part_pkg->svcpart('svc_acct') );
1054 if ( ! @cust_svc ) {
1055 return 'No account found to apply pre-paid time';
1056 } elsif ( scalar(@cust_svc) > 1 ) {
1057 return 'Multiple accounts found to apply pre-paid time';
1060 my $svc_acct = $cust_svc[0]->svc_x;
1061 warn " found service svcnum ". $svc_acct->pkgnum.
1062 ' ('. $svc_acct->email. ")\n"
1065 $column = "increment_$column";
1066 $svc_acct->$column($amount);
1070 =item insert_cust_pay_prepay AMOUNT [ PAYINFO ]
1072 Inserts a prepayment in the specified amount for this customer. An optional
1073 second argument can specify the prepayment identifier for tracking purposes.
1074 If there is an error, returns the error, otherwise returns false.
1078 sub insert_cust_pay_prepay {
1079 shift->insert_cust_pay('PREP', @_);
1082 =item insert_cust_pay_cash AMOUNT [ PAYINFO ]
1084 Inserts a cash payment in the specified amount for this customer. An optional
1085 second argument can specify the payment identifier for tracking purposes.
1086 If there is an error, returns the error, otherwise returns false.
1090 sub insert_cust_pay_cash {
1091 shift->insert_cust_pay('CASH', @_);
1094 =item insert_cust_pay_west AMOUNT [ PAYINFO ]
1096 Inserts a Western Union payment in the specified amount for this customer. An
1097 optional second argument can specify the prepayment identifier for tracking
1098 purposes. If there is an error, returns the error, otherwise returns false.
1102 sub insert_cust_pay_west {
1103 shift->insert_cust_pay('WEST', @_);
1106 sub insert_cust_pay {
1107 my( $self, $payby, $amount ) = splice(@_, 0, 3);
1108 my $payinfo = scalar(@_) ? shift : '';
1110 my $cust_pay = new FS::cust_pay {
1111 'custnum' => $self->custnum,
1112 'paid' => sprintf('%.2f', $amount),
1113 #'_date' => #date the prepaid card was purchased???
1115 'payinfo' => $payinfo,
1123 This method is deprecated. See the I<depend_jobnum> option to the insert and
1124 order_pkgs methods for a better way to defer provisioning.
1126 Re-schedules all exports by calling the B<reexport> method of all associated
1127 packages (see L<FS::cust_pkg>). If there is an error, returns the error;
1128 otherwise returns false.
1135 carp "WARNING: FS::cust_main::reexport is deprectated; ".
1136 "use the depend_jobnum option to insert or order_pkgs to delay export";
1138 local $SIG{HUP} = 'IGNORE';
1139 local $SIG{INT} = 'IGNORE';
1140 local $SIG{QUIT} = 'IGNORE';
1141 local $SIG{TERM} = 'IGNORE';
1142 local $SIG{TSTP} = 'IGNORE';
1143 local $SIG{PIPE} = 'IGNORE';
1145 my $oldAutoCommit = $FS::UID::AutoCommit;
1146 local $FS::UID::AutoCommit = 0;
1149 foreach my $cust_pkg ( $self->ncancelled_pkgs ) {
1150 my $error = $cust_pkg->reexport;
1152 $dbh->rollback if $oldAutoCommit;
1157 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1162 =item delete NEW_CUSTNUM
1164 This deletes the customer. If there is an error, returns the error, otherwise
1167 This will completely remove all traces of the customer record. This is not
1168 what you want when a customer cancels service; for that, cancel all of the
1169 customer's packages (see L</cancel>).
1171 If the customer has any uncancelled packages, you need to pass a new (valid)
1172 customer number for those packages to be transferred to. Cancelled packages
1173 will be deleted. Did I mention that this is NOT what you want when a customer
1174 cancels service and that you really should be looking see L<FS::cust_pkg/cancel>?
1176 You can't delete a customer with invoices (see L<FS::cust_bill>),
1177 or credits (see L<FS::cust_credit>), payments (see L<FS::cust_pay>) or
1178 refunds (see L<FS::cust_refund>).
1185 local $SIG{HUP} = 'IGNORE';
1186 local $SIG{INT} = 'IGNORE';
1187 local $SIG{QUIT} = 'IGNORE';
1188 local $SIG{TERM} = 'IGNORE';
1189 local $SIG{TSTP} = 'IGNORE';
1190 local $SIG{PIPE} = 'IGNORE';
1192 my $oldAutoCommit = $FS::UID::AutoCommit;
1193 local $FS::UID::AutoCommit = 0;
1196 if ( $self->cust_bill ) {
1197 $dbh->rollback if $oldAutoCommit;
1198 return "Can't delete a customer with invoices";
1200 if ( $self->cust_credit ) {
1201 $dbh->rollback if $oldAutoCommit;
1202 return "Can't delete a customer with credits";
1204 if ( $self->cust_pay ) {
1205 $dbh->rollback if $oldAutoCommit;
1206 return "Can't delete a customer with payments";
1208 if ( $self->cust_refund ) {
1209 $dbh->rollback if $oldAutoCommit;
1210 return "Can't delete a customer with refunds";
1213 my @cust_pkg = $self->ncancelled_pkgs;
1215 my $new_custnum = shift;
1216 unless ( qsearchs( 'cust_main', { 'custnum' => $new_custnum } ) ) {
1217 $dbh->rollback if $oldAutoCommit;
1218 return "Invalid new customer number: $new_custnum";
1220 foreach my $cust_pkg ( @cust_pkg ) {
1221 my %hash = $cust_pkg->hash;
1222 $hash{'custnum'} = $new_custnum;
1223 my $new_cust_pkg = new FS::cust_pkg ( \%hash );
1224 my $error = $new_cust_pkg->replace($cust_pkg,
1225 options => { $cust_pkg->options },
1228 $dbh->rollback if $oldAutoCommit;
1233 my @cancelled_cust_pkg = $self->all_pkgs;
1234 foreach my $cust_pkg ( @cancelled_cust_pkg ) {
1235 my $error = $cust_pkg->delete;
1237 $dbh->rollback if $oldAutoCommit;
1242 foreach my $cust_main_invoice ( #(email invoice destinations, not invoices)
1243 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } )
1245 my $error = $cust_main_invoice->delete;
1247 $dbh->rollback if $oldAutoCommit;
1252 my $error = $self->SUPER::delete;
1254 $dbh->rollback if $oldAutoCommit;
1258 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1263 =item replace [ OLD_RECORD ] [ INVOICING_LIST_ARYREF ]
1265 Replaces the OLD_RECORD with this one in the database. If there is an error,
1266 returns the error, otherwise returns false.
1268 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
1269 be set as the invoicing list (see L<"invoicing_list">). Errors return as
1270 expected and rollback the entire transaction; it is not necessary to call
1271 check_invoicing_list first. Here's an example:
1273 $new_cust_main->replace( $old_cust_main, [ $email, 'POST' ] );
1280 my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
1282 : $self->replace_old;
1286 warn "$me replace called\n"
1289 my $curuser = $FS::CurrentUser::CurrentUser;
1290 if ( $self->payby eq 'COMP'
1291 && $self->payby ne $old->payby
1292 && ! $curuser->access_right('Complimentary customer')
1295 return "You are not permitted to create complimentary accounts.";
1298 local($ignore_expired_card) = 1
1299 if $old->payby =~ /^(CARD|DCRD)$/
1300 && $self->payby =~ /^(CARD|DCRD)$/
1301 && ( $old->payinfo eq $self->payinfo || $old->paymask eq $self->paymask );
1303 local $SIG{HUP} = 'IGNORE';
1304 local $SIG{INT} = 'IGNORE';
1305 local $SIG{QUIT} = 'IGNORE';
1306 local $SIG{TERM} = 'IGNORE';
1307 local $SIG{TSTP} = 'IGNORE';
1308 local $SIG{PIPE} = 'IGNORE';
1310 my $oldAutoCommit = $FS::UID::AutoCommit;
1311 local $FS::UID::AutoCommit = 0;
1314 my $error = $self->SUPER::replace($old);
1317 $dbh->rollback if $oldAutoCommit;
1321 if ( @param ) { # INVOICING_LIST_ARYREF
1322 my $invoicing_list = shift @param;
1323 $error = $self->check_invoicing_list( $invoicing_list );
1325 $dbh->rollback if $oldAutoCommit;
1328 $self->invoicing_list( $invoicing_list );
1331 if ( $self->payby =~ /^(CARD|CHEK|LECB)$/ &&
1332 grep { $self->get($_) ne $old->get($_) } qw(payinfo paydate payname) ) {
1333 # card/check/lec info has changed, want to retry realtime_ invoice events
1334 my $error = $self->retry_realtime;
1336 $dbh->rollback if $oldAutoCommit;
1341 unless ( $import || $skip_fuzzyfiles ) {
1342 $error = $self->queue_fuzzyfiles_update;
1344 $dbh->rollback if $oldAutoCommit;
1345 return "updating fuzzy search cache: $error";
1349 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1354 =item queue_fuzzyfiles_update
1356 Used by insert & replace to update the fuzzy search cache
1360 sub queue_fuzzyfiles_update {
1363 local $SIG{HUP} = 'IGNORE';
1364 local $SIG{INT} = 'IGNORE';
1365 local $SIG{QUIT} = 'IGNORE';
1366 local $SIG{TERM} = 'IGNORE';
1367 local $SIG{TSTP} = 'IGNORE';
1368 local $SIG{PIPE} = 'IGNORE';
1370 my $oldAutoCommit = $FS::UID::AutoCommit;
1371 local $FS::UID::AutoCommit = 0;
1374 my $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
1375 my $error = $queue->insert( map $self->getfield($_),
1376 qw(first last company)
1379 $dbh->rollback if $oldAutoCommit;
1380 return "queueing job (transaction rolled back): $error";
1383 if ( $self->ship_last ) {
1384 $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
1385 $error = $queue->insert( map $self->getfield("ship_$_"),
1386 qw(first last company)
1389 $dbh->rollback if $oldAutoCommit;
1390 return "queueing job (transaction rolled back): $error";
1394 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1401 Checks all fields to make sure this is a valid customer record. If there is
1402 an error, returns the error, otherwise returns false. Called by the insert
1403 and replace methods.
1410 warn "$me check BEFORE: \n". $self->_dump
1414 $self->ut_numbern('custnum')
1415 || $self->ut_number('agentnum')
1416 || $self->ut_textn('agent_custid')
1417 || $self->ut_number('refnum')
1418 || $self->ut_textn('custbatch')
1419 || $self->ut_name('last')
1420 || $self->ut_name('first')
1421 || $self->ut_snumbern('birthdate')
1422 || $self->ut_snumbern('signupdate')
1423 || $self->ut_textn('company')
1424 || $self->ut_text('address1')
1425 || $self->ut_textn('address2')
1426 || $self->ut_text('city')
1427 || $self->ut_textn('county')
1428 || $self->ut_textn('state')
1429 || $self->ut_country('country')
1430 || $self->ut_anything('comments')
1431 || $self->ut_numbern('referral_custnum')
1432 || $self->ut_textn('stateid')
1433 || $self->ut_textn('stateid_state')
1434 || $self->ut_textn('invoice_terms')
1435 || $self->ut_alphan('geocode')
1438 #barf. need message catalogs. i18n. etc.
1439 $error .= "Please select an advertising source."
1440 if $error =~ /^Illegal or empty \(numeric\) refnum: /;
1441 return $error if $error;
1443 return "Unknown agent"
1444 unless qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
1446 return "Unknown refnum"
1447 unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } );
1449 return "Unknown referring custnum: ". $self->referral_custnum
1450 unless ! $self->referral_custnum
1451 || qsearchs( 'cust_main', { 'custnum' => $self->referral_custnum } );
1453 if ( $self->ss eq '' ) {
1458 $ss =~ /^(\d{3})(\d{2})(\d{4})$/
1459 or return "Illegal social security number: ". $self->ss;
1460 $self->ss("$1-$2-$3");
1464 # bad idea to disable, causes billing to fail because of no tax rates later
1465 # unless ( $import ) {
1466 unless ( qsearch('cust_main_county', {
1467 'country' => $self->country,
1470 return "Unknown state/county/country: ".
1471 $self->state. "/". $self->county. "/". $self->country
1472 unless qsearch('cust_main_county',{
1473 'state' => $self->state,
1474 'county' => $self->county,
1475 'country' => $self->country,
1481 $self->ut_phonen('daytime', $self->country)
1482 || $self->ut_phonen('night', $self->country)
1483 || $self->ut_phonen('fax', $self->country)
1484 || $self->ut_zip('zip', $self->country)
1486 return $error if $error;
1488 if ( $conf->exists('cust_main-require_phone')
1489 && ! length($self->daytime) && ! length($self->night)
1492 my $daytime_label = FS::Msgcat::_gettext('daytime') =~ /^(daytime)?$/
1494 : FS::Msgcat::_gettext('daytime');
1495 my $night_label = FS::Msgcat::_gettext('night') =~ /^(night)?$/
1497 : FS::Msgcat::_gettext('night');
1499 return "$daytime_label or $night_label is required"
1503 if ( $self->has_ship_address
1504 && scalar ( grep { $self->getfield($_) ne $self->getfield("ship_$_") }
1505 $self->addr_fields )
1509 $self->ut_name('ship_last')
1510 || $self->ut_name('ship_first')
1511 || $self->ut_textn('ship_company')
1512 || $self->ut_text('ship_address1')
1513 || $self->ut_textn('ship_address2')
1514 || $self->ut_text('ship_city')
1515 || $self->ut_textn('ship_county')
1516 || $self->ut_textn('ship_state')
1517 || $self->ut_country('ship_country')
1519 return $error if $error;
1521 #false laziness with above
1522 unless ( qsearchs('cust_main_county', {
1523 'country' => $self->ship_country,
1526 return "Unknown ship_state/ship_county/ship_country: ".
1527 $self->ship_state. "/". $self->ship_county. "/". $self->ship_country
1528 unless qsearch('cust_main_county',{
1529 'state' => $self->ship_state,
1530 'county' => $self->ship_county,
1531 'country' => $self->ship_country,
1537 $self->ut_phonen('ship_daytime', $self->ship_country)
1538 || $self->ut_phonen('ship_night', $self->ship_country)
1539 || $self->ut_phonen('ship_fax', $self->ship_country)
1540 || $self->ut_zip('ship_zip', $self->ship_country)
1542 return $error if $error;
1544 return "Unit # is required."
1545 if $self->ship_address2 =~ /^\s*$/
1546 && $conf->exists('cust_main-require_address2');
1548 } else { # ship_ info eq billing info, so don't store dup info in database
1550 $self->setfield("ship_$_", '')
1551 foreach $self->addr_fields;
1553 return "Unit # is required."
1554 if $self->address2 =~ /^\s*$/
1555 && $conf->exists('cust_main-require_address2');
1559 #$self->payby =~ /^(CARD|DCRD|CHEK|DCHK|LECB|BILL|COMP|PREPAY|CASH|WEST|MCRD)$/
1560 # or return "Illegal payby: ". $self->payby;
1562 FS::payby->can_payby($self->table, $self->payby)
1563 or return "Illegal payby: ". $self->payby;
1565 $error = $self->ut_numbern('paystart_month')
1566 || $self->ut_numbern('paystart_year')
1567 || $self->ut_numbern('payissue')
1568 || $self->ut_textn('paytype')
1570 return $error if $error;
1572 if ( $self->payip eq '' ) {
1575 $error = $self->ut_ip('payip');
1576 return $error if $error;
1579 # If it is encrypted and the private key is not availaible then we can't
1580 # check the credit card.
1582 my $check_payinfo = 1;
1584 if ($self->is_encrypted($self->payinfo)) {
1588 if ( $check_payinfo && $self->payby =~ /^(CARD|DCRD)$/ ) {
1590 my $payinfo = $self->payinfo;
1591 $payinfo =~ s/\D//g;
1592 $payinfo =~ /^(\d{13,16})$/
1593 or return gettext('invalid_card'); # . ": ". $self->payinfo;
1595 $self->payinfo($payinfo);
1597 or return gettext('invalid_card'); # . ": ". $self->payinfo;
1599 return gettext('unknown_card_type')
1600 if cardtype($self->payinfo) eq "Unknown";
1602 my $ban = qsearchs('banned_pay', $self->_banned_pay_hashref);
1604 return 'Banned credit card: banned on '.
1605 time2str('%a %h %o at %r', $ban->_date).
1606 ' by '. $ban->otaker.
1607 ' (ban# '. $ban->bannum. ')';
1610 if (length($self->paycvv) && !$self->is_encrypted($self->paycvv)) {
1611 if ( cardtype($self->payinfo) eq 'American Express card' ) {
1612 $self->paycvv =~ /^(\d{4})$/
1613 or return "CVV2 (CID) for American Express cards is four digits.";
1616 $self->paycvv =~ /^(\d{3})$/
1617 or return "CVV2 (CVC2/CID) is three digits.";
1624 my $cardtype = cardtype($payinfo);
1625 if ( $cardtype =~ /^(Switch|Solo)$/i ) {
1627 return "Start date or issue number is required for $cardtype cards"
1628 unless $self->paystart_month && $self->paystart_year or $self->payissue;
1630 return "Start month must be between 1 and 12"
1631 if $self->paystart_month
1632 and $self->paystart_month < 1 || $self->paystart_month > 12;
1634 return "Start year must be 1990 or later"
1635 if $self->paystart_year
1636 and $self->paystart_year < 1990;
1638 return "Issue number must be beween 1 and 99"
1640 and $self->payissue < 1 || $self->payissue > 99;
1643 $self->paystart_month('');
1644 $self->paystart_year('');
1645 $self->payissue('');
1648 } elsif ( $check_payinfo && $self->payby =~ /^(CHEK|DCHK)$/ ) {
1650 my $payinfo = $self->payinfo;
1651 $payinfo =~ s/[^\d\@]//g;
1652 if ( $conf->exists('echeck-nonus') ) {
1653 $payinfo =~ /^(\d+)\@(\d+)$/ or return 'invalid echeck account@aba';
1654 $payinfo = "$1\@$2";
1656 $payinfo =~ /^(\d+)\@(\d{9})$/ or return 'invalid echeck account@aba';
1657 $payinfo = "$1\@$2";
1659 $self->payinfo($payinfo);
1662 my $ban = qsearchs('banned_pay', $self->_banned_pay_hashref);
1664 return 'Banned ACH account: banned on '.
1665 time2str('%a %h %o at %r', $ban->_date).
1666 ' by '. $ban->otaker.
1667 ' (ban# '. $ban->bannum. ')';
1670 } elsif ( $self->payby eq 'LECB' ) {
1672 my $payinfo = $self->payinfo;
1673 $payinfo =~ s/\D//g;
1674 $payinfo =~ /^1?(\d{10})$/ or return 'invalid btn billing telephone number';
1676 $self->payinfo($payinfo);
1679 } elsif ( $self->payby eq 'BILL' ) {
1681 $error = $self->ut_textn('payinfo');
1682 return "Illegal P.O. number: ". $self->payinfo if $error;
1685 } elsif ( $self->payby eq 'COMP' ) {
1687 my $curuser = $FS::CurrentUser::CurrentUser;
1688 if ( ! $self->custnum
1689 && ! $curuser->access_right('Complimentary customer')
1692 return "You are not permitted to create complimentary accounts."
1695 $error = $self->ut_textn('payinfo');
1696 return "Illegal comp account issuer: ". $self->payinfo if $error;
1699 } elsif ( $self->payby eq 'PREPAY' ) {
1701 my $payinfo = $self->payinfo;
1702 $payinfo =~ s/\W//g; #anything else would just confuse things
1703 $self->payinfo($payinfo);
1704 $error = $self->ut_alpha('payinfo');
1705 return "Illegal prepayment identifier: ". $self->payinfo if $error;
1706 return "Unknown prepayment identifier"
1707 unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } );
1712 if ( $self->paydate eq '' || $self->paydate eq '-' ) {
1713 return "Expiration date required"
1714 unless $self->payby =~ /^(BILL|PREPAY|CHEK|DCHK|LECB|CASH|WEST|MCRD)$/;
1718 if ( $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/ ) {
1719 ( $m, $y ) = ( $1, length($2) == 4 ? $2 : "20$2" );
1720 } elsif ( $self->paydate =~ /^(20)?(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) {
1721 ( $m, $y ) = ( $3, "20$2" );
1723 return "Illegal expiration date: ". $self->paydate;
1725 $self->paydate("$y-$m-01");
1726 my($nowm,$nowy)=(localtime(time))[4,5]; $nowm++; $nowy+=1900;
1727 return gettext('expired_card')
1729 && !$ignore_expired_card
1730 && ( $y<$nowy || ( $y==$nowy && $1<$nowm ) );
1733 if ( $self->payname eq '' && $self->payby !~ /^(CHEK|DCHK)$/ &&
1734 ( ! $conf->exists('require_cardname')
1735 || $self->payby !~ /^(CARD|DCRD)$/ )
1737 $self->payname( $self->first. " ". $self->getfield('last') );
1739 $self->payname =~ /^([\w \,\.\-\'\&]+)$/
1740 or return gettext('illegal_name'). " payname: ". $self->payname;
1744 foreach my $flag (qw( tax spool_cdr squelch_cdr )) {
1745 $self->$flag() =~ /^(Y?)$/ or return "Illegal $flag: ". $self->$flag();
1749 $self->otaker(getotaker) unless $self->otaker;
1751 warn "$me check AFTER: \n". $self->_dump
1754 $self->SUPER::check;
1759 Returns a list of fields which have ship_ duplicates.
1764 qw( last first company
1765 address1 address2 city county state zip country
1770 =item has_ship_address
1772 Returns true if this customer record has a separate shipping address.
1776 sub has_ship_address {
1778 scalar( grep { $self->getfield("ship_$_") ne '' } $self->addr_fields );
1783 Returns all packages (see L<FS::cust_pkg>) for this customer.
1790 return $self->num_pkgs unless wantarray;
1793 if ( $self->{'_pkgnum'} ) {
1794 @cust_pkg = values %{ $self->{'_pkgnum'}->cache };
1796 @cust_pkg = qsearch( 'cust_pkg', { 'custnum' => $self->custnum });
1799 sort sort_packages @cust_pkg;
1804 Synonym for B<all_pkgs>.
1809 shift->all_pkgs(@_);
1814 Returns all locations (see L<FS::cust_location>) for this customer.
1820 qsearch('cust_location', { 'custnum' => $self->custnum } );
1823 =item ncancelled_pkgs
1825 Returns all non-cancelled packages (see L<FS::cust_pkg>) for this customer.
1829 sub ncancelled_pkgs {
1832 return $self->num_ncancelled_pkgs unless wantarray;
1835 if ( $self->{'_pkgnum'} ) {
1837 warn "$me ncancelled_pkgs: returning cached objects"
1840 @cust_pkg = grep { ! $_->getfield('cancel') }
1841 values %{ $self->{'_pkgnum'}->cache };
1845 warn "$me ncancelled_pkgs: searching for packages with custnum ".
1846 $self->custnum. "\n"
1850 qsearch( 'cust_pkg', {
1851 'custnum' => $self->custnum,
1855 qsearch( 'cust_pkg', {
1856 'custnum' => $self->custnum,
1861 sort sort_packages @cust_pkg;
1865 # This should be generalized to use config options to determine order.
1867 if ( $a->get('cancel') and $b->get('cancel') ) {
1868 $a->pkgnum <=> $b->pkgnum;
1869 } elsif ( $a->get('cancel') or $b->get('cancel') ) {
1870 return -1 if $b->get('cancel');
1871 return 1 if $a->get('cancel');
1874 $a->pkgnum <=> $b->pkgnum;
1878 =item suspended_pkgs
1880 Returns all suspended packages (see L<FS::cust_pkg>) for this customer.
1884 sub suspended_pkgs {
1886 grep { $_->susp } $self->ncancelled_pkgs;
1889 =item unflagged_suspended_pkgs
1891 Returns all unflagged suspended packages (see L<FS::cust_pkg>) for this
1892 customer (thouse packages without the `manual_flag' set).
1896 sub unflagged_suspended_pkgs {
1898 return $self->suspended_pkgs
1899 unless dbdef->table('cust_pkg')->column('manual_flag');
1900 grep { ! $_->manual_flag } $self->suspended_pkgs;
1903 =item unsuspended_pkgs
1905 Returns all unsuspended (and uncancelled) packages (see L<FS::cust_pkg>) for
1910 sub unsuspended_pkgs {
1912 grep { ! $_->susp } $self->ncancelled_pkgs;
1915 =item num_cancelled_pkgs
1917 Returns the number of cancelled packages (see L<FS::cust_pkg>) for this
1922 sub num_cancelled_pkgs {
1923 shift->num_pkgs("cust_pkg.cancel IS NOT NULL AND cust_pkg.cancel != 0");
1926 sub num_ncancelled_pkgs {
1927 shift->num_pkgs("( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )");
1931 my( $self ) = shift;
1932 my $sql = scalar(@_) ? shift : '';
1933 $sql = "AND $sql" if $sql && $sql !~ /^\s*$/ && $sql !~ /^\s*AND/i;
1934 my $sth = dbh->prepare(
1935 "SELECT COUNT(*) FROM cust_pkg WHERE custnum = ? $sql"
1936 ) or die dbh->errstr;
1937 $sth->execute($self->custnum) or die $sth->errstr;
1938 $sth->fetchrow_arrayref->[0];
1943 Unsuspends all unflagged suspended packages (see L</unflagged_suspended_pkgs>
1944 and L<FS::cust_pkg>) for this customer. Always returns a list: an empty list
1945 on success or a list of errors.
1951 grep { $_->unsuspend } $self->suspended_pkgs;
1956 Suspends all unsuspended packages (see L<FS::cust_pkg>) for this customer.
1958 Returns a list: an empty list on success or a list of errors.
1964 grep { $_->suspend(@_) } $self->unsuspended_pkgs;
1967 =item suspend_if_pkgpart HASHREF | PKGPART [ , PKGPART ... ]
1969 Suspends all unsuspended packages (see L<FS::cust_pkg>) matching the listed
1970 PKGPARTs (see L<FS::part_pkg>). Preferred usage is to pass a hashref instead
1971 of a list of pkgparts; the hashref has the following keys:
1975 =item pkgparts - listref of pkgparts
1977 =item (other options are passed to the suspend method)
1982 Returns a list: an empty list on success or a list of errors.
1986 sub suspend_if_pkgpart {
1988 my (@pkgparts, %opt);
1989 if (ref($_[0]) eq 'HASH'){
1990 @pkgparts = @{$_[0]{pkgparts}};
1995 grep { $_->suspend(%opt) }
1996 grep { my $pkgpart = $_->pkgpart; grep { $pkgpart eq $_ } @pkgparts }
1997 $self->unsuspended_pkgs;
2000 =item suspend_unless_pkgpart HASHREF | PKGPART [ , PKGPART ... ]
2002 Suspends all unsuspended packages (see L<FS::cust_pkg>) unless they match the
2003 given PKGPARTs (see L<FS::part_pkg>). Preferred usage is to pass a hashref
2004 instead of a list of pkgparts; the hashref has the following keys:
2008 =item pkgparts - listref of pkgparts
2010 =item (other options are passed to the suspend method)
2014 Returns a list: an empty list on success or a list of errors.
2018 sub suspend_unless_pkgpart {
2020 my (@pkgparts, %opt);
2021 if (ref($_[0]) eq 'HASH'){
2022 @pkgparts = @{$_[0]{pkgparts}};
2027 grep { $_->suspend(%opt) }
2028 grep { my $pkgpart = $_->pkgpart; ! grep { $pkgpart eq $_ } @pkgparts }
2029 $self->unsuspended_pkgs;
2032 =item cancel [ OPTION => VALUE ... ]
2034 Cancels all uncancelled packages (see L<FS::cust_pkg>) for this customer.
2036 Available options are:
2040 =item quiet - can be set true to supress email cancellation notices.
2042 =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.
2044 =item ban - can be set true to ban this customer's credit card or ACH information, if present.
2048 Always returns a list: an empty list on success or a list of errors.
2053 my( $self, %opt ) = @_;
2055 warn "$me cancel called on customer ". $self->custnum. " with options ".
2056 join(', ', map { "$_: $opt{$_}" } keys %opt ). "\n"
2059 return ( 'access denied' )
2060 unless $FS::CurrentUser::CurrentUser->access_right('Cancel customer');
2062 if ( $opt{'ban'} && $self->payby =~ /^(CARD|DCRD|CHEK|DCHK)$/ ) {
2064 #should try decryption (we might have the private key)
2065 # and if not maybe queue a job for the server that does?
2066 return ( "Can't (yet) ban encrypted credit cards" )
2067 if $self->is_encrypted($self->payinfo);
2069 my $ban = new FS::banned_pay $self->_banned_pay_hashref;
2070 my $error = $ban->insert;
2071 return ( $error ) if $error;
2075 my @pkgs = $self->ncancelled_pkgs;
2077 warn "$me cancelling ". scalar($self->ncancelled_pkgs). "/".
2078 scalar(@pkgs). " packages for customer ". $self->custnum. "\n"
2081 grep { $_ } map { $_->cancel(%opt) } $self->ncancelled_pkgs;
2084 sub _banned_pay_hashref {
2095 'payby' => $payby2ban{$self->payby},
2096 'payinfo' => md5_base64($self->payinfo),
2097 #don't ever *search* on reason! #'reason' =>
2103 Returns all notes (see L<FS::cust_main_note>) for this customer.
2110 qsearch( 'cust_main_note',
2111 { 'custnum' => $self->custnum },
2113 'ORDER BY _DATE DESC'
2119 Returns the agent (see L<FS::agent>) for this customer.
2125 qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
2128 =item bill_and_collect
2130 Cancels and suspends any packages due, generates bills, applies payments and
2133 Warns on errors (Does not currently: If there is an error, returns the error, otherwise returns false.)
2135 Options are passed as name-value pairs. Currently available options are:
2141 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:
2145 $cust_main->bill( 'time' => str2time('April 20th, 2001') );
2149 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.
2153 "1d" for the traditional, daily events (the default), or "1m" for the new monthly events (part_event.check_freq)
2157 If set true, re-charges setup fees.
2161 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)
2167 sub bill_and_collect {
2168 my( $self, %options ) = @_;
2174 #$options{actual_time} not $options{time} because freeside-daily -d is for
2175 #pre-printing invoices
2176 my @cancel_pkgs = grep { $_->expire && $_->expire <= $options{actual_time} }
2177 $self->ncancelled_pkgs;
2179 foreach my $cust_pkg ( @cancel_pkgs ) {
2180 my $cpr = $cust_pkg->last_cust_pkg_reason('expire');
2181 my $error = $cust_pkg->cancel($cpr ? ( 'reason' => $cpr->reasonnum,
2182 'reason_otaker' => $cpr->otaker
2186 warn "Error cancelling expired pkg ". $cust_pkg->pkgnum.
2187 " for custnum ". $self->custnum. ": $error"
2195 #$options{actual_time} not $options{time} because freeside-daily -d is for
2196 #pre-printing invoices
2199 && ( ( $_->part_pkg->is_prepaid
2201 && $_->bill < $options{actual_time}
2204 && $_->adjourn <= $options{actual_time}
2208 $self->ncancelled_pkgs;
2210 foreach my $cust_pkg ( @susp_pkgs ) {
2211 my $cpr = $cust_pkg->last_cust_pkg_reason('adjourn')
2212 if ($cust_pkg->adjourn && $cust_pkg->adjourn < $^T);
2213 my $error = $cust_pkg->suspend($cpr ? ( 'reason' => $cpr->reasonnum,
2214 'reason_otaker' => $cpr->otaker
2219 warn "Error suspending package ". $cust_pkg->pkgnum.
2220 " for custnum ". $self->custnum. ": $error"
2228 my $error = $self->bill( %options );
2229 warn "Error billing, custnum ". $self->custnum. ": $error" if $error;
2231 $self->apply_payments_and_credits;
2233 $error = $self->collect( %options );
2234 warn "Error collecting, custnum". $self->custnum. ": $error" if $error;
2240 Generates invoices (see L<FS::cust_bill>) for this customer. Usually used in
2241 conjunction with the collect method by calling B<bill_and_collect>.
2243 If there is an error, returns the error, otherwise returns false.
2245 Options are passed as name-value pairs. Currently available options are:
2251 If set true, re-charges setup fees.
2255 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:
2259 $cust_main->bill( 'time' => str2time('April 20th, 2001') );
2263 An array ref of specific packages (objects) to attempt billing, instead trying all of them.
2265 $cust_main->bill( pkg_list => [$pkg1, $pkg2] );
2269 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.
2276 my( $self, %options ) = @_;
2277 return '' if $self->payby eq 'COMP';
2278 warn "$me bill customer ". $self->custnum. "\n"
2281 my $time = $options{'time'} || time;
2282 my $invoice_time = $options{'invoice_time'} || $time;
2285 local $SIG{HUP} = 'IGNORE';
2286 local $SIG{INT} = 'IGNORE';
2287 local $SIG{QUIT} = 'IGNORE';
2288 local $SIG{TERM} = 'IGNORE';
2289 local $SIG{TSTP} = 'IGNORE';
2290 local $SIG{PIPE} = 'IGNORE';
2292 my $oldAutoCommit = $FS::UID::AutoCommit;
2293 local $FS::UID::AutoCommit = 0;
2296 $self->select_for_update; #mutex
2298 my @cust_bill_pkg = ();
2301 # find the packages which are due for billing, find out how much they are
2302 # & generate invoice database.
2305 my( $total_setup, $total_recur, $postal_charge ) = ( 0, 0, 0 );
2309 my @precommit_hooks = ();
2311 my @cust_pkgs = qsearch('cust_pkg', { 'custnum' => $self->custnum } );
2312 foreach my $cust_pkg (@cust_pkgs) {
2314 #NO!! next if $cust_pkg->cancel;
2315 next if $cust_pkg->getfield('cancel');
2317 warn " bill package ". $cust_pkg->pkgnum. "\n" if $DEBUG > 1;
2319 #? to avoid use of uninitialized value errors... ?
2320 $cust_pkg->setfield('bill', '')
2321 unless defined($cust_pkg->bill);
2323 #my $part_pkg = $cust_pkg->part_pkg;
2325 my $real_pkgpart = $cust_pkg->pkgpart;
2326 my %hash = $cust_pkg->hash;
2328 foreach my $part_pkg ( $cust_pkg->part_pkg->self_and_bill_linked ) {
2330 $cust_pkg->set($_, $hash{$_}) foreach qw ( setup last_bill bill );
2333 $self->_make_lines( 'part_pkg' => $part_pkg,
2334 'cust_pkg' => $cust_pkg,
2335 'precommit_hooks' => \@precommit_hooks,
2336 'line_items' => \@cust_bill_pkg,
2337 'setup' => \$total_setup,
2338 'recur' => \$total_recur,
2339 'tax_matrix' => \%taxlisthash,
2341 'options' => \%options,
2344 $dbh->rollback if $oldAutoCommit;
2348 } #foreach my $part_pkg
2350 } #foreach my $cust_pkg
2352 unless ( @cust_bill_pkg ) { #don't create an invoice w/o line items
2353 #but do commit any package date cycling that happened
2354 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2358 my $postal_pkg = $self->charge_postal_fee();
2359 if ( $postal_pkg && !ref( $postal_pkg ) ) {
2360 $dbh->rollback if $oldAutoCommit;
2361 return "can't charge postal invoice fee for customer ".
2362 $self->custnum. ": $postal_pkg";
2365 ( scalar( grep { $_->recur && $_->recur > 0 } @cust_bill_pkg) ||
2366 !$conf->exists('postal_invoice-recurring_only')
2370 foreach my $part_pkg ( $postal_pkg->part_pkg->self_and_bill_linked ) {
2372 $self->_make_lines( 'part_pkg' => $part_pkg,
2373 'cust_pkg' => $postal_pkg,
2374 'precommit_hooks' => \@precommit_hooks,
2375 'line_items' => \@cust_bill_pkg,
2376 'setup' => \$total_setup,
2377 'recur' => \$total_recur,
2378 'tax_matrix' => \%taxlisthash,
2380 'options' => \%options,
2383 $dbh->rollback if $oldAutoCommit;
2389 warn "having a look at the taxes we found...\n" if $DEBUG > 2;
2390 foreach my $tax ( keys %taxlisthash ) {
2391 my $tax_object = shift @{ $taxlisthash{$tax} };
2392 warn "found ". $tax_object->taxname. " as $tax\n" if $DEBUG > 2;
2393 my $listref_or_error =
2394 $tax_object->taxline( $taxlisthash{$tax},
2395 'custnum' => $self->custnum,
2396 'invoice_time' => $invoice_time
2398 unless (ref($listref_or_error)) {
2399 $dbh->rollback if $oldAutoCommit;
2400 return $listref_or_error;
2402 unshift @{ $taxlisthash{$tax} }, $tax_object;
2404 warn "adding ". $listref_or_error->[1].
2405 " as ". $listref_or_error->[0]. "\n"
2407 $tax{ $tax } += $listref_or_error->[1];
2408 if ( $taxname{ $listref_or_error->[0] } ) {
2409 push @{ $taxname{ $listref_or_error->[0] } }, $tax;
2411 $taxname{ $listref_or_error->[0] } = [ $tax ];
2416 #move the cust_tax_exempt_pkg records to the cust_bill_pkgs we will commit
2417 my %packagemap = map { $_->pkgnum => $_ } @cust_bill_pkg;
2418 foreach my $tax ( keys %taxlisthash ) {
2419 foreach ( @{ $taxlisthash{$tax} }[1 ... scalar(@{ $taxlisthash{$tax} })] ) {
2420 next unless ref($_) eq 'FS::cust_bill_pkg'; # shouldn't happen
2422 push @{ $packagemap{$_->pkgnum}->_cust_tax_exempt_pkg },
2423 splice( @{ $_->_cust_tax_exempt_pkg } );
2427 #some taxes are taxed
2430 warn "finding taxed taxes...\n" if $DEBUG > 2;
2431 foreach my $tax ( keys %taxlisthash ) {
2432 my $tax_object = shift @{ $taxlisthash{$tax} };
2433 warn "found possible taxed tax ". $tax_object->taxname. " we call $tax\n"
2435 next unless $tax_object->can('tax_on_tax');
2437 foreach my $tot ( $tax_object->tax_on_tax( $self ) ) {
2438 my $totname = ref( $tot ). ' '. $tot->taxnum;
2440 warn "checking $totname which we call ". $tot->taxname. " as applicable\n"
2442 next unless exists( $taxlisthash{ $totname } ); # only increase
2444 warn "adding $totname to taxed taxes\n" if $DEBUG > 2;
2445 if ( exists( $totlisthash{ $totname } ) ) {
2446 push @{ $totlisthash{ $totname } }, $tax{ $tax };
2448 $totlisthash{ $totname } = [ $tot, $tax{ $tax } ];
2453 warn "having a look at taxed taxes...\n" if $DEBUG > 2;
2454 foreach my $tax ( keys %totlisthash ) {
2455 my $tax_object = shift @{ $totlisthash{$tax} };
2456 warn "found previously found taxed tax ". $tax_object->taxname. "\n"
2458 my $listref_or_error =
2459 $tax_object->taxline( $totlisthash{$tax},
2460 'custnum' => $self->custnum,
2461 'invoice_time' => $invoice_time
2463 unless (ref($listref_or_error)) {
2464 $dbh->rollback if $oldAutoCommit;
2465 return $listref_or_error;
2468 warn "adding taxed tax amount ". $listref_or_error->[1].
2469 " as ". $tax_object->taxname. "\n"
2471 $tax{ $tax } += $listref_or_error->[1];
2474 #consolidate and create tax line items
2475 warn "consolidating and generating...\n" if $DEBUG > 2;
2476 foreach my $taxname ( keys %taxname ) {
2479 warn "adding $taxname\n" if $DEBUG > 1;
2480 foreach my $taxitem ( @{ $taxname{$taxname} } ) {
2481 $tax += $tax{$taxitem} unless $seen{$taxitem};
2482 $seen{$taxitem} = 1;
2483 warn "adding $tax{$taxitem}\n" if $DEBUG > 1;
2487 $tax = sprintf('%.2f', $tax );
2488 $total_setup = sprintf('%.2f', $total_setup+$tax );
2490 push @cust_bill_pkg, new FS::cust_bill_pkg {
2496 'itemdesc' => $taxname,
2501 my $charged = sprintf('%.2f', $total_setup + $total_recur );
2503 #create the new invoice
2504 my $cust_bill = new FS::cust_bill ( {
2505 'custnum' => $self->custnum,
2506 '_date' => ( $invoice_time ),
2507 'charged' => $charged,
2509 my $error = $cust_bill->insert;
2511 $dbh->rollback if $oldAutoCommit;
2512 return "can't create invoice for customer #". $self->custnum. ": $error";
2515 foreach my $cust_bill_pkg ( @cust_bill_pkg ) {
2516 $cust_bill_pkg->invnum($cust_bill->invnum);
2517 my $error = $cust_bill_pkg->insert;
2519 $dbh->rollback if $oldAutoCommit;
2520 return "can't create invoice line item: $error";
2525 foreach my $hook ( @precommit_hooks ) {
2527 &{$hook}; #($self) ?
2530 $dbh->rollback if $oldAutoCommit;
2531 return "$@ running precommit hook $hook\n";
2535 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2541 my ($self, %params) = @_;
2543 my $part_pkg = $params{part_pkg} or die "no part_pkg specified";
2544 my $cust_pkg = $params{cust_pkg} or die "no cust_pkg specified";
2545 my $precommit_hooks = $params{precommit_hooks} or die "no package specified";
2546 my $cust_bill_pkgs = $params{line_items} or die "no line buffer specified";
2547 my $total_setup = $params{setup} or die "no setup accumulator specified";
2548 my $total_recur = $params{recur} or die "no recur accumulator specified";
2549 my $taxlisthash = $params{tax_matrix} or die "no tax accumulator specified";
2550 my $time = $params{'time'} or die "no time specified";
2551 my (%options) = %{$params{options}}; #hmmm only for 'resetup'
2554 my $real_pkgpart = $cust_pkg->pkgpart;
2555 my %hash = $cust_pkg->hash;
2556 my $old_cust_pkg = new FS::cust_pkg \%hash;
2562 $cust_pkg->pkgpart($part_pkg->pkgpart);
2570 if ( ! $cust_pkg->setup &&
2572 ( $conf->exists('disable_setup_suspended_pkgs') &&
2573 ! $cust_pkg->getfield('susp')
2574 ) || ! $conf->exists('disable_setup_suspended_pkgs')
2576 || $options{'resetup'}
2579 warn " bill setup\n" if $DEBUG > 1;
2582 $setup = eval { $cust_pkg->calc_setup( $time, \@details ) };
2583 return "$@ running calc_setup for $cust_pkg\n"
2586 $unitsetup = $cust_pkg->part_pkg->unit_setup || $setup; #XXX uuh
2588 $cust_pkg->setfield('setup', $time)
2589 unless $cust_pkg->setup;
2590 #do need it, but it won't get written to the db
2591 #|| $cust_pkg->pkgpart != $real_pkgpart;
2596 # bill recurring fee
2599 #XXX unit stuff here too
2603 if ( ! $cust_pkg->getfield('susp') and
2604 ( $part_pkg->getfield('freq') ne '0' &&
2605 ( $cust_pkg->getfield('bill') || 0 ) <= $time
2607 || ( $part_pkg->plan eq 'voip_cdr'
2608 && $part_pkg->option('bill_every_call')
2612 # XXX should this be a package event? probably. events are called
2613 # at collection time at the moment, though...
2614 $part_pkg->reset_usage($cust_pkg, 'debug'=>$DEBUG)
2615 if $part_pkg->can('reset_usage');
2616 #don't want to reset usage just cause we want a line item??
2617 #&& $part_pkg->pkgpart == $real_pkgpart;
2619 warn " bill recur\n" if $DEBUG > 1;
2622 # XXX shared with $recur_prog
2623 $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
2625 #over two params! lets at least switch to a hashref for the rest...
2626 my $increment_next_bill = ( $part_pkg->freq ne '0'
2627 && ( $cust_pkg->getfield('bill') || 0 ) <= $time
2629 my %param = ( 'precommit_hooks' => $precommit_hooks,
2630 'increment_next_bill' => $increment_next_bill,
2633 $recur = eval { $cust_pkg->calc_recur( \$sdate, \@details, \%param ) };
2634 return "$@ running calc_recur for $cust_pkg\n"
2637 if ( $increment_next_bill ) {
2639 #change this bit to use Date::Manip? CAREFUL with timezones (see
2640 # mailing list archive)
2641 my ($sec,$min,$hour,$mday,$mon,$year) =
2642 (localtime($sdate) )[0,1,2,3,4,5];
2644 #pro-rating magic - if $recur_prog fiddles $sdate, want to use that
2645 # only for figuring next bill date, nothing else, so, reset $sdate again
2647 $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
2648 #no need, its in $hash{last_bill}# my $last_bill = $cust_pkg->last_bill;
2649 $cust_pkg->last_bill($sdate);
2651 if ( $part_pkg->freq =~ /^\d+$/ ) {
2652 $mon += $part_pkg->freq;
2653 until ( $mon < 12 ) { $mon -= 12; $year++; }
2654 } elsif ( $part_pkg->freq =~ /^(\d+)w$/ ) {
2656 $mday += $weeks * 7;
2657 } elsif ( $part_pkg->freq =~ /^(\d+)d$/ ) {
2660 } elsif ( $part_pkg->freq =~ /^(\d+)h$/ ) {
2664 return "unparsable frequency: ". $part_pkg->freq;
2666 $cust_pkg->setfield('bill',
2667 timelocal_nocheck($sec,$min,$hour,$mday,$mon,$year));
2673 warn "\$setup is undefined" unless defined($setup);
2674 warn "\$recur is undefined" unless defined($recur);
2675 warn "\$cust_pkg->bill is undefined" unless defined($cust_pkg->bill);
2678 # If there's line items, create em cust_bill_pkg records
2679 # If $cust_pkg has been modified, update it (if we're a real pkgpart)
2684 if ( $cust_pkg->modified && $cust_pkg->pkgpart == $real_pkgpart ) {
2685 # hmm.. and if just the options are modified in some weird price plan?
2687 warn " package ". $cust_pkg->pkgnum. " modified; updating\n"
2690 my $error = $cust_pkg->replace( $old_cust_pkg,
2691 'options' => { $cust_pkg->options },
2693 return "Error modifying pkgnum ". $cust_pkg->pkgnum. ": $error"
2694 if $error; #just in case
2697 $setup = sprintf( "%.2f", $setup );
2698 $recur = sprintf( "%.2f", $recur );
2699 if ( $setup < 0 && ! $conf->exists('allow_negative_charges') ) {
2700 return "negative setup $setup for pkgnum ". $cust_pkg->pkgnum;
2702 if ( $recur < 0 && ! $conf->exists('allow_negative_charges') ) {
2703 return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum;
2706 if ( $setup != 0 || $recur != 0 ) {
2708 warn " charges (setup=$setup, recur=$recur); adding line items\n"
2711 my @cust_pkg_detail = map { $_->detail } $cust_pkg->cust_pkg_detail('I');
2713 warn " adding customer package invoice detail: $_\n"
2714 foreach @cust_pkg_detail;
2716 push @details, @cust_pkg_detail;
2718 my $cust_bill_pkg = new FS::cust_bill_pkg {
2719 'pkgnum' => $cust_pkg->pkgnum,
2721 'unitsetup' => $unitsetup,
2723 'unitrecur' => $unitrecur,
2724 'quantity' => $cust_pkg->quantity,
2725 'details' => \@details,
2728 if ( $part_pkg->option('recur_temporality', 1) eq 'preceding' ) {
2729 $cust_bill_pkg->sdate( $hash{last_bill} );
2730 $cust_bill_pkg->edate( $sdate - 86399 ); #60s*60m*24h-1
2731 } else { #if ( $part_pkg->option('recur_temporality', 1) eq 'upcoming' ) {
2732 $cust_bill_pkg->sdate( $sdate );
2733 $cust_bill_pkg->edate( $cust_pkg->bill );
2736 $cust_bill_pkg->pkgpart_override($part_pkg->pkgpart)
2737 unless $part_pkg->pkgpart == $real_pkgpart;
2739 $$total_setup += $setup;
2740 $$total_recur += $recur;
2747 $self->_handle_taxes($part_pkg, $taxlisthash, $cust_bill_pkg, $cust_pkg);
2748 return $error if $error;
2750 push @$cust_bill_pkgs, $cust_bill_pkg;
2752 } #if $setup != 0 || $recur != 0
2762 my $part_pkg = shift;
2763 my $taxlisthash = shift;
2764 my $cust_bill_pkg = shift;
2765 my $cust_pkg = shift;
2767 my %cust_bill_pkg = ();
2771 ( $conf->exists('tax-ship_address') && length($self->ship_last) )
2776 #push @classes, $cust_bill_pkg->usage_classes if $cust_bill_pkg->type eq 'U';
2777 push @classes, $cust_bill_pkg->usage_classes if $cust_bill_pkg->usage;
2778 push @classes, 'setup' if $cust_bill_pkg->setup;
2779 push @classes, 'recur' if $cust_bill_pkg->recur;
2781 if ( $conf->exists('enable_taxproducts')
2782 && (scalar($part_pkg->part_pkg_taxoverride) || $part_pkg->has_taxproduct)
2783 && ( $self->tax !~ /Y/i && $self->payby ne 'COMP' )
2787 foreach my $class (@classes) {
2788 my $err_or_ref = $self->_gather_taxes( $part_pkg, $class, $prefix );
2789 return $err_or_ref unless ref($err_or_ref);
2790 $taxes{$class} = $err_or_ref;
2793 unless (exists $taxes{''}) {
2794 my $err_or_ref = $self->_gather_taxes( $part_pkg, '', $prefix );
2795 return $err_or_ref unless ref($err_or_ref);
2796 $taxes{''} = $err_or_ref;
2799 } elsif ( $self->tax !~ /Y/i && $self->payby ne 'COMP' ) {
2801 my %taxhash = map { $_ => $self->get("$prefix$_") }
2802 qw( state county country );
2804 $taxhash{'taxclass'} = $part_pkg->taxclass;
2806 my @taxes = qsearch( 'cust_main_county', \%taxhash );
2809 $taxhash{'taxclass'} = '';
2810 @taxes = qsearch( 'cust_main_county', \%taxhash );
2813 #one more try at a whole-country tax rate
2815 $taxhash{$_} = '' foreach qw( state county );
2816 @taxes = qsearch( 'cust_main_county', \%taxhash );
2819 $taxes{''} = [ @taxes ];
2820 $taxes{'setup'} = [ @taxes ];
2821 $taxes{'recur'} = [ @taxes ];
2822 $taxes{$_} = [ @taxes ] foreach (@classes);
2824 # maybe eliminate this entirely, along with all the 0% records
2827 "fatal: can't find tax rate for state/county/country/taxclass ".
2828 join('/', ( map $self->get("$prefix$_"),
2829 qw(state county country)
2831 $part_pkg->taxclass ). "\n";
2834 } #if $conf->exists('enable_taxproducts') ...
2837 if ( $conf->exists('separate_usage') ) {
2838 my $section = $cust_pkg->part_pkg->option('usage_section', 'Hush!');
2839 my $summary = $cust_pkg->part_pkg->option('summarize_usage', 'Hush!');
2840 push @display, new FS::cust_bill_pkg_display { type => 'S' };
2841 push @display, new FS::cust_bill_pkg_display { type => 'R' };
2842 push @display, new FS::cust_bill_pkg_display { type => 'U',
2845 if ($section && $summary) {
2846 $display[2]->post_total('Y');
2847 push @display, new FS::cust_bill_pkg_display { type => 'U',
2852 $cust_bill_pkg->set('display', \@display);
2854 my %tax_cust_bill_pkg = $cust_bill_pkg->disintegrate;
2855 foreach my $key (keys %tax_cust_bill_pkg) {
2856 my @taxes = @{ $taxes{$key} || [] };
2857 my $tax_cust_bill_pkg = $tax_cust_bill_pkg{$key};
2859 foreach my $tax ( @taxes ) {
2860 my $taxname = ref( $tax ). ' '. $tax->taxnum;
2861 if ( exists( $taxlisthash->{ $taxname } ) ) {
2862 push @{ $taxlisthash->{ $taxname } }, $tax_cust_bill_pkg;
2864 $taxlisthash->{ $taxname } = [ $tax, $tax_cust_bill_pkg ];
2874 my $part_pkg = shift;
2879 my $geocode = $self->geocode('cch');
2881 my @taxclassnums = map { $_->taxclassnum }
2882 $part_pkg->part_pkg_taxoverride($class);
2884 unless (@taxclassnums) {
2885 @taxclassnums = map { $_->taxclassnum }
2886 $part_pkg->part_pkg_taxrate('cch', $geocode, $class);
2888 warn "Found taxclassnum values of ". join(',', @taxclassnums)
2893 join(' OR ', map { "taxclassnum = $_" } @taxclassnums ). ")";
2895 @taxes = qsearch({ 'table' => 'tax_rate',
2896 'hashref' => { 'geocode' => $geocode, },
2897 'extra_sql' => $extra_sql,
2899 if scalar(@taxclassnums);
2901 # maybe eliminate this entirely, along with all the 0% records
2904 "fatal: can't find tax rate for zip/taxproduct/pkgpart ".
2905 join('/', ( map $self->get("$prefix$_"),
2908 $part_pkg->taxproduct_description,
2909 $part_pkg->pkgpart ). "\n";
2912 warn "Found taxes ".
2913 join(',', map{ ref($_). " ". $_->get($_->primary_key) } @taxes). "\n"
2920 =item collect OPTIONS
2922 (Attempt to) collect money for this customer's outstanding invoices (see
2923 L<FS::cust_bill>). Usually used after the bill method.
2925 Actions are now triggered by billing events; see L<FS::part_event> and the
2926 billing events web interface. Old-style invoice events (see
2927 L<FS::part_bill_event>) have been deprecated.
2929 If there is an error, returns the error, otherwise returns false.
2931 Options are passed as name-value pairs.
2933 Currently available options are:
2939 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.
2943 Retry card/echeck/LEC transactions even when not scheduled by invoice events.
2947 set true to surpress email card/ACH decline notices.
2951 "1d" for the traditional, daily events (the default), or "1m" for the new monthly events (part_event.check_freq)
2955 allows for one time override of normal customer billing method
2959 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)
2967 my( $self, %options ) = @_;
2968 my $invoice_time = $options{'invoice_time'} || time;
2971 local $SIG{HUP} = 'IGNORE';
2972 local $SIG{INT} = 'IGNORE';
2973 local $SIG{QUIT} = 'IGNORE';
2974 local $SIG{TERM} = 'IGNORE';
2975 local $SIG{TSTP} = 'IGNORE';
2976 local $SIG{PIPE} = 'IGNORE';
2978 my $oldAutoCommit = $FS::UID::AutoCommit;
2979 local $FS::UID::AutoCommit = 0;
2982 $self->select_for_update; #mutex
2985 my $balance = $self->balance;
2986 warn "$me collect customer ". $self->custnum. ": balance $balance\n"
2989 if ( exists($options{'retry_card'}) ) {
2990 carp 'retry_card option passed to collect is deprecated; use retry';
2991 $options{'retry'} ||= $options{'retry_card'};
2993 if ( exists($options{'retry'}) && $options{'retry'} ) {
2994 my $error = $self->retry_realtime;
2996 $dbh->rollback if $oldAutoCommit;
3001 # false laziness w/pay_batch::import_results
3003 my $due_cust_event = $self->due_cust_event(
3004 'debug' => ( $options{'debug'} || 0 ),
3005 'time' => $invoice_time,
3006 'check_freq' => $options{'check_freq'},
3008 unless( ref($due_cust_event) ) {
3009 $dbh->rollback if $oldAutoCommit;
3010 return $due_cust_event;
3013 foreach my $cust_event ( @$due_cust_event ) {
3017 #re-eval event conditions (a previous event could have changed things)
3018 unless ( $cust_event->test_conditions( 'time' => $invoice_time ) ) {
3019 #don't leave stray "new/locked" records around
3020 my $error = $cust_event->delete;
3022 #gah, even with transactions
3023 $dbh->commit if $oldAutoCommit; #well.
3030 local $realtime_bop_decline_quiet = 1 if $options{'quiet'};
3031 warn " running cust_event ". $cust_event->eventnum. "\n"
3035 #if ( my $error = $cust_event->do_event(%options) ) { #XXX %options?
3036 if ( my $error = $cust_event->do_event() ) {
3037 #XXX wtf is this? figure out a proper dealio with return value
3039 # gah, even with transactions.
3040 $dbh->commit if $oldAutoCommit; #well.
3047 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3052 =item due_cust_event [ HASHREF | OPTION => VALUE ... ]
3054 Inserts database records for and returns an ordered listref of new events due
3055 for this customer, as FS::cust_event objects (see L<FS::cust_event>). If no
3056 events are due, an empty listref is returned. If there is an error, returns a
3057 scalar error message.
3059 To actually run the events, call each event's test_condition method, and if
3060 still true, call the event's do_event method.
3062 Options are passed as a hashref or as a list of name-value pairs. Available
3069 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.
3073 "Current time" for the events.
3077 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)
3081 Only return events for the specified eventtable (by default, events of all eventtables are returned)
3085 Explicitly pass the objects to be tested (typically used with eventtable).
3089 Set to true to return the objects, but not actually insert them into the
3096 sub due_cust_event {
3098 my %opt = ref($_[0]) ? %{ $_[0] } : @_;
3101 #my $DEBUG = $opt{'debug'}
3102 local($DEBUG) = $opt{'debug'}
3103 if defined($opt{'debug'}) && $opt{'debug'} > $DEBUG;
3105 warn "$me due_cust_event called with options ".
3106 join(', ', map { "$_: $opt{$_}" } keys %opt). "\n"
3109 $opt{'time'} ||= time;
3111 local $SIG{HUP} = 'IGNORE';
3112 local $SIG{INT} = 'IGNORE';
3113 local $SIG{QUIT} = 'IGNORE';
3114 local $SIG{TERM} = 'IGNORE';
3115 local $SIG{TSTP} = 'IGNORE';
3116 local $SIG{PIPE} = 'IGNORE';
3118 my $oldAutoCommit = $FS::UID::AutoCommit;
3119 local $FS::UID::AutoCommit = 0;
3122 $self->select_for_update #mutex
3123 unless $opt{testonly};
3126 # 1: find possible events (initial search)
3129 my @cust_event = ();
3131 my @eventtable = $opt{'eventtable'}
3132 ? ( $opt{'eventtable'} )
3133 : FS::part_event->eventtables_runorder;
3135 foreach my $eventtable ( @eventtable ) {
3138 if ( $opt{'objects'} ) {
3140 @objects = @{ $opt{'objects'} };
3144 #my @objects = $self->eventtable(); # sub cust_main { @{ [ $self ] }; }
3145 @objects = ( $eventtable eq 'cust_main' )
3147 : ( $self->$eventtable() );
3151 my @e_cust_event = ();
3153 my $cross = "CROSS JOIN $eventtable";
3154 $cross .= ' LEFT JOIN cust_main USING ( custnum )'
3155 unless $eventtable eq 'cust_main';
3157 foreach my $object ( @objects ) {
3159 #this first search uses the condition_sql magic for optimization.
3160 #the more possible events we can eliminate in this step the better
3162 my $cross_where = '';
3163 my $pkey = $object->primary_key;
3164 $cross_where = "$eventtable.$pkey = ". $object->$pkey();
3166 my $join = FS::part_event_condition->join_conditions_sql( $eventtable );
3168 FS::part_event_condition->where_conditions_sql( $eventtable,
3169 'time'=>$opt{'time'}
3171 my $order = FS::part_event_condition->order_conditions_sql( $eventtable );
3173 $extra_sql = "AND $extra_sql" if $extra_sql;
3175 #here is the agent virtualization
3176 $extra_sql .= " AND ( part_event.agentnum IS NULL
3177 OR part_event.agentnum = ". $self->agentnum. ' )';
3179 $extra_sql .= " $order";
3181 warn "searching for events for $eventtable ". $object->$pkey. "\n"
3182 if $opt{'debug'} > 2;
3183 my @part_event = qsearch( {
3184 'debug' => ( $opt{'debug'} > 3 ? 1 : 0 ),
3185 'select' => 'part_event.*',
3186 'table' => 'part_event',
3187 'addl_from' => "$cross $join",
3188 'hashref' => { 'check_freq' => ( $opt{'check_freq'} || '1d' ),
3189 'eventtable' => $eventtable,
3192 'extra_sql' => "AND $cross_where $extra_sql",
3196 my $pkey = $object->primary_key;
3197 warn " ". scalar(@part_event).
3198 " possible events found for $eventtable ". $object->$pkey(). "\n";
3201 push @e_cust_event, map { $_->new_cust_event($object) } @part_event;
3205 warn " ". scalar(@e_cust_event).
3206 " subtotal possible cust events found for $eventtable\n"
3209 push @cust_event, @e_cust_event;
3213 warn " ". scalar(@cust_event).
3214 " total possible cust events found in initial search\n"
3218 # 2: test conditions
3223 @cust_event = grep $_->test_conditions( 'time' => $opt{'time'},
3224 'stats_hashref' => \%unsat ),
3227 warn " ". scalar(@cust_event). " cust events left satisfying conditions\n"
3230 warn " invalid conditions not eliminated with condition_sql:\n".
3231 join('', map " $_: ".$unsat{$_}."\n", keys %unsat )
3238 unless( $opt{testonly} ) {
3239 foreach my $cust_event ( @cust_event ) {
3241 my $error = $cust_event->insert();
3243 $dbh->rollback if $oldAutoCommit;
3250 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3256 warn " returning events: ". Dumper(@cust_event). "\n"
3263 =item retry_realtime
3265 Schedules realtime / batch credit card / electronic check / LEC billing
3266 events for for retry. Useful if card information has changed or manual
3267 retry is desired. The 'collect' method must be called to actually retry
3270 Implementation details: For either this customer, or for each of this
3271 customer's open invoices, changes the status of the first "done" (with
3272 statustext error) realtime processing event to "failed".
3276 sub retry_realtime {
3279 local $SIG{HUP} = 'IGNORE';
3280 local $SIG{INT} = 'IGNORE';
3281 local $SIG{QUIT} = 'IGNORE';
3282 local $SIG{TERM} = 'IGNORE';
3283 local $SIG{TSTP} = 'IGNORE';
3284 local $SIG{PIPE} = 'IGNORE';
3286 my $oldAutoCommit = $FS::UID::AutoCommit;
3287 local $FS::UID::AutoCommit = 0;
3290 #a little false laziness w/due_cust_event (not too bad, really)
3292 my $join = FS::part_event_condition->join_conditions_sql;
3293 my $order = FS::part_event_condition->order_conditions_sql;
3296 . join ( ' OR ' , map {
3297 "( part_event.eventtable = " . dbh->quote($_)
3298 . " AND tablenum IN( SELECT " . dbdef->table($_)->primary_key . " from $_ where custnum = " . dbh->quote( $self->custnum ) . "))" ;
3299 } FS::part_event->eventtables)
3302 #here is the agent virtualization
3303 my $agent_virt = " ( part_event.agentnum IS NULL
3304 OR part_event.agentnum = ". $self->agentnum. ' )';
3306 #XXX this shouldn't be hardcoded, actions should declare it...
3307 my @realtime_events = qw(
3308 cust_bill_realtime_card
3309 cust_bill_realtime_check
3310 cust_bill_realtime_lec
3314 my $is_realtime_event = ' ( '. join(' OR ', map "part_event.action = '$_'",
3319 my @cust_event = qsearchs({
3320 'table' => 'cust_event',
3321 'select' => 'cust_event.*',
3322 'addl_from' => "LEFT JOIN part_event USING ( eventpart ) $join",
3323 'hashref' => { 'status' => 'done' },
3324 'extra_sql' => " AND statustext IS NOT NULL AND statustext != '' ".
3325 " AND $mine AND $is_realtime_event AND $agent_virt $order" # LIMIT 1"
3328 my %seen_invnum = ();
3329 foreach my $cust_event (@cust_event) {
3331 #max one for the customer, one for each open invoice
3332 my $cust_X = $cust_event->cust_X;
3333 next if $seen_invnum{ $cust_event->part_event->eventtable eq 'cust_bill'
3337 or $cust_event->part_event->eventtable eq 'cust_bill'
3340 my $error = $cust_event->retry;
3342 $dbh->rollback if $oldAutoCommit;
3343 return "error scheduling event for retry: $error";
3348 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3353 =item realtime_bop METHOD AMOUNT [ OPTION => VALUE ... ]
3355 Runs a realtime credit card, ACH (electronic check) or phone bill transaction
3356 via a Business::OnlinePayment realtime gateway. See
3357 L<http://420.am/business-onlinepayment> for supported gateways.
3359 Available methods are: I<CC>, I<ECHECK> and I<LEC>
3361 Available options are: I<description>, I<invnum>, I<quiet>, I<paynum_ref>, I<payunique>
3363 The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
3364 I<zip>, I<payinfo> and I<paydate> are also available. Any of these options,
3365 if set, will override the value from the customer record.
3367 I<description> is a free-text field passed to the gateway. It defaults to
3368 "Internet services".
3370 If an I<invnum> is specified, this payment (if successful) is applied to the
3371 specified invoice. If you don't specify an I<invnum> you might want to
3372 call the B<apply_payments> method.
3374 I<quiet> can be set true to surpress email decline notices.
3376 I<paynum_ref> can be set to a scalar reference. It will be filled in with the
3377 resulting paynum, if any.
3379 I<payunique> is a unique identifier for this payment.
3381 (moved from cust_bill) (probably should get realtime_{card,ach,lec} here too)
3386 my( $self, $method, $amount, %options ) = @_;
3388 warn "$me realtime_bop: $method $amount\n";
3389 warn " $_ => $options{$_}\n" foreach keys %options;
3392 $options{'description'} ||= 'Internet services';
3394 return $self->fake_bop($method, $amount, %options) if $options{'fake'};
3396 eval "use Business::OnlinePayment";
3399 my $payinfo = exists($options{'payinfo'})
3400 ? $options{'payinfo'}
3403 my %method2payby = (
3410 # check for banned credit card/ACH
3413 my $ban = qsearchs('banned_pay', {
3414 'payby' => $method2payby{$method},
3415 'payinfo' => md5_base64($payinfo),
3417 return "Banned credit card" if $ban;
3424 if ( $options{'invnum'} ) {
3425 my $cust_bill = qsearchs('cust_bill', { 'invnum' => $options{'invnum'} } );
3426 die "invnum ". $options{'invnum'}. " not found" unless $cust_bill;
3428 map { $_->part_pkg->taxclass }
3430 map { $_->cust_pkg }
3431 $cust_bill->cust_bill_pkg;
3432 unless ( grep { $taxclasses[0] ne $_ } @taxclasses ) { #unless there are
3433 #different taxclasses
3434 $taxclass = $taxclasses[0];
3438 #look for an agent gateway override first
3440 if ( $method eq 'CC' ) {
3441 $cardtype = cardtype($payinfo);
3442 } elsif ( $method eq 'ECHECK' ) {
3445 $cardtype = $method;
3449 qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
3450 cardtype => $cardtype,
3451 taxclass => $taxclass, } )
3452 || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
3454 taxclass => $taxclass, } )
3455 || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
3456 cardtype => $cardtype,
3458 || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
3460 taxclass => '', } );
3462 my $payment_gateway = '';
3463 my( $processor, $login, $password, $action, @bop_options );
3464 if ( $override ) { #use a payment gateway override
3466 $payment_gateway = $override->payment_gateway;
3468 $processor = $payment_gateway->gateway_module;
3469 $login = $payment_gateway->gateway_username;
3470 $password = $payment_gateway->gateway_password;
3471 $action = $payment_gateway->gateway_action;
3472 @bop_options = $payment_gateway->options;
3474 } else { #use the standard settings from the config
3476 ( $processor, $login, $password, $action, @bop_options ) =
3477 $self->default_payment_gateway($method);
3485 my $address = exists($options{'address1'})
3486 ? $options{'address1'}
3488 my $address2 = exists($options{'address2'})
3489 ? $options{'address2'}
3491 $address .= ", ". $address2 if length($address2);
3493 my $o_payname = exists($options{'payname'})
3494 ? $options{'payname'}
3496 my($payname, $payfirst, $paylast);
3497 if ( $o_payname && $method ne 'ECHECK' ) {
3498 ($payname = $o_payname) =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
3499 or return "Illegal payname $payname";
3500 ($payfirst, $paylast) = ($1, $2);
3502 $payfirst = $self->getfield('first');
3503 $paylast = $self->getfield('last');
3504 $payname = "$payfirst $paylast";
3507 my @invoicing_list = $self->invoicing_list_emailonly;
3508 if ( $conf->exists('emailinvoiceautoalways')
3509 || $conf->exists('emailinvoiceauto') && ! @invoicing_list
3510 || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
3511 push @invoicing_list, $self->all_emails;
3514 my $email = ($conf->exists('business-onlinepayment-email-override'))
3515 ? $conf->config('business-onlinepayment-email-override')
3516 : $invoicing_list[0];
3520 my $payip = exists($options{'payip'})
3523 $content{customer_ip} = $payip
3526 $content{invoice_number} = $options{'invnum'}
3527 if exists($options{'invnum'}) && length($options{'invnum'});
3529 $content{email_customer} =
3530 ( $conf->exists('business-onlinepayment-email_customer')
3531 || $conf->exists('business-onlinepayment-email-override') );
3534 if ( $method eq 'CC' ) {
3536 $content{card_number} = $payinfo;
3537 $paydate = exists($options{'paydate'})
3538 ? $options{'paydate'}
3540 $paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
3541 $content{expiration} = "$2/$1";
3543 my $paycvv = exists($options{'paycvv'})
3544 ? $options{'paycvv'}
3546 $content{cvv2} = $paycvv
3549 my $paystart_month = exists($options{'paystart_month'})
3550 ? $options{'paystart_month'}
3551 : $self->paystart_month;
3553 my $paystart_year = exists($options{'paystart_year'})
3554 ? $options{'paystart_year'}
3555 : $self->paystart_year;
3557 $content{card_start} = "$paystart_month/$paystart_year"
3558 if $paystart_month && $paystart_year;
3560 my $payissue = exists($options{'payissue'})
3561 ? $options{'payissue'}
3563 $content{issue_number} = $payissue if $payissue;
3565 $content{recurring_billing} = 'YES'
3566 if qsearch('cust_pay', { 'custnum' => $self->custnum,
3568 'payinfo' => $payinfo,
3570 || qsearch('cust_pay', { 'custnum' => $self->custnum,
3572 'paymask' => $self->mask_payinfo('CARD', $payinfo),
3576 } elsif ( $method eq 'ECHECK' ) {
3577 ( $content{account_number}, $content{routing_code} ) =
3578 split('@', $payinfo);
3579 $content{bank_name} = $o_payname;
3580 $content{bank_state} = exists($options{'paystate'})
3581 ? $options{'paystate'}
3582 : $self->getfield('paystate');
3583 $content{account_type} = exists($options{'paytype'})
3584 ? uc($options{'paytype'}) || 'CHECKING'
3585 : uc($self->getfield('paytype')) || 'CHECKING';
3586 $content{account_name} = $payname;
3587 $content{customer_org} = $self->company ? 'B' : 'I';
3588 $content{state_id} = exists($options{'stateid'})
3589 ? $options{'stateid'}
3590 : $self->getfield('stateid');
3591 $content{state_id_state} = exists($options{'stateid_state'})
3592 ? $options{'stateid_state'}
3593 : $self->getfield('stateid_state');
3594 $content{customer_ssn} = exists($options{'ss'})
3597 } elsif ( $method eq 'LEC' ) {
3598 $content{phone} = $payinfo;
3602 # run transaction(s)
3605 my $balance = exists( $options{'balance'} )
3606 ? $options{'balance'}
3609 $self->select_for_update; #mutex ... just until we get our pending record in
3611 #the checks here are intended to catch concurrent payments
3612 #double-form-submission prevention is taken care of in cust_pay_pending::check
3615 return "The customer's balance has changed; $method transaction aborted."
3616 if $self->balance < $balance;
3617 #&& $self->balance < $amount; #might as well anyway?
3619 #also check and make sure there aren't *other* pending payments for this cust
3621 my @pending = qsearch('cust_pay_pending', {
3622 'custnum' => $self->custnum,
3623 'status' => { op=>'!=', value=>'done' }
3625 return "A payment is already being processed for this customer (".
3626 join(', ', map 'paypendingnum '. $_->paypendingnum, @pending ).
3627 "); $method transaction aborted."
3628 if scalar(@pending);
3630 #okay, good to go, if we're a duplicate, cust_pay_pending will kick us out
3632 my $cust_pay_pending = new FS::cust_pay_pending {
3633 'custnum' => $self->custnum,
3634 #'invnum' => $options{'invnum'},
3637 'payby' => $method2payby{$method},
3638 'payinfo' => $payinfo,
3639 'paydate' => $paydate,
3641 'gatewaynum' => ( $payment_gateway ? $payment_gateway->gatewaynum : '' ),
3643 $cust_pay_pending->payunique( $options{payunique} )
3644 if defined($options{payunique}) && length($options{payunique});
3645 my $cpp_new_err = $cust_pay_pending->insert; #mutex lost when this is inserted
3646 return $cpp_new_err if $cpp_new_err;
3648 my( $action1, $action2 ) = split(/\s*\,\s*/, $action );
3650 my $transaction = new Business::OnlinePayment( $processor, @bop_options );
3651 $transaction->content(
3654 'password' => $password,
3655 'action' => $action1,
3656 'description' => $options{'description'},
3657 'amount' => $amount,
3658 #'invoice_number' => $options{'invnum'},
3659 'customer_id' => $self->custnum,
3660 'last_name' => $paylast,
3661 'first_name' => $payfirst,
3663 'address' => $address,
3664 'city' => ( exists($options{'city'})
3667 'state' => ( exists($options{'state'})
3670 'zip' => ( exists($options{'zip'})
3673 'country' => ( exists($options{'country'})
3674 ? $options{'country'}
3676 'referer' => 'http://cleanwhisker.420.am/',
3678 'phone' => $self->daytime || $self->night,
3682 $cust_pay_pending->status('pending');
3683 my $cpp_pending_err = $cust_pay_pending->replace;
3684 return $cpp_pending_err if $cpp_pending_err;
3687 my $BOP_TESTING = 0;
3688 my $BOP_TESTING_SUCCESS = 1;
3690 unless ( $BOP_TESTING ) {
3691 $transaction->submit();
3693 if ( $BOP_TESTING_SUCCESS ) {
3694 $transaction->is_success(1);
3695 $transaction->authorization('fake auth');
3697 $transaction->is_success(0);
3698 $transaction->error_message('fake failure');
3702 if ( $transaction->is_success() && $action2 ) {
3704 $cust_pay_pending->status('authorized');
3705 my $cpp_authorized_err = $cust_pay_pending->replace;
3706 return $cpp_authorized_err if $cpp_authorized_err;
3708 my $auth = $transaction->authorization;
3709 my $ordernum = $transaction->can('order_number')
3710 ? $transaction->order_number
3714 new Business::OnlinePayment( $processor, @bop_options );
3721 password => $password,
3722 order_number => $ordernum,
3724 authorization => $auth,
3725 description => $options{'description'},
3728 foreach my $field (qw( authorization_source_code returned_ACI
3729 transaction_identifier validation_code
3730 transaction_sequence_num local_transaction_date
3731 local_transaction_time AVS_result_code )) {
3732 $capture{$field} = $transaction->$field() if $transaction->can($field);
3735 $capture->content( %capture );
3739 unless ( $capture->is_success ) {
3740 my $e = "Authorization successful but capture failed, custnum #".
3741 $self->custnum. ': '. $capture->result_code.
3742 ": ". $capture->error_message;
3749 $cust_pay_pending->status($transaction->is_success() ? 'captured' : 'declined');
3750 my $cpp_captured_err = $cust_pay_pending->replace;
3751 return $cpp_captured_err if $cpp_captured_err;
3754 # remove paycvv after initial transaction
3757 #false laziness w/misc/process/payment.cgi - check both to make sure working
3759 if ( defined $self->dbdef_table->column('paycvv')
3760 && length($self->paycvv)
3761 && ! grep { $_ eq cardtype($payinfo) } $conf->config('cvv-save')
3763 my $error = $self->remove_cvv;
3765 warn "WARNING: error removing cvv: $error\n";
3773 if ( $transaction->is_success() ) {
3776 if ( $payment_gateway ) { # agent override
3777 $paybatch = $payment_gateway->gatewaynum. '-';
3780 $paybatch .= "$processor:". $transaction->authorization;
3782 $paybatch .= ':'. $transaction->order_number
3783 if $transaction->can('order_number')
3784 && length($transaction->order_number);
3786 my $cust_pay = new FS::cust_pay ( {
3787 'custnum' => $self->custnum,
3788 'invnum' => $options{'invnum'},
3791 'payby' => $method2payby{$method},
3792 'payinfo' => $payinfo,
3793 'paybatch' => $paybatch,
3794 'paydate' => $paydate,
3796 #doesn't hurt to know, even though the dup check is in cust_pay_pending now
3797 $cust_pay->payunique( $options{payunique} )
3798 if defined($options{payunique}) && length($options{payunique});
3800 my $oldAutoCommit = $FS::UID::AutoCommit;
3801 local $FS::UID::AutoCommit = 0;
3804 #start a transaction, insert the cust_pay and set cust_pay_pending.status to done in a single transction
3806 my $error = $cust_pay->insert($options{'manual'} ? ( 'manual' => 1 ) : () );
3809 $cust_pay->invnum(''); #try again with no specific invnum
3810 my $error2 = $cust_pay->insert( $options{'manual'} ?
3811 ( 'manual' => 1 ) : ()
3814 # gah. but at least we have a record of the state we had to abort in
3815 # from cust_pay_pending now.
3816 my $e = "WARNING: $method captured but payment not recorded - ".
3817 "error inserting payment ($processor): $error2".
3818 " (previously tried insert with invnum #$options{'invnum'}" .
3819 ": $error ) - pending payment saved as paypendingnum ".
3820 $cust_pay_pending->paypendingnum. "\n";
3826 if ( $options{'paynum_ref'} ) {
3827 ${ $options{'paynum_ref'} } = $cust_pay->paynum;
3830 $cust_pay_pending->status('done');
3831 $cust_pay_pending->statustext('captured');
3832 my $cpp_done_err = $cust_pay_pending->replace;
3834 if ( $cpp_done_err ) {
3836 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
3837 my $e = "WARNING: $method captured but payment not recorded - ".
3838 "error updating status for paypendingnum ".
3839 $cust_pay_pending->paypendingnum. ": $cpp_done_err \n";
3845 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3846 return ''; #no error
3852 my $perror = "$processor error: ". $transaction->error_message;
3854 unless ( $transaction->error_message ) {
3857 if ( $transaction->can('response_page') ) {
3859 'page' => ( $transaction->can('response_page')
3860 ? $transaction->response_page
3863 'code' => ( $transaction->can('response_code')
3864 ? $transaction->response_code
3867 'headers' => ( $transaction->can('response_headers')
3868 ? $transaction->response_headers
3874 "No additional debugging information available for $processor";
3877 $perror .= "No error_message returned from $processor -- ".
3878 ( ref($t_response) ? Dumper($t_response) : $t_response );
3882 if ( !$options{'quiet'} && !$realtime_bop_decline_quiet
3883 && $conf->exists('emaildecline')
3884 && grep { $_ ne 'POST' } $self->invoicing_list
3885 && ! grep { $transaction->error_message =~ /$_/ }
3886 $conf->config('emaildecline-exclude')
3888 my @templ = $conf->config('declinetemplate');
3889 my $template = new Text::Template (
3891 SOURCE => [ map "$_\n", @templ ],
3892 ) or return "($perror) can't create template: $Text::Template::ERROR";
3893 $template->compile()
3894 or return "($perror) can't compile template: $Text::Template::ERROR";
3896 my $templ_hash = { error => $transaction->error_message };
3898 my $error = send_email(
3899 'from' => $conf->config('invoice_from'),
3900 'to' => [ grep { $_ ne 'POST' } $self->invoicing_list ],
3901 'subject' => 'Your payment could not be processed',
3902 'body' => [ $template->fill_in(HASH => $templ_hash) ],
3905 $perror .= " (also received error sending decline notification: $error)"
3910 $cust_pay_pending->status('done');
3911 $cust_pay_pending->statustext("declined: $perror");
3912 my $cpp_done_err = $cust_pay_pending->replace;
3913 if ( $cpp_done_err ) {
3914 my $e = "WARNING: $method declined but pending payment not resolved - ".
3915 "error updating status for paypendingnum ".
3916 $cust_pay_pending->paypendingnum. ": $cpp_done_err \n";
3918 $perror = "$e ($perror)";
3931 my( $self, $method, $amount, %options ) = @_;
3933 if ( $options{'fake_failure'} ) {
3934 return "Error: No error; test failure requested with fake_failure";
3937 my %method2payby = (
3944 #if ( $payment_gateway ) { # agent override
3945 # $paybatch = $payment_gateway->gatewaynum. '-';
3948 #$paybatch .= "$processor:". $transaction->authorization;
3950 #$paybatch .= ':'. $transaction->order_number
3951 # if $transaction->can('order_number')
3952 # && length($transaction->order_number);
3954 my $paybatch = 'FakeProcessor:54:32';
3956 my $cust_pay = new FS::cust_pay ( {
3957 'custnum' => $self->custnum,
3958 'invnum' => $options{'invnum'},
3961 'payby' => $method2payby{$method},
3962 #'payinfo' => $payinfo,
3963 'payinfo' => '4111111111111111',
3964 'paybatch' => $paybatch,
3965 #'paydate' => $paydate,
3966 'paydate' => '2012-05-01',
3968 $cust_pay->payunique( $options{payunique} ) if length($options{payunique});
3970 my $error = $cust_pay->insert($options{'manual'} ? ( 'manual' => 1 ) : () );
3973 $cust_pay->invnum(''); #try again with no specific invnum
3974 my $error2 = $cust_pay->insert( $options{'manual'} ?
3975 ( 'manual' => 1 ) : ()
3978 # gah, even with transactions.
3979 my $e = 'WARNING: Card/ACH debited but database not updated - '.
3980 "error inserting (fake!) payment: $error2".
3981 " (previously tried insert with invnum #$options{'invnum'}" .
3988 if ( $options{'paynum_ref'} ) {
3989 ${ $options{'paynum_ref'} } = $cust_pay->paynum;
3992 return ''; #no error
3996 =item default_payment_gateway
4000 sub default_payment_gateway {
4001 my( $self, $method ) = @_;
4003 die "Real-time processing not enabled\n"
4004 unless $conf->exists('business-onlinepayment');
4007 my $bop_config = 'business-onlinepayment';
4008 $bop_config .= '-ach'
4009 if $method =~ /^(ECHECK|CHEK)$/ && $conf->exists($bop_config. '-ach');
4010 my ( $processor, $login, $password, $action, @bop_options ) =
4011 $conf->config($bop_config);
4012 $action ||= 'normal authorization';
4013 pop @bop_options if scalar(@bop_options) % 2 && $bop_options[-1] =~ /^\s*$/;
4014 die "No real-time processor is enabled - ".
4015 "did you set the business-onlinepayment configuration value?\n"
4018 ( $processor, $login, $password, $action, @bop_options )
4023 Removes the I<paycvv> field from the database directly.
4025 If there is an error, returns the error, otherwise returns false.
4031 my $sth = dbh->prepare("UPDATE cust_main SET paycvv = '' WHERE custnum = ?")
4032 or return dbh->errstr;
4033 $sth->execute($self->custnum)
4034 or return $sth->errstr;
4039 =item realtime_refund_bop METHOD [ OPTION => VALUE ... ]
4041 Refunds a realtime credit card, ACH (electronic check) or phone bill transaction
4042 via a Business::OnlinePayment realtime gateway. See
4043 L<http://420.am/business-onlinepayment> for supported gateways.
4045 Available methods are: I<CC>, I<ECHECK> and I<LEC>
4047 Available options are: I<amount>, I<reason>, I<paynum>, I<paydate>
4049 Most gateways require a reference to an original payment transaction to refund,
4050 so you probably need to specify a I<paynum>.
4052 I<amount> defaults to the original amount of the payment if not specified.
4054 I<reason> specifies a reason for the refund.
4056 I<paydate> specifies the expiration date for a credit card overriding the
4057 value from the customer record or the payment record. Specified as yyyy-mm-dd
4059 Implementation note: If I<amount> is unspecified or equal to the amount of the
4060 orignal payment, first an attempt is made to "void" the transaction via
4061 the gateway (to cancel a not-yet settled transaction) and then if that fails,
4062 the normal attempt is made to "refund" ("credit") the transaction via the
4063 gateway is attempted.
4065 #The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
4066 #I<zip>, I<payinfo> and I<paydate> are also available. Any of these options,
4067 #if set, will override the value from the customer record.
4069 #If an I<invnum> is specified, this payment (if successful) is applied to the
4070 #specified invoice. If you don't specify an I<invnum> you might want to
4071 #call the B<apply_payments> method.
4075 #some false laziness w/realtime_bop, not enough to make it worth merging
4076 #but some useful small subs should be pulled out
4077 sub realtime_refund_bop {
4078 my( $self, $method, %options ) = @_;
4080 warn "$me realtime_refund_bop: $method refund\n";
4081 warn " $_ => $options{$_}\n" foreach keys %options;
4084 eval "use Business::OnlinePayment";
4088 # look up the original payment and optionally a gateway for that payment
4092 my $amount = $options{'amount'};
4094 my( $processor, $login, $password, @bop_options ) ;
4095 my( $auth, $order_number ) = ( '', '', '' );
4097 if ( $options{'paynum'} ) {
4099 warn " paynum: $options{paynum}\n" if $DEBUG > 1;
4100 $cust_pay = qsearchs('cust_pay', { paynum=>$options{'paynum'} } )
4101 or return "Unknown paynum $options{'paynum'}";
4102 $amount ||= $cust_pay->paid;
4104 $cust_pay->paybatch =~ /^((\d+)\-)?(\w+):\s*([\w\-\/ ]*)(:([\w\-]+))?$/
4105 or return "Can't parse paybatch for paynum $options{'paynum'}: ".
4106 $cust_pay->paybatch;
4107 my $gatewaynum = '';
4108 ( $gatewaynum, $processor, $auth, $order_number ) = ( $2, $3, $4, $6 );
4110 if ( $gatewaynum ) { #gateway for the payment to be refunded
4112 my $payment_gateway =
4113 qsearchs('payment_gateway', { 'gatewaynum' => $gatewaynum } );
4114 die "payment gateway $gatewaynum not found"
4115 unless $payment_gateway;
4117 $processor = $payment_gateway->gateway_module;
4118 $login = $payment_gateway->gateway_username;
4119 $password = $payment_gateway->gateway_password;
4120 @bop_options = $payment_gateway->options;
4122 } else { #try the default gateway
4124 my( $conf_processor, $unused_action );
4125 ( $conf_processor, $login, $password, $unused_action, @bop_options ) =
4126 $self->default_payment_gateway($method);
4128 return "processor of payment $options{'paynum'} $processor does not".
4129 " match default processor $conf_processor"
4130 unless $processor eq $conf_processor;
4135 } else { # didn't specify a paynum, so look for agent gateway overrides
4136 # like a normal transaction
4139 if ( $method eq 'CC' ) {
4140 $cardtype = cardtype($self->payinfo);
4141 } elsif ( $method eq 'ECHECK' ) {
4144 $cardtype = $method;
4147 qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
4148 cardtype => $cardtype,
4150 || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
4152 taxclass => '', } );
4154 if ( $override ) { #use a payment gateway override
4156 my $payment_gateway = $override->payment_gateway;
4158 $processor = $payment_gateway->gateway_module;
4159 $login = $payment_gateway->gateway_username;
4160 $password = $payment_gateway->gateway_password;
4161 #$action = $payment_gateway->gateway_action;
4162 @bop_options = $payment_gateway->options;
4164 } else { #use the standard settings from the config
4167 ( $processor, $login, $password, $unused_action, @bop_options ) =
4168 $self->default_payment_gateway($method);
4173 return "neither amount nor paynum specified" unless $amount;
4178 'password' => $password,
4179 'order_number' => $order_number,
4180 'amount' => $amount,
4181 'referer' => 'http://cleanwhisker.420.am/',
4183 $content{authorization} = $auth
4184 if length($auth); #echeck/ACH transactions have an order # but no auth
4185 #(at least with authorize.net)
4187 my $disable_void_after;
4188 if ($conf->exists('disable_void_after')
4189 && $conf->config('disable_void_after') =~ /^(\d+)$/) {
4190 $disable_void_after = $1;
4193 #first try void if applicable
4194 if ( $cust_pay && $cust_pay->paid == $amount
4196 ( not defined($disable_void_after) )
4197 || ( time < ($cust_pay->_date + $disable_void_after ) )
4200 warn " attempting void\n" if $DEBUG > 1;
4201 my $void = new Business::OnlinePayment( $processor, @bop_options );
4202 $void->content( 'action' => 'void', %content );
4204 if ( $void->is_success ) {
4205 my $error = $cust_pay->void($options{'reason'});
4207 # gah, even with transactions.
4208 my $e = 'WARNING: Card/ACH voided but database not updated - '.
4209 "error voiding payment: $error";
4213 warn " void successful\n" if $DEBUG > 1;
4218 warn " void unsuccessful, trying refund\n"
4222 my $address = $self->address1;
4223 $address .= ", ". $self->address2 if $self->address2;
4225 my($payname, $payfirst, $paylast);
4226 if ( $self->payname && $method ne 'ECHECK' ) {
4227 $payname = $self->payname;
4228 $payname =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
4229 or return "Illegal payname $payname";
4230 ($payfirst, $paylast) = ($1, $2);
4232 $payfirst = $self->getfield('first');
4233 $paylast = $self->getfield('last');
4234 $payname = "$payfirst $paylast";
4237 my @invoicing_list = $self->invoicing_list_emailonly;
4238 if ( $conf->exists('emailinvoiceautoalways')
4239 || $conf->exists('emailinvoiceauto') && ! @invoicing_list
4240 || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
4241 push @invoicing_list, $self->all_emails;
4244 my $email = ($conf->exists('business-onlinepayment-email-override'))
4245 ? $conf->config('business-onlinepayment-email-override')
4246 : $invoicing_list[0];
4248 my $payip = exists($options{'payip'})
4251 $content{customer_ip} = $payip
4255 if ( $method eq 'CC' ) {
4258 $content{card_number} = $payinfo = $cust_pay->payinfo;
4259 (exists($options{'paydate'}) ? $options{'paydate'} : $cust_pay->paydate)
4260 =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/ &&
4261 ($content{expiration} = "$2/$1"); # where available
4263 $content{card_number} = $payinfo = $self->payinfo;
4264 (exists($options{'paydate'}) ? $options{'paydate'} : $self->paydate)
4265 =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
4266 $content{expiration} = "$2/$1";
4269 } elsif ( $method eq 'ECHECK' ) {
4272 $payinfo = $cust_pay->payinfo;
4274 $payinfo = $self->payinfo;
4276 ( $content{account_number}, $content{routing_code} )= split('@', $payinfo );
4277 $content{bank_name} = $self->payname;
4278 $content{account_type} = 'CHECKING';
4279 $content{account_name} = $payname;
4280 $content{customer_org} = $self->company ? 'B' : 'I';
4281 $content{customer_ssn} = $self->ss;
4282 } elsif ( $method eq 'LEC' ) {
4283 $content{phone} = $payinfo = $self->payinfo;
4287 my $refund = new Business::OnlinePayment( $processor, @bop_options );
4288 my %sub_content = $refund->content(
4289 'action' => 'credit',
4290 'customer_id' => $self->custnum,
4291 'last_name' => $paylast,
4292 'first_name' => $payfirst,
4294 'address' => $address,
4295 'city' => $self->city,
4296 'state' => $self->state,
4297 'zip' => $self->zip,
4298 'country' => $self->country,
4300 'phone' => $self->daytime || $self->night,
4303 warn join('', map { " $_ => $sub_content{$_}\n" } keys %sub_content )
4307 return "$processor error: ". $refund->error_message
4308 unless $refund->is_success();
4310 my %method2payby = (
4316 my $paybatch = "$processor:". $refund->authorization;
4317 $paybatch .= ':'. $refund->order_number
4318 if $refund->can('order_number') && $refund->order_number;
4320 while ( $cust_pay && $cust_pay->unapplied < $amount ) {
4321 my @cust_bill_pay = $cust_pay->cust_bill_pay;
4322 last unless @cust_bill_pay;
4323 my $cust_bill_pay = pop @cust_bill_pay;
4324 my $error = $cust_bill_pay->delete;
4328 my $cust_refund = new FS::cust_refund ( {
4329 'custnum' => $self->custnum,
4330 'paynum' => $options{'paynum'},
4331 'refund' => $amount,
4333 'payby' => $method2payby{$method},
4334 'payinfo' => $payinfo,
4335 'paybatch' => $paybatch,
4336 'reason' => $options{'reason'} || 'card or ACH refund',
4338 my $error = $cust_refund->insert;
4340 $cust_refund->paynum(''); #try again with no specific paynum
4341 my $error2 = $cust_refund->insert;
4343 # gah, even with transactions.
4344 my $e = 'WARNING: Card/ACH refunded but database not updated - '.
4345 "error inserting refund ($processor): $error2".
4346 " (previously tried insert with paynum #$options{'paynum'}" .
4357 =item batch_card OPTION => VALUE...
4359 Adds a payment for this invoice to the pending credit card batch (see
4360 L<FS::cust_pay_batch>), or, if the B<realtime> option is set to a true value,
4361 runs the payment using a realtime gateway.
4366 my ($self, %options) = @_;
4369 if (exists($options{amount})) {
4370 $amount = $options{amount};
4372 $amount = sprintf("%.2f", $self->balance - $self->in_transit_payments);
4374 return '' unless $amount > 0;
4376 my $invnum = delete $options{invnum};
4377 my $payby = $options{invnum} || $self->payby; #dubious
4379 if ($options{'realtime'}) {
4380 return $self->realtime_bop( FS::payby->payby2bop($self->payby),
4386 my $oldAutoCommit = $FS::UID::AutoCommit;
4387 local $FS::UID::AutoCommit = 0;
4390 #this needs to handle mysql as well as Pg, like svc_acct.pm
4391 #(make it into a common function if folks need to do batching with mysql)
4392 $dbh->do("LOCK TABLE pay_batch IN SHARE ROW EXCLUSIVE MODE")
4393 or return "Cannot lock pay_batch: " . $dbh->errstr;
4397 'payby' => FS::payby->payby2payment($payby),
4400 my $pay_batch = qsearchs( 'pay_batch', \%pay_batch );
4402 unless ( $pay_batch ) {
4403 $pay_batch = new FS::pay_batch \%pay_batch;
4404 my $error = $pay_batch->insert;
4406 $dbh->rollback if $oldAutoCommit;
4407 die "error creating new batch: $error\n";
4411 my $old_cust_pay_batch = qsearchs('cust_pay_batch', {
4412 'batchnum' => $pay_batch->batchnum,
4413 'custnum' => $self->custnum,
4416 foreach (qw( address1 address2 city state zip country payby payinfo paydate
4418 $options{$_} = '' unless exists($options{$_});
4421 my $cust_pay_batch = new FS::cust_pay_batch ( {
4422 'batchnum' => $pay_batch->batchnum,
4423 'invnum' => $invnum || 0, # is there a better value?
4424 # this field should be
4426 # cust_bill_pay_batch now
4427 'custnum' => $self->custnum,
4428 'last' => $self->getfield('last'),
4429 'first' => $self->getfield('first'),
4430 'address1' => $options{address1} || $self->address1,
4431 'address2' => $options{address2} || $self->address2,
4432 'city' => $options{city} || $self->city,
4433 'state' => $options{state} || $self->state,
4434 'zip' => $options{zip} || $self->zip,
4435 'country' => $options{country} || $self->country,
4436 'payby' => $options{payby} || $self->payby,
4437 'payinfo' => $options{payinfo} || $self->payinfo,
4438 'exp' => $options{paydate} || $self->paydate,
4439 'payname' => $options{payname} || $self->payname,
4440 'amount' => $amount, # consolidating
4443 $cust_pay_batch->paybatchnum($old_cust_pay_batch->paybatchnum)
4444 if $old_cust_pay_batch;
4447 if ($old_cust_pay_batch) {
4448 $error = $cust_pay_batch->replace($old_cust_pay_batch)
4450 $error = $cust_pay_batch->insert;
4454 $dbh->rollback if $oldAutoCommit;
4458 my $unapplied = $self->total_unapplied_credits
4459 + $self->total_unapplied_payments
4460 + $self->in_transit_payments;
4461 foreach my $cust_bill ($self->open_cust_bill) {
4462 #$dbh->commit or die $dbh->errstr if $oldAutoCommit;
4463 my $cust_bill_pay_batch = new FS::cust_bill_pay_batch {
4464 'invnum' => $cust_bill->invnum,
4465 'paybatchnum' => $cust_pay_batch->paybatchnum,
4466 'amount' => $cust_bill->owed,
4469 if ($unapplied >= $cust_bill_pay_batch->amount){
4470 $unapplied -= $cust_bill_pay_batch->amount;
4473 $cust_bill_pay_batch->amount(sprintf ( "%.2f",
4474 $cust_bill_pay_batch->amount - $unapplied )); $unapplied = 0;
4476 $error = $cust_bill_pay_batch->insert;
4478 $dbh->rollback if $oldAutoCommit;
4483 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4487 =item apply_payments_and_credits
4489 Applies unapplied payments and credits.
4491 In most cases, this new method should be used in place of sequential
4492 apply_payments and apply_credits methods.
4494 If there is an error, returns the error, otherwise returns false.
4498 sub apply_payments_and_credits {
4501 local $SIG{HUP} = 'IGNORE';
4502 local $SIG{INT} = 'IGNORE';
4503 local $SIG{QUIT} = 'IGNORE';
4504 local $SIG{TERM} = 'IGNORE';
4505 local $SIG{TSTP} = 'IGNORE';
4506 local $SIG{PIPE} = 'IGNORE';
4508 my $oldAutoCommit = $FS::UID::AutoCommit;
4509 local $FS::UID::AutoCommit = 0;
4512 $self->select_for_update; #mutex
4514 foreach my $cust_bill ( $self->open_cust_bill ) {
4515 my $error = $cust_bill->apply_payments_and_credits;
4517 $dbh->rollback if $oldAutoCommit;
4518 return "Error applying: $error";
4522 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4527 =item apply_credits OPTION => VALUE ...
4529 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
4530 to outstanding invoice balances in chronological order (or reverse
4531 chronological order if the I<order> option is set to B<newest>) and returns the
4532 value of any remaining unapplied credits available for refund (see
4533 L<FS::cust_refund>).
4535 Dies if there is an error.
4543 local $SIG{HUP} = 'IGNORE';
4544 local $SIG{INT} = 'IGNORE';
4545 local $SIG{QUIT} = 'IGNORE';
4546 local $SIG{TERM} = 'IGNORE';
4547 local $SIG{TSTP} = 'IGNORE';
4548 local $SIG{PIPE} = 'IGNORE';
4550 my $oldAutoCommit = $FS::UID::AutoCommit;
4551 local $FS::UID::AutoCommit = 0;
4554 $self->select_for_update; #mutex
4556 unless ( $self->total_unapplied_credits ) {
4557 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4561 my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
4562 qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
4564 my @invoices = $self->open_cust_bill;
4565 @invoices = sort { $b->_date <=> $a->_date } @invoices
4566 if defined($opt{'order'}) && $opt{'order'} eq 'newest';
4569 foreach my $cust_bill ( @invoices ) {
4572 if ( !defined($credit) || $credit->credited == 0) {
4573 $credit = pop @credits or last;
4576 if ($cust_bill->owed >= $credit->credited) {
4577 $amount=$credit->credited;
4579 $amount=$cust_bill->owed;
4582 my $cust_credit_bill = new FS::cust_credit_bill ( {
4583 'crednum' => $credit->crednum,
4584 'invnum' => $cust_bill->invnum,
4585 'amount' => $amount,
4587 my $error = $cust_credit_bill->insert;
4589 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
4593 redo if ($cust_bill->owed > 0);
4597 my $total_unapplied_credits = $self->total_unapplied_credits;
4599 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4601 return $total_unapplied_credits;
4604 =item apply_payments
4606 Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
4607 to outstanding invoice balances in chronological order.
4609 #and returns the value of any remaining unapplied payments.
4611 Dies if there is an error.
4615 sub apply_payments {
4618 local $SIG{HUP} = 'IGNORE';
4619 local $SIG{INT} = 'IGNORE';
4620 local $SIG{QUIT} = 'IGNORE';
4621 local $SIG{TERM} = 'IGNORE';
4622 local $SIG{TSTP} = 'IGNORE';
4623 local $SIG{PIPE} = 'IGNORE';
4625 my $oldAutoCommit = $FS::UID::AutoCommit;
4626 local $FS::UID::AutoCommit = 0;
4629 $self->select_for_update; #mutex
4633 my @payments = sort { $b->_date <=> $a->_date }
4634 grep { $_->unapplied > 0 }
4637 my @invoices = sort { $a->_date <=> $b->_date}
4638 grep { $_->owed > 0 }
4643 foreach my $cust_bill ( @invoices ) {
4646 if ( !defined($payment) || $payment->unapplied == 0 ) {
4647 $payment = pop @payments or last;
4650 if ( $cust_bill->owed >= $payment->unapplied ) {
4651 $amount = $payment->unapplied;
4653 $amount = $cust_bill->owed;
4656 my $cust_bill_pay = new FS::cust_bill_pay ( {
4657 'paynum' => $payment->paynum,
4658 'invnum' => $cust_bill->invnum,
4659 'amount' => $amount,
4661 my $error = $cust_bill_pay->insert;
4663 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
4667 redo if ( $cust_bill->owed > 0);
4671 my $total_unapplied_payments = $self->total_unapplied_payments;
4673 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4675 return $total_unapplied_payments;
4680 Returns the total owed for this customer on all invoices
4681 (see L<FS::cust_bill/owed>).
4687 $self->total_owed_date(2145859200); #12/31/2037
4690 =item total_owed_date TIME
4692 Returns the total owed for this customer on all invoices with date earlier than
4693 TIME. TIME is specified as a UNIX timestamp; see L<perlfunc/"time">). Also
4694 see L<Time::Local> and L<Date::Parse> for conversion functions.
4698 sub total_owed_date {
4702 foreach my $cust_bill (
4703 grep { $_->_date <= $time }
4704 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
4706 $total_bill += $cust_bill->owed;
4708 sprintf( "%.2f", $total_bill );
4713 Returns the total amount of all payments.
4720 $total += $_->paid foreach $self->cust_pay;
4721 sprintf( "%.2f", $total );
4724 =item total_unapplied_credits
4726 Returns the total outstanding credit (see L<FS::cust_credit>) for this
4727 customer. See L<FS::cust_credit/credited>.
4729 =item total_credited
4731 Old name for total_unapplied_credits. Don't use.
4735 sub total_credited {
4736 #carp "total_credited deprecated, use total_unapplied_credits";
4737 shift->total_unapplied_credits(@_);
4740 sub total_unapplied_credits {
4742 my $total_credit = 0;
4743 $total_credit += $_->credited foreach $self->cust_credit;
4744 sprintf( "%.2f", $total_credit );
4747 =item total_unapplied_payments
4749 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
4750 See L<FS::cust_pay/unapplied>.
4754 sub total_unapplied_payments {
4756 my $total_unapplied = 0;
4757 $total_unapplied += $_->unapplied foreach $self->cust_pay;
4758 sprintf( "%.2f", $total_unapplied );
4761 =item total_unapplied_refunds
4763 Returns the total unrefunded refunds (see L<FS::cust_refund>) for this
4764 customer. See L<FS::cust_refund/unapplied>.
4768 sub total_unapplied_refunds {
4770 my $total_unapplied = 0;
4771 $total_unapplied += $_->unapplied foreach $self->cust_refund;
4772 sprintf( "%.2f", $total_unapplied );
4777 Returns the balance for this customer (total_owed plus total_unrefunded, minus
4778 total_unapplied_credits minus total_unapplied_payments).
4786 + $self->total_unapplied_refunds
4787 - $self->total_unapplied_credits
4788 - $self->total_unapplied_payments
4792 =item balance_date TIME
4794 Returns the balance for this customer, only considering invoices with date
4795 earlier than TIME (total_owed_date minus total_credited minus
4796 total_unapplied_payments). TIME is specified as a UNIX timestamp; see
4797 L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion
4806 $self->total_owed_date($time)
4807 + $self->total_unapplied_refunds
4808 - $self->total_unapplied_credits
4809 - $self->total_unapplied_payments
4813 =item in_transit_payments
4815 Returns the total of requests for payments for this customer pending in
4816 batches in transit to the bank. See L<FS::pay_batch> and L<FS::cust_pay_batch>
4820 sub in_transit_payments {
4822 my $in_transit_payments = 0;
4823 foreach my $pay_batch ( qsearch('pay_batch', {
4826 foreach my $cust_pay_batch ( qsearch('cust_pay_batch', {
4827 'batchnum' => $pay_batch->batchnum,
4828 'custnum' => $self->custnum,
4830 $in_transit_payments += $cust_pay_batch->amount;
4833 sprintf( "%.2f", $in_transit_payments );
4836 =item paydate_monthyear
4838 Returns a two-element list consisting of the month and year of this customer's
4839 paydate (credit card expiration date for CARD customers)
4843 sub paydate_monthyear {
4845 if ( $self->paydate =~ /^(\d{4})-(\d{1,2})-\d{1,2}$/ ) { #Pg date format
4847 } elsif ( $self->paydate =~ /^(\d{1,2})-(\d{1,2}-)?(\d{4}$)/ ) {
4854 =item invoicing_list [ ARRAYREF ]
4856 If an arguement is given, sets these email addresses as invoice recipients
4857 (see L<FS::cust_main_invoice>). Errors are not fatal and are not reported
4858 (except as warnings), so use check_invoicing_list first.
4860 Returns a list of email addresses (with svcnum entries expanded).
4862 Note: You can clear the invoicing list by passing an empty ARRAYREF. You can
4863 check it without disturbing anything by passing nothing.
4865 This interface may change in the future.
4869 sub invoicing_list {
4870 my( $self, $arrayref ) = @_;
4873 my @cust_main_invoice;
4874 if ( $self->custnum ) {
4875 @cust_main_invoice =
4876 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
4878 @cust_main_invoice = ();
4880 foreach my $cust_main_invoice ( @cust_main_invoice ) {
4881 #warn $cust_main_invoice->destnum;
4882 unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
4883 #warn $cust_main_invoice->destnum;
4884 my $error = $cust_main_invoice->delete;
4885 warn $error if $error;
4888 if ( $self->custnum ) {
4889 @cust_main_invoice =
4890 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
4892 @cust_main_invoice = ();
4894 my %seen = map { $_->address => 1 } @cust_main_invoice;
4895 foreach my $address ( @{$arrayref} ) {
4896 next if exists $seen{$address} && $seen{$address};
4897 $seen{$address} = 1;
4898 my $cust_main_invoice = new FS::cust_main_invoice ( {
4899 'custnum' => $self->custnum,
4902 my $error = $cust_main_invoice->insert;
4903 warn $error if $error;
4907 if ( $self->custnum ) {
4909 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
4916 =item check_invoicing_list ARRAYREF
4918 Checks these arguements as valid input for the invoicing_list method. If there
4919 is an error, returns the error, otherwise returns false.
4923 sub check_invoicing_list {
4924 my( $self, $arrayref ) = @_;
4926 foreach my $address ( @$arrayref ) {
4928 if ($address eq 'FAX' and $self->getfield('fax') eq '') {
4929 return 'Can\'t add FAX invoice destination with a blank FAX number.';
4932 my $cust_main_invoice = new FS::cust_main_invoice ( {
4933 'custnum' => $self->custnum,
4936 my $error = $self->custnum
4937 ? $cust_main_invoice->check
4938 : $cust_main_invoice->checkdest
4940 return $error if $error;
4944 return "Email address required"
4945 if $conf->exists('cust_main-require_invoicing_list_email')
4946 && ! grep { $_ !~ /^([A-Z]+)$/ } @$arrayref;
4951 =item set_default_invoicing_list
4953 Sets the invoicing list to all accounts associated with this customer,
4954 overwriting any previous invoicing list.
4958 sub set_default_invoicing_list {
4960 $self->invoicing_list($self->all_emails);
4965 Returns the email addresses of all accounts provisioned for this customer.
4972 foreach my $cust_pkg ( $self->all_pkgs ) {
4973 my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
4975 map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
4976 grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
4978 $list{$_}=1 foreach map { $_->email } @svc_acct;
4983 =item invoicing_list_addpost
4985 Adds postal invoicing to this customer. If this customer is already configured
4986 to receive postal invoices, does nothing.
4990 sub invoicing_list_addpost {
4992 return if grep { $_ eq 'POST' } $self->invoicing_list;
4993 my @invoicing_list = $self->invoicing_list;
4994 push @invoicing_list, 'POST';
4995 $self->invoicing_list(\@invoicing_list);
4998 =item invoicing_list_emailonly
5000 Returns the list of email invoice recipients (invoicing_list without non-email
5001 destinations such as POST and FAX).
5005 sub invoicing_list_emailonly {
5007 warn "$me invoicing_list_emailonly called"
5009 grep { $_ !~ /^([A-Z]+)$/ } $self->invoicing_list;
5012 =item invoicing_list_emailonly_scalar
5014 Returns the list of email invoice recipients (invoicing_list without non-email
5015 destinations such as POST and FAX) as a comma-separated scalar.
5019 sub invoicing_list_emailonly_scalar {
5021 warn "$me invoicing_list_emailonly_scalar called"
5023 join(', ', $self->invoicing_list_emailonly);
5026 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
5028 Returns an array of customers referred by this customer (referral_custnum set
5029 to this custnum). If DEPTH is given, recurses up to the given depth, returning
5030 customers referred by customers referred by this customer and so on, inclusive.
5031 The default behavior is DEPTH 1 (no recursion).
5035 sub referral_cust_main {
5037 my $depth = @_ ? shift : 1;
5038 my $exclude = @_ ? shift : {};
5041 map { $exclude->{$_->custnum}++; $_; }
5042 grep { ! $exclude->{ $_->custnum } }
5043 qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
5047 map { $_->referral_cust_main($depth-1, $exclude) }
5054 =item referral_cust_main_ncancelled
5056 Same as referral_cust_main, except only returns customers with uncancelled
5061 sub referral_cust_main_ncancelled {
5063 grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
5066 =item referral_cust_pkg [ DEPTH ]
5068 Like referral_cust_main, except returns a flat list of all unsuspended (and
5069 uncancelled) packages for each customer. The number of items in this list may
5070 be useful for comission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
5074 sub referral_cust_pkg {
5076 my $depth = @_ ? shift : 1;
5078 map { $_->unsuspended_pkgs }
5079 grep { $_->unsuspended_pkgs }
5080 $self->referral_cust_main($depth);
5083 =item referring_cust_main
5085 Returns the single cust_main record for the customer who referred this customer
5086 (referral_custnum), or false.
5090 sub referring_cust_main {
5092 return '' unless $self->referral_custnum;
5093 qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
5096 =item credit AMOUNT, REASON [ , OPTION => VALUE ... ]
5098 Applies a credit to this customer. If there is an error, returns the error,
5099 otherwise returns false.
5101 REASON can be a text string, an FS::reason object, or a scalar reference to
5102 a reasonnum. If a text string, it will be automatically inserted as a new
5103 reason, and a 'reason_type' option must be passed to indicate the
5104 FS::reason_type for the new reason.
5106 An I<addlinfo> option may be passed to set the credit's I<addlinfo> field.
5108 Any other options are passed to FS::cust_credit::insert.
5113 my( $self, $amount, $reason, %options ) = @_;
5115 my $cust_credit = new FS::cust_credit {
5116 'custnum' => $self->custnum,
5117 'amount' => $amount,
5120 if ( ref($reason) ) {
5122 if ( ref($reason) eq 'SCALAR' ) {
5123 $cust_credit->reasonnum( $$reason );
5125 $cust_credit->reasonnum( $reason->reasonnum );
5129 $cust_credit->set('reason', $reason)
5132 $cust_credit->addlinfo( delete $options{'addlinfo'} )
5133 if exists($options{'addlinfo'});
5135 $cust_credit->insert(%options);
5139 =item charge AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
5141 Creates a one-time charge for this customer. If there is an error, returns
5142 the error, otherwise returns false.
5148 my ( $amount, $quantity, $pkg, $comment, $taxclass, $additional, $classnum );
5149 my ( $taxproduct, $override );
5150 if ( ref( $_[0] ) ) {
5151 $amount = $_[0]->{amount};
5152 $quantity = exists($_[0]->{quantity}) ? $_[0]->{quantity} : 1;
5153 $pkg = exists($_[0]->{pkg}) ? $_[0]->{pkg} : 'One-time charge';
5154 $comment = exists($_[0]->{comment}) ? $_[0]->{comment}
5155 : '$'. sprintf("%.2f",$amount);
5156 $taxclass = exists($_[0]->{taxclass}) ? $_[0]->{taxclass} : '';
5157 $classnum = exists($_[0]->{classnum}) ? $_[0]->{classnum} : '';
5158 $additional = $_[0]->{additional};
5159 $taxproduct = $_[0]->{taxproductnum};
5160 $override = { '' => $_[0]->{tax_override} };
5164 $pkg = @_ ? shift : 'One-time charge';
5165 $comment = @_ ? shift : '$'. sprintf("%.2f",$amount);
5166 $taxclass = @_ ? shift : '';
5170 local $SIG{HUP} = 'IGNORE';
5171 local $SIG{INT} = 'IGNORE';
5172 local $SIG{QUIT} = 'IGNORE';
5173 local $SIG{TERM} = 'IGNORE';
5174 local $SIG{TSTP} = 'IGNORE';
5175 local $SIG{PIPE} = 'IGNORE';
5177 my $oldAutoCommit = $FS::UID::AutoCommit;
5178 local $FS::UID::AutoCommit = 0;
5181 my $part_pkg = new FS::part_pkg ( {
5183 'comment' => $comment,
5187 'classnum' => $classnum ? $classnum : '',
5188 'taxclass' => $taxclass,
5189 'taxproductnum' => $taxproduct,
5192 my %options = ( ( map { ("additional_info$_" => $additional->[$_] ) }
5193 ( 0 .. @$additional - 1 )
5195 'additional_count' => scalar(@$additional),
5196 'setup_fee' => $amount,
5199 my $error = $part_pkg->insert( options => \%options,
5200 tax_overrides => $override,
5203 $dbh->rollback if $oldAutoCommit;
5207 my $pkgpart = $part_pkg->pkgpart;
5208 my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
5209 unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
5210 my $type_pkgs = new FS::type_pkgs \%type_pkgs;
5211 $error = $type_pkgs->insert;
5213 $dbh->rollback if $oldAutoCommit;
5218 my $cust_pkg = new FS::cust_pkg ( {
5219 'custnum' => $self->custnum,
5220 'pkgpart' => $pkgpart,
5221 'quantity' => $quantity,
5224 $error = $cust_pkg->insert;
5226 $dbh->rollback if $oldAutoCommit;
5230 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
5235 #=item charge_postal_fee
5237 #Applies a one time charge this customer. If there is an error,
5238 #returns the error, returns the cust_pkg charge object or false
5239 #if there was no charge.
5243 # This should be a customer event. For that to work requires that bill
5244 # also be a customer event.
5246 sub charge_postal_fee {
5249 my $pkgpart = $conf->config('postal_invoice-fee_pkgpart');
5250 return '' unless ($pkgpart && grep { $_ eq 'POST' } $self->invoicing_list);
5252 my $cust_pkg = new FS::cust_pkg ( {
5253 'custnum' => $self->custnum,
5254 'pkgpart' => $pkgpart,
5258 my $error = $cust_pkg->insert;
5259 $error ? $error : $cust_pkg;
5264 Returns all the invoices (see L<FS::cust_bill>) for this customer.
5270 sort { $a->_date <=> $b->_date }
5271 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
5274 =item open_cust_bill
5276 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
5281 sub open_cust_bill {
5283 grep { $_->owed > 0 } $self->cust_bill;
5288 Returns all the credits (see L<FS::cust_credit>) for this customer.
5294 sort { $a->_date <=> $b->_date }
5295 qsearch( 'cust_credit', { 'custnum' => $self->custnum } )
5300 Returns all the payments (see L<FS::cust_pay>) for this customer.
5306 sort { $a->_date <=> $b->_date }
5307 qsearch( 'cust_pay', { 'custnum' => $self->custnum } )
5312 Returns all voided payments (see L<FS::cust_pay_void>) for this customer.
5318 sort { $a->_date <=> $b->_date }
5319 qsearch( 'cust_pay_void', { 'custnum' => $self->custnum } )
5322 =item cust_pay_batch
5324 Returns all batched payments (see L<FS::cust_pay_void>) for this customer.
5328 sub cust_pay_batch {
5330 sort { $a->_date <=> $b->_date }
5331 qsearch( 'cust_pay_batch', { 'custnum' => $self->custnum } )
5336 Returns all the refunds (see L<FS::cust_refund>) for this customer.
5342 sort { $a->_date <=> $b->_date }
5343 qsearch( 'cust_refund', { 'custnum' => $self->custnum } )
5346 =item display_custnum
5348 Returns the displayed customer number for this customer: agent_custid if
5349 cust_main-default_agent_custid is set and it has a value, custnum otherwise.
5353 sub display_custnum {
5355 if ( $conf->exists('cust_main-default_agent_custid') && $self->agent_custid ){
5356 return $self->agent_custid;
5358 return $self->custnum;
5364 Returns a name string for this customer, either "Company (Last, First)" or
5371 my $name = $self->contact;
5372 $name = $self->company. " ($name)" if $self->company;
5378 Returns a name string for this (service/shipping) contact, either
5379 "Company (Last, First)" or "Last, First".
5385 if ( $self->get('ship_last') ) {
5386 my $name = $self->ship_contact;
5387 $name = $self->ship_company. " ($name)" if $self->ship_company;
5396 Returns this customer's full (billing) contact name only, "Last, First"
5402 $self->get('last'). ', '. $self->first;
5407 Returns this customer's full (shipping) contact name only, "Last, First"
5413 $self->get('ship_last')
5414 ? $self->get('ship_last'). ', '. $self->ship_first
5420 Returns this customer's full country name
5426 code2country($self->country);
5429 =item geocode DATA_VENDOR
5431 Returns a value for the customer location as encoded by DATA_VENDOR.
5432 Currently this only makes sense for "CCH" as DATA_VENDOR.
5437 my ($self, $data_vendor) = (shift, shift); #always cch for now
5439 my $geocode = $self->get('geocode'); #XXX only one data_vendor for geocode
5440 return $geocode if $geocode;
5442 my $prefix = ( $conf->exists('tax-ship_address') && length($self->ship_last) )
5446 my ($zip,$plus4) = split /-/, $self->get("${prefix}zip")
5447 if $self->country eq 'US';
5449 #CCH specific location stuff
5450 my $extra_sql = "AND plus4lo <= '$plus4' AND plus4hi >= '$plus4'";
5452 my @cust_tax_location =
5454 'table' => 'cust_tax_location',
5455 'hashref' => { 'zip' => $zip, 'data_vendor' => $data_vendor },
5456 'extra_sql' => $extra_sql,
5457 'order_by' => 'ORDER BY plus4hi',#overlapping with distinct ends
5460 $geocode = $cust_tax_location[0]->geocode
5461 if scalar(@cust_tax_location);
5470 Returns a status string for this customer, currently:
5474 =item prospect - No packages have ever been ordered
5476 =item active - One or more recurring packages is active
5478 =item inactive - No active recurring packages, but otherwise unsuspended/uncancelled (the inactive status is new - previously inactive customers were mis-identified as cancelled)
5480 =item suspended - All non-cancelled recurring packages are suspended
5482 =item cancelled - All recurring packages are cancelled
5488 sub status { shift->cust_status(@_); }
5492 for my $status (qw( prospect active inactive suspended cancelled )) {
5493 my $method = $status.'_sql';
5494 my $numnum = ( my $sql = $self->$method() ) =~ s/cust_main\.custnum/?/g;
5495 my $sth = dbh->prepare("SELECT $sql") or die dbh->errstr;
5496 $sth->execute( ($self->custnum) x $numnum )
5497 or die "Error executing 'SELECT $sql': ". $sth->errstr;
5498 return $status if $sth->fetchrow_arrayref->[0];
5502 =item ucfirst_cust_status
5504 =item ucfirst_status
5506 Returns the status with the first character capitalized.
5510 sub ucfirst_status { shift->ucfirst_cust_status(@_); }
5512 sub ucfirst_cust_status {
5514 ucfirst($self->cust_status);
5519 Returns a hex triplet color string for this customer's status.
5523 use vars qw(%statuscolor);
5524 tie %statuscolor, 'Tie::IxHash',
5525 'prospect' => '7e0079', #'000000', #black? naw, purple
5526 'active' => '00CC00', #green
5527 'inactive' => '0000CC', #blue
5528 'suspended' => 'FF9900', #yellow
5529 'cancelled' => 'FF0000', #red
5532 sub statuscolor { shift->cust_statuscolor(@_); }
5534 sub cust_statuscolor {
5536 $statuscolor{$self->cust_status};
5541 Returns an array of hashes representing the customer's RT tickets.
5548 my $num = $conf->config('cust_main-max_tickets') || 10;
5551 unless ( $conf->config('ticket_system-custom_priority_field') ) {
5553 @tickets = @{ FS::TicketSystem->customer_tickets($self->custnum, $num) };
5557 foreach my $priority (
5558 $conf->config('ticket_system-custom_priority_field-values'), ''
5560 last if scalar(@tickets) >= $num;
5562 @{ FS::TicketSystem->customer_tickets( $self->custnum,
5563 $num - scalar(@tickets),
5572 # Return services representing svc_accts in customer support packages
5573 sub support_services {
5575 my %packages = map { $_ => 1 } $conf->config('support_packages');
5577 grep { $_->pkg_svc && $_->pkg_svc->primary_svc eq 'Y' }
5578 grep { $_->part_svc->svcdb eq 'svc_acct' }
5579 map { $_->cust_svc }
5580 grep { exists $packages{ $_->pkgpart } }
5581 $self->ncancelled_pkgs;
5587 =head1 CLASS METHODS
5593 Class method that returns the list of possible status strings for customers
5594 (see L<the status method|/status>). For example:
5596 @statuses = FS::cust_main->statuses();
5601 #my $self = shift; #could be class...
5607 Returns an SQL expression identifying prospective cust_main records (customers
5608 with no packages ever ordered)
5612 use vars qw($select_count_pkgs);
5613 $select_count_pkgs =
5614 "SELECT COUNT(*) FROM cust_pkg
5615 WHERE cust_pkg.custnum = cust_main.custnum";
5617 sub select_count_pkgs_sql {
5621 sub prospect_sql { "
5622 0 = ( $select_count_pkgs )
5627 Returns an SQL expression identifying active cust_main records (customers with
5628 active recurring packages).
5633 0 < ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. "
5639 Returns an SQL expression identifying inactive cust_main records (customers with
5640 no active recurring packages, but otherwise unsuspended/uncancelled).
5644 sub inactive_sql { "
5645 0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " )
5647 0 < ( $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " )
5653 Returns an SQL expression identifying suspended cust_main records.
5658 sub suspended_sql { susp_sql(@_); }
5660 0 < ( $select_count_pkgs AND ". FS::cust_pkg->suspended_sql. " )
5662 0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " )
5668 Returns an SQL expression identifying cancelled cust_main records.
5672 sub cancelled_sql { cancel_sql(@_); }
5675 my $recurring_sql = FS::cust_pkg->recurring_sql;
5676 my $cancelled_sql = FS::cust_pkg->cancelled_sql;
5679 0 < ( $select_count_pkgs )
5680 AND 0 < ( $select_count_pkgs AND $recurring_sql AND $cancelled_sql )
5681 AND 0 = ( $select_count_pkgs AND $recurring_sql
5682 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
5684 AND 0 = ( $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " )
5690 =item uncancelled_sql
5692 Returns an SQL expression identifying un-cancelled cust_main records.
5696 sub uncancelled_sql { uncancel_sql(@_); }
5697 sub uncancel_sql { "
5698 ( 0 < ( $select_count_pkgs
5699 AND ( cust_pkg.cancel IS NULL
5700 OR cust_pkg.cancel = 0
5703 OR 0 = ( $select_count_pkgs )
5709 Returns an SQL fragment to retreive the balance.
5714 ( SELECT COALESCE( SUM(charged), 0 ) FROM cust_bill
5715 WHERE cust_bill.custnum = cust_main.custnum )
5716 - ( SELECT COALESCE( SUM(paid), 0 ) FROM cust_pay
5717 WHERE cust_pay.custnum = cust_main.custnum )
5718 - ( SELECT COALESCE( SUM(amount), 0 ) FROM cust_credit
5719 WHERE cust_credit.custnum = cust_main.custnum )
5720 + ( SELECT COALESCE( SUM(refund), 0 ) FROM cust_refund
5721 WHERE cust_refund.custnum = cust_main.custnum )
5724 =item balance_date_sql START_TIME [ END_TIME [ OPTION => VALUE ... ] ]
5726 Returns an SQL fragment to retreive the balance for this customer, only
5727 considering invoices with date earlier than START_TIME, and optionally not
5728 later than END_TIME (total_owed_date minus total_unapplied_credits minus
5729 total_unapplied_payments).
5731 Times are specified as SQL fragments or numeric
5732 UNIX timestamps; see L<perlfunc/"time">). Also see L<Time::Local> and
5733 L<Date::Parse> for conversion functions. The empty string can be passed
5734 to disable that time constraint completely.
5736 Available options are:
5740 =item unapplied_date
5742 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)
5747 set to true to remove all customer comparison clauses, for totals
5752 WHERE clause hashref (elements "AND"ed together) (typically used with the total option)
5757 JOIN clause (typically used with the total option)
5763 sub balance_date_sql {
5764 my( $class, $start, $end, %opt ) = @_;
5766 my $owed = FS::cust_bill->owed_sql;
5767 my $unapp_refund = FS::cust_refund->unapplied_sql;
5768 my $unapp_credit = FS::cust_credit->unapplied_sql;
5769 my $unapp_pay = FS::cust_pay->unapplied_sql;
5771 my $j = $opt{'join'} || '';
5773 my $owed_wh = $class->_money_table_where( 'cust_bill', $start,$end,%opt );
5774 my $refund_wh = $class->_money_table_where( 'cust_refund', $start,$end,%opt );
5775 my $credit_wh = $class->_money_table_where( 'cust_credit', $start,$end,%opt );
5776 my $pay_wh = $class->_money_table_where( 'cust_pay', $start,$end,%opt );
5778 " ( SELECT COALESCE(SUM($owed), 0) FROM cust_bill $j $owed_wh )
5779 + ( SELECT COALESCE(SUM($unapp_refund), 0) FROM cust_refund $j $refund_wh )
5780 - ( SELECT COALESCE(SUM($unapp_credit), 0) FROM cust_credit $j $credit_wh )
5781 - ( SELECT COALESCE(SUM($unapp_pay), 0) FROM cust_pay $j $pay_wh )
5786 =item _money_table_where TABLE START_TIME [ END_TIME [ OPTION => VALUE ... ] ]
5788 Helper method for balance_date_sql; name (and usage) subject to change
5789 (suggestions welcome).
5791 Returns a WHERE clause for the specified monetary TABLE (cust_bill,
5792 cust_refund, cust_credit or cust_pay).
5794 If TABLE is "cust_bill" or the unapplied_date option is true, only
5795 considers records with date earlier than START_TIME, and optionally not
5796 later than END_TIME .
5800 sub _money_table_where {
5801 my( $class, $table, $start, $end, %opt ) = @_;
5804 push @where, "cust_main.custnum = $table.custnum" unless $opt{'total'};
5805 if ( $table eq 'cust_bill' || $opt{'unapplied_date'} ) {
5806 push @where, "$table._date <= $start" if defined($start) && length($start);
5807 push @where, "$table._date > $end" if defined($end) && length($end);
5809 push @where, @{$opt{'where'}} if $opt{'where'};
5810 my $where = scalar(@where) ? 'WHERE '. join(' AND ', @where ) : '';
5816 =item search_sql HASHREF
5820 Returns a qsearch hash expression to search for parameters specified in HREF.
5821 Valid parameters are
5829 =item cancelled_pkgs
5835 listref of start date, end date
5841 =item current_balance
5843 listref (list returned by FS::UI::Web::parse_lt_gt($cgi, 'current_balance'))
5847 =item flattened_pkgs
5856 my ($class, $params) = @_;
5867 if ( $params->{'agentnum'} =~ /^(\d+)$/ and $1 ) {
5869 "cust_main.agentnum = $1";
5876 #prospect active inactive suspended cancelled
5877 if ( grep { $params->{'status'} eq $_ } FS::cust_main->statuses() ) {
5878 my $method = $params->{'status'}. '_sql';
5879 #push @where, $class->$method();
5880 push @where, FS::cust_main->$method();
5884 # parse cancelled package checkbox
5889 $pkgwhere .= "AND (cancel = 0 or cancel is null)"
5890 unless $params->{'cancelled_pkgs'};
5896 foreach my $field (qw( signupdate )) {
5898 next unless exists($params->{$field});
5900 my($beginning, $ending) = @{$params->{$field}};
5903 "cust_main.$field IS NOT NULL",
5904 "cust_main.$field >= $beginning",
5905 "cust_main.$field <= $ending";
5907 $orderby ||= "ORDER BY cust_main.$field";
5915 my @payby = grep /^([A-Z]{4})$/, @{ $params->{'payby'} };
5917 push @where, '( '. join(' OR ', map "cust_main.payby = '$_'", @payby). ' )';
5924 #my $balance_sql = $class->balance_sql();
5925 my $balance_sql = FS::cust_main->balance_sql();
5927 push @where, map { s/current_balance/$balance_sql/; $_ }
5928 @{ $params->{'current_balance'} };
5934 if ( $params->{'custbatch'} =~ /^([\w\/\-\:\.]+)$/ and $1 ) {
5936 "cust_main.custbatch = '$1'";
5940 # setup queries, subs, etc. for the search
5943 $orderby ||= 'ORDER BY custnum';
5945 # here is the agent virtualization
5946 push @where, $FS::CurrentUser::CurrentUser->agentnums_sql;
5948 my $extra_sql = scalar(@where) ? ' WHERE '. join(' AND ', @where) : '';
5950 my $addl_from = 'LEFT JOIN cust_pkg USING ( custnum ) ';
5952 my $count_query = "SELECT COUNT(*) FROM cust_main $extra_sql";
5954 my $select = join(', ',
5955 'cust_main.custnum',
5956 FS::UI::Web::cust_sql_fields($params->{'cust_fields'}),
5959 my(@extra_headers) = ();
5960 my(@extra_fields) = ();
5962 if ($params->{'flattened_pkgs'}) {
5964 if ($dbh->{Driver}->{Name} eq 'Pg') {
5966 $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";
5968 }elsif ($dbh->{Driver}->{Name} =~ /^mysql/i) {
5969 $select .= ", GROUP_CONCAT(pkg SEPARATOR '|') as magic";
5970 $addl_from .= " LEFT JOIN part_pkg using ( pkgpart )";
5972 warn "warning: unknown database type ". $dbh->{Driver}->{Name}.
5973 "omitting packing information from report.";
5976 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";
5978 my $sth = dbh->prepare($header_query) or die dbh->errstr;
5979 $sth->execute() or die $sth->errstr;
5980 my $headerrow = $sth->fetchrow_arrayref;
5981 my $headercount = $headerrow ? $headerrow->[0] : 0;
5982 while($headercount) {
5983 unshift @extra_headers, "Package ". $headercount;
5984 unshift @extra_fields, eval q!sub {my $c = shift;
5985 my @a = split '\|', $c->magic;
5986 my $p = $a[!.--$headercount. q!];
5994 'table' => 'cust_main',
5995 'select' => $select,
5997 'extra_sql' => $extra_sql,
5998 'order_by' => $orderby,
5999 'count_query' => $count_query,
6000 'extra_headers' => \@extra_headers,
6001 'extra_fields' => \@extra_fields,
6006 =item email_search_sql HASHREF
6010 Emails a notice to the specified customers.
6012 Valid parameters are those of the L<search_sql> method, plus the following:
6034 Optional job queue job for status updates.
6038 Returns an error message, or false for success.
6040 If an error occurs during any email, stops the enture send and returns that
6041 error. Presumably if you're getting SMTP errors aborting is better than
6042 retrying everything.
6046 sub email_search_sql {
6047 my($class, $params) = @_;
6049 my $from = delete $params->{from};
6050 my $subject = delete $params->{subject};
6051 my $html_body = delete $params->{html_body};
6052 my $text_body = delete $params->{text_body};
6054 my $job = delete $params->{'job'};
6056 my $sql_query = $class->search_sql($params);
6058 my $count_query = delete($sql_query->{'count_query'});
6059 my $count_sth = dbh->prepare($count_query)
6060 or die "Error preparing $count_query: ". dbh->errstr;
6062 or die "Error executing $count_query: ". $count_sth->errstr;
6063 my $count_arrayref = $count_sth->fetchrow_arrayref;
6064 my $num_cust = $count_arrayref->[0];
6066 #my @extra_headers = @{ delete($sql_query->{'extra_headers'}) };
6067 #my @extra_fields = @{ delete($sql_query->{'extra_fields'}) };
6070 my( $num, $last, $min_sec ) = (0, time, 5); #progresbar foo
6072 #eventually order+limit magic to reduce memory use?
6073 foreach my $cust_main ( qsearch($sql_query) ) {
6075 my $to = $cust_main->invoicing_list_emailonly_scalar;
6078 my $error = send_email(
6082 'subject' => $subject,
6083 'html_body' => $html_body,
6084 'text_body' => $text_body,
6087 return $error if $error;
6089 if ( $job ) { #progressbar foo
6091 if ( time - $min_sec > $last ) {
6092 my $error = $job->update_statustext(
6093 int( 100 * $num / $num_cust )
6095 die $error if $error;
6105 use Storable qw(thaw);
6108 sub process_email_search_sql {
6110 #warn "$me process_re_X $method for job $job\n" if $DEBUG;
6112 my $param = thaw(decode_base64(shift));
6113 warn Dumper($param) if $DEBUG;
6115 $param->{'job'} = $job;
6117 my $error = FS::cust_main->email_search_sql( $param );
6118 die $error if $error;
6122 =item fuzzy_search FUZZY_HASHREF [ HASHREF, SELECT, EXTRA_SQL, CACHE_OBJ ]
6124 Performs a fuzzy (approximate) search and returns the matching FS::cust_main
6125 records. Currently, I<first>, I<last> and/or I<company> may be specified (the
6126 appropriate ship_ field is also searched).
6128 Additional options are the same as FS::Record::qsearch
6133 my( $self, $fuzzy, $hash, @opt) = @_;
6138 check_and_rebuild_fuzzyfiles();
6139 foreach my $field ( keys %$fuzzy ) {
6141 my $all = $self->all_X($field);
6142 next unless scalar(@$all);
6145 $match{$_}=1 foreach ( amatch( $fuzzy->{$field}, ['i'], @$all ) );
6148 foreach ( keys %match ) {
6149 push @fcust, qsearch('cust_main', { %$hash, $field=>$_}, @opt);
6150 push @fcust, qsearch('cust_main', { %$hash, "ship_$field"=>$_}, @opt);
6153 push @cust_main, grep { ! $fsaw{$_->custnum}++ } @fcust;
6156 # we want the components of $fuzzy ANDed, not ORed, but still don't want dupes
6158 @cust_main = grep { ++$saw{$_->custnum} == scalar(keys %$fuzzy) } @cust_main;
6166 Returns a masked version of the named field
6171 my ($self,$field) = @_;
6175 'x'x(length($self->getfield($field))-4).
6176 substr($self->getfield($field), (length($self->getfield($field))-4));
6186 =item smart_search OPTION => VALUE ...
6188 Accepts the following options: I<search>, the string to search for. The string
6189 will be searched for as a customer number, phone number, name or company name,
6190 as an exact, or, in some cases, a substring or fuzzy match (see the source code
6191 for the exact heuristics used); I<no_fuzzy_on_exact>, causes smart_search to
6192 skip fuzzy matching when an exact match is found.
6194 Any additional options are treated as an additional qualifier on the search
6197 Returns a (possibly empty) array of FS::cust_main objects.
6204 #here is the agent virtualization
6205 my $agentnums_sql = $FS::CurrentUser::CurrentUser->agentnums_sql;
6209 my $skip_fuzzy = delete $options{'no_fuzzy_on_exact'};
6210 my $search = delete $options{'search'};
6211 ( my $alphanum_search = $search ) =~ s/\W//g;
6213 if ( $alphanum_search =~ /^1?(\d{3})(\d{3})(\d{4})(\d*)$/ ) { #phone# search
6215 #false laziness w/Record::ut_phone
6216 my $phonen = "$1-$2-$3";
6217 $phonen .= " x$4" if $4;
6219 push @cust_main, qsearch( {
6220 'table' => 'cust_main',
6221 'hashref' => { %options },
6222 'extra_sql' => ( scalar(keys %options) ? ' AND ' : ' WHERE ' ).
6224 join(' OR ', map "$_ = '$phonen'",
6225 qw( daytime night fax
6226 ship_daytime ship_night ship_fax )
6229 " AND $agentnums_sql", #agent virtualization
6232 unless ( @cust_main || $phonen =~ /x\d+$/ ) { #no exact match
6233 #try looking for matches with extensions unless one was specified
6235 push @cust_main, qsearch( {
6236 'table' => 'cust_main',
6237 'hashref' => { %options },
6238 'extra_sql' => ( scalar(keys %options) ? ' AND ' : ' WHERE ' ).
6240 join(' OR ', map "$_ LIKE '$phonen\%'",
6242 ship_daytime ship_night )
6245 " AND $agentnums_sql", #agent virtualization
6250 # custnum search (also try agent_custid), with some tweaking options if your
6251 # legacy cust "numbers" have letters
6254 if ( $search =~ /^\s*(\d+)\s*$/
6255 || ( $conf->config('cust_main-agent_custid-format') eq 'ww?d+'
6256 && $search =~ /^\s*(\w\w?\d+)\s*$/
6263 if ( $num <= 2147483647 ) { #need a bigint custnum? wow.
6264 push @cust_main, qsearch( {
6265 'table' => 'cust_main',
6266 'hashref' => { 'custnum' => $num, %options },
6267 'extra_sql' => " AND $agentnums_sql", #agent virtualization
6271 push @cust_main, qsearch( {
6272 'table' => 'cust_main',
6273 'hashref' => { 'agent_custid' => $num, %options },
6274 'extra_sql' => " AND $agentnums_sql", #agent virtualization
6277 } elsif ( $search =~ /^\s*(\S.*\S)\s+\((.+), ([^,]+)\)\s*$/ ) {
6279 my($company, $last, $first) = ( $1, $2, $3 );
6281 # "Company (Last, First)"
6282 #this is probably something a browser remembered,
6283 #so just do an exact search
6285 foreach my $prefix ( '', 'ship_' ) {
6286 push @cust_main, qsearch( {
6287 'table' => 'cust_main',
6288 'hashref' => { $prefix.'first' => $first,
6289 $prefix.'last' => $last,
6290 $prefix.'company' => $company,
6293 'extra_sql' => " AND $agentnums_sql",
6297 } elsif ( $search =~ /^\s*(\S.*\S)\s*$/ ) { # value search
6298 # try (ship_){last,company}
6302 # # remove "(Last, First)" in "Company (Last, First)", otherwise the
6303 # # full strings the browser remembers won't work
6304 # $value =~ s/\([\w \,\.\-\']*\)$//; #false laziness w/Record::ut_name
6306 use Lingua::EN::NameParse;
6307 my $NameParse = new Lingua::EN::NameParse(
6309 allow_reversed => 1,
6312 my($last, $first) = ( '', '' );
6313 #maybe disable this too and just rely on NameParse?
6314 if ( $value =~ /^(.+),\s*([^,]+)$/ ) { # Last, First
6316 ($last, $first) = ( $1, $2 );
6318 #} elsif ( $value =~ /^(.+)\s+(.+)$/ ) {
6319 } elsif ( ! $NameParse->parse($value) ) {
6321 my %name = $NameParse->components;
6322 $first = $name{'given_name_1'};
6323 $last = $name{'surname_1'};
6327 if ( $first && $last ) {
6329 my($q_last, $q_first) = ( dbh->quote($last), dbh->quote($first) );
6332 my $sql = scalar(keys %options) ? ' AND ' : ' WHERE ';
6334 ( ( LOWER(last) = $q_last AND LOWER(first) = $q_first )
6335 OR ( LOWER(ship_last) = $q_last AND LOWER(ship_first) = $q_first )
6338 push @cust_main, qsearch( {
6339 'table' => 'cust_main',
6340 'hashref' => \%options,
6341 'extra_sql' => "$sql AND $agentnums_sql", #agent virtualization
6344 # or it just be something that was typed in... (try that in a sec)
6348 my $q_value = dbh->quote($value);
6351 my $sql = scalar(keys %options) ? ' AND ' : ' WHERE ';
6352 $sql .= " ( LOWER(last) = $q_value
6353 OR LOWER(company) = $q_value
6354 OR LOWER(ship_last) = $q_value
6355 OR LOWER(ship_company) = $q_value
6358 push @cust_main, qsearch( {
6359 'table' => 'cust_main',
6360 'hashref' => \%options,
6361 'extra_sql' => "$sql AND $agentnums_sql", #agent virtualization
6364 #no exact match, trying substring/fuzzy
6365 #always do substring & fuzzy (unless they're explicity config'ed off)
6366 #getting complaints searches are not returning enough
6367 unless ( @cust_main && $skip_fuzzy || $conf->exists('disable-fuzzy') ) {
6369 #still some false laziness w/search_sql (was search/cust_main.cgi)
6374 { 'company' => { op=>'ILIKE', value=>"%$value%" }, },
6375 { 'ship_company' => { op=>'ILIKE', value=>"%$value%" }, },
6378 if ( $first && $last ) {
6381 { 'first' => { op=>'ILIKE', value=>"%$first%" },
6382 'last' => { op=>'ILIKE', value=>"%$last%" },
6384 { 'ship_first' => { op=>'ILIKE', value=>"%$first%" },
6385 'ship_last' => { op=>'ILIKE', value=>"%$last%" },
6392 { 'last' => { op=>'ILIKE', value=>"%$value%" }, },
6393 { 'ship_last' => { op=>'ILIKE', value=>"%$value%" }, },
6397 foreach my $hashref ( @hashrefs ) {
6399 push @cust_main, qsearch( {
6400 'table' => 'cust_main',
6401 'hashref' => { %$hashref,
6404 'extra_sql' => " AND $agentnums_sql", #agent virtualizaiton
6413 " AND $agentnums_sql", #extra_sql #agent virtualization
6416 if ( $first && $last ) {
6417 push @cust_main, FS::cust_main->fuzzy_search(
6418 { 'last' => $last, #fuzzy hashref
6419 'first' => $first }, #
6423 foreach my $field ( 'last', 'company' ) {
6425 FS::cust_main->fuzzy_search( { $field => $value }, @fuzopts );
6430 #eliminate duplicates
6432 @cust_main = grep { !$saw{$_->custnum}++ } @cust_main;
6442 Accepts the following options: I<email>, the email address to search for. The
6443 email address will be searched for as an email invoice destination and as an
6446 #Any additional options are treated as an additional qualifier on the search
6447 #(i.e. I<agentnum>).
6449 Returns a (possibly empty) array of FS::cust_main objects (but usually just
6459 my $email = delete $options{'email'};
6461 #we're only being used by RT at the moment... no agent virtualization yet
6462 #my $agentnums_sql = $FS::CurrentUser::CurrentUser->agentnums_sql;
6466 if ( $email =~ /([^@]+)\@([^@]+)/ ) {
6468 my ( $user, $domain ) = ( $1, $2 );
6470 warn "$me smart_search: searching for $user in domain $domain"
6476 'table' => 'cust_main_invoice',
6477 'hashref' => { 'dest' => $email },
6484 map $_->cust_svc->cust_pkg,
6486 'table' => 'svc_acct',
6487 'hashref' => { 'username' => $user, },
6489 'AND ( SELECT domain FROM svc_domain
6490 WHERE svc_acct.domsvc = svc_domain.svcnum
6491 ) = '. dbh->quote($domain),
6497 @cust_main = grep { !$saw{$_->custnum}++ } @cust_main;
6499 warn "$me smart_search: found ". scalar(@cust_main). " unique customers"
6506 =item check_and_rebuild_fuzzyfiles
6510 use vars qw(@fuzzyfields);
6511 @fuzzyfields = ( 'last', 'first', 'company' );
6513 sub check_and_rebuild_fuzzyfiles {
6514 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
6515 rebuild_fuzzyfiles() if grep { ! -e "$dir/cust_main.$_" } @fuzzyfields
6518 =item rebuild_fuzzyfiles
6522 sub rebuild_fuzzyfiles {
6524 use Fcntl qw(:flock);
6526 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
6527 mkdir $dir, 0700 unless -d $dir;
6529 foreach my $fuzzy ( @fuzzyfields ) {
6531 open(LOCK,">>$dir/cust_main.$fuzzy")
6532 or die "can't open $dir/cust_main.$fuzzy: $!";
6534 or die "can't lock $dir/cust_main.$fuzzy: $!";
6536 open (CACHE,">$dir/cust_main.$fuzzy.tmp")
6537 or die "can't open $dir/cust_main.$fuzzy.tmp: $!";
6539 foreach my $field ( $fuzzy, "ship_$fuzzy" ) {
6540 my $sth = dbh->prepare("SELECT $field FROM cust_main".
6541 " WHERE $field != '' AND $field IS NOT NULL");
6542 $sth->execute or die $sth->errstr;
6544 while ( my $row = $sth->fetchrow_arrayref ) {
6545 print CACHE $row->[0]. "\n";
6550 close CACHE or die "can't close $dir/cust_main.$fuzzy.tmp: $!";
6552 rename "$dir/cust_main.$fuzzy.tmp", "$dir/cust_main.$fuzzy";
6563 my( $self, $field ) = @_;
6564 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
6565 open(CACHE,"<$dir/cust_main.$field")
6566 or die "can't open $dir/cust_main.$field: $!";
6567 my @array = map { chomp; $_; } <CACHE>;
6572 =item append_fuzzyfiles LASTNAME COMPANY
6576 sub append_fuzzyfiles {
6577 #my( $first, $last, $company ) = @_;
6579 &check_and_rebuild_fuzzyfiles;
6581 use Fcntl qw(:flock);
6583 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
6585 foreach my $field (qw( first last company )) {
6590 open(CACHE,">>$dir/cust_main.$field")
6591 or die "can't open $dir/cust_main.$field: $!";
6592 flock(CACHE,LOCK_EX)
6593 or die "can't lock $dir/cust_main.$field: $!";
6595 print CACHE "$value\n";
6597 flock(CACHE,LOCK_UN)
6598 or die "can't unlock $dir/cust_main.$field: $!";
6613 #warn join('-',keys %$param);
6614 my $fh = $param->{filehandle};
6615 my @fields = @{$param->{fields}};
6617 eval "use Text::CSV_XS;";
6620 my $csv = new Text::CSV_XS;
6627 local $SIG{HUP} = 'IGNORE';
6628 local $SIG{INT} = 'IGNORE';
6629 local $SIG{QUIT} = 'IGNORE';
6630 local $SIG{TERM} = 'IGNORE';
6631 local $SIG{TSTP} = 'IGNORE';
6632 local $SIG{PIPE} = 'IGNORE';
6634 my $oldAutoCommit = $FS::UID::AutoCommit;
6635 local $FS::UID::AutoCommit = 0;
6638 #while ( $columns = $csv->getline($fh) ) {
6640 while ( defined($line=<$fh>) ) {
6642 $csv->parse($line) or do {
6643 $dbh->rollback if $oldAutoCommit;
6644 return "can't parse: ". $csv->error_input();
6647 my @columns = $csv->fields();
6648 #warn join('-',@columns);
6651 foreach my $field ( @fields ) {
6652 $row{$field} = shift @columns;
6655 my $cust_main = qsearchs('cust_main', { 'custnum' => $row{'custnum'} } );
6656 unless ( $cust_main ) {
6657 $dbh->rollback if $oldAutoCommit;
6658 return "unknown custnum $row{'custnum'}";
6661 if ( $row{'amount'} > 0 ) {
6662 my $error = $cust_main->charge($row{'amount'}, $row{'pkg'});
6664 $dbh->rollback if $oldAutoCommit;
6668 } elsif ( $row{'amount'} < 0 ) {
6669 my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ),
6672 $dbh->rollback if $oldAutoCommit;
6682 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
6684 return "Empty file!" unless $imported;
6690 =item notify CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
6692 Sends a templated email notification to the customer (see L<Text::Template>).
6694 OPTIONS is a hash and may include
6696 I<from> - the email sender (default is invoice_from)
6698 I<to> - comma-separated scalar or arrayref of recipients
6699 (default is invoicing_list)
6701 I<subject> - The subject line of the sent email notification
6702 (default is "Notice from company_name")
6704 I<extra_fields> - a hashref of name/value pairs which will be substituted
6707 The following variables are vavailable in the template.
6709 I<$first> - the customer first name
6710 I<$last> - the customer last name
6711 I<$company> - the customer company
6712 I<$payby> - a description of the method of payment for the customer
6713 # would be nice to use FS::payby::shortname
6714 I<$payinfo> - the account information used to collect for this customer
6715 I<$expdate> - the expiration of the customer payment in seconds from epoch
6720 my ($customer, $template, %options) = @_;
6722 return unless $conf->exists($template);
6724 my $from = $conf->config('invoice_from') if $conf->exists('invoice_from');
6725 $from = $options{from} if exists($options{from});
6727 my $to = join(',', $customer->invoicing_list_emailonly);
6728 $to = $options{to} if exists($options{to});
6730 my $subject = "Notice from " . $conf->config('company_name')
6731 if $conf->exists('company_name');
6732 $subject = $options{subject} if exists($options{subject});
6734 my $notify_template = new Text::Template (TYPE => 'ARRAY',
6735 SOURCE => [ map "$_\n",
6736 $conf->config($template)]
6738 or die "can't create new Text::Template object: Text::Template::ERROR";
6739 $notify_template->compile()
6740 or die "can't compile template: Text::Template::ERROR";
6742 $FS::notify_template::_template::company_name = $conf->config('company_name');
6743 $FS::notify_template::_template::company_address =
6744 join("\n", $conf->config('company_address') ). "\n";
6746 my $paydate = $customer->paydate || '2037-12-31';
6747 $FS::notify_template::_template::first = $customer->first;
6748 $FS::notify_template::_template::last = $customer->last;
6749 $FS::notify_template::_template::company = $customer->company;
6750 $FS::notify_template::_template::payinfo = $customer->mask_payinfo;
6751 my $payby = $customer->payby;
6752 my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
6753 my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
6755 #credit cards expire at the end of the month/year of their exp date
6756 if ($payby eq 'CARD' || $payby eq 'DCRD') {
6757 $FS::notify_template::_template::payby = 'credit card';
6758 ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
6759 $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
6761 }elsif ($payby eq 'COMP') {
6762 $FS::notify_template::_template::payby = 'complimentary account';
6764 $FS::notify_template::_template::payby = 'current method';
6766 $FS::notify_template::_template::expdate = $expire_time;
6768 for (keys %{$options{extra_fields}}){
6770 ${"FS::notify_template::_template::$_"} = $options{extra_fields}->{$_};
6773 send_email(from => $from,
6775 subject => $subject,
6776 body => $notify_template->fill_in( PACKAGE =>
6777 'FS::notify_template::_template' ),
6782 =item generate_letter CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
6784 Generates a templated notification to the customer (see L<Text::Template>).
6786 OPTIONS is a hash and may include
6788 I<extra_fields> - a hashref of name/value pairs which will be substituted
6789 into the template. These values may override values mentioned below
6790 and those from the customer record.
6792 The following variables are available in the template instead of or in addition
6793 to the fields of the customer record.
6795 I<$payby> - a description of the method of payment for the customer
6796 # would be nice to use FS::payby::shortname
6797 I<$payinfo> - the masked account information used to collect for this customer
6798 I<$expdate> - the expiration of the customer payment method in seconds from epoch
6799 I<$returnaddress> - the return address defaults to invoice_latexreturnaddress or company_address
6803 sub generate_letter {
6804 my ($self, $template, %options) = @_;
6806 return unless $conf->exists($template);
6808 my $letter_template = new Text::Template
6810 SOURCE => [ map "$_\n", $conf->config($template)],
6811 DELIMITERS => [ '[@--', '--@]' ],
6813 or die "can't create new Text::Template object: Text::Template::ERROR";
6815 $letter_template->compile()
6816 or die "can't compile template: Text::Template::ERROR";
6818 my %letter_data = map { $_ => $self->$_ } $self->fields;
6819 $letter_data{payinfo} = $self->mask_payinfo;
6821 #my $paydate = $self->paydate || '2037-12-31';
6822 my $paydate = $self->paydate =~ /^\S+$/ ? $self->paydate : '2037-12-31';
6824 my $payby = $self->payby;
6825 my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
6826 my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
6828 #credit cards expire at the end of the month/year of their exp date
6829 if ($payby eq 'CARD' || $payby eq 'DCRD') {
6830 $letter_data{payby} = 'credit card';
6831 ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
6832 $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
6834 }elsif ($payby eq 'COMP') {
6835 $letter_data{payby} = 'complimentary account';
6837 $letter_data{payby} = 'current method';
6839 $letter_data{expdate} = $expire_time;
6841 for (keys %{$options{extra_fields}}){
6842 $letter_data{$_} = $options{extra_fields}->{$_};
6845 unless(exists($letter_data{returnaddress})){
6846 my $retadd = join("\n", $conf->config_orbase( 'invoice_latexreturnaddress',
6847 $self->agent_template)
6849 if ( length($retadd) ) {
6850 $letter_data{returnaddress} = $retadd;
6851 } elsif ( grep /\S/, $conf->config('company_address') ) {
6852 $letter_data{returnaddress} =
6853 join( '\\*'."\n", map s/( {2,})/'~' x length($1)/eg,
6854 $conf->config('company_address')
6857 $letter_data{returnaddress} = '~';
6861 $letter_data{conf_dir} = "$FS::UID::conf_dir/conf.$FS::UID::datasrc";
6863 $letter_data{company_name} = $conf->config('company_name');
6865 my $dir = $FS::UID::conf_dir."/cache.". $FS::UID::datasrc;
6866 my $fh = new File::Temp( TEMPLATE => 'letter.'. $self->custnum. '.XXXXXXXX',
6870 ) or die "can't open temp file: $!\n";
6872 $letter_template->fill_in( OUTPUT => $fh, HASH => \%letter_data );
6874 $fh->filename =~ /^(.*).tex$/ or die "unparsable filename: ". $fh->filename;
6878 =item print_ps TEMPLATE
6880 Returns an postscript letter filled in from TEMPLATE, as a scalar.
6886 my $file = $self->generate_letter(@_);
6887 FS::Misc::generate_ps($file);
6890 =item print TEMPLATE
6892 Prints the filled in template.
6894 TEMPLATE is the name of a L<Text::Template> to fill in and print.
6898 sub queueable_print {
6901 my $self = qsearchs('cust_main', { 'custnum' => $opt{custnum} } )
6902 or die "invalid customer number: " . $opt{custvnum};
6904 my $error = $self->print( $opt{template} );
6905 die $error if $error;
6909 my ($self, $template) = (shift, shift);
6910 do_print [ $self->print_ps($template) ];
6913 sub agent_template {
6915 $self->_agent_plandata('agent_templatename');
6918 sub agent_invoice_from {
6920 $self->_agent_plandata('agent_invoice_from');
6923 sub _agent_plandata {
6924 my( $self, $option ) = @_;
6926 #yuck. this whole thing needs to be reconciled better with 1.9's idea of
6927 #agent-specific Conf
6929 use FS::part_event::Condition;
6931 my $agentnum = $self->agentnum;
6934 if ( driver_name =~ /^Pg/i ) {
6936 } elsif ( driver_name =~ /^mysql/i ) {
6939 die "don't know how to use regular expressions in ". driver_name. " databases";
6942 my $part_event_option =
6944 'select' => 'part_event_option.*',
6945 'table' => 'part_event_option',
6947 LEFT JOIN part_event USING ( eventpart )
6948 LEFT JOIN part_event_option AS peo_agentnum
6949 ON ( part_event.eventpart = peo_agentnum.eventpart
6950 AND peo_agentnum.optionname = 'agentnum'
6951 AND peo_agentnum.optionvalue }. $regexp. q{ '(^|,)}. $agentnum. q{(,|$)'
6953 LEFT JOIN part_event_option AS peo_cust_bill_age
6954 ON ( part_event.eventpart = peo_cust_bill_age.eventpart
6955 AND peo_cust_bill_age.optionname = 'cust_bill_age'
6958 #'hashref' => { 'optionname' => $option },
6959 #'hashref' => { 'part_event_option.optionname' => $option },
6961 " WHERE part_event_option.optionname = ". dbh->quote($option).
6962 " AND action = 'cust_bill_send_agent' ".
6963 " AND ( disabled IS NULL OR disabled != 'Y' ) ".
6964 " AND peo_agentnum.optionname = 'agentnum' ".
6965 " AND ( agentnum IS NULL OR agentnum = $agentnum ) ".
6967 CASE WHEN peo_cust_bill_age.optionname != 'cust_bill_age'
6969 ELSE ". FS::part_event::Condition->age2seconds_sql('peo_cust_bill_age.optionvalue').
6971 , part_event.weight".
6975 unless ( $part_event_option ) {
6976 return $self->agent->invoice_template || ''
6977 if $option eq 'agent_templatename';
6981 $part_event_option->optionvalue;
6986 ## actual sub, not a method, designed to be called from the queue.
6987 ## sets up the customer, and calls the bill_and_collect
6988 my (%args) = @_; #, ($time, $invoice_time, $check_freq, $resetup) = @_;
6989 my $cust_main = qsearchs( 'cust_main', { custnum => $args{'custnum'} } );
6990 $cust_main->bill_and_collect(
7001 The delete method should possibly take an FS::cust_main object reference
7002 instead of a scalar customer number.
7004 Bill and collect options should probably be passed as references instead of a
7007 There should probably be a configuration file with a list of allowed credit
7010 No multiple currency support (probably a larger project than just this module).
7012 payinfo_masked false laziness with cust_pay.pm and cust_refund.pm
7014 Birthdates rely on negative epoch values.
7016 The payby for card/check batches is broken. With mixed batching, bad
7019 B<collect> I<invoice_time> should be renamed I<time>, like B<bill>.
7023 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
7024 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
7025 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.