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_pkg HASHREF | OPTION => VALUE ...
664 Orders a single package.
666 Options may be passed as a list of key/value pairs or as a hash reference.
677 Optional FS::cust_location object
681 Optional arryaref of FS::svc_* service objects.
685 If this option is set to a job queue jobnum (see L<FS::queue>), all provisioning
686 jobs will have a dependancy on the supplied job (they will not run until the
687 specific job completes). This can be used to defer provisioning until some
688 action completes (such as running the customer's credit card successfully).
696 my $opt = ref($_[0]) ? shift : { @_ };
698 warn "$me order_pkg called with options ".
699 join(', ', map { "$_: $opt->{$_}" } keys %$opt ). "\n"
702 my $cust_pkg = $opt->{'cust_pkg'};
703 my $seconds = $opt->{'seconds'};
704 my $svcs = $opt->{'svcs'} || [];
706 my %svc_options = ();
707 $svc_options{'depend_jobnum'} = $opt->{'depend_jobnum'}
708 if exists($opt->{'depend_jobnum'}) && $opt->{'depend_jobnum'};
710 local $SIG{HUP} = 'IGNORE';
711 local $SIG{INT} = 'IGNORE';
712 local $SIG{QUIT} = 'IGNORE';
713 local $SIG{TERM} = 'IGNORE';
714 local $SIG{TSTP} = 'IGNORE';
715 local $SIG{PIPE} = 'IGNORE';
717 my $oldAutoCommit = $FS::UID::AutoCommit;
718 local $FS::UID::AutoCommit = 0;
721 if ( $opt->{'cust_location'} &&
722 ( ! $cust_pkg->locationnum || $cust_pkg->locationnum == -1 ) ) {
723 my $error = $opt->{'cust_location'}->insert;
725 $dbh->rollback if $oldAutoCommit;
726 return "inserting cust_location (transaction rolled back): $error";
728 $cust_pkg->locationnum($opt->{'cust_location'}->locationnum);
731 $cust_pkg->custnum( $self->custnum );
733 my $error = $cust_pkg->insert;
735 $dbh->rollback if $oldAutoCommit;
736 return "inserting cust_pkg (transaction rolled back): $error";
739 foreach my $svc_something ( @{ $opt->{'svcs'} } ) {
740 if ( $svc_something->svcnum ) {
741 my $old_cust_svc = $svc_something->cust_svc;
742 my $new_cust_svc = new FS::cust_svc { $old_cust_svc->hash };
743 $new_cust_svc->pkgnum( $cust_pkg->pkgnum);
744 $error = $new_cust_svc->replace($old_cust_svc);
746 $svc_something->pkgnum( $cust_pkg->pkgnum );
747 if ( $seconds && $$seconds && $svc_something->isa('FS::svc_acct') ) {
748 $svc_something->seconds( $svc_something->seconds + $$seconds );
751 $error = $svc_something->insert(%svc_options);
754 $dbh->rollback if $oldAutoCommit;
755 return "inserting svc_ (transaction rolled back): $error";
759 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
764 =item order_pkgs HASHREF, [ SECONDSREF, [ , OPTION => VALUE ... ] ]
766 Like the insert method on an existing record, this method orders multiple
767 packages and included services atomicaly. Pass a Tie::RefHash data structure
768 to this method containing FS::cust_pkg and FS::svc_I<tablename> objects.
769 There should be a better explanation of this, but until then, here's an
773 tie %hash, 'Tie::RefHash'; #this part is important
775 $cust_pkg => [ $svc_acct ],
778 $cust_main->order_pkgs( \%hash, \'0', 'noexport'=>1 );
780 Services can be new, in which case they are inserted, or existing unaudited
781 services, in which case they are linked to the newly-created package.
783 Currently available options are: I<depend_jobnum> and I<noexport>.
785 If I<depend_jobnum> is set, all provisioning jobs will have a dependancy
786 on the supplied jobnum (they will not run until the specific job completes).
787 This can be used to defer provisioning until some action completes (such
788 as running the customer's credit card successfully).
790 The I<noexport> option is deprecated. If I<noexport> is set true, no
791 provisioning jobs (exports) are scheduled. (You can schedule them later with
792 the B<reexport> method for each cust_pkg object. Using the B<reexport> method
793 on the cust_main object is not recommended, as existing services will also be
800 my $cust_pkgs = shift;
804 warn "$me order_pkgs called with options ".
805 join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
808 local $SIG{HUP} = 'IGNORE';
809 local $SIG{INT} = 'IGNORE';
810 local $SIG{QUIT} = 'IGNORE';
811 local $SIG{TERM} = 'IGNORE';
812 local $SIG{TSTP} = 'IGNORE';
813 local $SIG{PIPE} = 'IGNORE';
815 my $oldAutoCommit = $FS::UID::AutoCommit;
816 local $FS::UID::AutoCommit = 0;
819 local $FS::svc_Common::noexport_hack = 1 if $options{'noexport'};
821 foreach my $cust_pkg ( keys %$cust_pkgs ) {
823 my $error = $self->order_pkg( 'cust_pkg' => $cust_pkg,
824 'svcs' => $cust_pkgs->{$cust_pkg},
825 'seconds' => $seconds,
826 'depend_jobnum' => $options{'depend_jobnum'},
829 $dbh->rollback if $oldAutoCommit;
835 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
839 =item recharge_prepay IDENTIFIER | PREPAY_CREDIT_OBJ [ , AMOUNTREF, SECONDSREF, UPBYTEREF, DOWNBYTEREF ]
841 Recharges this (existing) customer with the specified prepaid card (see
842 L<FS::prepay_credit>), specified either by I<identifier> or as an
843 FS::prepay_credit object. If there is an error, returns the error, otherwise
846 Optionally, four scalar references can be passed as well. They will have their
847 values filled in with the amount, number of seconds, and number of upload and
848 download bytes applied by this prepaid
853 sub recharge_prepay {
854 my( $self, $prepay_credit, $amountref, $secondsref,
855 $upbytesref, $downbytesref, $totalbytesref ) = @_;
857 local $SIG{HUP} = 'IGNORE';
858 local $SIG{INT} = 'IGNORE';
859 local $SIG{QUIT} = 'IGNORE';
860 local $SIG{TERM} = 'IGNORE';
861 local $SIG{TSTP} = 'IGNORE';
862 local $SIG{PIPE} = 'IGNORE';
864 my $oldAutoCommit = $FS::UID::AutoCommit;
865 local $FS::UID::AutoCommit = 0;
868 my( $amount, $seconds, $upbytes, $downbytes, $totalbytes) = ( 0, 0, 0, 0, 0 );
870 my $error = $self->get_prepay($prepay_credit, \$amount,
871 \$seconds, \$upbytes, \$downbytes, \$totalbytes)
872 || $self->increment_seconds($seconds)
873 || $self->increment_upbytes($upbytes)
874 || $self->increment_downbytes($downbytes)
875 || $self->increment_totalbytes($totalbytes)
876 || $self->insert_cust_pay_prepay( $amount,
878 ? $prepay_credit->identifier
883 $dbh->rollback if $oldAutoCommit;
887 if ( defined($amountref) ) { $$amountref = $amount; }
888 if ( defined($secondsref) ) { $$secondsref = $seconds; }
889 if ( defined($upbytesref) ) { $$upbytesref = $upbytes; }
890 if ( defined($downbytesref) ) { $$downbytesref = $downbytes; }
891 if ( defined($totalbytesref) ) { $$totalbytesref = $totalbytes; }
893 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
898 =item get_prepay IDENTIFIER | PREPAY_CREDIT_OBJ , AMOUNTREF, SECONDSREF
900 Looks up and deletes a prepaid card (see L<FS::prepay_credit>),
901 specified either by I<identifier> or as an FS::prepay_credit object.
903 References to I<amount> and I<seconds> scalars should be passed as arguments
904 and will be incremented by the values of the prepaid card.
906 If the prepaid card specifies an I<agentnum> (see L<FS::agent>), it is used to
907 check or set this customer's I<agentnum>.
909 If there is an error, returns the error, otherwise returns false.
915 my( $self, $prepay_credit, $amountref, $secondsref,
916 $upref, $downref, $totalref) = @_;
918 local $SIG{HUP} = 'IGNORE';
919 local $SIG{INT} = 'IGNORE';
920 local $SIG{QUIT} = 'IGNORE';
921 local $SIG{TERM} = 'IGNORE';
922 local $SIG{TSTP} = 'IGNORE';
923 local $SIG{PIPE} = 'IGNORE';
925 my $oldAutoCommit = $FS::UID::AutoCommit;
926 local $FS::UID::AutoCommit = 0;
929 unless ( ref($prepay_credit) ) {
931 my $identifier = $prepay_credit;
933 $prepay_credit = qsearchs(
935 { 'identifier' => $prepay_credit },
940 unless ( $prepay_credit ) {
941 $dbh->rollback if $oldAutoCommit;
942 return "Invalid prepaid card: ". $identifier;
947 if ( $prepay_credit->agentnum ) {
948 if ( $self->agentnum && $self->agentnum != $prepay_credit->agentnum ) {
949 $dbh->rollback if $oldAutoCommit;
950 return "prepaid card not valid for agent ". $self->agentnum;
952 $self->agentnum($prepay_credit->agentnum);
955 my $error = $prepay_credit->delete;
957 $dbh->rollback if $oldAutoCommit;
958 return "removing prepay_credit (transaction rolled back): $error";
961 $$amountref += $prepay_credit->amount;
962 $$secondsref += $prepay_credit->seconds;
963 $$upref += $prepay_credit->upbytes;
964 $$downref += $prepay_credit->downbytes;
965 $$totalref += $prepay_credit->totalbytes;
967 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
972 =item increment_upbytes SECONDS
974 Updates this customer's single or primary account (see L<FS::svc_acct>) by
975 the specified number of upbytes. If there is an error, returns the error,
976 otherwise returns false.
980 sub increment_upbytes {
981 _increment_column( shift, 'upbytes', @_);
984 =item increment_downbytes SECONDS
986 Updates this customer's single or primary account (see L<FS::svc_acct>) by
987 the specified number of downbytes. If there is an error, returns the error,
988 otherwise returns false.
992 sub increment_downbytes {
993 _increment_column( shift, 'downbytes', @_);
996 =item increment_totalbytes SECONDS
998 Updates this customer's single or primary account (see L<FS::svc_acct>) by
999 the specified number of totalbytes. If there is an error, returns the error,
1000 otherwise returns false.
1004 sub increment_totalbytes {
1005 _increment_column( shift, 'totalbytes', @_);
1008 =item increment_seconds SECONDS
1010 Updates this customer's single or primary account (see L<FS::svc_acct>) by
1011 the specified number of seconds. If there is an error, returns the error,
1012 otherwise returns false.
1016 sub increment_seconds {
1017 _increment_column( shift, 'seconds', @_);
1020 =item _increment_column AMOUNT
1022 Updates this customer's single or primary account (see L<FS::svc_acct>) by
1023 the specified number of seconds or bytes. If there is an error, returns
1024 the error, otherwise returns false.
1028 sub _increment_column {
1029 my( $self, $column, $amount ) = @_;
1030 warn "$me increment_column called: $column, $amount\n"
1033 return '' unless $amount;
1035 my @cust_pkg = grep { $_->part_pkg->svcpart('svc_acct') }
1036 $self->ncancelled_pkgs;
1038 if ( ! @cust_pkg ) {
1039 return 'No packages with primary or single services found'.
1040 ' to apply pre-paid time';
1041 } elsif ( scalar(@cust_pkg) > 1 ) {
1042 #maybe have a way to specify the package/account?
1043 return 'Multiple packages found to apply pre-paid time';
1046 my $cust_pkg = $cust_pkg[0];
1047 warn " found package pkgnum ". $cust_pkg->pkgnum. "\n"
1051 $cust_pkg->cust_svc( $cust_pkg->part_pkg->svcpart('svc_acct') );
1053 if ( ! @cust_svc ) {
1054 return 'No account found to apply pre-paid time';
1055 } elsif ( scalar(@cust_svc) > 1 ) {
1056 return 'Multiple accounts found to apply pre-paid time';
1059 my $svc_acct = $cust_svc[0]->svc_x;
1060 warn " found service svcnum ". $svc_acct->pkgnum.
1061 ' ('. $svc_acct->email. ")\n"
1064 $column = "increment_$column";
1065 $svc_acct->$column($amount);
1069 =item insert_cust_pay_prepay AMOUNT [ PAYINFO ]
1071 Inserts a prepayment in the specified amount for this customer. An optional
1072 second argument can specify the prepayment identifier for tracking purposes.
1073 If there is an error, returns the error, otherwise returns false.
1077 sub insert_cust_pay_prepay {
1078 shift->insert_cust_pay('PREP', @_);
1081 =item insert_cust_pay_cash AMOUNT [ PAYINFO ]
1083 Inserts a cash payment in the specified amount for this customer. An optional
1084 second argument can specify the payment identifier for tracking purposes.
1085 If there is an error, returns the error, otherwise returns false.
1089 sub insert_cust_pay_cash {
1090 shift->insert_cust_pay('CASH', @_);
1093 =item insert_cust_pay_west AMOUNT [ PAYINFO ]
1095 Inserts a Western Union payment in the specified amount for this customer. An
1096 optional second argument can specify the prepayment identifier for tracking
1097 purposes. If there is an error, returns the error, otherwise returns false.
1101 sub insert_cust_pay_west {
1102 shift->insert_cust_pay('WEST', @_);
1105 sub insert_cust_pay {
1106 my( $self, $payby, $amount ) = splice(@_, 0, 3);
1107 my $payinfo = scalar(@_) ? shift : '';
1109 my $cust_pay = new FS::cust_pay {
1110 'custnum' => $self->custnum,
1111 'paid' => sprintf('%.2f', $amount),
1112 #'_date' => #date the prepaid card was purchased???
1114 'payinfo' => $payinfo,
1122 This method is deprecated. See the I<depend_jobnum> option to the insert and
1123 order_pkgs methods for a better way to defer provisioning.
1125 Re-schedules all exports by calling the B<reexport> method of all associated
1126 packages (see L<FS::cust_pkg>). If there is an error, returns the error;
1127 otherwise returns false.
1134 carp "WARNING: FS::cust_main::reexport is deprectated; ".
1135 "use the depend_jobnum option to insert or order_pkgs to delay export";
1137 local $SIG{HUP} = 'IGNORE';
1138 local $SIG{INT} = 'IGNORE';
1139 local $SIG{QUIT} = 'IGNORE';
1140 local $SIG{TERM} = 'IGNORE';
1141 local $SIG{TSTP} = 'IGNORE';
1142 local $SIG{PIPE} = 'IGNORE';
1144 my $oldAutoCommit = $FS::UID::AutoCommit;
1145 local $FS::UID::AutoCommit = 0;
1148 foreach my $cust_pkg ( $self->ncancelled_pkgs ) {
1149 my $error = $cust_pkg->reexport;
1151 $dbh->rollback if $oldAutoCommit;
1156 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1161 =item delete NEW_CUSTNUM
1163 This deletes the customer. If there is an error, returns the error, otherwise
1166 This will completely remove all traces of the customer record. This is not
1167 what you want when a customer cancels service; for that, cancel all of the
1168 customer's packages (see L</cancel>).
1170 If the customer has any uncancelled packages, you need to pass a new (valid)
1171 customer number for those packages to be transferred to. Cancelled packages
1172 will be deleted. Did I mention that this is NOT what you want when a customer
1173 cancels service and that you really should be looking see L<FS::cust_pkg/cancel>?
1175 You can't delete a customer with invoices (see L<FS::cust_bill>),
1176 or credits (see L<FS::cust_credit>), payments (see L<FS::cust_pay>) or
1177 refunds (see L<FS::cust_refund>).
1184 local $SIG{HUP} = 'IGNORE';
1185 local $SIG{INT} = 'IGNORE';
1186 local $SIG{QUIT} = 'IGNORE';
1187 local $SIG{TERM} = 'IGNORE';
1188 local $SIG{TSTP} = 'IGNORE';
1189 local $SIG{PIPE} = 'IGNORE';
1191 my $oldAutoCommit = $FS::UID::AutoCommit;
1192 local $FS::UID::AutoCommit = 0;
1195 if ( $self->cust_bill ) {
1196 $dbh->rollback if $oldAutoCommit;
1197 return "Can't delete a customer with invoices";
1199 if ( $self->cust_credit ) {
1200 $dbh->rollback if $oldAutoCommit;
1201 return "Can't delete a customer with credits";
1203 if ( $self->cust_pay ) {
1204 $dbh->rollback if $oldAutoCommit;
1205 return "Can't delete a customer with payments";
1207 if ( $self->cust_refund ) {
1208 $dbh->rollback if $oldAutoCommit;
1209 return "Can't delete a customer with refunds";
1212 my @cust_pkg = $self->ncancelled_pkgs;
1214 my $new_custnum = shift;
1215 unless ( qsearchs( 'cust_main', { 'custnum' => $new_custnum } ) ) {
1216 $dbh->rollback if $oldAutoCommit;
1217 return "Invalid new customer number: $new_custnum";
1219 foreach my $cust_pkg ( @cust_pkg ) {
1220 my %hash = $cust_pkg->hash;
1221 $hash{'custnum'} = $new_custnum;
1222 my $new_cust_pkg = new FS::cust_pkg ( \%hash );
1223 my $error = $new_cust_pkg->replace($cust_pkg,
1224 options => { $cust_pkg->options },
1227 $dbh->rollback if $oldAutoCommit;
1232 my @cancelled_cust_pkg = $self->all_pkgs;
1233 foreach my $cust_pkg ( @cancelled_cust_pkg ) {
1234 my $error = $cust_pkg->delete;
1236 $dbh->rollback if $oldAutoCommit;
1241 foreach my $cust_main_invoice ( #(email invoice destinations, not invoices)
1242 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } )
1244 my $error = $cust_main_invoice->delete;
1246 $dbh->rollback if $oldAutoCommit;
1251 my $error = $self->SUPER::delete;
1253 $dbh->rollback if $oldAutoCommit;
1257 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1262 =item replace [ OLD_RECORD ] [ INVOICING_LIST_ARYREF ]
1264 Replaces the OLD_RECORD with this one in the database. If there is an error,
1265 returns the error, otherwise returns false.
1267 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
1268 be set as the invoicing list (see L<"invoicing_list">). Errors return as
1269 expected and rollback the entire transaction; it is not necessary to call
1270 check_invoicing_list first. Here's an example:
1272 $new_cust_main->replace( $old_cust_main, [ $email, 'POST' ] );
1279 my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
1281 : $self->replace_old;
1285 warn "$me replace called\n"
1288 my $curuser = $FS::CurrentUser::CurrentUser;
1289 if ( $self->payby eq 'COMP'
1290 && $self->payby ne $old->payby
1291 && ! $curuser->access_right('Complimentary customer')
1294 return "You are not permitted to create complimentary accounts.";
1297 local($ignore_expired_card) = 1
1298 if $old->payby =~ /^(CARD|DCRD)$/
1299 && $self->payby =~ /^(CARD|DCRD)$/
1300 && ( $old->payinfo eq $self->payinfo || $old->paymask eq $self->paymask );
1302 local $SIG{HUP} = 'IGNORE';
1303 local $SIG{INT} = 'IGNORE';
1304 local $SIG{QUIT} = 'IGNORE';
1305 local $SIG{TERM} = 'IGNORE';
1306 local $SIG{TSTP} = 'IGNORE';
1307 local $SIG{PIPE} = 'IGNORE';
1309 my $oldAutoCommit = $FS::UID::AutoCommit;
1310 local $FS::UID::AutoCommit = 0;
1313 my $error = $self->SUPER::replace($old);
1316 $dbh->rollback if $oldAutoCommit;
1320 if ( @param ) { # INVOICING_LIST_ARYREF
1321 my $invoicing_list = shift @param;
1322 $error = $self->check_invoicing_list( $invoicing_list );
1324 $dbh->rollback if $oldAutoCommit;
1327 $self->invoicing_list( $invoicing_list );
1330 if ( $self->payby =~ /^(CARD|CHEK|LECB)$/ &&
1331 grep { $self->get($_) ne $old->get($_) } qw(payinfo paydate payname) ) {
1332 # card/check/lec info has changed, want to retry realtime_ invoice events
1333 my $error = $self->retry_realtime;
1335 $dbh->rollback if $oldAutoCommit;
1340 unless ( $import || $skip_fuzzyfiles ) {
1341 $error = $self->queue_fuzzyfiles_update;
1343 $dbh->rollback if $oldAutoCommit;
1344 return "updating fuzzy search cache: $error";
1348 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1353 =item queue_fuzzyfiles_update
1355 Used by insert & replace to update the fuzzy search cache
1359 sub queue_fuzzyfiles_update {
1362 local $SIG{HUP} = 'IGNORE';
1363 local $SIG{INT} = 'IGNORE';
1364 local $SIG{QUIT} = 'IGNORE';
1365 local $SIG{TERM} = 'IGNORE';
1366 local $SIG{TSTP} = 'IGNORE';
1367 local $SIG{PIPE} = 'IGNORE';
1369 my $oldAutoCommit = $FS::UID::AutoCommit;
1370 local $FS::UID::AutoCommit = 0;
1373 my $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
1374 my $error = $queue->insert( map $self->getfield($_),
1375 qw(first last company)
1378 $dbh->rollback if $oldAutoCommit;
1379 return "queueing job (transaction rolled back): $error";
1382 if ( $self->ship_last ) {
1383 $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
1384 $error = $queue->insert( map $self->getfield("ship_$_"),
1385 qw(first last company)
1388 $dbh->rollback if $oldAutoCommit;
1389 return "queueing job (transaction rolled back): $error";
1393 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1400 Checks all fields to make sure this is a valid customer record. If there is
1401 an error, returns the error, otherwise returns false. Called by the insert
1402 and replace methods.
1409 warn "$me check BEFORE: \n". $self->_dump
1413 $self->ut_numbern('custnum')
1414 || $self->ut_number('agentnum')
1415 || $self->ut_textn('agent_custid')
1416 || $self->ut_number('refnum')
1417 || $self->ut_textn('custbatch')
1418 || $self->ut_name('last')
1419 || $self->ut_name('first')
1420 || $self->ut_snumbern('birthdate')
1421 || $self->ut_snumbern('signupdate')
1422 || $self->ut_textn('company')
1423 || $self->ut_text('address1')
1424 || $self->ut_textn('address2')
1425 || $self->ut_text('city')
1426 || $self->ut_textn('county')
1427 || $self->ut_textn('state')
1428 || $self->ut_country('country')
1429 || $self->ut_anything('comments')
1430 || $self->ut_numbern('referral_custnum')
1431 || $self->ut_textn('stateid')
1432 || $self->ut_textn('stateid_state')
1433 || $self->ut_textn('invoice_terms')
1434 || $self->ut_alphan('geocode')
1437 #barf. need message catalogs. i18n. etc.
1438 $error .= "Please select an advertising source."
1439 if $error =~ /^Illegal or empty \(numeric\) refnum: /;
1440 return $error if $error;
1442 return "Unknown agent"
1443 unless qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
1445 return "Unknown refnum"
1446 unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } );
1448 return "Unknown referring custnum: ". $self->referral_custnum
1449 unless ! $self->referral_custnum
1450 || qsearchs( 'cust_main', { 'custnum' => $self->referral_custnum } );
1452 if ( $self->ss eq '' ) {
1457 $ss =~ /^(\d{3})(\d{2})(\d{4})$/
1458 or return "Illegal social security number: ". $self->ss;
1459 $self->ss("$1-$2-$3");
1463 # bad idea to disable, causes billing to fail because of no tax rates later
1464 # unless ( $import ) {
1465 unless ( qsearch('cust_main_county', {
1466 'country' => $self->country,
1469 return "Unknown state/county/country: ".
1470 $self->state. "/". $self->county. "/". $self->country
1471 unless qsearch('cust_main_county',{
1472 'state' => $self->state,
1473 'county' => $self->county,
1474 'country' => $self->country,
1480 $self->ut_phonen('daytime', $self->country)
1481 || $self->ut_phonen('night', $self->country)
1482 || $self->ut_phonen('fax', $self->country)
1483 || $self->ut_zip('zip', $self->country)
1485 return $error if $error;
1487 if ( $conf->exists('cust_main-require_phone')
1488 && ! length($self->daytime) && ! length($self->night)
1491 my $daytime_label = FS::Msgcat::_gettext('daytime') =~ /^(daytime)?$/
1493 : FS::Msgcat::_gettext('daytime');
1494 my $night_label = FS::Msgcat::_gettext('night') =~ /^(night)?$/
1496 : FS::Msgcat::_gettext('night');
1498 return "$daytime_label or $night_label is required"
1502 if ( $self->has_ship_address
1503 && scalar ( grep { $self->getfield($_) ne $self->getfield("ship_$_") }
1504 $self->addr_fields )
1508 $self->ut_name('ship_last')
1509 || $self->ut_name('ship_first')
1510 || $self->ut_textn('ship_company')
1511 || $self->ut_text('ship_address1')
1512 || $self->ut_textn('ship_address2')
1513 || $self->ut_text('ship_city')
1514 || $self->ut_textn('ship_county')
1515 || $self->ut_textn('ship_state')
1516 || $self->ut_country('ship_country')
1518 return $error if $error;
1520 #false laziness with above
1521 unless ( qsearchs('cust_main_county', {
1522 'country' => $self->ship_country,
1525 return "Unknown ship_state/ship_county/ship_country: ".
1526 $self->ship_state. "/". $self->ship_county. "/". $self->ship_country
1527 unless qsearch('cust_main_county',{
1528 'state' => $self->ship_state,
1529 'county' => $self->ship_county,
1530 'country' => $self->ship_country,
1536 $self->ut_phonen('ship_daytime', $self->ship_country)
1537 || $self->ut_phonen('ship_night', $self->ship_country)
1538 || $self->ut_phonen('ship_fax', $self->ship_country)
1539 || $self->ut_zip('ship_zip', $self->ship_country)
1541 return $error if $error;
1543 return "Unit # is required."
1544 if $self->ship_address2 =~ /^\s*$/
1545 && $conf->exists('cust_main-require_address2');
1547 } else { # ship_ info eq billing info, so don't store dup info in database
1549 $self->setfield("ship_$_", '')
1550 foreach $self->addr_fields;
1552 return "Unit # is required."
1553 if $self->address2 =~ /^\s*$/
1554 && $conf->exists('cust_main-require_address2');
1558 #$self->payby =~ /^(CARD|DCRD|CHEK|DCHK|LECB|BILL|COMP|PREPAY|CASH|WEST|MCRD)$/
1559 # or return "Illegal payby: ". $self->payby;
1561 FS::payby->can_payby($self->table, $self->payby)
1562 or return "Illegal payby: ". $self->payby;
1564 $error = $self->ut_numbern('paystart_month')
1565 || $self->ut_numbern('paystart_year')
1566 || $self->ut_numbern('payissue')
1567 || $self->ut_textn('paytype')
1569 return $error if $error;
1571 if ( $self->payip eq '' ) {
1574 $error = $self->ut_ip('payip');
1575 return $error if $error;
1578 # If it is encrypted and the private key is not availaible then we can't
1579 # check the credit card.
1581 my $check_payinfo = 1;
1583 if ($self->is_encrypted($self->payinfo)) {
1587 if ( $check_payinfo && $self->payby =~ /^(CARD|DCRD)$/ ) {
1589 my $payinfo = $self->payinfo;
1590 $payinfo =~ s/\D//g;
1591 $payinfo =~ /^(\d{13,16})$/
1592 or return gettext('invalid_card'); # . ": ". $self->payinfo;
1594 $self->payinfo($payinfo);
1596 or return gettext('invalid_card'); # . ": ". $self->payinfo;
1598 return gettext('unknown_card_type')
1599 if cardtype($self->payinfo) eq "Unknown";
1601 my $ban = qsearchs('banned_pay', $self->_banned_pay_hashref);
1603 return 'Banned credit card: banned on '.
1604 time2str('%a %h %o at %r', $ban->_date).
1605 ' by '. $ban->otaker.
1606 ' (ban# '. $ban->bannum. ')';
1609 if (length($self->paycvv) && !$self->is_encrypted($self->paycvv)) {
1610 if ( cardtype($self->payinfo) eq 'American Express card' ) {
1611 $self->paycvv =~ /^(\d{4})$/
1612 or return "CVV2 (CID) for American Express cards is four digits.";
1615 $self->paycvv =~ /^(\d{3})$/
1616 or return "CVV2 (CVC2/CID) is three digits.";
1623 my $cardtype = cardtype($payinfo);
1624 if ( $cardtype =~ /^(Switch|Solo)$/i ) {
1626 return "Start date or issue number is required for $cardtype cards"
1627 unless $self->paystart_month && $self->paystart_year or $self->payissue;
1629 return "Start month must be between 1 and 12"
1630 if $self->paystart_month
1631 and $self->paystart_month < 1 || $self->paystart_month > 12;
1633 return "Start year must be 1990 or later"
1634 if $self->paystart_year
1635 and $self->paystart_year < 1990;
1637 return "Issue number must be beween 1 and 99"
1639 and $self->payissue < 1 || $self->payissue > 99;
1642 $self->paystart_month('');
1643 $self->paystart_year('');
1644 $self->payissue('');
1647 } elsif ( $check_payinfo && $self->payby =~ /^(CHEK|DCHK)$/ ) {
1649 my $payinfo = $self->payinfo;
1650 $payinfo =~ s/[^\d\@]//g;
1651 if ( $conf->exists('echeck-nonus') ) {
1652 $payinfo =~ /^(\d+)\@(\d+)$/ or return 'invalid echeck account@aba';
1653 $payinfo = "$1\@$2";
1655 $payinfo =~ /^(\d+)\@(\d{9})$/ or return 'invalid echeck account@aba';
1656 $payinfo = "$1\@$2";
1658 $self->payinfo($payinfo);
1661 my $ban = qsearchs('banned_pay', $self->_banned_pay_hashref);
1663 return 'Banned ACH account: banned on '.
1664 time2str('%a %h %o at %r', $ban->_date).
1665 ' by '. $ban->otaker.
1666 ' (ban# '. $ban->bannum. ')';
1669 } elsif ( $self->payby eq 'LECB' ) {
1671 my $payinfo = $self->payinfo;
1672 $payinfo =~ s/\D//g;
1673 $payinfo =~ /^1?(\d{10})$/ or return 'invalid btn billing telephone number';
1675 $self->payinfo($payinfo);
1678 } elsif ( $self->payby eq 'BILL' ) {
1680 $error = $self->ut_textn('payinfo');
1681 return "Illegal P.O. number: ". $self->payinfo if $error;
1684 } elsif ( $self->payby eq 'COMP' ) {
1686 my $curuser = $FS::CurrentUser::CurrentUser;
1687 if ( ! $self->custnum
1688 && ! $curuser->access_right('Complimentary customer')
1691 return "You are not permitted to create complimentary accounts."
1694 $error = $self->ut_textn('payinfo');
1695 return "Illegal comp account issuer: ". $self->payinfo if $error;
1698 } elsif ( $self->payby eq 'PREPAY' ) {
1700 my $payinfo = $self->payinfo;
1701 $payinfo =~ s/\W//g; #anything else would just confuse things
1702 $self->payinfo($payinfo);
1703 $error = $self->ut_alpha('payinfo');
1704 return "Illegal prepayment identifier: ". $self->payinfo if $error;
1705 return "Unknown prepayment identifier"
1706 unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } );
1711 if ( $self->paydate eq '' || $self->paydate eq '-' ) {
1712 return "Expiration date required"
1713 unless $self->payby =~ /^(BILL|PREPAY|CHEK|DCHK|LECB|CASH|WEST|MCRD)$/;
1717 if ( $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/ ) {
1718 ( $m, $y ) = ( $1, length($2) == 4 ? $2 : "20$2" );
1719 } elsif ( $self->paydate =~ /^(20)?(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) {
1720 ( $m, $y ) = ( $3, "20$2" );
1722 return "Illegal expiration date: ". $self->paydate;
1724 $self->paydate("$y-$m-01");
1725 my($nowm,$nowy)=(localtime(time))[4,5]; $nowm++; $nowy+=1900;
1726 return gettext('expired_card')
1728 && !$ignore_expired_card
1729 && ( $y<$nowy || ( $y==$nowy && $1<$nowm ) );
1732 if ( $self->payname eq '' && $self->payby !~ /^(CHEK|DCHK)$/ &&
1733 ( ! $conf->exists('require_cardname')
1734 || $self->payby !~ /^(CARD|DCRD)$/ )
1736 $self->payname( $self->first. " ". $self->getfield('last') );
1738 $self->payname =~ /^([\w \,\.\-\'\&]+)$/
1739 or return gettext('illegal_name'). " payname: ". $self->payname;
1743 foreach my $flag (qw( tax spool_cdr squelch_cdr )) {
1744 $self->$flag() =~ /^(Y?)$/ or return "Illegal $flag: ". $self->$flag();
1748 $self->otaker(getotaker) unless $self->otaker;
1750 warn "$me check AFTER: \n". $self->_dump
1753 $self->SUPER::check;
1758 Returns a list of fields which have ship_ duplicates.
1763 qw( last first company
1764 address1 address2 city county state zip country
1769 =item has_ship_address
1771 Returns true if this customer record has a separate shipping address.
1775 sub has_ship_address {
1777 scalar( grep { $self->getfield("ship_$_") ne '' } $self->addr_fields );
1782 Returns all packages (see L<FS::cust_pkg>) for this customer.
1789 return $self->num_pkgs unless wantarray;
1792 if ( $self->{'_pkgnum'} ) {
1793 @cust_pkg = values %{ $self->{'_pkgnum'}->cache };
1795 @cust_pkg = qsearch( 'cust_pkg', { 'custnum' => $self->custnum });
1798 sort sort_packages @cust_pkg;
1803 Synonym for B<all_pkgs>.
1808 shift->all_pkgs(@_);
1813 Returns all locations (see L<FS::cust_location>) for this customer.
1819 qsearch('cust_location', { 'custnum' => $self->custnum } );
1822 =item ncancelled_pkgs
1824 Returns all non-cancelled packages (see L<FS::cust_pkg>) for this customer.
1828 sub ncancelled_pkgs {
1831 return $self->num_ncancelled_pkgs unless wantarray;
1834 if ( $self->{'_pkgnum'} ) {
1836 warn "$me ncancelled_pkgs: returning cached objects"
1839 @cust_pkg = grep { ! $_->getfield('cancel') }
1840 values %{ $self->{'_pkgnum'}->cache };
1844 warn "$me ncancelled_pkgs: searching for packages with custnum ".
1845 $self->custnum. "\n"
1849 qsearch( 'cust_pkg', {
1850 'custnum' => $self->custnum,
1854 qsearch( 'cust_pkg', {
1855 'custnum' => $self->custnum,
1860 sort sort_packages @cust_pkg;
1864 # This should be generalized to use config options to determine order.
1866 if ( $a->get('cancel') and $b->get('cancel') ) {
1867 $a->pkgnum <=> $b->pkgnum;
1868 } elsif ( $a->get('cancel') or $b->get('cancel') ) {
1869 return -1 if $b->get('cancel');
1870 return 1 if $a->get('cancel');
1873 $a->pkgnum <=> $b->pkgnum;
1877 =item suspended_pkgs
1879 Returns all suspended packages (see L<FS::cust_pkg>) for this customer.
1883 sub suspended_pkgs {
1885 grep { $_->susp } $self->ncancelled_pkgs;
1888 =item unflagged_suspended_pkgs
1890 Returns all unflagged suspended packages (see L<FS::cust_pkg>) for this
1891 customer (thouse packages without the `manual_flag' set).
1895 sub unflagged_suspended_pkgs {
1897 return $self->suspended_pkgs
1898 unless dbdef->table('cust_pkg')->column('manual_flag');
1899 grep { ! $_->manual_flag } $self->suspended_pkgs;
1902 =item unsuspended_pkgs
1904 Returns all unsuspended (and uncancelled) packages (see L<FS::cust_pkg>) for
1909 sub unsuspended_pkgs {
1911 grep { ! $_->susp } $self->ncancelled_pkgs;
1914 =item num_cancelled_pkgs
1916 Returns the number of cancelled packages (see L<FS::cust_pkg>) for this
1921 sub num_cancelled_pkgs {
1922 shift->num_pkgs("cust_pkg.cancel IS NOT NULL AND cust_pkg.cancel != 0");
1925 sub num_ncancelled_pkgs {
1926 shift->num_pkgs("( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )");
1930 my( $self ) = shift;
1931 my $sql = scalar(@_) ? shift : '';
1932 $sql = "AND $sql" if $sql && $sql !~ /^\s*$/ && $sql !~ /^\s*AND/i;
1933 my $sth = dbh->prepare(
1934 "SELECT COUNT(*) FROM cust_pkg WHERE custnum = ? $sql"
1935 ) or die dbh->errstr;
1936 $sth->execute($self->custnum) or die $sth->errstr;
1937 $sth->fetchrow_arrayref->[0];
1942 Unsuspends all unflagged suspended packages (see L</unflagged_suspended_pkgs>
1943 and L<FS::cust_pkg>) for this customer. Always returns a list: an empty list
1944 on success or a list of errors.
1950 grep { $_->unsuspend } $self->suspended_pkgs;
1955 Suspends all unsuspended packages (see L<FS::cust_pkg>) for this customer.
1957 Returns a list: an empty list on success or a list of errors.
1963 grep { $_->suspend(@_) } $self->unsuspended_pkgs;
1966 =item suspend_if_pkgpart HASHREF | PKGPART [ , PKGPART ... ]
1968 Suspends all unsuspended packages (see L<FS::cust_pkg>) matching the listed
1969 PKGPARTs (see L<FS::part_pkg>). Preferred usage is to pass a hashref instead
1970 of a list of pkgparts; the hashref has the following keys:
1974 =item pkgparts - listref of pkgparts
1976 =item (other options are passed to the suspend method)
1981 Returns a list: an empty list on success or a list of errors.
1985 sub suspend_if_pkgpart {
1987 my (@pkgparts, %opt);
1988 if (ref($_[0]) eq 'HASH'){
1989 @pkgparts = @{$_[0]{pkgparts}};
1994 grep { $_->suspend(%opt) }
1995 grep { my $pkgpart = $_->pkgpart; grep { $pkgpart eq $_ } @pkgparts }
1996 $self->unsuspended_pkgs;
1999 =item suspend_unless_pkgpart HASHREF | PKGPART [ , PKGPART ... ]
2001 Suspends all unsuspended packages (see L<FS::cust_pkg>) unless they match the
2002 given PKGPARTs (see L<FS::part_pkg>). Preferred usage is to pass a hashref
2003 instead of a list of pkgparts; the hashref has the following keys:
2007 =item pkgparts - listref of pkgparts
2009 =item (other options are passed to the suspend method)
2013 Returns a list: an empty list on success or a list of errors.
2017 sub suspend_unless_pkgpart {
2019 my (@pkgparts, %opt);
2020 if (ref($_[0]) eq 'HASH'){
2021 @pkgparts = @{$_[0]{pkgparts}};
2026 grep { $_->suspend(%opt) }
2027 grep { my $pkgpart = $_->pkgpart; ! grep { $pkgpart eq $_ } @pkgparts }
2028 $self->unsuspended_pkgs;
2031 =item cancel [ OPTION => VALUE ... ]
2033 Cancels all uncancelled packages (see L<FS::cust_pkg>) for this customer.
2035 Available options are:
2039 =item quiet - can be set true to supress email cancellation notices.
2041 =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.
2043 =item ban - can be set true to ban this customer's credit card or ACH information, if present.
2047 Always returns a list: an empty list on success or a list of errors.
2052 my( $self, %opt ) = @_;
2054 warn "$me cancel called on customer ". $self->custnum. " with options ".
2055 join(', ', map { "$_: $opt{$_}" } keys %opt ). "\n"
2058 return ( 'access denied' )
2059 unless $FS::CurrentUser::CurrentUser->access_right('Cancel customer');
2061 if ( $opt{'ban'} && $self->payby =~ /^(CARD|DCRD|CHEK|DCHK)$/ ) {
2063 #should try decryption (we might have the private key)
2064 # and if not maybe queue a job for the server that does?
2065 return ( "Can't (yet) ban encrypted credit cards" )
2066 if $self->is_encrypted($self->payinfo);
2068 my $ban = new FS::banned_pay $self->_banned_pay_hashref;
2069 my $error = $ban->insert;
2070 return ( $error ) if $error;
2074 my @pkgs = $self->ncancelled_pkgs;
2076 warn "$me cancelling ". scalar($self->ncancelled_pkgs). "/".
2077 scalar(@pkgs). " packages for customer ". $self->custnum. "\n"
2080 grep { $_ } map { $_->cancel(%opt) } $self->ncancelled_pkgs;
2083 sub _banned_pay_hashref {
2094 'payby' => $payby2ban{$self->payby},
2095 'payinfo' => md5_base64($self->payinfo),
2096 #don't ever *search* on reason! #'reason' =>
2102 Returns all notes (see L<FS::cust_main_note>) for this customer.
2109 qsearch( 'cust_main_note',
2110 { 'custnum' => $self->custnum },
2112 'ORDER BY _DATE DESC'
2118 Returns the agent (see L<FS::agent>) for this customer.
2124 qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
2127 =item bill_and_collect
2129 Cancels and suspends any packages due, generates bills, applies payments and
2132 Warns on errors (Does not currently: If there is an error, returns the error, otherwise returns false.)
2134 Options are passed as name-value pairs. Currently available options are:
2140 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:
2144 $cust_main->bill( 'time' => str2time('April 20th, 2001') );
2148 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.
2152 "1d" for the traditional, daily events (the default), or "1m" for the new monthly events (part_event.check_freq)
2156 If set true, re-charges setup fees.
2160 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)
2166 sub bill_and_collect {
2167 my( $self, %options ) = @_;
2173 #$options{actual_time} not $options{time} because freeside-daily -d is for
2174 #pre-printing invoices
2175 my @cancel_pkgs = grep { $_->expire && $_->expire <= $options{actual_time} }
2176 $self->ncancelled_pkgs;
2178 foreach my $cust_pkg ( @cancel_pkgs ) {
2179 my $cpr = $cust_pkg->last_cust_pkg_reason('expire');
2180 my $error = $cust_pkg->cancel($cpr ? ( 'reason' => $cpr->reasonnum,
2181 'reason_otaker' => $cpr->otaker
2185 warn "Error cancelling expired pkg ". $cust_pkg->pkgnum.
2186 " for custnum ". $self->custnum. ": $error"
2194 #$options{actual_time} not $options{time} because freeside-daily -d is for
2195 #pre-printing invoices
2198 && ( ( $_->part_pkg->is_prepaid
2200 && $_->bill < $options{actual_time}
2203 && $_->adjourn <= $options{actual_time}
2207 $self->ncancelled_pkgs;
2209 foreach my $cust_pkg ( @susp_pkgs ) {
2210 my $cpr = $cust_pkg->last_cust_pkg_reason('adjourn')
2211 if ($cust_pkg->adjourn && $cust_pkg->adjourn < $^T);
2212 my $error = $cust_pkg->suspend($cpr ? ( 'reason' => $cpr->reasonnum,
2213 'reason_otaker' => $cpr->otaker
2218 warn "Error suspending package ". $cust_pkg->pkgnum.
2219 " for custnum ". $self->custnum. ": $error"
2227 my $error = $self->bill( %options );
2228 warn "Error billing, custnum ". $self->custnum. ": $error" if $error;
2230 $self->apply_payments_and_credits;
2232 $error = $self->collect( %options );
2233 warn "Error collecting, custnum". $self->custnum. ": $error" if $error;
2239 Generates invoices (see L<FS::cust_bill>) for this customer. Usually used in
2240 conjunction with the collect method by calling B<bill_and_collect>.
2242 If there is an error, returns the error, otherwise returns false.
2244 Options are passed as name-value pairs. Currently available options are:
2250 If set true, re-charges setup fees.
2254 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:
2258 $cust_main->bill( 'time' => str2time('April 20th, 2001') );
2262 An array ref of specific packages (objects) to attempt billing, instead trying all of them.
2264 $cust_main->bill( pkg_list => [$pkg1, $pkg2] );
2268 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.
2275 my( $self, %options ) = @_;
2276 return '' if $self->payby eq 'COMP';
2277 warn "$me bill customer ". $self->custnum. "\n"
2280 my $time = $options{'time'} || time;
2281 my $invoice_time = $options{'invoice_time'} || $time;
2284 local $SIG{HUP} = 'IGNORE';
2285 local $SIG{INT} = 'IGNORE';
2286 local $SIG{QUIT} = 'IGNORE';
2287 local $SIG{TERM} = 'IGNORE';
2288 local $SIG{TSTP} = 'IGNORE';
2289 local $SIG{PIPE} = 'IGNORE';
2291 my $oldAutoCommit = $FS::UID::AutoCommit;
2292 local $FS::UID::AutoCommit = 0;
2295 $self->select_for_update; #mutex
2297 my @cust_bill_pkg = ();
2300 # find the packages which are due for billing, find out how much they are
2301 # & generate invoice database.
2304 my( $total_setup, $total_recur, $postal_charge ) = ( 0, 0, 0 );
2308 my @precommit_hooks = ();
2310 my @cust_pkgs = qsearch('cust_pkg', { 'custnum' => $self->custnum } );
2311 foreach my $cust_pkg (@cust_pkgs) {
2313 #NO!! next if $cust_pkg->cancel;
2314 next if $cust_pkg->getfield('cancel');
2316 warn " bill package ". $cust_pkg->pkgnum. "\n" if $DEBUG > 1;
2318 #? to avoid use of uninitialized value errors... ?
2319 $cust_pkg->setfield('bill', '')
2320 unless defined($cust_pkg->bill);
2322 #my $part_pkg = $cust_pkg->part_pkg;
2324 my $real_pkgpart = $cust_pkg->pkgpart;
2325 my %hash = $cust_pkg->hash;
2327 foreach my $part_pkg ( $cust_pkg->part_pkg->self_and_bill_linked ) {
2329 $cust_pkg->set($_, $hash{$_}) foreach qw ( setup last_bill bill );
2332 $self->_make_lines( 'part_pkg' => $part_pkg,
2333 'cust_pkg' => $cust_pkg,
2334 'precommit_hooks' => \@precommit_hooks,
2335 'line_items' => \@cust_bill_pkg,
2336 'setup' => \$total_setup,
2337 'recur' => \$total_recur,
2338 'tax_matrix' => \%taxlisthash,
2340 'options' => \%options,
2343 $dbh->rollback if $oldAutoCommit;
2347 } #foreach my $part_pkg
2349 } #foreach my $cust_pkg
2351 unless ( @cust_bill_pkg ) { #don't create an invoice w/o line items
2352 #but do commit any package date cycling that happened
2353 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2357 my $postal_pkg = $self->charge_postal_fee();
2358 if ( $postal_pkg && !ref( $postal_pkg ) ) {
2359 $dbh->rollback if $oldAutoCommit;
2360 return "can't charge postal invoice fee for customer ".
2361 $self->custnum. ": $postal_pkg";
2364 ( scalar( grep { $_->recur && $_->recur > 0 } @cust_bill_pkg) ||
2365 !$conf->exists('postal_invoice-recurring_only')
2369 foreach my $part_pkg ( $postal_pkg->part_pkg->self_and_bill_linked ) {
2371 $self->_make_lines( 'part_pkg' => $part_pkg,
2372 'cust_pkg' => $postal_pkg,
2373 'precommit_hooks' => \@precommit_hooks,
2374 'line_items' => \@cust_bill_pkg,
2375 'setup' => \$total_setup,
2376 'recur' => \$total_recur,
2377 'tax_matrix' => \%taxlisthash,
2379 'options' => \%options,
2382 $dbh->rollback if $oldAutoCommit;
2388 warn "having a look at the taxes we found...\n" if $DEBUG > 2;
2389 foreach my $tax ( keys %taxlisthash ) {
2390 my $tax_object = shift @{ $taxlisthash{$tax} };
2391 warn "found ". $tax_object->taxname. " as $tax\n" if $DEBUG > 2;
2392 my $listref_or_error =
2393 $tax_object->taxline( $taxlisthash{$tax},
2394 'custnum' => $self->custnum,
2395 'invoice_time' => $invoice_time
2397 unless (ref($listref_or_error)) {
2398 $dbh->rollback if $oldAutoCommit;
2399 return $listref_or_error;
2401 unshift @{ $taxlisthash{$tax} }, $tax_object;
2403 warn "adding ". $listref_or_error->[1].
2404 " as ". $listref_or_error->[0]. "\n"
2406 $tax{ $tax } += $listref_or_error->[1];
2407 if ( $taxname{ $listref_or_error->[0] } ) {
2408 push @{ $taxname{ $listref_or_error->[0] } }, $tax;
2410 $taxname{ $listref_or_error->[0] } = [ $tax ];
2415 #move the cust_tax_exempt_pkg records to the cust_bill_pkgs we will commit
2416 my %packagemap = map { $_->pkgnum => $_ } @cust_bill_pkg;
2417 foreach my $tax ( keys %taxlisthash ) {
2418 foreach ( @{ $taxlisthash{$tax} }[1 ... scalar(@{ $taxlisthash{$tax} })] ) {
2419 next unless ref($_) eq 'FS::cust_bill_pkg'; # shouldn't happen
2421 push @{ $packagemap{$_->pkgnum}->_cust_tax_exempt_pkg },
2422 splice( @{ $_->_cust_tax_exempt_pkg } );
2426 #some taxes are taxed
2429 warn "finding taxed taxes...\n" if $DEBUG > 2;
2430 foreach my $tax ( keys %taxlisthash ) {
2431 my $tax_object = shift @{ $taxlisthash{$tax} };
2432 warn "found possible taxed tax ". $tax_object->taxname. " we call $tax\n"
2434 next unless $tax_object->can('tax_on_tax');
2436 foreach my $tot ( $tax_object->tax_on_tax( $self ) ) {
2437 my $totname = ref( $tot ). ' '. $tot->taxnum;
2439 warn "checking $totname which we call ". $tot->taxname. " as applicable\n"
2441 next unless exists( $taxlisthash{ $totname } ); # only increase
2443 warn "adding $totname to taxed taxes\n" if $DEBUG > 2;
2444 if ( exists( $totlisthash{ $totname } ) ) {
2445 push @{ $totlisthash{ $totname } }, $tax{ $tax };
2447 $totlisthash{ $totname } = [ $tot, $tax{ $tax } ];
2452 warn "having a look at taxed taxes...\n" if $DEBUG > 2;
2453 foreach my $tax ( keys %totlisthash ) {
2454 my $tax_object = shift @{ $totlisthash{$tax} };
2455 warn "found previously found taxed tax ". $tax_object->taxname. "\n"
2457 my $listref_or_error =
2458 $tax_object->taxline( $totlisthash{$tax},
2459 'custnum' => $self->custnum,
2460 'invoice_time' => $invoice_time
2462 unless (ref($listref_or_error)) {
2463 $dbh->rollback if $oldAutoCommit;
2464 return $listref_or_error;
2467 warn "adding taxed tax amount ". $listref_or_error->[1].
2468 " as ". $tax_object->taxname. "\n"
2470 $tax{ $tax } += $listref_or_error->[1];
2473 #consolidate and create tax line items
2474 warn "consolidating and generating...\n" if $DEBUG > 2;
2475 foreach my $taxname ( keys %taxname ) {
2478 warn "adding $taxname\n" if $DEBUG > 1;
2479 foreach my $taxitem ( @{ $taxname{$taxname} } ) {
2480 $tax += $tax{$taxitem} unless $seen{$taxitem};
2481 $seen{$taxitem} = 1;
2482 warn "adding $tax{$taxitem}\n" if $DEBUG > 1;
2486 $tax = sprintf('%.2f', $tax );
2487 $total_setup = sprintf('%.2f', $total_setup+$tax );
2489 push @cust_bill_pkg, new FS::cust_bill_pkg {
2495 'itemdesc' => $taxname,
2500 my $charged = sprintf('%.2f', $total_setup + $total_recur );
2502 #create the new invoice
2503 my $cust_bill = new FS::cust_bill ( {
2504 'custnum' => $self->custnum,
2505 '_date' => ( $invoice_time ),
2506 'charged' => $charged,
2508 my $error = $cust_bill->insert;
2510 $dbh->rollback if $oldAutoCommit;
2511 return "can't create invoice for customer #". $self->custnum. ": $error";
2514 foreach my $cust_bill_pkg ( @cust_bill_pkg ) {
2515 $cust_bill_pkg->invnum($cust_bill->invnum);
2516 my $error = $cust_bill_pkg->insert;
2518 $dbh->rollback if $oldAutoCommit;
2519 return "can't create invoice line item: $error";
2524 foreach my $hook ( @precommit_hooks ) {
2526 &{$hook}; #($self) ?
2529 $dbh->rollback if $oldAutoCommit;
2530 return "$@ running precommit hook $hook\n";
2534 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2540 my ($self, %params) = @_;
2542 my $part_pkg = $params{part_pkg} or die "no part_pkg specified";
2543 my $cust_pkg = $params{cust_pkg} or die "no cust_pkg specified";
2544 my $precommit_hooks = $params{precommit_hooks} or die "no package specified";
2545 my $cust_bill_pkgs = $params{line_items} or die "no line buffer specified";
2546 my $total_setup = $params{setup} or die "no setup accumulator specified";
2547 my $total_recur = $params{recur} or die "no recur accumulator specified";
2548 my $taxlisthash = $params{tax_matrix} or die "no tax accumulator specified";
2549 my $time = $params{'time'} or die "no time specified";
2550 my (%options) = %{$params{options}}; #hmmm only for 'resetup'
2553 my $real_pkgpart = $cust_pkg->pkgpart;
2554 my %hash = $cust_pkg->hash;
2555 my $old_cust_pkg = new FS::cust_pkg \%hash;
2561 $cust_pkg->pkgpart($part_pkg->pkgpart);
2569 if ( ! $cust_pkg->setup &&
2571 ( $conf->exists('disable_setup_suspended_pkgs') &&
2572 ! $cust_pkg->getfield('susp')
2573 ) || ! $conf->exists('disable_setup_suspended_pkgs')
2575 || $options{'resetup'}
2578 warn " bill setup\n" if $DEBUG > 1;
2581 $setup = eval { $cust_pkg->calc_setup( $time, \@details ) };
2582 return "$@ running calc_setup for $cust_pkg\n"
2585 $unitsetup = $cust_pkg->part_pkg->unit_setup || $setup; #XXX uuh
2587 $cust_pkg->setfield('setup', $time)
2588 unless $cust_pkg->setup;
2589 #do need it, but it won't get written to the db
2590 #|| $cust_pkg->pkgpart != $real_pkgpart;
2595 # bill recurring fee
2598 #XXX unit stuff here too
2602 if ( ! $cust_pkg->getfield('susp') and
2603 ( $part_pkg->getfield('freq') ne '0' &&
2604 ( $cust_pkg->getfield('bill') || 0 ) <= $time
2606 || ( $part_pkg->plan eq 'voip_cdr'
2607 && $part_pkg->option('bill_every_call')
2611 # XXX should this be a package event? probably. events are called
2612 # at collection time at the moment, though...
2613 $part_pkg->reset_usage($cust_pkg, 'debug'=>$DEBUG)
2614 if $part_pkg->can('reset_usage');
2615 #don't want to reset usage just cause we want a line item??
2616 #&& $part_pkg->pkgpart == $real_pkgpart;
2618 warn " bill recur\n" if $DEBUG > 1;
2621 # XXX shared with $recur_prog
2622 $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
2624 #over two params! lets at least switch to a hashref for the rest...
2625 my $increment_next_bill = ( $part_pkg->freq ne '0'
2626 && ( $cust_pkg->getfield('bill') || 0 ) <= $time
2628 my %param = ( 'precommit_hooks' => $precommit_hooks,
2629 'increment_next_bill' => $increment_next_bill,
2632 $recur = eval { $cust_pkg->calc_recur( \$sdate, \@details, \%param ) };
2633 return "$@ running calc_recur for $cust_pkg\n"
2636 if ( $increment_next_bill ) {
2638 #change this bit to use Date::Manip? CAREFUL with timezones (see
2639 # mailing list archive)
2640 my ($sec,$min,$hour,$mday,$mon,$year) =
2641 (localtime($sdate) )[0,1,2,3,4,5];
2643 #pro-rating magic - if $recur_prog fiddles $sdate, want to use that
2644 # only for figuring next bill date, nothing else, so, reset $sdate again
2646 $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
2647 #no need, its in $hash{last_bill}# my $last_bill = $cust_pkg->last_bill;
2648 $cust_pkg->last_bill($sdate);
2650 if ( $part_pkg->freq =~ /^\d+$/ ) {
2651 $mon += $part_pkg->freq;
2652 until ( $mon < 12 ) { $mon -= 12; $year++; }
2653 } elsif ( $part_pkg->freq =~ /^(\d+)w$/ ) {
2655 $mday += $weeks * 7;
2656 } elsif ( $part_pkg->freq =~ /^(\d+)d$/ ) {
2659 } elsif ( $part_pkg->freq =~ /^(\d+)h$/ ) {
2663 return "unparsable frequency: ". $part_pkg->freq;
2665 $cust_pkg->setfield('bill',
2666 timelocal_nocheck($sec,$min,$hour,$mday,$mon,$year));
2672 warn "\$setup is undefined" unless defined($setup);
2673 warn "\$recur is undefined" unless defined($recur);
2674 warn "\$cust_pkg->bill is undefined" unless defined($cust_pkg->bill);
2677 # If there's line items, create em cust_bill_pkg records
2678 # If $cust_pkg has been modified, update it (if we're a real pkgpart)
2683 if ( $cust_pkg->modified && $cust_pkg->pkgpart == $real_pkgpart ) {
2684 # hmm.. and if just the options are modified in some weird price plan?
2686 warn " package ". $cust_pkg->pkgnum. " modified; updating\n"
2689 my $error = $cust_pkg->replace( $old_cust_pkg,
2690 'options' => { $cust_pkg->options },
2692 return "Error modifying pkgnum ". $cust_pkg->pkgnum. ": $error"
2693 if $error; #just in case
2696 $setup = sprintf( "%.2f", $setup );
2697 $recur = sprintf( "%.2f", $recur );
2698 if ( $setup < 0 && ! $conf->exists('allow_negative_charges') ) {
2699 return "negative setup $setup for pkgnum ". $cust_pkg->pkgnum;
2701 if ( $recur < 0 && ! $conf->exists('allow_negative_charges') ) {
2702 return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum;
2705 if ( $setup != 0 || $recur != 0 ) {
2707 warn " charges (setup=$setup, recur=$recur); adding line items\n"
2710 my @cust_pkg_detail = map { $_->detail } $cust_pkg->cust_pkg_detail('I');
2712 warn " adding customer package invoice detail: $_\n"
2713 foreach @cust_pkg_detail;
2715 push @details, @cust_pkg_detail;
2717 my $cust_bill_pkg = new FS::cust_bill_pkg {
2718 'pkgnum' => $cust_pkg->pkgnum,
2720 'unitsetup' => $unitsetup,
2722 'unitrecur' => $unitrecur,
2723 'quantity' => $cust_pkg->quantity,
2724 'details' => \@details,
2727 if ( $part_pkg->option('recur_temporality', 1) eq 'preceding' ) {
2728 $cust_bill_pkg->sdate( $hash{last_bill} );
2729 $cust_bill_pkg->edate( $sdate - 86399 ); #60s*60m*24h-1
2730 } else { #if ( $part_pkg->option('recur_temporality', 1) eq 'upcoming' ) {
2731 $cust_bill_pkg->sdate( $sdate );
2732 $cust_bill_pkg->edate( $cust_pkg->bill );
2735 $cust_bill_pkg->pkgpart_override($part_pkg->pkgpart)
2736 unless $part_pkg->pkgpart == $real_pkgpart;
2738 $$total_setup += $setup;
2739 $$total_recur += $recur;
2746 $self->_handle_taxes($part_pkg, $taxlisthash, $cust_bill_pkg, $cust_pkg);
2747 return $error if $error;
2749 push @$cust_bill_pkgs, $cust_bill_pkg;
2751 } #if $setup != 0 || $recur != 0
2761 my $part_pkg = shift;
2762 my $taxlisthash = shift;
2763 my $cust_bill_pkg = shift;
2764 my $cust_pkg = shift;
2766 my %cust_bill_pkg = ();
2770 ( $conf->exists('tax-ship_address') && length($self->ship_last) )
2775 #push @classes, $cust_bill_pkg->usage_classes if $cust_bill_pkg->type eq 'U';
2776 push @classes, $cust_bill_pkg->usage_classes if $cust_bill_pkg->usage;
2777 push @classes, 'setup' if $cust_bill_pkg->setup;
2778 push @classes, 'recur' if $cust_bill_pkg->recur;
2780 if ( $conf->exists('enable_taxproducts')
2781 && (scalar($part_pkg->part_pkg_taxoverride) || $part_pkg->has_taxproduct)
2782 && ( $self->tax !~ /Y/i && $self->payby ne 'COMP' )
2786 foreach my $class (@classes) {
2787 my $err_or_ref = $self->_gather_taxes( $part_pkg, $class, $prefix );
2788 return $err_or_ref unless ref($err_or_ref);
2789 $taxes{$class} = $err_or_ref;
2792 unless (exists $taxes{''}) {
2793 my $err_or_ref = $self->_gather_taxes( $part_pkg, '', $prefix );
2794 return $err_or_ref unless ref($err_or_ref);
2795 $taxes{''} = $err_or_ref;
2798 } elsif ( $self->tax !~ /Y/i && $self->payby ne 'COMP' ) {
2800 my %taxhash = map { $_ => $self->get("$prefix$_") }
2801 qw( state county country );
2803 $taxhash{'taxclass'} = $part_pkg->taxclass;
2805 my @taxes = qsearch( 'cust_main_county', \%taxhash );
2808 $taxhash{'taxclass'} = '';
2809 @taxes = qsearch( 'cust_main_county', \%taxhash );
2812 #one more try at a whole-country tax rate
2814 $taxhash{$_} = '' foreach qw( state county );
2815 @taxes = qsearch( 'cust_main_county', \%taxhash );
2818 $taxes{''} = [ @taxes ];
2819 $taxes{'setup'} = [ @taxes ];
2820 $taxes{'recur'} = [ @taxes ];
2821 $taxes{$_} = [ @taxes ] foreach (@classes);
2823 # maybe eliminate this entirely, along with all the 0% records
2826 "fatal: can't find tax rate for state/county/country/taxclass ".
2827 join('/', ( map $self->get("$prefix$_"),
2828 qw(state county country)
2830 $part_pkg->taxclass ). "\n";
2833 } #if $conf->exists('enable_taxproducts') ...
2836 if ( $conf->exists('separate_usage') ) {
2837 my $section = $cust_pkg->part_pkg->option('usage_section', 'Hush!');
2838 my $summary = $cust_pkg->part_pkg->option('summarize_usage', 'Hush!');
2839 push @display, new FS::cust_bill_pkg_display { type => 'S' };
2840 push @display, new FS::cust_bill_pkg_display { type => 'R' };
2841 push @display, new FS::cust_bill_pkg_display { type => 'U',
2844 if ($section && $summary) {
2845 $display[2]->post_total('Y');
2846 push @display, new FS::cust_bill_pkg_display { type => 'U',
2851 $cust_bill_pkg->set('display', \@display);
2853 my %tax_cust_bill_pkg = $cust_bill_pkg->disintegrate;
2854 foreach my $key (keys %tax_cust_bill_pkg) {
2855 my @taxes = @{ $taxes{$key} || [] };
2856 my $tax_cust_bill_pkg = $tax_cust_bill_pkg{$key};
2858 foreach my $tax ( @taxes ) {
2859 my $taxname = ref( $tax ). ' '. $tax->taxnum;
2860 if ( exists( $taxlisthash->{ $taxname } ) ) {
2861 push @{ $taxlisthash->{ $taxname } }, $tax_cust_bill_pkg;
2863 $taxlisthash->{ $taxname } = [ $tax, $tax_cust_bill_pkg ];
2873 my $part_pkg = shift;
2878 my $geocode = $self->geocode('cch');
2880 my @taxclassnums = map { $_->taxclassnum }
2881 $part_pkg->part_pkg_taxoverride($class);
2883 unless (@taxclassnums) {
2884 @taxclassnums = map { $_->taxclassnum }
2885 $part_pkg->part_pkg_taxrate('cch', $geocode, $class);
2887 warn "Found taxclassnum values of ". join(',', @taxclassnums)
2892 join(' OR ', map { "taxclassnum = $_" } @taxclassnums ). ")";
2894 @taxes = qsearch({ 'table' => 'tax_rate',
2895 'hashref' => { 'geocode' => $geocode, },
2896 'extra_sql' => $extra_sql,
2898 if scalar(@taxclassnums);
2900 # maybe eliminate this entirely, along with all the 0% records
2903 "fatal: can't find tax rate for zip/taxproduct/pkgpart ".
2904 join('/', ( map $self->get("$prefix$_"),
2907 $part_pkg->taxproduct_description,
2908 $part_pkg->pkgpart ). "\n";
2911 warn "Found taxes ".
2912 join(',', map{ ref($_). " ". $_->get($_->primary_key) } @taxes). "\n"
2919 =item collect OPTIONS
2921 (Attempt to) collect money for this customer's outstanding invoices (see
2922 L<FS::cust_bill>). Usually used after the bill method.
2924 Actions are now triggered by billing events; see L<FS::part_event> and the
2925 billing events web interface. Old-style invoice events (see
2926 L<FS::part_bill_event>) have been deprecated.
2928 If there is an error, returns the error, otherwise returns false.
2930 Options are passed as name-value pairs.
2932 Currently available options are:
2938 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.
2942 Retry card/echeck/LEC transactions even when not scheduled by invoice events.
2946 set true to surpress email card/ACH decline notices.
2950 "1d" for the traditional, daily events (the default), or "1m" for the new monthly events (part_event.check_freq)
2954 allows for one time override of normal customer billing method
2958 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)
2966 my( $self, %options ) = @_;
2967 my $invoice_time = $options{'invoice_time'} || time;
2970 local $SIG{HUP} = 'IGNORE';
2971 local $SIG{INT} = 'IGNORE';
2972 local $SIG{QUIT} = 'IGNORE';
2973 local $SIG{TERM} = 'IGNORE';
2974 local $SIG{TSTP} = 'IGNORE';
2975 local $SIG{PIPE} = 'IGNORE';
2977 my $oldAutoCommit = $FS::UID::AutoCommit;
2978 local $FS::UID::AutoCommit = 0;
2981 $self->select_for_update; #mutex
2984 my $balance = $self->balance;
2985 warn "$me collect customer ". $self->custnum. ": balance $balance\n"
2988 if ( exists($options{'retry_card'}) ) {
2989 carp 'retry_card option passed to collect is deprecated; use retry';
2990 $options{'retry'} ||= $options{'retry_card'};
2992 if ( exists($options{'retry'}) && $options{'retry'} ) {
2993 my $error = $self->retry_realtime;
2995 $dbh->rollback if $oldAutoCommit;
3000 # false laziness w/pay_batch::import_results
3002 my $due_cust_event = $self->due_cust_event(
3003 'debug' => ( $options{'debug'} || 0 ),
3004 'time' => $invoice_time,
3005 'check_freq' => $options{'check_freq'},
3007 unless( ref($due_cust_event) ) {
3008 $dbh->rollback if $oldAutoCommit;
3009 return $due_cust_event;
3012 foreach my $cust_event ( @$due_cust_event ) {
3016 #re-eval event conditions (a previous event could have changed things)
3017 unless ( $cust_event->test_conditions( 'time' => $invoice_time ) ) {
3018 #don't leave stray "new/locked" records around
3019 my $error = $cust_event->delete;
3021 #gah, even with transactions
3022 $dbh->commit if $oldAutoCommit; #well.
3029 local $realtime_bop_decline_quiet = 1 if $options{'quiet'};
3030 warn " running cust_event ". $cust_event->eventnum. "\n"
3034 #if ( my $error = $cust_event->do_event(%options) ) { #XXX %options?
3035 if ( my $error = $cust_event->do_event() ) {
3036 #XXX wtf is this? figure out a proper dealio with return value
3038 # gah, even with transactions.
3039 $dbh->commit if $oldAutoCommit; #well.
3046 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3051 =item due_cust_event [ HASHREF | OPTION => VALUE ... ]
3053 Inserts database records for and returns an ordered listref of new events due
3054 for this customer, as FS::cust_event objects (see L<FS::cust_event>). If no
3055 events are due, an empty listref is returned. If there is an error, returns a
3056 scalar error message.
3058 To actually run the events, call each event's test_condition method, and if
3059 still true, call the event's do_event method.
3061 Options are passed as a hashref or as a list of name-value pairs. Available
3068 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.
3072 "Current time" for the events.
3076 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)
3080 Only return events for the specified eventtable (by default, events of all eventtables are returned)
3084 Explicitly pass the objects to be tested (typically used with eventtable).
3088 Set to true to return the objects, but not actually insert them into the
3095 sub due_cust_event {
3097 my %opt = ref($_[0]) ? %{ $_[0] } : @_;
3100 #my $DEBUG = $opt{'debug'}
3101 local($DEBUG) = $opt{'debug'}
3102 if defined($opt{'debug'}) && $opt{'debug'} > $DEBUG;
3104 warn "$me due_cust_event called with options ".
3105 join(', ', map { "$_: $opt{$_}" } keys %opt). "\n"
3108 $opt{'time'} ||= time;
3110 local $SIG{HUP} = 'IGNORE';
3111 local $SIG{INT} = 'IGNORE';
3112 local $SIG{QUIT} = 'IGNORE';
3113 local $SIG{TERM} = 'IGNORE';
3114 local $SIG{TSTP} = 'IGNORE';
3115 local $SIG{PIPE} = 'IGNORE';
3117 my $oldAutoCommit = $FS::UID::AutoCommit;
3118 local $FS::UID::AutoCommit = 0;
3121 $self->select_for_update #mutex
3122 unless $opt{testonly};
3125 # 1: find possible events (initial search)
3128 my @cust_event = ();
3130 my @eventtable = $opt{'eventtable'}
3131 ? ( $opt{'eventtable'} )
3132 : FS::part_event->eventtables_runorder;
3134 foreach my $eventtable ( @eventtable ) {
3137 if ( $opt{'objects'} ) {
3139 @objects = @{ $opt{'objects'} };
3143 #my @objects = $self->eventtable(); # sub cust_main { @{ [ $self ] }; }
3144 @objects = ( $eventtable eq 'cust_main' )
3146 : ( $self->$eventtable() );
3150 my @e_cust_event = ();
3152 my $cross = "CROSS JOIN $eventtable";
3153 $cross .= ' LEFT JOIN cust_main USING ( custnum )'
3154 unless $eventtable eq 'cust_main';
3156 foreach my $object ( @objects ) {
3158 #this first search uses the condition_sql magic for optimization.
3159 #the more possible events we can eliminate in this step the better
3161 my $cross_where = '';
3162 my $pkey = $object->primary_key;
3163 $cross_where = "$eventtable.$pkey = ". $object->$pkey();
3165 my $join = FS::part_event_condition->join_conditions_sql( $eventtable );
3167 FS::part_event_condition->where_conditions_sql( $eventtable,
3168 'time'=>$opt{'time'}
3170 my $order = FS::part_event_condition->order_conditions_sql( $eventtable );
3172 $extra_sql = "AND $extra_sql" if $extra_sql;
3174 #here is the agent virtualization
3175 $extra_sql .= " AND ( part_event.agentnum IS NULL
3176 OR part_event.agentnum = ". $self->agentnum. ' )';
3178 $extra_sql .= " $order";
3180 warn "searching for events for $eventtable ". $object->$pkey. "\n"
3181 if $opt{'debug'} > 2;
3182 my @part_event = qsearch( {
3183 'debug' => ( $opt{'debug'} > 3 ? 1 : 0 ),
3184 'select' => 'part_event.*',
3185 'table' => 'part_event',
3186 'addl_from' => "$cross $join",
3187 'hashref' => { 'check_freq' => ( $opt{'check_freq'} || '1d' ),
3188 'eventtable' => $eventtable,
3191 'extra_sql' => "AND $cross_where $extra_sql",
3195 my $pkey = $object->primary_key;
3196 warn " ". scalar(@part_event).
3197 " possible events found for $eventtable ". $object->$pkey(). "\n";
3200 push @e_cust_event, map { $_->new_cust_event($object) } @part_event;
3204 warn " ". scalar(@e_cust_event).
3205 " subtotal possible cust events found for $eventtable\n"
3208 push @cust_event, @e_cust_event;
3212 warn " ". scalar(@cust_event).
3213 " total possible cust events found in initial search\n"
3217 # 2: test conditions
3222 @cust_event = grep $_->test_conditions( 'time' => $opt{'time'},
3223 'stats_hashref' => \%unsat ),
3226 warn " ". scalar(@cust_event). " cust events left satisfying conditions\n"
3229 warn " invalid conditions not eliminated with condition_sql:\n".
3230 join('', map " $_: ".$unsat{$_}."\n", keys %unsat )
3237 unless( $opt{testonly} ) {
3238 foreach my $cust_event ( @cust_event ) {
3240 my $error = $cust_event->insert();
3242 $dbh->rollback if $oldAutoCommit;
3249 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3255 warn " returning events: ". Dumper(@cust_event). "\n"
3262 =item retry_realtime
3264 Schedules realtime / batch credit card / electronic check / LEC billing
3265 events for for retry. Useful if card information has changed or manual
3266 retry is desired. The 'collect' method must be called to actually retry
3269 Implementation details: For either this customer, or for each of this
3270 customer's open invoices, changes the status of the first "done" (with
3271 statustext error) realtime processing event to "failed".
3275 sub retry_realtime {
3278 local $SIG{HUP} = 'IGNORE';
3279 local $SIG{INT} = 'IGNORE';
3280 local $SIG{QUIT} = 'IGNORE';
3281 local $SIG{TERM} = 'IGNORE';
3282 local $SIG{TSTP} = 'IGNORE';
3283 local $SIG{PIPE} = 'IGNORE';
3285 my $oldAutoCommit = $FS::UID::AutoCommit;
3286 local $FS::UID::AutoCommit = 0;
3289 #a little false laziness w/due_cust_event (not too bad, really)
3291 my $join = FS::part_event_condition->join_conditions_sql;
3292 my $order = FS::part_event_condition->order_conditions_sql;
3295 . join ( ' OR ' , map {
3296 "( part_event.eventtable = " . dbh->quote($_)
3297 . " AND tablenum IN( SELECT " . dbdef->table($_)->primary_key . " from $_ where custnum = " . dbh->quote( $self->custnum ) . "))" ;
3298 } FS::part_event->eventtables)
3301 #here is the agent virtualization
3302 my $agent_virt = " ( part_event.agentnum IS NULL
3303 OR part_event.agentnum = ". $self->agentnum. ' )';
3305 #XXX this shouldn't be hardcoded, actions should declare it...
3306 my @realtime_events = qw(
3307 cust_bill_realtime_card
3308 cust_bill_realtime_check
3309 cust_bill_realtime_lec
3313 my $is_realtime_event = ' ( '. join(' OR ', map "part_event.action = '$_'",
3318 my @cust_event = qsearchs({
3319 'table' => 'cust_event',
3320 'select' => 'cust_event.*',
3321 'addl_from' => "LEFT JOIN part_event USING ( eventpart ) $join",
3322 'hashref' => { 'status' => 'done' },
3323 'extra_sql' => " AND statustext IS NOT NULL AND statustext != '' ".
3324 " AND $mine AND $is_realtime_event AND $agent_virt $order" # LIMIT 1"
3327 my %seen_invnum = ();
3328 foreach my $cust_event (@cust_event) {
3330 #max one for the customer, one for each open invoice
3331 my $cust_X = $cust_event->cust_X;
3332 next if $seen_invnum{ $cust_event->part_event->eventtable eq 'cust_bill'
3336 or $cust_event->part_event->eventtable eq 'cust_bill'
3339 my $error = $cust_event->retry;
3341 $dbh->rollback if $oldAutoCommit;
3342 return "error scheduling event for retry: $error";
3347 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3352 =item realtime_bop METHOD AMOUNT [ OPTION => VALUE ... ]
3354 Runs a realtime credit card, ACH (electronic check) or phone bill transaction
3355 via a Business::OnlinePayment realtime gateway. See
3356 L<http://420.am/business-onlinepayment> for supported gateways.
3358 Available methods are: I<CC>, I<ECHECK> and I<LEC>
3360 Available options are: I<description>, I<invnum>, I<quiet>, I<paynum_ref>, I<payunique>
3362 The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
3363 I<zip>, I<payinfo> and I<paydate> are also available. Any of these options,
3364 if set, will override the value from the customer record.
3366 I<description> is a free-text field passed to the gateway. It defaults to
3367 "Internet services".
3369 If an I<invnum> is specified, this payment (if successful) is applied to the
3370 specified invoice. If you don't specify an I<invnum> you might want to
3371 call the B<apply_payments> method.
3373 I<quiet> can be set true to surpress email decline notices.
3375 I<paynum_ref> can be set to a scalar reference. It will be filled in with the
3376 resulting paynum, if any.
3378 I<payunique> is a unique identifier for this payment.
3380 (moved from cust_bill) (probably should get realtime_{card,ach,lec} here too)
3385 my( $self, $method, $amount, %options ) = @_;
3387 warn "$me realtime_bop: $method $amount\n";
3388 warn " $_ => $options{$_}\n" foreach keys %options;
3391 $options{'description'} ||= 'Internet services';
3393 return $self->fake_bop($method, $amount, %options) if $options{'fake'};
3395 eval "use Business::OnlinePayment";
3398 my $payinfo = exists($options{'payinfo'})
3399 ? $options{'payinfo'}
3402 my %method2payby = (
3409 # check for banned credit card/ACH
3412 my $ban = qsearchs('banned_pay', {
3413 'payby' => $method2payby{$method},
3414 'payinfo' => md5_base64($payinfo),
3416 return "Banned credit card" if $ban;
3423 if ( $options{'invnum'} ) {
3424 my $cust_bill = qsearchs('cust_bill', { 'invnum' => $options{'invnum'} } );
3425 die "invnum ". $options{'invnum'}. " not found" unless $cust_bill;
3427 map { $_->part_pkg->taxclass }
3429 map { $_->cust_pkg }
3430 $cust_bill->cust_bill_pkg;
3431 unless ( grep { $taxclasses[0] ne $_ } @taxclasses ) { #unless there are
3432 #different taxclasses
3433 $taxclass = $taxclasses[0];
3437 #look for an agent gateway override first
3439 if ( $method eq 'CC' ) {
3440 $cardtype = cardtype($payinfo);
3441 } elsif ( $method eq 'ECHECK' ) {
3444 $cardtype = $method;
3448 qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
3449 cardtype => $cardtype,
3450 taxclass => $taxclass, } )
3451 || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
3453 taxclass => $taxclass, } )
3454 || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
3455 cardtype => $cardtype,
3457 || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
3459 taxclass => '', } );
3461 my $payment_gateway = '';
3462 my( $processor, $login, $password, $action, @bop_options );
3463 if ( $override ) { #use a payment gateway override
3465 $payment_gateway = $override->payment_gateway;
3467 $processor = $payment_gateway->gateway_module;
3468 $login = $payment_gateway->gateway_username;
3469 $password = $payment_gateway->gateway_password;
3470 $action = $payment_gateway->gateway_action;
3471 @bop_options = $payment_gateway->options;
3473 } else { #use the standard settings from the config
3475 ( $processor, $login, $password, $action, @bop_options ) =
3476 $self->default_payment_gateway($method);
3484 my $address = exists($options{'address1'})
3485 ? $options{'address1'}
3487 my $address2 = exists($options{'address2'})
3488 ? $options{'address2'}
3490 $address .= ", ". $address2 if length($address2);
3492 my $o_payname = exists($options{'payname'})
3493 ? $options{'payname'}
3495 my($payname, $payfirst, $paylast);
3496 if ( $o_payname && $method ne 'ECHECK' ) {
3497 ($payname = $o_payname) =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
3498 or return "Illegal payname $payname";
3499 ($payfirst, $paylast) = ($1, $2);
3501 $payfirst = $self->getfield('first');
3502 $paylast = $self->getfield('last');
3503 $payname = "$payfirst $paylast";
3506 my @invoicing_list = $self->invoicing_list_emailonly;
3507 if ( $conf->exists('emailinvoiceautoalways')
3508 || $conf->exists('emailinvoiceauto') && ! @invoicing_list
3509 || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
3510 push @invoicing_list, $self->all_emails;
3513 my $email = ($conf->exists('business-onlinepayment-email-override'))
3514 ? $conf->config('business-onlinepayment-email-override')
3515 : $invoicing_list[0];
3519 my $payip = exists($options{'payip'})
3522 $content{customer_ip} = $payip
3525 $content{invoice_number} = $options{'invnum'}
3526 if exists($options{'invnum'}) && length($options{'invnum'});
3528 $content{email_customer} =
3529 ( $conf->exists('business-onlinepayment-email_customer')
3530 || $conf->exists('business-onlinepayment-email-override') );
3533 if ( $method eq 'CC' ) {
3535 $content{card_number} = $payinfo;
3536 $paydate = exists($options{'paydate'})
3537 ? $options{'paydate'}
3539 $paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
3540 $content{expiration} = "$2/$1";
3542 my $paycvv = exists($options{'paycvv'})
3543 ? $options{'paycvv'}
3545 $content{cvv2} = $paycvv
3548 my $paystart_month = exists($options{'paystart_month'})
3549 ? $options{'paystart_month'}
3550 : $self->paystart_month;
3552 my $paystart_year = exists($options{'paystart_year'})
3553 ? $options{'paystart_year'}
3554 : $self->paystart_year;
3556 $content{card_start} = "$paystart_month/$paystart_year"
3557 if $paystart_month && $paystart_year;
3559 my $payissue = exists($options{'payissue'})
3560 ? $options{'payissue'}
3562 $content{issue_number} = $payissue if $payissue;
3564 $content{recurring_billing} = 'YES'
3565 if qsearch('cust_pay', { 'custnum' => $self->custnum,
3567 'payinfo' => $payinfo,
3569 || qsearch('cust_pay', { 'custnum' => $self->custnum,
3571 'paymask' => $self->mask_payinfo('CARD', $payinfo),
3575 } elsif ( $method eq 'ECHECK' ) {
3576 ( $content{account_number}, $content{routing_code} ) =
3577 split('@', $payinfo);
3578 $content{bank_name} = $o_payname;
3579 $content{bank_state} = exists($options{'paystate'})
3580 ? $options{'paystate'}
3581 : $self->getfield('paystate');
3582 $content{account_type} = exists($options{'paytype'})
3583 ? uc($options{'paytype'}) || 'CHECKING'
3584 : uc($self->getfield('paytype')) || 'CHECKING';
3585 $content{account_name} = $payname;
3586 $content{customer_org} = $self->company ? 'B' : 'I';
3587 $content{state_id} = exists($options{'stateid'})
3588 ? $options{'stateid'}
3589 : $self->getfield('stateid');
3590 $content{state_id_state} = exists($options{'stateid_state'})
3591 ? $options{'stateid_state'}
3592 : $self->getfield('stateid_state');
3593 $content{customer_ssn} = exists($options{'ss'})
3596 } elsif ( $method eq 'LEC' ) {
3597 $content{phone} = $payinfo;
3601 # run transaction(s)
3604 my $balance = exists( $options{'balance'} )
3605 ? $options{'balance'}
3608 $self->select_for_update; #mutex ... just until we get our pending record in
3610 #the checks here are intended to catch concurrent payments
3611 #double-form-submission prevention is taken care of in cust_pay_pending::check
3614 return "The customer's balance has changed; $method transaction aborted."
3615 if $self->balance < $balance;
3616 #&& $self->balance < $amount; #might as well anyway?
3618 #also check and make sure there aren't *other* pending payments for this cust
3620 my @pending = qsearch('cust_pay_pending', {
3621 'custnum' => $self->custnum,
3622 'status' => { op=>'!=', value=>'done' }
3624 return "A payment is already being processed for this customer (".
3625 join(', ', map 'paypendingnum '. $_->paypendingnum, @pending ).
3626 "); $method transaction aborted."
3627 if scalar(@pending);
3629 #okay, good to go, if we're a duplicate, cust_pay_pending will kick us out
3631 my $cust_pay_pending = new FS::cust_pay_pending {
3632 'custnum' => $self->custnum,
3633 #'invnum' => $options{'invnum'},
3636 'payby' => $method2payby{$method},
3637 'payinfo' => $payinfo,
3638 'paydate' => $paydate,
3640 'gatewaynum' => ( $payment_gateway ? $payment_gateway->gatewaynum : '' ),
3642 $cust_pay_pending->payunique( $options{payunique} )
3643 if defined($options{payunique}) && length($options{payunique});
3644 my $cpp_new_err = $cust_pay_pending->insert; #mutex lost when this is inserted
3645 return $cpp_new_err if $cpp_new_err;
3647 my( $action1, $action2 ) = split(/\s*\,\s*/, $action );
3649 my $transaction = new Business::OnlinePayment( $processor, @bop_options );
3650 $transaction->content(
3653 'password' => $password,
3654 'action' => $action1,
3655 'description' => $options{'description'},
3656 'amount' => $amount,
3657 #'invoice_number' => $options{'invnum'},
3658 'customer_id' => $self->custnum,
3659 'last_name' => $paylast,
3660 'first_name' => $payfirst,
3662 'address' => $address,
3663 'city' => ( exists($options{'city'})
3666 'state' => ( exists($options{'state'})
3669 'zip' => ( exists($options{'zip'})
3672 'country' => ( exists($options{'country'})
3673 ? $options{'country'}
3675 'referer' => 'http://cleanwhisker.420.am/',
3677 'phone' => $self->daytime || $self->night,
3681 $cust_pay_pending->status('pending');
3682 my $cpp_pending_err = $cust_pay_pending->replace;
3683 return $cpp_pending_err if $cpp_pending_err;
3686 my $BOP_TESTING = 0;
3687 my $BOP_TESTING_SUCCESS = 1;
3689 unless ( $BOP_TESTING ) {
3690 $transaction->submit();
3692 if ( $BOP_TESTING_SUCCESS ) {
3693 $transaction->is_success(1);
3694 $transaction->authorization('fake auth');
3696 $transaction->is_success(0);
3697 $transaction->error_message('fake failure');
3701 if ( $transaction->is_success() && $action2 ) {
3703 $cust_pay_pending->status('authorized');
3704 my $cpp_authorized_err = $cust_pay_pending->replace;
3705 return $cpp_authorized_err if $cpp_authorized_err;
3707 my $auth = $transaction->authorization;
3708 my $ordernum = $transaction->can('order_number')
3709 ? $transaction->order_number
3713 new Business::OnlinePayment( $processor, @bop_options );
3720 password => $password,
3721 order_number => $ordernum,
3723 authorization => $auth,
3724 description => $options{'description'},
3727 foreach my $field (qw( authorization_source_code returned_ACI
3728 transaction_identifier validation_code
3729 transaction_sequence_num local_transaction_date
3730 local_transaction_time AVS_result_code )) {
3731 $capture{$field} = $transaction->$field() if $transaction->can($field);
3734 $capture->content( %capture );
3738 unless ( $capture->is_success ) {
3739 my $e = "Authorization successful but capture failed, custnum #".
3740 $self->custnum. ': '. $capture->result_code.
3741 ": ". $capture->error_message;
3748 $cust_pay_pending->status($transaction->is_success() ? 'captured' : 'declined');
3749 my $cpp_captured_err = $cust_pay_pending->replace;
3750 return $cpp_captured_err if $cpp_captured_err;
3753 # remove paycvv after initial transaction
3756 #false laziness w/misc/process/payment.cgi - check both to make sure working
3758 if ( defined $self->dbdef_table->column('paycvv')
3759 && length($self->paycvv)
3760 && ! grep { $_ eq cardtype($payinfo) } $conf->config('cvv-save')
3762 my $error = $self->remove_cvv;
3764 warn "WARNING: error removing cvv: $error\n";
3772 if ( $transaction->is_success() ) {
3775 if ( $payment_gateway ) { # agent override
3776 $paybatch = $payment_gateway->gatewaynum. '-';
3779 $paybatch .= "$processor:". $transaction->authorization;
3781 $paybatch .= ':'. $transaction->order_number
3782 if $transaction->can('order_number')
3783 && length($transaction->order_number);
3785 my $cust_pay = new FS::cust_pay ( {
3786 'custnum' => $self->custnum,
3787 'invnum' => $options{'invnum'},
3790 'payby' => $method2payby{$method},
3791 'payinfo' => $payinfo,
3792 'paybatch' => $paybatch,
3793 'paydate' => $paydate,
3795 #doesn't hurt to know, even though the dup check is in cust_pay_pending now
3796 $cust_pay->payunique( $options{payunique} )
3797 if defined($options{payunique}) && length($options{payunique});
3799 my $oldAutoCommit = $FS::UID::AutoCommit;
3800 local $FS::UID::AutoCommit = 0;
3803 #start a transaction, insert the cust_pay and set cust_pay_pending.status to done in a single transction
3805 my $error = $cust_pay->insert($options{'manual'} ? ( 'manual' => 1 ) : () );
3808 $cust_pay->invnum(''); #try again with no specific invnum
3809 my $error2 = $cust_pay->insert( $options{'manual'} ?
3810 ( 'manual' => 1 ) : ()
3813 # gah. but at least we have a record of the state we had to abort in
3814 # from cust_pay_pending now.
3815 my $e = "WARNING: $method captured but payment not recorded - ".
3816 "error inserting payment ($processor): $error2".
3817 " (previously tried insert with invnum #$options{'invnum'}" .
3818 ": $error ) - pending payment saved as paypendingnum ".
3819 $cust_pay_pending->paypendingnum. "\n";
3825 if ( $options{'paynum_ref'} ) {
3826 ${ $options{'paynum_ref'} } = $cust_pay->paynum;
3829 $cust_pay_pending->status('done');
3830 $cust_pay_pending->statustext('captured');
3831 my $cpp_done_err = $cust_pay_pending->replace;
3833 if ( $cpp_done_err ) {
3835 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
3836 my $e = "WARNING: $method captured but payment not recorded - ".
3837 "error updating status for paypendingnum ".
3838 $cust_pay_pending->paypendingnum. ": $cpp_done_err \n";
3844 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3845 return ''; #no error
3851 my $perror = "$processor error: ". $transaction->error_message;
3853 unless ( $transaction->error_message ) {
3856 if ( $transaction->can('response_page') ) {
3858 'page' => ( $transaction->can('response_page')
3859 ? $transaction->response_page
3862 'code' => ( $transaction->can('response_code')
3863 ? $transaction->response_code
3866 'headers' => ( $transaction->can('response_headers')
3867 ? $transaction->response_headers
3873 "No additional debugging information available for $processor";
3876 $perror .= "No error_message returned from $processor -- ".
3877 ( ref($t_response) ? Dumper($t_response) : $t_response );
3881 if ( !$options{'quiet'} && !$realtime_bop_decline_quiet
3882 && $conf->exists('emaildecline')
3883 && grep { $_ ne 'POST' } $self->invoicing_list
3884 && ! grep { $transaction->error_message =~ /$_/ }
3885 $conf->config('emaildecline-exclude')
3887 my @templ = $conf->config('declinetemplate');
3888 my $template = new Text::Template (
3890 SOURCE => [ map "$_\n", @templ ],
3891 ) or return "($perror) can't create template: $Text::Template::ERROR";
3892 $template->compile()
3893 or return "($perror) can't compile template: $Text::Template::ERROR";
3895 my $templ_hash = { error => $transaction->error_message };
3897 my $error = send_email(
3898 'from' => $conf->config('invoice_from', $self->agentnum ),
3899 'to' => [ grep { $_ ne 'POST' } $self->invoicing_list ],
3900 'subject' => 'Your payment could not be processed',
3901 'body' => [ $template->fill_in(HASH => $templ_hash) ],
3904 $perror .= " (also received error sending decline notification: $error)"
3909 $cust_pay_pending->status('done');
3910 $cust_pay_pending->statustext("declined: $perror");
3911 my $cpp_done_err = $cust_pay_pending->replace;
3912 if ( $cpp_done_err ) {
3913 my $e = "WARNING: $method declined but pending payment not resolved - ".
3914 "error updating status for paypendingnum ".
3915 $cust_pay_pending->paypendingnum. ": $cpp_done_err \n";
3917 $perror = "$e ($perror)";
3930 my( $self, $method, $amount, %options ) = @_;
3932 if ( $options{'fake_failure'} ) {
3933 return "Error: No error; test failure requested with fake_failure";
3936 my %method2payby = (
3943 #if ( $payment_gateway ) { # agent override
3944 # $paybatch = $payment_gateway->gatewaynum. '-';
3947 #$paybatch .= "$processor:". $transaction->authorization;
3949 #$paybatch .= ':'. $transaction->order_number
3950 # if $transaction->can('order_number')
3951 # && length($transaction->order_number);
3953 my $paybatch = 'FakeProcessor:54:32';
3955 my $cust_pay = new FS::cust_pay ( {
3956 'custnum' => $self->custnum,
3957 'invnum' => $options{'invnum'},
3960 'payby' => $method2payby{$method},
3961 #'payinfo' => $payinfo,
3962 'payinfo' => '4111111111111111',
3963 'paybatch' => $paybatch,
3964 #'paydate' => $paydate,
3965 'paydate' => '2012-05-01',
3967 $cust_pay->payunique( $options{payunique} ) if length($options{payunique});
3969 my $error = $cust_pay->insert($options{'manual'} ? ( 'manual' => 1 ) : () );
3972 $cust_pay->invnum(''); #try again with no specific invnum
3973 my $error2 = $cust_pay->insert( $options{'manual'} ?
3974 ( 'manual' => 1 ) : ()
3977 # gah, even with transactions.
3978 my $e = 'WARNING: Card/ACH debited but database not updated - '.
3979 "error inserting (fake!) payment: $error2".
3980 " (previously tried insert with invnum #$options{'invnum'}" .
3987 if ( $options{'paynum_ref'} ) {
3988 ${ $options{'paynum_ref'} } = $cust_pay->paynum;
3991 return ''; #no error
3995 =item default_payment_gateway
3999 sub default_payment_gateway {
4000 my( $self, $method ) = @_;
4002 die "Real-time processing not enabled\n"
4003 unless $conf->exists('business-onlinepayment');
4006 my $bop_config = 'business-onlinepayment';
4007 $bop_config .= '-ach'
4008 if $method =~ /^(ECHECK|CHEK)$/ && $conf->exists($bop_config. '-ach');
4009 my ( $processor, $login, $password, $action, @bop_options ) =
4010 $conf->config($bop_config);
4011 $action ||= 'normal authorization';
4012 pop @bop_options if scalar(@bop_options) % 2 && $bop_options[-1] =~ /^\s*$/;
4013 die "No real-time processor is enabled - ".
4014 "did you set the business-onlinepayment configuration value?\n"
4017 ( $processor, $login, $password, $action, @bop_options )
4022 Removes the I<paycvv> field from the database directly.
4024 If there is an error, returns the error, otherwise returns false.
4030 my $sth = dbh->prepare("UPDATE cust_main SET paycvv = '' WHERE custnum = ?")
4031 or return dbh->errstr;
4032 $sth->execute($self->custnum)
4033 or return $sth->errstr;
4038 =item realtime_refund_bop METHOD [ OPTION => VALUE ... ]
4040 Refunds a realtime credit card, ACH (electronic check) or phone bill transaction
4041 via a Business::OnlinePayment realtime gateway. See
4042 L<http://420.am/business-onlinepayment> for supported gateways.
4044 Available methods are: I<CC>, I<ECHECK> and I<LEC>
4046 Available options are: I<amount>, I<reason>, I<paynum>, I<paydate>
4048 Most gateways require a reference to an original payment transaction to refund,
4049 so you probably need to specify a I<paynum>.
4051 I<amount> defaults to the original amount of the payment if not specified.
4053 I<reason> specifies a reason for the refund.
4055 I<paydate> specifies the expiration date for a credit card overriding the
4056 value from the customer record or the payment record. Specified as yyyy-mm-dd
4058 Implementation note: If I<amount> is unspecified or equal to the amount of the
4059 orignal payment, first an attempt is made to "void" the transaction via
4060 the gateway (to cancel a not-yet settled transaction) and then if that fails,
4061 the normal attempt is made to "refund" ("credit") the transaction via the
4062 gateway is attempted.
4064 #The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
4065 #I<zip>, I<payinfo> and I<paydate> are also available. Any of these options,
4066 #if set, will override the value from the customer record.
4068 #If an I<invnum> is specified, this payment (if successful) is applied to the
4069 #specified invoice. If you don't specify an I<invnum> you might want to
4070 #call the B<apply_payments> method.
4074 #some false laziness w/realtime_bop, not enough to make it worth merging
4075 #but some useful small subs should be pulled out
4076 sub realtime_refund_bop {
4077 my( $self, $method, %options ) = @_;
4079 warn "$me realtime_refund_bop: $method refund\n";
4080 warn " $_ => $options{$_}\n" foreach keys %options;
4083 eval "use Business::OnlinePayment";
4087 # look up the original payment and optionally a gateway for that payment
4091 my $amount = $options{'amount'};
4093 my( $processor, $login, $password, @bop_options ) ;
4094 my( $auth, $order_number ) = ( '', '', '' );
4096 if ( $options{'paynum'} ) {
4098 warn " paynum: $options{paynum}\n" if $DEBUG > 1;
4099 $cust_pay = qsearchs('cust_pay', { paynum=>$options{'paynum'} } )
4100 or return "Unknown paynum $options{'paynum'}";
4101 $amount ||= $cust_pay->paid;
4103 $cust_pay->paybatch =~ /^((\d+)\-)?(\w+):\s*([\w\-\/ ]*)(:([\w\-]+))?$/
4104 or return "Can't parse paybatch for paynum $options{'paynum'}: ".
4105 $cust_pay->paybatch;
4106 my $gatewaynum = '';
4107 ( $gatewaynum, $processor, $auth, $order_number ) = ( $2, $3, $4, $6 );
4109 if ( $gatewaynum ) { #gateway for the payment to be refunded
4111 my $payment_gateway =
4112 qsearchs('payment_gateway', { 'gatewaynum' => $gatewaynum } );
4113 die "payment gateway $gatewaynum not found"
4114 unless $payment_gateway;
4116 $processor = $payment_gateway->gateway_module;
4117 $login = $payment_gateway->gateway_username;
4118 $password = $payment_gateway->gateway_password;
4119 @bop_options = $payment_gateway->options;
4121 } else { #try the default gateway
4123 my( $conf_processor, $unused_action );
4124 ( $conf_processor, $login, $password, $unused_action, @bop_options ) =
4125 $self->default_payment_gateway($method);
4127 return "processor of payment $options{'paynum'} $processor does not".
4128 " match default processor $conf_processor"
4129 unless $processor eq $conf_processor;
4134 } else { # didn't specify a paynum, so look for agent gateway overrides
4135 # like a normal transaction
4138 if ( $method eq 'CC' ) {
4139 $cardtype = cardtype($self->payinfo);
4140 } elsif ( $method eq 'ECHECK' ) {
4143 $cardtype = $method;
4146 qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
4147 cardtype => $cardtype,
4149 || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
4151 taxclass => '', } );
4153 if ( $override ) { #use a payment gateway override
4155 my $payment_gateway = $override->payment_gateway;
4157 $processor = $payment_gateway->gateway_module;
4158 $login = $payment_gateway->gateway_username;
4159 $password = $payment_gateway->gateway_password;
4160 #$action = $payment_gateway->gateway_action;
4161 @bop_options = $payment_gateway->options;
4163 } else { #use the standard settings from the config
4166 ( $processor, $login, $password, $unused_action, @bop_options ) =
4167 $self->default_payment_gateway($method);
4172 return "neither amount nor paynum specified" unless $amount;
4177 'password' => $password,
4178 'order_number' => $order_number,
4179 'amount' => $amount,
4180 'referer' => 'http://cleanwhisker.420.am/',
4182 $content{authorization} = $auth
4183 if length($auth); #echeck/ACH transactions have an order # but no auth
4184 #(at least with authorize.net)
4186 my $disable_void_after;
4187 if ($conf->exists('disable_void_after')
4188 && $conf->config('disable_void_after') =~ /^(\d+)$/) {
4189 $disable_void_after = $1;
4192 #first try void if applicable
4193 if ( $cust_pay && $cust_pay->paid == $amount
4195 ( not defined($disable_void_after) )
4196 || ( time < ($cust_pay->_date + $disable_void_after ) )
4199 warn " attempting void\n" if $DEBUG > 1;
4200 my $void = new Business::OnlinePayment( $processor, @bop_options );
4201 $void->content( 'action' => 'void', %content );
4203 if ( $void->is_success ) {
4204 my $error = $cust_pay->void($options{'reason'});
4206 # gah, even with transactions.
4207 my $e = 'WARNING: Card/ACH voided but database not updated - '.
4208 "error voiding payment: $error";
4212 warn " void successful\n" if $DEBUG > 1;
4217 warn " void unsuccessful, trying refund\n"
4221 my $address = $self->address1;
4222 $address .= ", ". $self->address2 if $self->address2;
4224 my($payname, $payfirst, $paylast);
4225 if ( $self->payname && $method ne 'ECHECK' ) {
4226 $payname = $self->payname;
4227 $payname =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
4228 or return "Illegal payname $payname";
4229 ($payfirst, $paylast) = ($1, $2);
4231 $payfirst = $self->getfield('first');
4232 $paylast = $self->getfield('last');
4233 $payname = "$payfirst $paylast";
4236 my @invoicing_list = $self->invoicing_list_emailonly;
4237 if ( $conf->exists('emailinvoiceautoalways')
4238 || $conf->exists('emailinvoiceauto') && ! @invoicing_list
4239 || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
4240 push @invoicing_list, $self->all_emails;
4243 my $email = ($conf->exists('business-onlinepayment-email-override'))
4244 ? $conf->config('business-onlinepayment-email-override')
4245 : $invoicing_list[0];
4247 my $payip = exists($options{'payip'})
4250 $content{customer_ip} = $payip
4254 if ( $method eq 'CC' ) {
4257 $content{card_number} = $payinfo = $cust_pay->payinfo;
4258 (exists($options{'paydate'}) ? $options{'paydate'} : $cust_pay->paydate)
4259 =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/ &&
4260 ($content{expiration} = "$2/$1"); # where available
4262 $content{card_number} = $payinfo = $self->payinfo;
4263 (exists($options{'paydate'}) ? $options{'paydate'} : $self->paydate)
4264 =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
4265 $content{expiration} = "$2/$1";
4268 } elsif ( $method eq 'ECHECK' ) {
4271 $payinfo = $cust_pay->payinfo;
4273 $payinfo = $self->payinfo;
4275 ( $content{account_number}, $content{routing_code} )= split('@', $payinfo );
4276 $content{bank_name} = $self->payname;
4277 $content{account_type} = 'CHECKING';
4278 $content{account_name} = $payname;
4279 $content{customer_org} = $self->company ? 'B' : 'I';
4280 $content{customer_ssn} = $self->ss;
4281 } elsif ( $method eq 'LEC' ) {
4282 $content{phone} = $payinfo = $self->payinfo;
4286 my $refund = new Business::OnlinePayment( $processor, @bop_options );
4287 my %sub_content = $refund->content(
4288 'action' => 'credit',
4289 'customer_id' => $self->custnum,
4290 'last_name' => $paylast,
4291 'first_name' => $payfirst,
4293 'address' => $address,
4294 'city' => $self->city,
4295 'state' => $self->state,
4296 'zip' => $self->zip,
4297 'country' => $self->country,
4299 'phone' => $self->daytime || $self->night,
4302 warn join('', map { " $_ => $sub_content{$_}\n" } keys %sub_content )
4306 return "$processor error: ". $refund->error_message
4307 unless $refund->is_success();
4309 my %method2payby = (
4315 my $paybatch = "$processor:". $refund->authorization;
4316 $paybatch .= ':'. $refund->order_number
4317 if $refund->can('order_number') && $refund->order_number;
4319 while ( $cust_pay && $cust_pay->unapplied < $amount ) {
4320 my @cust_bill_pay = $cust_pay->cust_bill_pay;
4321 last unless @cust_bill_pay;
4322 my $cust_bill_pay = pop @cust_bill_pay;
4323 my $error = $cust_bill_pay->delete;
4327 my $cust_refund = new FS::cust_refund ( {
4328 'custnum' => $self->custnum,
4329 'paynum' => $options{'paynum'},
4330 'refund' => $amount,
4332 'payby' => $method2payby{$method},
4333 'payinfo' => $payinfo,
4334 'paybatch' => $paybatch,
4335 'reason' => $options{'reason'} || 'card or ACH refund',
4337 my $error = $cust_refund->insert;
4339 $cust_refund->paynum(''); #try again with no specific paynum
4340 my $error2 = $cust_refund->insert;
4342 # gah, even with transactions.
4343 my $e = 'WARNING: Card/ACH refunded but database not updated - '.
4344 "error inserting refund ($processor): $error2".
4345 " (previously tried insert with paynum #$options{'paynum'}" .
4356 =item batch_card OPTION => VALUE...
4358 Adds a payment for this invoice to the pending credit card batch (see
4359 L<FS::cust_pay_batch>), or, if the B<realtime> option is set to a true value,
4360 runs the payment using a realtime gateway.
4365 my ($self, %options) = @_;
4368 if (exists($options{amount})) {
4369 $amount = $options{amount};
4371 $amount = sprintf("%.2f", $self->balance - $self->in_transit_payments);
4373 return '' unless $amount > 0;
4375 my $invnum = delete $options{invnum};
4376 my $payby = $options{invnum} || $self->payby; #dubious
4378 if ($options{'realtime'}) {
4379 return $self->realtime_bop( FS::payby->payby2bop($self->payby),
4385 my $oldAutoCommit = $FS::UID::AutoCommit;
4386 local $FS::UID::AutoCommit = 0;
4389 #this needs to handle mysql as well as Pg, like svc_acct.pm
4390 #(make it into a common function if folks need to do batching with mysql)
4391 $dbh->do("LOCK TABLE pay_batch IN SHARE ROW EXCLUSIVE MODE")
4392 or return "Cannot lock pay_batch: " . $dbh->errstr;
4396 'payby' => FS::payby->payby2payment($payby),
4399 my $pay_batch = qsearchs( 'pay_batch', \%pay_batch );
4401 unless ( $pay_batch ) {
4402 $pay_batch = new FS::pay_batch \%pay_batch;
4403 my $error = $pay_batch->insert;
4405 $dbh->rollback if $oldAutoCommit;
4406 die "error creating new batch: $error\n";
4410 my $old_cust_pay_batch = qsearchs('cust_pay_batch', {
4411 'batchnum' => $pay_batch->batchnum,
4412 'custnum' => $self->custnum,
4415 foreach (qw( address1 address2 city state zip country payby payinfo paydate
4417 $options{$_} = '' unless exists($options{$_});
4420 my $cust_pay_batch = new FS::cust_pay_batch ( {
4421 'batchnum' => $pay_batch->batchnum,
4422 'invnum' => $invnum || 0, # is there a better value?
4423 # this field should be
4425 # cust_bill_pay_batch now
4426 'custnum' => $self->custnum,
4427 'last' => $self->getfield('last'),
4428 'first' => $self->getfield('first'),
4429 'address1' => $options{address1} || $self->address1,
4430 'address2' => $options{address2} || $self->address2,
4431 'city' => $options{city} || $self->city,
4432 'state' => $options{state} || $self->state,
4433 'zip' => $options{zip} || $self->zip,
4434 'country' => $options{country} || $self->country,
4435 'payby' => $options{payby} || $self->payby,
4436 'payinfo' => $options{payinfo} || $self->payinfo,
4437 'exp' => $options{paydate} || $self->paydate,
4438 'payname' => $options{payname} || $self->payname,
4439 'amount' => $amount, # consolidating
4442 $cust_pay_batch->paybatchnum($old_cust_pay_batch->paybatchnum)
4443 if $old_cust_pay_batch;
4446 if ($old_cust_pay_batch) {
4447 $error = $cust_pay_batch->replace($old_cust_pay_batch)
4449 $error = $cust_pay_batch->insert;
4453 $dbh->rollback if $oldAutoCommit;
4457 my $unapplied = $self->total_unapplied_credits
4458 + $self->total_unapplied_payments
4459 + $self->in_transit_payments;
4460 foreach my $cust_bill ($self->open_cust_bill) {
4461 #$dbh->commit or die $dbh->errstr if $oldAutoCommit;
4462 my $cust_bill_pay_batch = new FS::cust_bill_pay_batch {
4463 'invnum' => $cust_bill->invnum,
4464 'paybatchnum' => $cust_pay_batch->paybatchnum,
4465 'amount' => $cust_bill->owed,
4468 if ($unapplied >= $cust_bill_pay_batch->amount){
4469 $unapplied -= $cust_bill_pay_batch->amount;
4472 $cust_bill_pay_batch->amount(sprintf ( "%.2f",
4473 $cust_bill_pay_batch->amount - $unapplied )); $unapplied = 0;
4475 $error = $cust_bill_pay_batch->insert;
4477 $dbh->rollback if $oldAutoCommit;
4482 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4486 =item apply_payments_and_credits
4488 Applies unapplied payments and credits.
4490 In most cases, this new method should be used in place of sequential
4491 apply_payments and apply_credits methods.
4493 If there is an error, returns the error, otherwise returns false.
4497 sub apply_payments_and_credits {
4500 local $SIG{HUP} = 'IGNORE';
4501 local $SIG{INT} = 'IGNORE';
4502 local $SIG{QUIT} = 'IGNORE';
4503 local $SIG{TERM} = 'IGNORE';
4504 local $SIG{TSTP} = 'IGNORE';
4505 local $SIG{PIPE} = 'IGNORE';
4507 my $oldAutoCommit = $FS::UID::AutoCommit;
4508 local $FS::UID::AutoCommit = 0;
4511 $self->select_for_update; #mutex
4513 foreach my $cust_bill ( $self->open_cust_bill ) {
4514 my $error = $cust_bill->apply_payments_and_credits;
4516 $dbh->rollback if $oldAutoCommit;
4517 return "Error applying: $error";
4521 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4526 =item apply_credits OPTION => VALUE ...
4528 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
4529 to outstanding invoice balances in chronological order (or reverse
4530 chronological order if the I<order> option is set to B<newest>) and returns the
4531 value of any remaining unapplied credits available for refund (see
4532 L<FS::cust_refund>).
4534 Dies if there is an error.
4542 local $SIG{HUP} = 'IGNORE';
4543 local $SIG{INT} = 'IGNORE';
4544 local $SIG{QUIT} = 'IGNORE';
4545 local $SIG{TERM} = 'IGNORE';
4546 local $SIG{TSTP} = 'IGNORE';
4547 local $SIG{PIPE} = 'IGNORE';
4549 my $oldAutoCommit = $FS::UID::AutoCommit;
4550 local $FS::UID::AutoCommit = 0;
4553 $self->select_for_update; #mutex
4555 unless ( $self->total_unapplied_credits ) {
4556 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4560 my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
4561 qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
4563 my @invoices = $self->open_cust_bill;
4564 @invoices = sort { $b->_date <=> $a->_date } @invoices
4565 if defined($opt{'order'}) && $opt{'order'} eq 'newest';
4568 foreach my $cust_bill ( @invoices ) {
4571 if ( !defined($credit) || $credit->credited == 0) {
4572 $credit = pop @credits or last;
4575 if ($cust_bill->owed >= $credit->credited) {
4576 $amount=$credit->credited;
4578 $amount=$cust_bill->owed;
4581 my $cust_credit_bill = new FS::cust_credit_bill ( {
4582 'crednum' => $credit->crednum,
4583 'invnum' => $cust_bill->invnum,
4584 'amount' => $amount,
4586 my $error = $cust_credit_bill->insert;
4588 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
4592 redo if ($cust_bill->owed > 0);
4596 my $total_unapplied_credits = $self->total_unapplied_credits;
4598 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4600 return $total_unapplied_credits;
4603 =item apply_payments
4605 Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
4606 to outstanding invoice balances in chronological order.
4608 #and returns the value of any remaining unapplied payments.
4610 Dies if there is an error.
4614 sub apply_payments {
4617 local $SIG{HUP} = 'IGNORE';
4618 local $SIG{INT} = 'IGNORE';
4619 local $SIG{QUIT} = 'IGNORE';
4620 local $SIG{TERM} = 'IGNORE';
4621 local $SIG{TSTP} = 'IGNORE';
4622 local $SIG{PIPE} = 'IGNORE';
4624 my $oldAutoCommit = $FS::UID::AutoCommit;
4625 local $FS::UID::AutoCommit = 0;
4628 $self->select_for_update; #mutex
4632 my @payments = sort { $b->_date <=> $a->_date }
4633 grep { $_->unapplied > 0 }
4636 my @invoices = sort { $a->_date <=> $b->_date}
4637 grep { $_->owed > 0 }
4642 foreach my $cust_bill ( @invoices ) {
4645 if ( !defined($payment) || $payment->unapplied == 0 ) {
4646 $payment = pop @payments or last;
4649 if ( $cust_bill->owed >= $payment->unapplied ) {
4650 $amount = $payment->unapplied;
4652 $amount = $cust_bill->owed;
4655 my $cust_bill_pay = new FS::cust_bill_pay ( {
4656 'paynum' => $payment->paynum,
4657 'invnum' => $cust_bill->invnum,
4658 'amount' => $amount,
4660 my $error = $cust_bill_pay->insert;
4662 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
4666 redo if ( $cust_bill->owed > 0);
4670 my $total_unapplied_payments = $self->total_unapplied_payments;
4672 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4674 return $total_unapplied_payments;
4679 Returns the total owed for this customer on all invoices
4680 (see L<FS::cust_bill/owed>).
4686 $self->total_owed_date(2145859200); #12/31/2037
4689 =item total_owed_date TIME
4691 Returns the total owed for this customer on all invoices with date earlier than
4692 TIME. TIME is specified as a UNIX timestamp; see L<perlfunc/"time">). Also
4693 see L<Time::Local> and L<Date::Parse> for conversion functions.
4697 sub total_owed_date {
4701 foreach my $cust_bill (
4702 grep { $_->_date <= $time }
4703 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
4705 $total_bill += $cust_bill->owed;
4707 sprintf( "%.2f", $total_bill );
4712 Returns the total amount of all payments.
4719 $total += $_->paid foreach $self->cust_pay;
4720 sprintf( "%.2f", $total );
4723 =item total_unapplied_credits
4725 Returns the total outstanding credit (see L<FS::cust_credit>) for this
4726 customer. See L<FS::cust_credit/credited>.
4728 =item total_credited
4730 Old name for total_unapplied_credits. Don't use.
4734 sub total_credited {
4735 #carp "total_credited deprecated, use total_unapplied_credits";
4736 shift->total_unapplied_credits(@_);
4739 sub total_unapplied_credits {
4741 my $total_credit = 0;
4742 $total_credit += $_->credited foreach $self->cust_credit;
4743 sprintf( "%.2f", $total_credit );
4746 =item total_unapplied_payments
4748 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
4749 See L<FS::cust_pay/unapplied>.
4753 sub total_unapplied_payments {
4755 my $total_unapplied = 0;
4756 $total_unapplied += $_->unapplied foreach $self->cust_pay;
4757 sprintf( "%.2f", $total_unapplied );
4760 =item total_unapplied_refunds
4762 Returns the total unrefunded refunds (see L<FS::cust_refund>) for this
4763 customer. See L<FS::cust_refund/unapplied>.
4767 sub total_unapplied_refunds {
4769 my $total_unapplied = 0;
4770 $total_unapplied += $_->unapplied foreach $self->cust_refund;
4771 sprintf( "%.2f", $total_unapplied );
4776 Returns the balance for this customer (total_owed plus total_unrefunded, minus
4777 total_unapplied_credits minus total_unapplied_payments).
4785 + $self->total_unapplied_refunds
4786 - $self->total_unapplied_credits
4787 - $self->total_unapplied_payments
4791 =item balance_date TIME
4793 Returns the balance for this customer, only considering invoices with date
4794 earlier than TIME (total_owed_date minus total_credited minus
4795 total_unapplied_payments). TIME is specified as a UNIX timestamp; see
4796 L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion
4805 $self->total_owed_date($time)
4806 + $self->total_unapplied_refunds
4807 - $self->total_unapplied_credits
4808 - $self->total_unapplied_payments
4812 =item in_transit_payments
4814 Returns the total of requests for payments for this customer pending in
4815 batches in transit to the bank. See L<FS::pay_batch> and L<FS::cust_pay_batch>
4819 sub in_transit_payments {
4821 my $in_transit_payments = 0;
4822 foreach my $pay_batch ( qsearch('pay_batch', {
4825 foreach my $cust_pay_batch ( qsearch('cust_pay_batch', {
4826 'batchnum' => $pay_batch->batchnum,
4827 'custnum' => $self->custnum,
4829 $in_transit_payments += $cust_pay_batch->amount;
4832 sprintf( "%.2f", $in_transit_payments );
4835 =item paydate_monthyear
4837 Returns a two-element list consisting of the month and year of this customer's
4838 paydate (credit card expiration date for CARD customers)
4842 sub paydate_monthyear {
4844 if ( $self->paydate =~ /^(\d{4})-(\d{1,2})-\d{1,2}$/ ) { #Pg date format
4846 } elsif ( $self->paydate =~ /^(\d{1,2})-(\d{1,2}-)?(\d{4}$)/ ) {
4853 =item invoicing_list [ ARRAYREF ]
4855 If an arguement is given, sets these email addresses as invoice recipients
4856 (see L<FS::cust_main_invoice>). Errors are not fatal and are not reported
4857 (except as warnings), so use check_invoicing_list first.
4859 Returns a list of email addresses (with svcnum entries expanded).
4861 Note: You can clear the invoicing list by passing an empty ARRAYREF. You can
4862 check it without disturbing anything by passing nothing.
4864 This interface may change in the future.
4868 sub invoicing_list {
4869 my( $self, $arrayref ) = @_;
4872 my @cust_main_invoice;
4873 if ( $self->custnum ) {
4874 @cust_main_invoice =
4875 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
4877 @cust_main_invoice = ();
4879 foreach my $cust_main_invoice ( @cust_main_invoice ) {
4880 #warn $cust_main_invoice->destnum;
4881 unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
4882 #warn $cust_main_invoice->destnum;
4883 my $error = $cust_main_invoice->delete;
4884 warn $error if $error;
4887 if ( $self->custnum ) {
4888 @cust_main_invoice =
4889 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
4891 @cust_main_invoice = ();
4893 my %seen = map { $_->address => 1 } @cust_main_invoice;
4894 foreach my $address ( @{$arrayref} ) {
4895 next if exists $seen{$address} && $seen{$address};
4896 $seen{$address} = 1;
4897 my $cust_main_invoice = new FS::cust_main_invoice ( {
4898 'custnum' => $self->custnum,
4901 my $error = $cust_main_invoice->insert;
4902 warn $error if $error;
4906 if ( $self->custnum ) {
4908 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
4915 =item check_invoicing_list ARRAYREF
4917 Checks these arguements as valid input for the invoicing_list method. If there
4918 is an error, returns the error, otherwise returns false.
4922 sub check_invoicing_list {
4923 my( $self, $arrayref ) = @_;
4925 foreach my $address ( @$arrayref ) {
4927 if ($address eq 'FAX' and $self->getfield('fax') eq '') {
4928 return 'Can\'t add FAX invoice destination with a blank FAX number.';
4931 my $cust_main_invoice = new FS::cust_main_invoice ( {
4932 'custnum' => $self->custnum,
4935 my $error = $self->custnum
4936 ? $cust_main_invoice->check
4937 : $cust_main_invoice->checkdest
4939 return $error if $error;
4943 return "Email address required"
4944 if $conf->exists('cust_main-require_invoicing_list_email')
4945 && ! grep { $_ !~ /^([A-Z]+)$/ } @$arrayref;
4950 =item set_default_invoicing_list
4952 Sets the invoicing list to all accounts associated with this customer,
4953 overwriting any previous invoicing list.
4957 sub set_default_invoicing_list {
4959 $self->invoicing_list($self->all_emails);
4964 Returns the email addresses of all accounts provisioned for this customer.
4971 foreach my $cust_pkg ( $self->all_pkgs ) {
4972 my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
4974 map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
4975 grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
4977 $list{$_}=1 foreach map { $_->email } @svc_acct;
4982 =item invoicing_list_addpost
4984 Adds postal invoicing to this customer. If this customer is already configured
4985 to receive postal invoices, does nothing.
4989 sub invoicing_list_addpost {
4991 return if grep { $_ eq 'POST' } $self->invoicing_list;
4992 my @invoicing_list = $self->invoicing_list;
4993 push @invoicing_list, 'POST';
4994 $self->invoicing_list(\@invoicing_list);
4997 =item invoicing_list_emailonly
4999 Returns the list of email invoice recipients (invoicing_list without non-email
5000 destinations such as POST and FAX).
5004 sub invoicing_list_emailonly {
5006 warn "$me invoicing_list_emailonly called"
5008 grep { $_ !~ /^([A-Z]+)$/ } $self->invoicing_list;
5011 =item invoicing_list_emailonly_scalar
5013 Returns the list of email invoice recipients (invoicing_list without non-email
5014 destinations such as POST and FAX) as a comma-separated scalar.
5018 sub invoicing_list_emailonly_scalar {
5020 warn "$me invoicing_list_emailonly_scalar called"
5022 join(', ', $self->invoicing_list_emailonly);
5025 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
5027 Returns an array of customers referred by this customer (referral_custnum set
5028 to this custnum). If DEPTH is given, recurses up to the given depth, returning
5029 customers referred by customers referred by this customer and so on, inclusive.
5030 The default behavior is DEPTH 1 (no recursion).
5034 sub referral_cust_main {
5036 my $depth = @_ ? shift : 1;
5037 my $exclude = @_ ? shift : {};
5040 map { $exclude->{$_->custnum}++; $_; }
5041 grep { ! $exclude->{ $_->custnum } }
5042 qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
5046 map { $_->referral_cust_main($depth-1, $exclude) }
5053 =item referral_cust_main_ncancelled
5055 Same as referral_cust_main, except only returns customers with uncancelled
5060 sub referral_cust_main_ncancelled {
5062 grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
5065 =item referral_cust_pkg [ DEPTH ]
5067 Like referral_cust_main, except returns a flat list of all unsuspended (and
5068 uncancelled) packages for each customer. The number of items in this list may
5069 be useful for comission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
5073 sub referral_cust_pkg {
5075 my $depth = @_ ? shift : 1;
5077 map { $_->unsuspended_pkgs }
5078 grep { $_->unsuspended_pkgs }
5079 $self->referral_cust_main($depth);
5082 =item referring_cust_main
5084 Returns the single cust_main record for the customer who referred this customer
5085 (referral_custnum), or false.
5089 sub referring_cust_main {
5091 return '' unless $self->referral_custnum;
5092 qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
5095 =item credit AMOUNT, REASON [ , OPTION => VALUE ... ]
5097 Applies a credit to this customer. If there is an error, returns the error,
5098 otherwise returns false.
5100 REASON can be a text string, an FS::reason object, or a scalar reference to
5101 a reasonnum. If a text string, it will be automatically inserted as a new
5102 reason, and a 'reason_type' option must be passed to indicate the
5103 FS::reason_type for the new reason.
5105 An I<addlinfo> option may be passed to set the credit's I<addlinfo> field.
5107 Any other options are passed to FS::cust_credit::insert.
5112 my( $self, $amount, $reason, %options ) = @_;
5114 my $cust_credit = new FS::cust_credit {
5115 'custnum' => $self->custnum,
5116 'amount' => $amount,
5119 if ( ref($reason) ) {
5121 if ( ref($reason) eq 'SCALAR' ) {
5122 $cust_credit->reasonnum( $$reason );
5124 $cust_credit->reasonnum( $reason->reasonnum );
5128 $cust_credit->set('reason', $reason)
5131 $cust_credit->addlinfo( delete $options{'addlinfo'} )
5132 if exists($options{'addlinfo'});
5134 $cust_credit->insert(%options);
5138 =item charge AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
5140 Creates a one-time charge for this customer. If there is an error, returns
5141 the error, otherwise returns false.
5147 my ( $amount, $quantity, $pkg, $comment, $taxclass, $additional, $classnum );
5148 my ( $taxproduct, $override );
5149 if ( ref( $_[0] ) ) {
5150 $amount = $_[0]->{amount};
5151 $quantity = exists($_[0]->{quantity}) ? $_[0]->{quantity} : 1;
5152 $pkg = exists($_[0]->{pkg}) ? $_[0]->{pkg} : 'One-time charge';
5153 $comment = exists($_[0]->{comment}) ? $_[0]->{comment}
5154 : '$'. sprintf("%.2f",$amount);
5155 $taxclass = exists($_[0]->{taxclass}) ? $_[0]->{taxclass} : '';
5156 $classnum = exists($_[0]->{classnum}) ? $_[0]->{classnum} : '';
5157 $additional = $_[0]->{additional};
5158 $taxproduct = $_[0]->{taxproductnum};
5159 $override = { '' => $_[0]->{tax_override} };
5163 $pkg = @_ ? shift : 'One-time charge';
5164 $comment = @_ ? shift : '$'. sprintf("%.2f",$amount);
5165 $taxclass = @_ ? shift : '';
5169 local $SIG{HUP} = 'IGNORE';
5170 local $SIG{INT} = 'IGNORE';
5171 local $SIG{QUIT} = 'IGNORE';
5172 local $SIG{TERM} = 'IGNORE';
5173 local $SIG{TSTP} = 'IGNORE';
5174 local $SIG{PIPE} = 'IGNORE';
5176 my $oldAutoCommit = $FS::UID::AutoCommit;
5177 local $FS::UID::AutoCommit = 0;
5180 my $part_pkg = new FS::part_pkg ( {
5182 'comment' => $comment,
5186 'classnum' => $classnum ? $classnum : '',
5187 'taxclass' => $taxclass,
5188 'taxproductnum' => $taxproduct,
5191 my %options = ( ( map { ("additional_info$_" => $additional->[$_] ) }
5192 ( 0 .. @$additional - 1 )
5194 'additional_count' => scalar(@$additional),
5195 'setup_fee' => $amount,
5198 my $error = $part_pkg->insert( options => \%options,
5199 tax_overrides => $override,
5202 $dbh->rollback if $oldAutoCommit;
5206 my $pkgpart = $part_pkg->pkgpart;
5207 my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
5208 unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
5209 my $type_pkgs = new FS::type_pkgs \%type_pkgs;
5210 $error = $type_pkgs->insert;
5212 $dbh->rollback if $oldAutoCommit;
5217 my $cust_pkg = new FS::cust_pkg ( {
5218 'custnum' => $self->custnum,
5219 'pkgpart' => $pkgpart,
5220 'quantity' => $quantity,
5223 $error = $cust_pkg->insert;
5225 $dbh->rollback if $oldAutoCommit;
5229 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
5234 #=item charge_postal_fee
5236 #Applies a one time charge this customer. If there is an error,
5237 #returns the error, returns the cust_pkg charge object or false
5238 #if there was no charge.
5242 # This should be a customer event. For that to work requires that bill
5243 # also be a customer event.
5245 sub charge_postal_fee {
5248 my $pkgpart = $conf->config('postal_invoice-fee_pkgpart');
5249 return '' unless ($pkgpart && grep { $_ eq 'POST' } $self->invoicing_list);
5251 my $cust_pkg = new FS::cust_pkg ( {
5252 'custnum' => $self->custnum,
5253 'pkgpart' => $pkgpart,
5257 my $error = $cust_pkg->insert;
5258 $error ? $error : $cust_pkg;
5263 Returns all the invoices (see L<FS::cust_bill>) for this customer.
5269 sort { $a->_date <=> $b->_date }
5270 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
5273 =item open_cust_bill
5275 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
5280 sub open_cust_bill {
5282 grep { $_->owed > 0 } $self->cust_bill;
5287 Returns all the credits (see L<FS::cust_credit>) for this customer.
5293 sort { $a->_date <=> $b->_date }
5294 qsearch( 'cust_credit', { 'custnum' => $self->custnum } )
5299 Returns all the payments (see L<FS::cust_pay>) for this customer.
5305 sort { $a->_date <=> $b->_date }
5306 qsearch( 'cust_pay', { 'custnum' => $self->custnum } )
5311 Returns all voided payments (see L<FS::cust_pay_void>) for this customer.
5317 sort { $a->_date <=> $b->_date }
5318 qsearch( 'cust_pay_void', { 'custnum' => $self->custnum } )
5321 =item cust_pay_batch
5323 Returns all batched payments (see L<FS::cust_pay_void>) for this customer.
5327 sub cust_pay_batch {
5329 sort { $a->_date <=> $b->_date }
5330 qsearch( 'cust_pay_batch', { 'custnum' => $self->custnum } )
5335 Returns all the refunds (see L<FS::cust_refund>) for this customer.
5341 sort { $a->_date <=> $b->_date }
5342 qsearch( 'cust_refund', { 'custnum' => $self->custnum } )
5345 =item display_custnum
5347 Returns the displayed customer number for this customer: agent_custid if
5348 cust_main-default_agent_custid is set and it has a value, custnum otherwise.
5352 sub display_custnum {
5354 if ( $conf->exists('cust_main-default_agent_custid') && $self->agent_custid ){
5355 return $self->agent_custid;
5357 return $self->custnum;
5363 Returns a name string for this customer, either "Company (Last, First)" or
5370 my $name = $self->contact;
5371 $name = $self->company. " ($name)" if $self->company;
5377 Returns a name string for this (service/shipping) contact, either
5378 "Company (Last, First)" or "Last, First".
5384 if ( $self->get('ship_last') ) {
5385 my $name = $self->ship_contact;
5386 $name = $self->ship_company. " ($name)" if $self->ship_company;
5395 Returns a name string for this customer, either "Company" or "First Last".
5401 $self->company !~ /^\s*$/ ? $self->company : $self->contact_firstlast;
5404 =item ship_name_short
5406 Returns a name string for this (service/shipping) contact, either "Company"
5411 sub ship_name_short {
5413 if ( $self->get('ship_last') ) {
5414 $self->ship_company !~ /^\s*$/
5415 ? $self->ship_company
5416 : $self->ship_contact_firstlast;
5418 $self->name_company_or_firstlast;
5424 Returns this customer's full (billing) contact name only, "Last, First"
5430 $self->get('last'). ', '. $self->first;
5435 Returns this customer's full (shipping) contact name only, "Last, First"
5441 $self->get('ship_last')
5442 ? $self->get('ship_last'). ', '. $self->ship_first
5446 =item contact_firstlast
5448 Returns this customers full (billing) contact name only, "First Last".
5452 sub contact_firstlast {
5454 $self->first. ' '. $self->get('last');
5457 =item ship_contact_firstlast
5459 Returns this customer's full (shipping) contact name only, "First Last".
5463 sub ship_contact_firstlast {
5465 $self->get('ship_last')
5466 ? $self->first. ' '. $self->get('ship_last')
5467 : $self->contact_firstlast;
5472 Returns this customer's full country name
5478 code2country($self->country);
5481 =item geocode DATA_VENDOR
5483 Returns a value for the customer location as encoded by DATA_VENDOR.
5484 Currently this only makes sense for "CCH" as DATA_VENDOR.
5489 my ($self, $data_vendor) = (shift, shift); #always cch for now
5491 my $geocode = $self->get('geocode'); #XXX only one data_vendor for geocode
5492 return $geocode if $geocode;
5494 my $prefix = ( $conf->exists('tax-ship_address') && length($self->ship_last) )
5498 my ($zip,$plus4) = split /-/, $self->get("${prefix}zip")
5499 if $self->country eq 'US';
5501 #CCH specific location stuff
5502 my $extra_sql = "AND plus4lo <= '$plus4' AND plus4hi >= '$plus4'";
5504 my @cust_tax_location =
5506 'table' => 'cust_tax_location',
5507 'hashref' => { 'zip' => $zip, 'data_vendor' => $data_vendor },
5508 'extra_sql' => $extra_sql,
5509 'order_by' => 'ORDER BY plus4hi',#overlapping with distinct ends
5512 $geocode = $cust_tax_location[0]->geocode
5513 if scalar(@cust_tax_location);
5522 Returns a status string for this customer, currently:
5526 =item prospect - No packages have ever been ordered
5528 =item active - One or more recurring packages is active
5530 =item inactive - No active recurring packages, but otherwise unsuspended/uncancelled (the inactive status is new - previously inactive customers were mis-identified as cancelled)
5532 =item suspended - All non-cancelled recurring packages are suspended
5534 =item cancelled - All recurring packages are cancelled
5540 sub status { shift->cust_status(@_); }
5544 for my $status (qw( prospect active inactive suspended cancelled )) {
5545 my $method = $status.'_sql';
5546 my $numnum = ( my $sql = $self->$method() ) =~ s/cust_main\.custnum/?/g;
5547 my $sth = dbh->prepare("SELECT $sql") or die dbh->errstr;
5548 $sth->execute( ($self->custnum) x $numnum )
5549 or die "Error executing 'SELECT $sql': ". $sth->errstr;
5550 return $status if $sth->fetchrow_arrayref->[0];
5554 =item ucfirst_cust_status
5556 =item ucfirst_status
5558 Returns the status with the first character capitalized.
5562 sub ucfirst_status { shift->ucfirst_cust_status(@_); }
5564 sub ucfirst_cust_status {
5566 ucfirst($self->cust_status);
5571 Returns a hex triplet color string for this customer's status.
5575 use vars qw(%statuscolor);
5576 tie %statuscolor, 'Tie::IxHash',
5577 'prospect' => '7e0079', #'000000', #black? naw, purple
5578 'active' => '00CC00', #green
5579 'inactive' => '0000CC', #blue
5580 'suspended' => 'FF9900', #yellow
5581 'cancelled' => 'FF0000', #red
5584 sub statuscolor { shift->cust_statuscolor(@_); }
5586 sub cust_statuscolor {
5588 $statuscolor{$self->cust_status};
5593 Returns an array of hashes representing the customer's RT tickets.
5600 my $num = $conf->config('cust_main-max_tickets') || 10;
5603 if ( $conf->config('ticket_system') ) {
5604 unless ( $conf->config('ticket_system-custom_priority_field') ) {
5606 @tickets = @{ FS::TicketSystem->customer_tickets($self->custnum, $num) };
5610 foreach my $priority (
5611 $conf->config('ticket_system-custom_priority_field-values'), ''
5613 last if scalar(@tickets) >= $num;
5615 @{ FS::TicketSystem->customer_tickets( $self->custnum,
5616 $num - scalar(@tickets),
5626 # Return services representing svc_accts in customer support packages
5627 sub support_services {
5629 my %packages = map { $_ => 1 } $conf->config('support_packages');
5631 grep { $_->pkg_svc && $_->pkg_svc->primary_svc eq 'Y' }
5632 grep { $_->part_svc->svcdb eq 'svc_acct' }
5633 map { $_->cust_svc }
5634 grep { exists $packages{ $_->pkgpart } }
5635 $self->ncancelled_pkgs;
5641 =head1 CLASS METHODS
5647 Class method that returns the list of possible status strings for customers
5648 (see L<the status method|/status>). For example:
5650 @statuses = FS::cust_main->statuses();
5655 #my $self = shift; #could be class...
5661 Returns an SQL expression identifying prospective cust_main records (customers
5662 with no packages ever ordered)
5666 use vars qw($select_count_pkgs);
5667 $select_count_pkgs =
5668 "SELECT COUNT(*) FROM cust_pkg
5669 WHERE cust_pkg.custnum = cust_main.custnum";
5671 sub select_count_pkgs_sql {
5675 sub prospect_sql { "
5676 0 = ( $select_count_pkgs )
5681 Returns an SQL expression identifying active cust_main records (customers with
5682 active recurring packages).
5687 0 < ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. "
5693 Returns an SQL expression identifying inactive cust_main records (customers with
5694 no active recurring packages, but otherwise unsuspended/uncancelled).
5698 sub inactive_sql { "
5699 0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " )
5701 0 < ( $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " )
5707 Returns an SQL expression identifying suspended cust_main records.
5712 sub suspended_sql { susp_sql(@_); }
5714 0 < ( $select_count_pkgs AND ". FS::cust_pkg->suspended_sql. " )
5716 0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " )
5722 Returns an SQL expression identifying cancelled cust_main records.
5726 sub cancelled_sql { cancel_sql(@_); }
5729 my $recurring_sql = FS::cust_pkg->recurring_sql;
5730 my $cancelled_sql = FS::cust_pkg->cancelled_sql;
5733 0 < ( $select_count_pkgs )
5734 AND 0 < ( $select_count_pkgs AND $recurring_sql AND $cancelled_sql )
5735 AND 0 = ( $select_count_pkgs AND $recurring_sql
5736 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
5738 AND 0 = ( $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " )
5744 =item uncancelled_sql
5746 Returns an SQL expression identifying un-cancelled cust_main records.
5750 sub uncancelled_sql { uncancel_sql(@_); }
5751 sub uncancel_sql { "
5752 ( 0 < ( $select_count_pkgs
5753 AND ( cust_pkg.cancel IS NULL
5754 OR cust_pkg.cancel = 0
5757 OR 0 = ( $select_count_pkgs )
5763 Returns an SQL fragment to retreive the balance.
5768 ( SELECT COALESCE( SUM(charged), 0 ) FROM cust_bill
5769 WHERE cust_bill.custnum = cust_main.custnum )
5770 - ( SELECT COALESCE( SUM(paid), 0 ) FROM cust_pay
5771 WHERE cust_pay.custnum = cust_main.custnum )
5772 - ( SELECT COALESCE( SUM(amount), 0 ) FROM cust_credit
5773 WHERE cust_credit.custnum = cust_main.custnum )
5774 + ( SELECT COALESCE( SUM(refund), 0 ) FROM cust_refund
5775 WHERE cust_refund.custnum = cust_main.custnum )
5778 =item balance_date_sql START_TIME [ END_TIME [ OPTION => VALUE ... ] ]
5780 Returns an SQL fragment to retreive the balance for this customer, only
5781 considering invoices with date earlier than START_TIME, and optionally not
5782 later than END_TIME (total_owed_date minus total_unapplied_credits minus
5783 total_unapplied_payments).
5785 Times are specified as SQL fragments or numeric
5786 UNIX timestamps; see L<perlfunc/"time">). Also see L<Time::Local> and
5787 L<Date::Parse> for conversion functions. The empty string can be passed
5788 to disable that time constraint completely.
5790 Available options are:
5794 =item unapplied_date
5796 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)
5801 set to true to remove all customer comparison clauses, for totals
5806 WHERE clause hashref (elements "AND"ed together) (typically used with the total option)
5811 JOIN clause (typically used with the total option)
5817 sub balance_date_sql {
5818 my( $class, $start, $end, %opt ) = @_;
5820 my $owed = FS::cust_bill->owed_sql;
5821 my $unapp_refund = FS::cust_refund->unapplied_sql;
5822 my $unapp_credit = FS::cust_credit->unapplied_sql;
5823 my $unapp_pay = FS::cust_pay->unapplied_sql;
5825 my $j = $opt{'join'} || '';
5827 my $owed_wh = $class->_money_table_where( 'cust_bill', $start,$end,%opt );
5828 my $refund_wh = $class->_money_table_where( 'cust_refund', $start,$end,%opt );
5829 my $credit_wh = $class->_money_table_where( 'cust_credit', $start,$end,%opt );
5830 my $pay_wh = $class->_money_table_where( 'cust_pay', $start,$end,%opt );
5832 " ( SELECT COALESCE(SUM($owed), 0) FROM cust_bill $j $owed_wh )
5833 + ( SELECT COALESCE(SUM($unapp_refund), 0) FROM cust_refund $j $refund_wh )
5834 - ( SELECT COALESCE(SUM($unapp_credit), 0) FROM cust_credit $j $credit_wh )
5835 - ( SELECT COALESCE(SUM($unapp_pay), 0) FROM cust_pay $j $pay_wh )
5840 =item _money_table_where TABLE START_TIME [ END_TIME [ OPTION => VALUE ... ] ]
5842 Helper method for balance_date_sql; name (and usage) subject to change
5843 (suggestions welcome).
5845 Returns a WHERE clause for the specified monetary TABLE (cust_bill,
5846 cust_refund, cust_credit or cust_pay).
5848 If TABLE is "cust_bill" or the unapplied_date option is true, only
5849 considers records with date earlier than START_TIME, and optionally not
5850 later than END_TIME .
5854 sub _money_table_where {
5855 my( $class, $table, $start, $end, %opt ) = @_;
5858 push @where, "cust_main.custnum = $table.custnum" unless $opt{'total'};
5859 if ( $table eq 'cust_bill' || $opt{'unapplied_date'} ) {
5860 push @where, "$table._date <= $start" if defined($start) && length($start);
5861 push @where, "$table._date > $end" if defined($end) && length($end);
5863 push @where, @{$opt{'where'}} if $opt{'where'};
5864 my $where = scalar(@where) ? 'WHERE '. join(' AND ', @where ) : '';
5870 =item search_sql HASHREF
5874 Returns a qsearch hash expression to search for parameters specified in HREF.
5875 Valid parameters are
5883 =item cancelled_pkgs
5889 listref of start date, end date
5895 =item current_balance
5897 listref (list returned by FS::UI::Web::parse_lt_gt($cgi, 'current_balance'))
5901 =item flattened_pkgs
5910 my ($class, $params) = @_;
5921 if ( $params->{'agentnum'} =~ /^(\d+)$/ and $1 ) {
5923 "cust_main.agentnum = $1";
5930 #prospect active inactive suspended cancelled
5931 if ( grep { $params->{'status'} eq $_ } FS::cust_main->statuses() ) {
5932 my $method = $params->{'status'}. '_sql';
5933 #push @where, $class->$method();
5934 push @where, FS::cust_main->$method();
5938 # parse cancelled package checkbox
5943 $pkgwhere .= "AND (cancel = 0 or cancel is null)"
5944 unless $params->{'cancelled_pkgs'};
5950 foreach my $field (qw( signupdate )) {
5952 next unless exists($params->{$field});
5954 my($beginning, $ending) = @{$params->{$field}};
5957 "cust_main.$field IS NOT NULL",
5958 "cust_main.$field >= $beginning",
5959 "cust_main.$field <= $ending";
5961 $orderby ||= "ORDER BY cust_main.$field";
5969 my @payby = grep /^([A-Z]{4})$/, @{ $params->{'payby'} };
5971 push @where, '( '. join(' OR ', map "cust_main.payby = '$_'", @payby). ' )';
5978 #my $balance_sql = $class->balance_sql();
5979 my $balance_sql = FS::cust_main->balance_sql();
5981 push @where, map { s/current_balance/$balance_sql/; $_ }
5982 @{ $params->{'current_balance'} };
5988 if ( $params->{'custbatch'} =~ /^([\w\/\-\:\.]+)$/ and $1 ) {
5990 "cust_main.custbatch = '$1'";
5994 # setup queries, subs, etc. for the search
5997 $orderby ||= 'ORDER BY custnum';
5999 # here is the agent virtualization
6000 push @where, $FS::CurrentUser::CurrentUser->agentnums_sql;
6002 my $extra_sql = scalar(@where) ? ' WHERE '. join(' AND ', @where) : '';
6004 my $addl_from = 'LEFT JOIN cust_pkg USING ( custnum ) ';
6006 my $count_query = "SELECT COUNT(*) FROM cust_main $extra_sql";
6008 my $select = join(', ',
6009 'cust_main.custnum',
6010 FS::UI::Web::cust_sql_fields($params->{'cust_fields'}),
6013 my(@extra_headers) = ();
6014 my(@extra_fields) = ();
6016 if ($params->{'flattened_pkgs'}) {
6018 if ($dbh->{Driver}->{Name} eq 'Pg') {
6020 $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";
6022 }elsif ($dbh->{Driver}->{Name} =~ /^mysql/i) {
6023 $select .= ", GROUP_CONCAT(pkg SEPARATOR '|') as magic";
6024 $addl_from .= " LEFT JOIN part_pkg using ( pkgpart )";
6026 warn "warning: unknown database type ". $dbh->{Driver}->{Name}.
6027 "omitting packing information from report.";
6030 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";
6032 my $sth = dbh->prepare($header_query) or die dbh->errstr;
6033 $sth->execute() or die $sth->errstr;
6034 my $headerrow = $sth->fetchrow_arrayref;
6035 my $headercount = $headerrow ? $headerrow->[0] : 0;
6036 while($headercount) {
6037 unshift @extra_headers, "Package ". $headercount;
6038 unshift @extra_fields, eval q!sub {my $c = shift;
6039 my @a = split '\|', $c->magic;
6040 my $p = $a[!.--$headercount. q!];
6048 'table' => 'cust_main',
6049 'select' => $select,
6051 'extra_sql' => $extra_sql,
6052 'order_by' => $orderby,
6053 'count_query' => $count_query,
6054 'extra_headers' => \@extra_headers,
6055 'extra_fields' => \@extra_fields,
6060 =item email_search_sql HASHREF
6064 Emails a notice to the specified customers.
6066 Valid parameters are those of the L<search_sql> method, plus the following:
6088 Optional job queue job for status updates.
6092 Returns an error message, or false for success.
6094 If an error occurs during any email, stops the enture send and returns that
6095 error. Presumably if you're getting SMTP errors aborting is better than
6096 retrying everything.
6100 sub email_search_sql {
6101 my($class, $params) = @_;
6103 my $from = delete $params->{from};
6104 my $subject = delete $params->{subject};
6105 my $html_body = delete $params->{html_body};
6106 my $text_body = delete $params->{text_body};
6108 my $job = delete $params->{'job'};
6110 my $sql_query = $class->search_sql($params);
6112 my $count_query = delete($sql_query->{'count_query'});
6113 my $count_sth = dbh->prepare($count_query)
6114 or die "Error preparing $count_query: ". dbh->errstr;
6116 or die "Error executing $count_query: ". $count_sth->errstr;
6117 my $count_arrayref = $count_sth->fetchrow_arrayref;
6118 my $num_cust = $count_arrayref->[0];
6120 #my @extra_headers = @{ delete($sql_query->{'extra_headers'}) };
6121 #my @extra_fields = @{ delete($sql_query->{'extra_fields'}) };
6124 my( $num, $last, $min_sec ) = (0, time, 5); #progresbar foo
6126 #eventually order+limit magic to reduce memory use?
6127 foreach my $cust_main ( qsearch($sql_query) ) {
6129 my $to = $cust_main->invoicing_list_emailonly_scalar;
6132 my $error = send_email(
6136 'subject' => $subject,
6137 'html_body' => $html_body,
6138 'text_body' => $text_body,
6141 return $error if $error;
6143 if ( $job ) { #progressbar foo
6145 if ( time - $min_sec > $last ) {
6146 my $error = $job->update_statustext(
6147 int( 100 * $num / $num_cust )
6149 die $error if $error;
6159 use Storable qw(thaw);
6162 sub process_email_search_sql {
6164 #warn "$me process_re_X $method for job $job\n" if $DEBUG;
6166 my $param = thaw(decode_base64(shift));
6167 warn Dumper($param) if $DEBUG;
6169 $param->{'job'} = $job;
6171 my $error = FS::cust_main->email_search_sql( $param );
6172 die $error if $error;
6176 =item fuzzy_search FUZZY_HASHREF [ HASHREF, SELECT, EXTRA_SQL, CACHE_OBJ ]
6178 Performs a fuzzy (approximate) search and returns the matching FS::cust_main
6179 records. Currently, I<first>, I<last> and/or I<company> may be specified (the
6180 appropriate ship_ field is also searched).
6182 Additional options are the same as FS::Record::qsearch
6187 my( $self, $fuzzy, $hash, @opt) = @_;
6192 check_and_rebuild_fuzzyfiles();
6193 foreach my $field ( keys %$fuzzy ) {
6195 my $all = $self->all_X($field);
6196 next unless scalar(@$all);
6199 $match{$_}=1 foreach ( amatch( $fuzzy->{$field}, ['i'], @$all ) );
6202 foreach ( keys %match ) {
6203 push @fcust, qsearch('cust_main', { %$hash, $field=>$_}, @opt);
6204 push @fcust, qsearch('cust_main', { %$hash, "ship_$field"=>$_}, @opt);
6207 push @cust_main, grep { ! $fsaw{$_->custnum}++ } @fcust;
6210 # we want the components of $fuzzy ANDed, not ORed, but still don't want dupes
6212 @cust_main = grep { ++$saw{$_->custnum} == scalar(keys %$fuzzy) } @cust_main;
6220 Returns a masked version of the named field
6225 my ($self,$field) = @_;
6229 'x'x(length($self->getfield($field))-4).
6230 substr($self->getfield($field), (length($self->getfield($field))-4));
6240 =item smart_search OPTION => VALUE ...
6242 Accepts the following options: I<search>, the string to search for. The string
6243 will be searched for as a customer number, phone number, name or company name,
6244 as an exact, or, in some cases, a substring or fuzzy match (see the source code
6245 for the exact heuristics used); I<no_fuzzy_on_exact>, causes smart_search to
6246 skip fuzzy matching when an exact match is found.
6248 Any additional options are treated as an additional qualifier on the search
6251 Returns a (possibly empty) array of FS::cust_main objects.
6258 #here is the agent virtualization
6259 my $agentnums_sql = $FS::CurrentUser::CurrentUser->agentnums_sql;
6263 my $skip_fuzzy = delete $options{'no_fuzzy_on_exact'};
6264 my $search = delete $options{'search'};
6265 ( my $alphanum_search = $search ) =~ s/\W//g;
6267 if ( $alphanum_search =~ /^1?(\d{3})(\d{3})(\d{4})(\d*)$/ ) { #phone# search
6269 #false laziness w/Record::ut_phone
6270 my $phonen = "$1-$2-$3";
6271 $phonen .= " x$4" if $4;
6273 push @cust_main, qsearch( {
6274 'table' => 'cust_main',
6275 'hashref' => { %options },
6276 'extra_sql' => ( scalar(keys %options) ? ' AND ' : ' WHERE ' ).
6278 join(' OR ', map "$_ = '$phonen'",
6279 qw( daytime night fax
6280 ship_daytime ship_night ship_fax )
6283 " AND $agentnums_sql", #agent virtualization
6286 unless ( @cust_main || $phonen =~ /x\d+$/ ) { #no exact match
6287 #try looking for matches with extensions unless one was specified
6289 push @cust_main, qsearch( {
6290 'table' => 'cust_main',
6291 'hashref' => { %options },
6292 'extra_sql' => ( scalar(keys %options) ? ' AND ' : ' WHERE ' ).
6294 join(' OR ', map "$_ LIKE '$phonen\%'",
6296 ship_daytime ship_night )
6299 " AND $agentnums_sql", #agent virtualization
6304 # custnum search (also try agent_custid), with some tweaking options if your
6305 # legacy cust "numbers" have letters
6308 if ( $search =~ /^\s*(\d+)\s*$/
6309 || ( $conf->config('cust_main-agent_custid-format') eq 'ww?d+'
6310 && $search =~ /^\s*(\w\w?\d+)\s*$/
6317 if ( $num <= 2147483647 ) { #need a bigint custnum? wow.
6318 push @cust_main, qsearch( {
6319 'table' => 'cust_main',
6320 'hashref' => { 'custnum' => $num, %options },
6321 'extra_sql' => " AND $agentnums_sql", #agent virtualization
6325 push @cust_main, qsearch( {
6326 'table' => 'cust_main',
6327 'hashref' => { 'agent_custid' => $num, %options },
6328 'extra_sql' => " AND $agentnums_sql", #agent virtualization
6331 } elsif ( $search =~ /^\s*(\S.*\S)\s+\((.+), ([^,]+)\)\s*$/ ) {
6333 my($company, $last, $first) = ( $1, $2, $3 );
6335 # "Company (Last, First)"
6336 #this is probably something a browser remembered,
6337 #so just do an exact search
6339 foreach my $prefix ( '', 'ship_' ) {
6340 push @cust_main, qsearch( {
6341 'table' => 'cust_main',
6342 'hashref' => { $prefix.'first' => $first,
6343 $prefix.'last' => $last,
6344 $prefix.'company' => $company,
6347 'extra_sql' => " AND $agentnums_sql",
6351 } elsif ( $search =~ /^\s*(\S.*\S)\s*$/ ) { # value search
6352 # try (ship_){last,company}
6356 # # remove "(Last, First)" in "Company (Last, First)", otherwise the
6357 # # full strings the browser remembers won't work
6358 # $value =~ s/\([\w \,\.\-\']*\)$//; #false laziness w/Record::ut_name
6360 use Lingua::EN::NameParse;
6361 my $NameParse = new Lingua::EN::NameParse(
6363 allow_reversed => 1,
6366 my($last, $first) = ( '', '' );
6367 #maybe disable this too and just rely on NameParse?
6368 if ( $value =~ /^(.+),\s*([^,]+)$/ ) { # Last, First
6370 ($last, $first) = ( $1, $2 );
6372 #} elsif ( $value =~ /^(.+)\s+(.+)$/ ) {
6373 } elsif ( ! $NameParse->parse($value) ) {
6375 my %name = $NameParse->components;
6376 $first = $name{'given_name_1'};
6377 $last = $name{'surname_1'};
6381 if ( $first && $last ) {
6383 my($q_last, $q_first) = ( dbh->quote($last), dbh->quote($first) );
6386 my $sql = scalar(keys %options) ? ' AND ' : ' WHERE ';
6388 ( ( LOWER(last) = $q_last AND LOWER(first) = $q_first )
6389 OR ( LOWER(ship_last) = $q_last AND LOWER(ship_first) = $q_first )
6392 push @cust_main, qsearch( {
6393 'table' => 'cust_main',
6394 'hashref' => \%options,
6395 'extra_sql' => "$sql AND $agentnums_sql", #agent virtualization
6398 # or it just be something that was typed in... (try that in a sec)
6402 my $q_value = dbh->quote($value);
6405 my $sql = scalar(keys %options) ? ' AND ' : ' WHERE ';
6406 $sql .= " ( LOWER(last) = $q_value
6407 OR LOWER(company) = $q_value
6408 OR LOWER(ship_last) = $q_value
6409 OR LOWER(ship_company) = $q_value
6412 push @cust_main, qsearch( {
6413 'table' => 'cust_main',
6414 'hashref' => \%options,
6415 'extra_sql' => "$sql AND $agentnums_sql", #agent virtualization
6418 #no exact match, trying substring/fuzzy
6419 #always do substring & fuzzy (unless they're explicity config'ed off)
6420 #getting complaints searches are not returning enough
6421 unless ( @cust_main && $skip_fuzzy || $conf->exists('disable-fuzzy') ) {
6423 #still some false laziness w/search_sql (was search/cust_main.cgi)
6428 { 'company' => { op=>'ILIKE', value=>"%$value%" }, },
6429 { 'ship_company' => { op=>'ILIKE', value=>"%$value%" }, },
6432 if ( $first && $last ) {
6435 { 'first' => { op=>'ILIKE', value=>"%$first%" },
6436 'last' => { op=>'ILIKE', value=>"%$last%" },
6438 { 'ship_first' => { op=>'ILIKE', value=>"%$first%" },
6439 'ship_last' => { op=>'ILIKE', value=>"%$last%" },
6446 { 'last' => { op=>'ILIKE', value=>"%$value%" }, },
6447 { 'ship_last' => { op=>'ILIKE', value=>"%$value%" }, },
6451 foreach my $hashref ( @hashrefs ) {
6453 push @cust_main, qsearch( {
6454 'table' => 'cust_main',
6455 'hashref' => { %$hashref,
6458 'extra_sql' => " AND $agentnums_sql", #agent virtualizaiton
6467 " AND $agentnums_sql", #extra_sql #agent virtualization
6470 if ( $first && $last ) {
6471 push @cust_main, FS::cust_main->fuzzy_search(
6472 { 'last' => $last, #fuzzy hashref
6473 'first' => $first }, #
6477 foreach my $field ( 'last', 'company' ) {
6479 FS::cust_main->fuzzy_search( { $field => $value }, @fuzopts );
6484 #eliminate duplicates
6486 @cust_main = grep { !$saw{$_->custnum}++ } @cust_main;
6496 Accepts the following options: I<email>, the email address to search for. The
6497 email address will be searched for as an email invoice destination and as an
6500 #Any additional options are treated as an additional qualifier on the search
6501 #(i.e. I<agentnum>).
6503 Returns a (possibly empty) array of FS::cust_main objects (but usually just
6513 my $email = delete $options{'email'};
6515 #we're only being used by RT at the moment... no agent virtualization yet
6516 #my $agentnums_sql = $FS::CurrentUser::CurrentUser->agentnums_sql;
6520 if ( $email =~ /([^@]+)\@([^@]+)/ ) {
6522 my ( $user, $domain ) = ( $1, $2 );
6524 warn "$me smart_search: searching for $user in domain $domain"
6530 'table' => 'cust_main_invoice',
6531 'hashref' => { 'dest' => $email },
6538 map $_->cust_svc->cust_pkg,
6540 'table' => 'svc_acct',
6541 'hashref' => { 'username' => $user, },
6543 'AND ( SELECT domain FROM svc_domain
6544 WHERE svc_acct.domsvc = svc_domain.svcnum
6545 ) = '. dbh->quote($domain),
6551 @cust_main = grep { !$saw{$_->custnum}++ } @cust_main;
6553 warn "$me smart_search: found ". scalar(@cust_main). " unique customers"
6560 =item check_and_rebuild_fuzzyfiles
6564 use vars qw(@fuzzyfields);
6565 @fuzzyfields = ( 'last', 'first', 'company' );
6567 sub check_and_rebuild_fuzzyfiles {
6568 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
6569 rebuild_fuzzyfiles() if grep { ! -e "$dir/cust_main.$_" } @fuzzyfields
6572 =item rebuild_fuzzyfiles
6576 sub rebuild_fuzzyfiles {
6578 use Fcntl qw(:flock);
6580 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
6581 mkdir $dir, 0700 unless -d $dir;
6583 foreach my $fuzzy ( @fuzzyfields ) {
6585 open(LOCK,">>$dir/cust_main.$fuzzy")
6586 or die "can't open $dir/cust_main.$fuzzy: $!";
6588 or die "can't lock $dir/cust_main.$fuzzy: $!";
6590 open (CACHE,">$dir/cust_main.$fuzzy.tmp")
6591 or die "can't open $dir/cust_main.$fuzzy.tmp: $!";
6593 foreach my $field ( $fuzzy, "ship_$fuzzy" ) {
6594 my $sth = dbh->prepare("SELECT $field FROM cust_main".
6595 " WHERE $field != '' AND $field IS NOT NULL");
6596 $sth->execute or die $sth->errstr;
6598 while ( my $row = $sth->fetchrow_arrayref ) {
6599 print CACHE $row->[0]. "\n";
6604 close CACHE or die "can't close $dir/cust_main.$fuzzy.tmp: $!";
6606 rename "$dir/cust_main.$fuzzy.tmp", "$dir/cust_main.$fuzzy";
6617 my( $self, $field ) = @_;
6618 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
6619 open(CACHE,"<$dir/cust_main.$field")
6620 or die "can't open $dir/cust_main.$field: $!";
6621 my @array = map { chomp; $_; } <CACHE>;
6626 =item append_fuzzyfiles LASTNAME COMPANY
6630 sub append_fuzzyfiles {
6631 #my( $first, $last, $company ) = @_;
6633 &check_and_rebuild_fuzzyfiles;
6635 use Fcntl qw(:flock);
6637 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
6639 foreach my $field (qw( first last company )) {
6644 open(CACHE,">>$dir/cust_main.$field")
6645 or die "can't open $dir/cust_main.$field: $!";
6646 flock(CACHE,LOCK_EX)
6647 or die "can't lock $dir/cust_main.$field: $!";
6649 print CACHE "$value\n";
6651 flock(CACHE,LOCK_UN)
6652 or die "can't unlock $dir/cust_main.$field: $!";
6667 #warn join('-',keys %$param);
6668 my $fh = $param->{filehandle};
6669 my @fields = @{$param->{fields}};
6671 eval "use Text::CSV_XS;";
6674 my $csv = new Text::CSV_XS;
6681 local $SIG{HUP} = 'IGNORE';
6682 local $SIG{INT} = 'IGNORE';
6683 local $SIG{QUIT} = 'IGNORE';
6684 local $SIG{TERM} = 'IGNORE';
6685 local $SIG{TSTP} = 'IGNORE';
6686 local $SIG{PIPE} = 'IGNORE';
6688 my $oldAutoCommit = $FS::UID::AutoCommit;
6689 local $FS::UID::AutoCommit = 0;
6692 #while ( $columns = $csv->getline($fh) ) {
6694 while ( defined($line=<$fh>) ) {
6696 $csv->parse($line) or do {
6697 $dbh->rollback if $oldAutoCommit;
6698 return "can't parse: ". $csv->error_input();
6701 my @columns = $csv->fields();
6702 #warn join('-',@columns);
6705 foreach my $field ( @fields ) {
6706 $row{$field} = shift @columns;
6709 my $cust_main = qsearchs('cust_main', { 'custnum' => $row{'custnum'} } );
6710 unless ( $cust_main ) {
6711 $dbh->rollback if $oldAutoCommit;
6712 return "unknown custnum $row{'custnum'}";
6715 if ( $row{'amount'} > 0 ) {
6716 my $error = $cust_main->charge($row{'amount'}, $row{'pkg'});
6718 $dbh->rollback if $oldAutoCommit;
6722 } elsif ( $row{'amount'} < 0 ) {
6723 my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ),
6726 $dbh->rollback if $oldAutoCommit;
6736 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
6738 return "Empty file!" unless $imported;
6744 =item notify CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
6746 Sends a templated email notification to the customer (see L<Text::Template>).
6748 OPTIONS is a hash and may include
6750 I<from> - the email sender (default is invoice_from)
6752 I<to> - comma-separated scalar or arrayref of recipients
6753 (default is invoicing_list)
6755 I<subject> - The subject line of the sent email notification
6756 (default is "Notice from company_name")
6758 I<extra_fields> - a hashref of name/value pairs which will be substituted
6761 The following variables are vavailable in the template.
6763 I<$first> - the customer first name
6764 I<$last> - the customer last name
6765 I<$company> - the customer company
6766 I<$payby> - a description of the method of payment for the customer
6767 # would be nice to use FS::payby::shortname
6768 I<$payinfo> - the account information used to collect for this customer
6769 I<$expdate> - the expiration of the customer payment in seconds from epoch
6774 my ($self, $template, %options) = @_;
6776 return unless $conf->exists($template);
6778 my $from = $conf->config('invoice_from', $self->agentnum)
6779 if $conf->exists('invoice_from', $self->agentnum);
6780 $from = $options{from} if exists($options{from});
6782 my $to = join(',', $self->invoicing_list_emailonly);
6783 $to = $options{to} if exists($options{to});
6785 my $subject = "Notice from " . $conf->config('company_name', $self->agentnum)
6786 if $conf->exists('company_name', $self->agentnum);
6787 $subject = $options{subject} if exists($options{subject});
6789 my $notify_template = new Text::Template (TYPE => 'ARRAY',
6790 SOURCE => [ map "$_\n",
6791 $conf->config($template)]
6793 or die "can't create new Text::Template object: Text::Template::ERROR";
6794 $notify_template->compile()
6795 or die "can't compile template: Text::Template::ERROR";
6797 $FS::notify_template::_template::company_name =
6798 $conf->config('company_name', $self->agentnum);
6799 $FS::notify_template::_template::company_address =
6800 join("\n", $conf->config('company_address', $self->agentnum) ). "\n";
6802 my $paydate = $self->paydate || '2037-12-31';
6803 $FS::notify_template::_template::first = $self->first;
6804 $FS::notify_template::_template::last = $self->last;
6805 $FS::notify_template::_template::company = $self->company;
6806 $FS::notify_template::_template::payinfo = $self->mask_payinfo;
6807 my $payby = $self->payby;
6808 my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
6809 my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
6811 #credit cards expire at the end of the month/year of their exp date
6812 if ($payby eq 'CARD' || $payby eq 'DCRD') {
6813 $FS::notify_template::_template::payby = 'credit card';
6814 ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
6815 $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
6817 }elsif ($payby eq 'COMP') {
6818 $FS::notify_template::_template::payby = 'complimentary account';
6820 $FS::notify_template::_template::payby = 'current method';
6822 $FS::notify_template::_template::expdate = $expire_time;
6824 for (keys %{$options{extra_fields}}){
6826 ${"FS::notify_template::_template::$_"} = $options{extra_fields}->{$_};
6829 send_email(from => $from,
6831 subject => $subject,
6832 body => $notify_template->fill_in( PACKAGE =>
6833 'FS::notify_template::_template' ),
6838 =item generate_letter CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
6840 Generates a templated notification to the customer (see L<Text::Template>).
6842 OPTIONS is a hash and may include
6844 I<extra_fields> - a hashref of name/value pairs which will be substituted
6845 into the template. These values may override values mentioned below
6846 and those from the customer record.
6848 The following variables are available in the template instead of or in addition
6849 to the fields of the customer record.
6851 I<$payby> - a description of the method of payment for the customer
6852 # would be nice to use FS::payby::shortname
6853 I<$payinfo> - the masked account information used to collect for this customer
6854 I<$expdate> - the expiration of the customer payment method in seconds from epoch
6855 I<$returnaddress> - the return address defaults to invoice_latexreturnaddress or company_address
6859 sub generate_letter {
6860 my ($self, $template, %options) = @_;
6862 return unless $conf->exists($template);
6864 my $letter_template = new Text::Template
6866 SOURCE => [ map "$_\n", $conf->config($template)],
6867 DELIMITERS => [ '[@--', '--@]' ],
6869 or die "can't create new Text::Template object: Text::Template::ERROR";
6871 $letter_template->compile()
6872 or die "can't compile template: Text::Template::ERROR";
6874 my %letter_data = map { $_ => $self->$_ } $self->fields;
6875 $letter_data{payinfo} = $self->mask_payinfo;
6877 #my $paydate = $self->paydate || '2037-12-31';
6878 my $paydate = $self->paydate =~ /^\S+$/ ? $self->paydate : '2037-12-31';
6880 my $payby = $self->payby;
6881 my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
6882 my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
6884 #credit cards expire at the end of the month/year of their exp date
6885 if ($payby eq 'CARD' || $payby eq 'DCRD') {
6886 $letter_data{payby} = 'credit card';
6887 ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
6888 $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
6890 }elsif ($payby eq 'COMP') {
6891 $letter_data{payby} = 'complimentary account';
6893 $letter_data{payby} = 'current method';
6895 $letter_data{expdate} = $expire_time;
6897 for (keys %{$options{extra_fields}}){
6898 $letter_data{$_} = $options{extra_fields}->{$_};
6901 unless(exists($letter_data{returnaddress})){
6902 my $retadd = join("\n", $conf->config_orbase( 'invoice_latexreturnaddress',
6903 $self->agent_template)
6905 if ( length($retadd) ) {
6906 $letter_data{returnaddress} = $retadd;
6907 } elsif ( grep /\S/, $conf->config('company_address', $self->agentnum) ) {
6908 $letter_data{returnaddress} =
6909 join( '\\*'."\n", map s/( {2,})/'~' x length($1)/eg,
6910 $conf->config('company_address', $self->agentnum)
6913 $letter_data{returnaddress} = '~';
6917 $letter_data{conf_dir} = "$FS::UID::conf_dir/conf.$FS::UID::datasrc";
6919 $letter_data{company_name} = $conf->config('company_name', $self->agentnum);
6921 my $dir = $FS::UID::conf_dir."/cache.". $FS::UID::datasrc;
6922 my $fh = new File::Temp( TEMPLATE => 'letter.'. $self->custnum. '.XXXXXXXX',
6926 ) or die "can't open temp file: $!\n";
6928 $letter_template->fill_in( OUTPUT => $fh, HASH => \%letter_data );
6930 $fh->filename =~ /^(.*).tex$/ or die "unparsable filename: ". $fh->filename;
6934 =item print_ps TEMPLATE
6936 Returns an postscript letter filled in from TEMPLATE, as a scalar.
6942 my $file = $self->generate_letter(@_);
6943 FS::Misc::generate_ps($file);
6946 =item print TEMPLATE
6948 Prints the filled in template.
6950 TEMPLATE is the name of a L<Text::Template> to fill in and print.
6954 sub queueable_print {
6957 my $self = qsearchs('cust_main', { 'custnum' => $opt{custnum} } )
6958 or die "invalid customer number: " . $opt{custvnum};
6960 my $error = $self->print( $opt{template} );
6961 die $error if $error;
6965 my ($self, $template) = (shift, shift);
6966 do_print [ $self->print_ps($template) ];
6969 #these three subs should just go away once agent stuff is all config overrides
6971 sub agent_template {
6973 $self->_agent_plandata('agent_templatename');
6976 sub agent_invoice_from {
6978 $self->_agent_plandata('agent_invoice_from');
6981 sub _agent_plandata {
6982 my( $self, $option ) = @_;
6984 #yuck. this whole thing needs to be reconciled better with 1.9's idea of
6985 #agent-specific Conf
6987 use FS::part_event::Condition;
6989 my $agentnum = $self->agentnum;
6992 if ( driver_name =~ /^Pg/i ) {
6994 } elsif ( driver_name =~ /^mysql/i ) {
6997 die "don't know how to use regular expressions in ". driver_name. " databases";
7000 my $part_event_option =
7002 'select' => 'part_event_option.*',
7003 'table' => 'part_event_option',
7005 LEFT JOIN part_event USING ( eventpart )
7006 LEFT JOIN part_event_option AS peo_agentnum
7007 ON ( part_event.eventpart = peo_agentnum.eventpart
7008 AND peo_agentnum.optionname = 'agentnum'
7009 AND peo_agentnum.optionvalue }. $regexp. q{ '(^|,)}. $agentnum. q{(,|$)'
7011 LEFT JOIN part_event_option AS peo_cust_bill_age
7012 ON ( part_event.eventpart = peo_cust_bill_age.eventpart
7013 AND peo_cust_bill_age.optionname = 'cust_bill_age'
7016 #'hashref' => { 'optionname' => $option },
7017 #'hashref' => { 'part_event_option.optionname' => $option },
7019 " WHERE part_event_option.optionname = ". dbh->quote($option).
7020 " AND action = 'cust_bill_send_agent' ".
7021 " AND ( disabled IS NULL OR disabled != 'Y' ) ".
7022 " AND peo_agentnum.optionname = 'agentnum' ".
7023 " AND ( agentnum IS NULL OR agentnum = $agentnum ) ".
7025 CASE WHEN peo_cust_bill_age.optionname != 'cust_bill_age'
7027 ELSE ". FS::part_event::Condition->age2seconds_sql('peo_cust_bill_age.optionvalue').
7029 , part_event.weight".
7033 unless ( $part_event_option ) {
7034 return $self->agent->invoice_template || ''
7035 if $option eq 'agent_templatename';
7039 $part_event_option->optionvalue;
7044 ## actual sub, not a method, designed to be called from the queue.
7045 ## sets up the customer, and calls the bill_and_collect
7046 my (%args) = @_; #, ($time, $invoice_time, $check_freq, $resetup) = @_;
7047 my $cust_main = qsearchs( 'cust_main', { custnum => $args{'custnum'} } );
7048 $cust_main->bill_and_collect(
7059 The delete method should possibly take an FS::cust_main object reference
7060 instead of a scalar customer number.
7062 Bill and collect options should probably be passed as references instead of a
7065 There should probably be a configuration file with a list of allowed credit
7068 No multiple currency support (probably a larger project than just this module).
7070 payinfo_masked false laziness with cust_pay.pm and cust_refund.pm
7072 Birthdates rely on negative epoch values.
7074 The payby for card/check batches is broken. With mixed batching, bad
7077 B<collect> I<invoice_time> should be renamed I<time>, like B<bill>.
7081 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
7082 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
7083 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.